Follow-up Comment #1, bug #68826 (group groff): These commits are cued up on my development branch awaiting end of code freeze:-
commit 88b99fb0437bc35ebf465811fc120fad2b191850 Author: Deri James <[email protected]> Date: Sat Oct 24 17:14:37 2026 +0100 [gropdf] Remove undocumented code. * src/devices/gropdf/gropdf.pl (do_x): Remove code for 'import'. Start fix for <https://savannah.gnu.org/bugs/index.php?68826>. diff --git a/src/devices/gropdf/gropdf.pl b/src/devices/gropdf/gropdf.pl index f4504eb7f..792f7d86f 100644 --- a/src/devices/gropdf/gropdf.pl +++ b/src/devices/gropdf/gropdf.pl @@ -1630,71 +1630,7 @@ sub do_x } elsif (lc($xprm[0]) eq 'pdf:') { - if (lc($xprm[1]) eq 'import') - { - my $fil=$xprm[2]; - my $llx=$xprm[3]; - my $lly=$xprm[4]; - my $urx=$xprm[5]; - my $ury=$xprm[6]; - my $wid=GetPoints($xprm[7]); - my $hgt=GetPoints($xprm[8])||-1; - my $mat=[1,0,0,1,0,0]; - - if (!exists($incfil{$fil})) - { - if ($fil=~m/\.pdf$/) - { - $incfil{$fil}=LoadPDF($fil,$mat,$wid,$hgt,"import"); - } - elsif ($fil=~m/\.swf$/) - { - my $xscale=$wid/($urx-$llx+1); - my $yscale=($hgt<=0)?$xscale:($hgt/($ury-$lly+1)); - $hgt=($ury-$lly+1)*$yscale; - - if ($rot) - { - $mat->[3]=$xscale; - $mat->[0]=$yscale; - } - else - { - $mat->[0]=$xscale; - $mat->[3]=$yscale; - } - - $incfil{$fil}=LoadSWF($fil,[$llx,$lly,$urx,$ury],$mat); - } - else - { - Warn("unrecognized 'import' file type '$fil'"); - return undef; - } - } - - if (defined($incfil{$fil})) - { - IsGraphic(); - if ($fil=~m/\.pdf$/) - { - my $bbox=$incfil{$fil}->[1]; - my $xscale=d3($wid/($bbox->[2]-$bbox->[0]+1)); - my $yscale=d3(($hgt<=0)?$xscale:($hgt/($bbox->[3]-$bbox->[1]+1))); - $wid=($bbox->[2]-$bbox->[0])*$xscale; - $hgt=($bbox->[3]-$bbox->[1])*$yscale; - $ypos+=$hgt; - $stream.="q $xscale 0 0 $yscale ".PutXY($xpos,$ypos)." cm"; - $stream.=" 0 1 -1 0 0 0 cm" if $rot; - $stream.=" /$incfil{$fil}->[0] Do Q\n"; - } - elsif ($fil=~m/\.swf$/) - { - $stream.=PutXY($xpos,$ypos)." m /$incfil{$fil} Do\n"; - } - } - } - elsif (lc($xprm[1]) eq 'pdfpic' or lc($xprm[1]) eq 'inline') + if (lc($xprm[1]) eq 'pdfpic' or lc($xprm[1]) eq 'inline') { my $fil=URIName($xprm[2]); my $flag=uc($xprm[3]||'-L'); And the new code:- commit 9a78f41d649b3bceae5890097732f47855ef9201 Author: Deri James <[email protected]> Date: Sat Oct 24 17:50:40 2026 +0100 [gropdf] New device command 'pdf: put'. * src/devices/gropdf/gropdf.pl (do_x): Add code for 'pdf: put. (LoadImage) New. Common code for 'pdf: pdfpic' and 'pdf: put' Continue fix for <https://savannah.gnu.org/bugs/index.php?68826>. diff --git a/src/devices/gropdf/gropdf.pl b/src/devices/gropdf/gropdf.pl index 792f7d86f..9194c8bd3 100644 --- a/src/devices/gropdf/gropdf.pl +++ b/src/devices/gropdf/gropdf.pl @@ -1630,7 +1630,89 @@ sub do_x } elsif (lc($xprm[0]) eq 'pdf:') { - if (lc($xprm[1]) eq 'pdfpic' or lc($xprm[1]) eq 'inline') + if (lc($xprm[1]) eq 'put') + { + my $fil=URIName($xprm[2]); + my $marg=0; + my ($X,$Y,$wid,$hgt)=(0,0,0,0); + if (lc($xprm[3]) eq 'page') + { + $X='page'; + $marg=defined($xprm[4])?GetPoints($xprm[4]):0; + } + else + { + $X=GetPoints($xprm[3])||0; + $Y=GetPoints($xprm[4])||0; + $wid=GetPoints($xprm[5])||0; + $hgt=GetPoints($xprm[6])||0; + Warn("width and height parameters to 'pdf: import $fil' must be present and can't be zero'") if (1*$wid*$hgt)==0; + } + + my $mat=[1,0,0,1,0,0]; + + my ($imgtype,$info,$image,$FDnm)=(LoadImage($fil,$wid,$hgt)); + + if (defined($incfil{$fil})) + { + IsGraphic(); + my $bbox=$incfil{$fil}->[1]; + $imgtype=$incfil{$fil}->[2]; + Warn("Failed to extract width x height for '$FDnm'"),return if !defined($bbox->[2]) or !defined($bbox->[3]); + if ($X eq 'page') + { + $X=$marg; + $Y=$marg; + $wid=$mediabox[2]-$mediabox[0]-2*$marg; + $hgt=$mediabox[3]-$mediabox[1]-2*$marg; + if ($rot) + { + my $tx=$wid; + $wid=$hgt; + $hgt=$tx; + } + } + else + { + $wid=($bbox->[2]-$bbox->[0]) if $wid == 0 and $hgt == 0; + } + if ($hgt > 0) + { + $Y+=$hgt; + } + + $hgt=abs($hgt); + $wid=($bbox->[2]-$bbox->[0]) if $wid == 0 and $hgt == 0; + my $xscale=d3($wid/($bbox->[2]-$bbox->[0])); + my $yscale=d3($hgt/($bbox->[3]-$bbox->[1])); + if ($rot) + { + my $tx=$xscale; + $xscale=$yscale; + $yscale=$tx; + } + + if ($imgtype ne 'PDF') + { + if ($rot) + { + $xscale*=$bbox->[3]; + $yscale*=$bbox->[2]; + } + else + { + $xscale*=$bbox->[2]; + $yscale*=$bbox->[3]; + } + + } + + $stream.="q $xscale 0 0 $yscale ".PutXY($X,$Y)." cm"; + $stream.=" 0 1 -1 0 0 0 cm" if $rot; + $stream.=" /$incfil{$fil}->[0] Do Q\n"; + } + } + elsif (lc($xprm[1]) eq 'pdfpic' or lc($xprm[1]) eq 'inline') { my $fil=URIName($xprm[2]); my $flag=uc($xprm[3]||'-L'); @@ -1638,83 +1720,8 @@ sub do_x my $hgt=GetPoints($xprm[5]||-1); my $ll=GetPoints($xprm[6]||0); my $mat=[1,0,0,1,0,0]; - my $imgtype='PDF'; - my $info; - my $image; - my ($FD,$FDnm)=OpenInc($fil); - - if (!defined($FD)) - { - Warn("failed to open image file '$FDnm'"); - return; - } - - if (!exists($incfil{$fil})) - { - if ($gotexif and $FDnm!~m/\.pdf$/i) - { - binmode $FD; - - $image = Image::Magick->new; - my $x = $image->Read(file => $FD); - Warn("Image '$FDnm': $x"), return if "$x"; - $imgtype=$image->Get('magick'); - $info->{ImageWidth}=$image->Get('width'); - $info->{ImageHeight}=$image->Get('height'); - $info->{ColorComponents}= - ($image->Get('colorspace') eq 'Gray')?1:3; - } - else - { - my $dim=`( identify $FDnm 2>/dev/null || file $FDnm )`; - if ($dim=~m/(?:[,=A-Z]|JP2) (\d+)\s*x\s*(\d+)/) - { - $info->{ImageWidth}=$1; - $info->{ImageHeight}=$2; - } - elsif ($dim=~m/height=(\d+).+width=(\d+)/) - { - $info->{ImageWidth}=$2; - $info->{ImageHeight}=$1; - } - - if ($dim=~m/JPEG \d+x|JFIF/) - { - $imgtype='JPEG'; - $info->{ColorComponents}=3; - - if ($dim=~m/Gray|components 1/) - { - $info->{ColorComponents}=1; - } - } - elsif ($dim=~m/JP2 \d+x/) - { - $imgtype='JP2'; - } - } - - if ($imgtype eq 'PDF') - { - $incfil{$fil}=LoadPDF($FD,$FDnm,$mat,$wid,$hgt,"pdfpic"); - } - elsif ($imgtype eq 'JPEG') - { - $incfil{$fil}=LoadJPEG($FD,$FDnm,$info); - } - elsif ($imgtype eq 'JP2') - { - $incfil{$fil}=LoadJP2($FD,$FDnm,$info); - } - else - { - $incfil{$fil}=LoadMagick($image,$FDnm,$info); - } - - return if !defined($incfil{$fil}); - $incfil{$fil}->[2]=$imgtype; - } + my ($imgtype,$info,$image,$FDnm)=(LoadImage($fil,$wid,$hgt)); if (defined($incfil{$fil})) { @@ -2041,6 +2048,100 @@ sub do_x } } +sub LoadImage +{ + my $fil=shift; + my $wid=shift; + my $hgt=shift; + my $mat=[1,0,0,1,0,0]; + my $imgtype='PDF'; + my $info; + my $image; + my ($FD,$FDnm)=OpenInc($fil); + + if (!defined($FD)) + { + Warn("failed to open image file '$FDnm'"); + return; + } + + if (!exists($incfil{$fil})) + { + if ($gotexif and $FDnm!~m/\.pdf$/i) + { + binmode $FD; + + $image = Image::Magick->new; + my $x = $image->Read(file => $FD); + Warn("Image '$FDnm': $x"), return if "$x"; + $imgtype=$image->Get('magick'); + $info->{ImageWidth}=$image->Get('width'); + $info->{ImageHeight}=$image->Get('height'); + $info->{ColorComponents}= + ($image->Get('colorspace') eq 'Gray')?1:3; + $info->{matte}=$image->Get('matte'); + } + else + { + my $dim=`( identify '$FDnm' 2>/dev/null || file '$FDnm')`; + if ($dim=~m/(?:[,=A-Z]|JP2) (\d+)\s*x\s*(\d+)/) + { + $info->{ImageWidth}=$1; + $info->{ImageHeight}=$2; + } + elsif ($dim=~m/height=(\d+).+width=(\d+)/) + { + $info->{ImageWidth}=$2; + $info->{ImageHeight}=$1; + } + + if ($dim=~m/JPEG \d+x|JFIF/) + { + $imgtype='JPEG'; + $info->{ColorComponents}=3; + + if ($dim=~m/Gray|components 1/) + { + $info->{ColorComponents}=1; + } + } + elsif ($dim=~m/(?:JP2|J2K|J2C) \d+x/) + { + $imgtype='JP2'; + } + } + + if ($imgtype eq 'PDF') + { + $incfil{$fil}=LoadPDF($FD,$FDnm,$mat,$wid,$hgt,"pdfpic"); + } + elsif ($imgtype eq 'JPEG') + { + $incfil{$fil}=LoadJPEG($FD,$FDnm,$info); + } + elsif ($imgtype eq 'JP2' or $imgtype eq 'J2K') + { + $incfil{$fil}=LoadJP2($FD,$FDnm,$info,$image); + } + else + { + if ($gotexif) + { + $incfil{$fil}=LoadMagick($image,$FDnm,$info); + } + else + { + Warn("'$FDnm' cannot be embedded in the pdf until perlmagick is installed (only pdf, jpg and jp2 files can be embedded without it)"); + } + } + + return if !defined($incfil{$fil}); + $incfil{$fil}->[2]=$imgtype; + } + + return($imgtype,$info,$image,$FDnm); +} + sub URIName { my $s=shift; _______________________________________________________ Reply to this item at: <https://savannah.gnu.org/bugs/?68826> _______________________________________________ Message sent via Savannah https://savannah.gnu.org/
signature.asc
Description: PGP signature
