view release on metacpan or  search on metacpan

bin/html2ps  view on Meta::CPAN

  }
  $hword="";
  for $i (0..$len-1) {
    $hword.=substr($_[0],$i,1);
    if(($h || $i>$hyphenation{'start'}-2 && $i<$len-$hyphenation{'end'})
      && $br[$i+2]%2==1) {$hword.=")HY("};
  }
  $hword.=")YH(" if(length $word < length $hword);
  $hword;
}
sub setel {
  $el=$_[0];
  eval "\%arr=\%$el";
  &fs($el);
  push(@font,$fontid{"\L$font"});
  push(@styl,$styl);
  push(@size,$arr{'font-size'});
  push(@alig,$algn{$arr{'text-align'}}-1);
  push(@topm,$arr{'margin-top'});
  push(@botm,$arr{'margin-bottom'});
  push(@lftm,$arr{'margin-left'});
  push(@rgtm,$arr{'margin-right'});
  push(@colr,$col eq "[16#00 16#00 16#00]"?0:$col);
  $temp=$arr{'margin-top'}*$arr{'font-size'};
  $mi=$temp if($temp>$mi);
  $temp=$arr{'margin-bottom'}*$arr{'font-size'};
  $mi=$temp if($temp>$mi);
}
sub fs {
  $arr{'font-family'}='times' if($el ne 'p' && !$latin1 && !defined $arr{$_});
  for ("font-family","font-size") {
    $arr{$_}=$body{$_} if(!defined $arr{$_});
  }
  ($font=$arr{'font-family'})=~s/\W/-/g;
  if(!$font_names{"\L$font"}) {$font=$fal{$font}};
  if(!$font_names{"\L$font"}) {
    &dbg("Unknown font: $arr{'font-family'}, using $deffnt{$_[0]}\n");
    $font=$deffnt{$_[0]};
  }
  if(!defined $fontid{"\L$font"}) {
    $fontid{"\L$font"}=$nfont++;
    @names=split(/\s+/,$font_names{"\L$font"});
    for($#names+1..3) {push(@names,$names[0])};
    @docfonts=(@docfonts,@names);
  }
  &getval($arr{"font-size"},2);
  for ('left','right','top','bottom') {
    $arr{"margin-$_"}=0 if(!defined $arr{"margin-$_"});
  }
  for ($arr{"text-indent"},$arr{"margin-top"},$arr{"margin-bottom"},
       $arr{"margin-left"},$arr{"margin-right"}) {
    &getval($_,0);
  }
  $styl=$arr{'font-style'}=~/^(i|o)/+2*($arr{'font-weight'}=~/^b/);
  $col=$arr{'color'}?&col2rgb($arr{'color'}):-1;
}
sub img {
  local($_,$red,$grn,$blu)=@_;
  local($beg,$end);
  ($red,$grn,$blu)=("FF","FF","FF") if(!$opt_U || $red.$grn.$blu !~ /^\w{6}$/);
  while (/<(img|fig|hr|overlay|object)\s/i) {
    $imgcmd="\L$1";
    $beg=$`;
    $'=~/>/;
    $img=" $`";
    $end=$';
    $img=~s/\n/ /g;
    if($imgcmd ne "object" || $img=~/data\s*=\s*['"]?([\w\/\.:~%-]+\.$IM)/i
       || $img=~/type\s*=\s*['"]?(image\/|application\/postscript)/i){
    if($opt_T) {
      &getalt;
    } else {
      $al=0;
      $off="";
      ($align)=$img=~/align\s*=\s*['"]?(\w*)/i;
      if($align=~/^middle$/i) {$al=1};
      if($align=~/^top$/i) {$al=2};
      if($imgcmd eq "overlay") {
        $al=4;
        $xoff=0;
        $yoff=0;
        if($img=~/\s*x\s*=\s*['"]?(\d+)/i) {$xoff=$1};
        if($img=~/\s*y\s*=\s*['"]?(\d+)/i) {$yoff=$1};
        $off="$xoff $yoff ";
      }
      $url="";
      if($img=~/\s(src|data)\s*=\s*($S)/i) {($url)=$+=~/([^ \n]*)/};
      &dbg("Image: $url\n") if($opt_d && $url);
      $URL=$url;
      unless($url=~m|://|) {
        $url=~s/^file://;
        if($url=~m|^/|) {$URL=$b1.$url} else {$URL=$b2.$url}
      }
      while($URL!~m|^\.\./| && $URL=~m|[^/]*/\.\./|) {$URL=$`.$'};
      $URL=~s|/\./|/|g;
      $text=$src{$URL}?$cmd{$URL.$red.$grn.$blu}:$cmd{$URL};
      if(!$text || $opt_U && $src{$URL} && !$cmd{$URL.$red.$grn.$blu}) {
        if(!$url || $failed{$url}) {
          &getalt;
        } else {
          &pictops;
          if($bm || $ps) {
            &dbg("Size: $xs*$ys\n") if($opt_d);
            $nimg++;
            push(@XS,$xs);
            push(@YS,$ys);
            if($bm) {
              $nm++;
              push(@DP,$dp);
              push(@BM,$bm);
              push(@WS,int(($xs-1)*$dp/8)+1);
              push(@FC,$fc);
              push(@IX,$nm);
              push(@IT,0);
            }
            if($ps) {
              $nps--;
              push(@IX,$nps);
              push(@IT,1);
              $nli=30000;
              $n=1;
              $npr=$ps=~s|(.*\n){$nli}|sprintf("$&} D\n/P$nimg\_%d {",$n++)|eg;
              if($npr) {
                $proc=" (";
                for $i (0..$npr) {
                  $proc.="P$nimg\_$i ";
                }
                $proc.=")";
                $pv.="/P$nimg\_0 {$ps} D\n";
                $eps{"P$nimg\_0"}=$ps;
              } else {
                $proc=" (P$nimg)";
                $pv.="/P$nimg {$ps} D\n";
                $eps{"P$nimg"}=$ps;
              }
            }
            $text="$proc $nimg IM(";
            $cmd{$URL}=$text if(!$cmd{$URL});
            $cmd{$URL.$red.$grn.$blu}=$text if($src{$URL});
            $proc="";
            $end=$' if($imgcmd eq "object" && $end=~m|</object>|i);
          } else {
            &getalt;
            $failed{"$url"}=1;
          }
        }
      } elsif($imgcmd eq "object" && $end=~m|</object>|i) {
        $end=$';
      }
    }
    if($cmd{$URL}) {
      $text=")".$off.$al.$text;
      if($imgcmd eq "fig") {
        $end=~m|</fig>|i;
        $fig=$`;
        $end=$';
        $over="";
        while($fig=~/(<overlay$R)/ig) {$over.=$1};
        ($dum,$cap)=$fig=~m|<caption$R([\w\W]*)</caption>|i;
        ($dum,$cred)=$fig=~m|<credit$R([\w\W]*)</credit>|i;
        $text=")BN($text$over)BN($cap)BN($cred)BN(";
      }
    }
    }
    $_=$beg.$text.$end;
  }
  s|<[hH][rR]$R|)2 1 1 HR(|g;
  $_[0]=$_;
}
sub getval{
  local($val,$unit)=$_[0]=~/$V\s*(\w*)/g;
  $val*=$cm{$unit} if($_[1]==1 && defined $cm{$unit});
  $val*=$pt{$unit} if($_[1]==2 && defined $pt{$unit});
  $_[0]=$val;
}
sub getconf {
  local($_)=@_;
  while(/\@import\s+(([\w.\/-]+)|"([^"]*)"|'([^']*)')\s*;/) {
    if(open(SS,"<$+") && !$read{$+}) {
      $conf=<SS>;
      $_=$`.$conf.$';
      print DBG "***** $+:\n$conf" if($opt_d);
      close SS;
      $read{$+}=1;
    } else {
      &dbg($read{$+}?"Infinite \@import loop: $+\n":"Error opening: $+\n");
      $_=$`.$';
    }
  }
  @block=();
  while(&getblk($_)){};
}
sub getblk {
  local($_)=@_;
  local ($beg,$match,$end,$blk,$key,$val,$id,$temp);
  while(/^\s*\/\*/) {
    /\*\/|$/;
    $_=$';
  }
  return 0 if !/\S/;
  /[\w,:.@\s-]+\{/;
  $_=$';
  ($id=$&)=~s/^\s*|\s*\{//g;
  $id=lc $id;
  push(@block,"\L$id");
  if($#block==1) {
    $valid{$id}=1 if(!$user);
    if($id eq "color") {$id="colour"};
    if(!$valid{$id}) {
      &dbg("Error in configuration file: unknown block name '$id'\n");
    }
  }
  $blk="";
  W:while(/\s*(\/\*|[\w][\w-]*\s*:|[\w,:.\s-]+\{|\})\s*/) {
    $blk.=$1 if($1 ne "/*");
    $beg=$`;
    $match=$1;
    $end=$';