view release on metacpan or  search on metacpan

Enscript.pm  view on Meta::CPAN

		       -width => $width,
		       -height => $height);
	$y = $uly;
	$page++;
	$c->delete('all');
    };

    if (defined $filename) {
	$text = _read_file($filename);
    }

    my $try_again = 0;
    foreach $line (split(/\n/, $text)) {
	$line = expand($line);
	my $i;
	my @text_args = ($llx, $y,
			 -width => $urx-$llx,
			 -text => $line, -anchor => 'nw',
			);
	eval {
	    $i = $c->createText(@text_args,
				-font => $font,
			       );
	};
	warn $@ if $@;
	if (!defined $i) {
	    warn "Can't get font <$font>, fallback to default font.\n";
	    $i = $c->createText(@text_args);
	}
	$y = ($c->bbox($i))[3];
	if ($y > $lry && !$try_again) {
	    $c->delete($i);
	    $ps_output_sub->();
	    $try_again++;
	    redo;
	}
	$try_again = 0;
    }

    $ps_output_sub->();
    $c->destroy;

    ($output, $page-1);		# gibt Output-Dateiname und Anzahl der Seiten zurück
}

sub _read_file {
    my $filename = shift;
    my $text;
    open(F, $filename) or die "Can't open $filename: $!";
    local($/) = undef;
    $text = <F>;
    close F;
    $text;
}

sub parse_cfg {
    my $cfg_file = shift;
    my @cfg_files = (Tk->findINC('enscript.cfg'));
    if (!defined $cfg_file) {
	my $home_dir = eval { local $SIG{__DIE__};
			      (getpwuid($<))[7];
			  } || $ENV{'HOME'} || '';
	my $pers_cfg_file = "$home_dir/.enscriptrc";
	if (-f $pers_cfg_file && -r $pers_cfg_file) {
	    $cfg_file = $pers_cfg_file;
	}
    }
    if (defined $cfg_file) {
	push @cfg_files, $cfg_file;
    }
    if (!@cfg_files) {
	die "Can't found any configuration enscript.cfg.";
    }

    %media = ();
    %postscript_to_x11_font = ();

    for my $cfg_file (@cfg_files) {
	open(CFG, $cfg_file)
	    or die "Can't open config file <$cfg_file>: $!";
	while(<CFG>) {
	    s/\s*\#.*//;
	    next if /^\s*$/;
	    if (/^\s*Media:\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/) {
		$media{$1} = {Width  => $2,
			      Height => $3,
			      LLX    => $4,
			      LLY    => $5,
			      URX    => $6,
			      URY    => $7};
	    } elsif (/^\s*FontMap:\s*(\S+)\s+(.*)/) {
		$postscript_to_x11_font{$1} = $2;
	    } else {
		#warn "Can't parse $_";
	    }
	}
	close CFG;
    }
}

sub postscript_to_x11_font {
    my($psfont) = @_;
    my $x11font;
    if ($psfont !~ /^(.*?)(\d+)?$/) {
	die "Can't parse postscript font $psfont";
    }
    my($font, $size) = (lc($1), $2);
    if (!defined $size) { $size = 10 }
    my $x11font_fmt = $postscript_to_x11_font{$font};
    if (!defined $x11font_fmt) {
	die "No X11 font for $font defined";
    }
    $x11font = sprintf($x11font_fmt, $size*10);
    $x11font;
}

sub x11_font_to_tk_font {
    my($t, $x11font) = @_;

    my $Font;
    if ($Tk::VERSION >= 800.012) {