Import existing Perl code

1 files changed, 501 insertions, 0 deletions

diff --git a/src/eslaides b/src/eslaides
new file mode 100755
index 0000000..d80977a
--- /dev/null
+++ b/src/eslaides
@@ -0,0 +1,501 @@
+#!/usr/bin/env perl
+
+use v5.34;
+use warnings;
+use feature 'signatures';
+no warnings ('experimental::signatures');
+use Getopt::Std ();
+use JSON ();
+
+
+sub usage($fh) {
+	print $fh <<~'EOF'
+		Usage:
+		  eslaides [-c CONFIG] [FILE]
+		  eslaides -h
+		EOF
+}
+
+sub help($fh) {
+	print $fh <<~'EOF'
+
+
+		Options:
+		  -h, --help    show this message
+		  -c CONFIG     use configuration from CONFIG
+
+
+		Emit PostScript slideshow file from input "*.slides" content.
+		If FILE is not given, get data from STDIN.
+
+
+		Examples:
+
+		  Generate PostScript for "keynote.slides", using config
+		  from "eslaides.json":
+
+		    $ eslaides -c eslaides.json keynote.slides > keynote.ps
+
+
+		  Generate final PDF in a pipeline:
+
+		    $ eslaides kn.slides | ps2pdf - > kn.pdf
+		EOF
+}
+
+
+for (@ARGV) {
+	last if $_ eq '--';
+	if ($_ eq '--help') {
+		usage *STDOUT;
+		help *STDOUT;
+		exit;
+	}
+}
+
+my %opts;
+if (!Getopt::Std::getopts('c:h', \%opts)) {
+	usage *STDERR;
+	exit 2;
+}
+
+if ($opts{h}) {
+	usage *STDOUT;
+	help *STDOUT;
+	exit;
+
+}
+
+
+
+sub load_json($fname) {
+	my $str = do {
+		open my $fh, $fname or die "Failed opening \"$fname\"";
+		local $/;
+		<$fh>;
+	};
+	return %{JSON::decode_json($str)};
+}
+
+my %DEFAULT_CONFIG = (
+	'fonts-reencoding'      => 'ISOLatin1Encoding',
+
+	'header-height'         => 75,
+	'header-color'          => '0 0 0',
+	'background-color'      => '1 1 1',
+	'line-color'            => '0 0 0',
+
+	'frontpage-font-family' => 'Helvetica',
+	'frontpage-font-size'   => 60,
+	'frontpage-font-color'  => '0.5 0.5 0.9',
+
+	'author-font-family'    => 'Times-Italic',
+	'author-font-size'      => 40,
+	'author-font-color'     => '0 0 0',
+
+	'title-font-family'     => 'Helvetica',
+	'title-font-size'       => 40,
+	'title-font-color'      => '0.5 0.5 0.9',
+
+	'main-font-family'      => 'Courier',
+	'main-font-size'        => 30,
+	'main-font-color'       => '0 0 0',
+
+	'code-font-family'      => 'Courier',
+	'code-font-size'        => 18,
+	'code-font-color'       => '0 0 0',
+
+	'tiny-font-family'      => 'Times',
+	'tiny-font-size'        => 18,
+	'tiny-font-color'       => '0 0 0',
+);
+
+my %c = (
+	%DEFAULT_CONFIG,
+	$opts{c} ? load_json($opts{c}) : (),
+);
+
+
+sub preamble() {
+	my %fonts = ();
+	for (keys %c) {
+		next if !/.*-font-family$/;
+		$fonts{$c{$_}} = 1;
+	}
+	my $fonts_reencoding = '';
+	$fonts_reencoding .= "/$_ /$_ reencode\n" for (keys %fonts);
+
+	print <<~EOF;
+		%!PS-Adobe-3.0 
+		%%DocumentMedia: SLIDE 842 595 0 () () 
+		%%EndComments 
+		%%BeginDefaults 
+		%%PageMedia: SLIDE
+		%%EndDefaults 
+		<< /PageSize [842 595] /ImagingBBox null >> setpagedevice 
+
+		/reencode {
+			exch
+			findfont
+			dup length dict
+			begin
+			{       
+				1 index /FID ne
+				{ def }
+				{ pop pop }
+				ifelse
+			} forall
+			/Encoding $c{'fonts-reencoding'} def
+			currentdict
+			end
+			definefont pop
+		} def
+		$fonts_reencoding
+
+		/headerheight $c{'header-height'} def
+
+		/frontfontsz  $c{'frontpage-font-size'} def
+		/authorfontsz $c{'author-font-size'}    def
+		/titlefontsz  $c{'title-font-size'}     def
+		/mainfontsz   $c{'main-font-size'}      def
+		/codefontsz   $c{'code-font-size'}      def
+		/tinyfontsz   $c{'tiny-font-size'}      def
+
+		/titlefont  /$c{'title-font-family'}     findfont titlefontsz  scalefont def
+		/mainfont   /$c{'main-font-family'}      findfont mainfontsz   scalefont def
+		/codefont   /$c{'code-font-family'}      findfont codefontsz   scalefont def
+		/tinyfont   /$c{'tiny-font-family'}      findfont tinyfontsz   scalefont def
+		/frontfont  /$c{'frontpage-font-family'} findfont frontfontsz  scalefont def
+		/authorfont /$c{'author-font-family'}    findfont authorfontsz scalefont def
+		/authorfonttwo /Times findfont authorfontsz scalefont def
+
+
+		/pagewidth  842 def
+		/pageheight 595 def
+		/leftmargin 30  def
+		/topmargin  595 def
+
+		/pad 10 def
+
+		/titlefonth  titlefontsz  pad add def
+		/mainfonth   mainfontsz   pad add def
+		/codefonth   codefontsz   pad add def
+		/tinyfonth   tinyfontsz   pad add def
+		/frontfonth  frontfontsz  pad add def
+		/authorfonth authorfontsz pad add def
+
+		/headermargin
+			pageheight headerheight titlefonth sub 2 div titlefontsz add sub
+		def
+		/rightmargin pagewidth leftmargin sub def
+		/tbtop topmargin def
+		/ypos topmargin def
+
+		/xcur { currentpoint pop      } def
+		/ycur { currentpoint exch pop } def
+
+		/wordbreak ( ) def
+		/linewrap {
+			/proc exch def
+			/linelength exch def
+			/textstring exch def
+			/breakwidth wordbreak stringwidth pop def
+			/curwidth 0 def
+			/lastwordbreak 0 def
+			/startchar 0 def
+			/restoftext textstring def
+			{
+				restoftext wordbreak search
+				{
+					/nextword exch def pop
+					/restoftext exch def
+					/wordwidth nextword stringwidth pop def
+					curwidth wordwidth add linelength gt
+					{
+						textstring startchar
+						lastwordbreak startchar sub
+						getinterval proc
+						/startchar lastwordbreak def
+						/curwidth wordwidth breakwidth add def
+					}
+					{
+						/curwidth curwidth wordwidth add
+						breakwidth add def 
+					} ifelse
+					/lastwordbreak lastwordbreak
+					nextword length add 1 add def
+				}
+				{
+					pop exit
+				} ifelse
+			} loop
+			/lastchar textstring length def
+			textstring startchar lastchar startchar sub 
+			getinterval proc
+		} def
+
+		/line {
+			$c{'line-color'} setrgbcolor
+			0.5 setlinewidth
+			leftmargin ypos moveto
+			rightmargin ypos lineto
+			stroke
+		} def
+
+		/center {
+			dup
+			/str exch def
+			/sw str stringwidth pop def
+			/xpos pagewidth sw sub 2 div xcur sub def
+			xpos 0 rmoveto
+		} def
+
+		/objcenter {
+			pagewidth exch sub 2 div 0 translate
+		} def
+
+		/s {
+			/tbtop topmargin def
+			/ypos topmargin def
+			$c{'background-color'} setrgbcolor
+			0 setlinewidth
+			newpath
+			0 pageheight moveto
+			pagewidth pageheight lineto
+			pagewidth 0 lineto
+			0 0 lineto
+			closepath
+			fill
+			stroke
+		} def
+
+		/l {
+			/h exch def
+			/ypos ypos h sub def
+			leftmargin ypos moveto
+		} def
+
+		/title {
+			frontfonth l
+			frontfont setfont
+			$c{'frontpage-font-color'} setrgbcolor
+			{ pagewidth leftmargin 2 mul sub }
+			{ frontfonth l center show }
+			linewrap
+			frontfonth 2 div l
+			frontfonth l
+		} def
+
+		/author {
+			authorfont setfont
+			$c{'author-font-color'} setrgbcolor
+			{ pagewidth leftmargin 2 mul sub }
+			{ authorfonth l center show }
+			linewrap
+		} def
+
+		/authortwo {
+			authorfonttwo setfont
+			$c{'author-font-color'} setrgbcolor
+			{ pagewidth leftmargin 2 mul sub }
+			{ authorfonth l center show }
+			linewrap
+		} def
+
+		/header {
+			/ypos pageheight headerheight sub def
+			$c{'header-color'} setrgbcolor
+			0 setlinewidth
+			newpath
+			0 pageheight moveto
+			pagewidth pageheight lineto
+			pagewidth ypos lineto
+			0 ypos lineto
+			closepath
+			fill
+			stroke
+			leftmargin headermargin moveto
+			titlefont setfont 
+			$c{'title-font-color'} setrgbcolor
+			center show
+			leftmargin ypos moveto
+		} def
+
+		/n {
+			mainfont setfont
+			$c{'main-font-color'} setrgbcolor
+			{ pagewidth leftmargin 2 mul sub }
+			{ mainfonth l show }
+			linewrap
+		} def
+
+		/cn {
+			codefont setfont
+			$c{'code-font-color'} setrgbcolor
+			{ pagewidth leftmargin 2 mul sub }
+			{ codefonth l show }
+			linewrap
+		} def
+
+		/tn {
+			tinyfont setfont
+			$c{'tiny-font-color'} setrgbcolor
+			{ pagewidth leftmargin 2 mul sub }
+			{ tinyfonth l show }
+			linewrap
+		} def
+
+		/is {
+			/level1 save def
+			/showpage {} def
+		} def
+
+		/ie {
+			level1 restore
+		} def
+
+		/bs {
+			/tbtop ypos def
+		} def
+
+		/be {
+			/tm tbtop pad sub def
+			/bm ypos pad sub def
+			newpath
+			leftmargin 10 sub tm moveto
+			rightmargin tm lineto
+			rightmargin bm lineto
+			leftmargin 10 sub bm lineto
+			closepath
+			$c{'line-color'} setrgbcolor
+			0.5 setlinewidth
+			stroke
+		} def
+		EOF
+}
+
+sub postamble() {
+	print <<~'EOF';
+		
+		showpage
+
+		%%EOF
+		EOF
+}
+
+sub img($fname) {
+	if (!($fname=~/\.ps$/)) {
+		print STDERR `convert '$fname' '$fname.ps'`;
+		die if $?;
+		$fname = $fname . '.ps';
+	}
+	open (my $fh, "<", $fname) or die "Cannot open image file \"$fname\"";
+	print "is\n";
+	my $s;
+	for ($s=""; <$fh>; $s.=$_) {
+		if ($_=~/%%BoundingBox: -?\d+ -?\d+ (-?\d+) -?\d+/) {
+			print "$1 objcenter\n";
+			last;
+		}
+	}
+	print "%%BeginDocument: $fname\n$s",<$fh>,"\n\n%%EndDocument\nie\n";
+	close $fh;
+}
+
+
+my $pages = 1;
+my $code = 0;
+my $bgimg = "";
+
+sub emit_line {
+	s/[\r\n]+//g;
+	s/([^^])\\/$1\\\\/g;
+	s/(\(|\))/\\$1/g;
+	/^([^\t])/ && $code && do {
+		print "be\n";
+		$code = 0;
+	};
+
+	/^%/ && return;
+	/^$/ && return;
+
+	/^---$/ && do {
+		print "showpage\n";
+		print "%%Page: $pages $pages\n";
+		print "s\n";
+		if ($bgimg ne "") {
+			img $bgimg;
+		}
+		$pages++;
+		return;
+	};
+	/^\t(.*)/ && do {
+		if (!$code) {
+			print "bs\n";
+			$code = 1;
+		}
+		print "($1) cn\n";
+		return;
+	};
+	/^#([^#].*)$/ && do {
+		print "($1) title\n";
+		return;
+	};
+	/^##(.*)/ && do {
+		print "($1) header\n";
+		return;
+	};
+	/^\.+$/ && do {
+		print "() n\n" x length;
+		return;
+	};
+	/^@([^@].*)/ && do {
+		print "($1) authortwo\n";
+		return;
+	};
+	/^@@(.*)/ && do {
+		print "($1) author\n";
+		return;
+	};
+	/^\[(.*)\]/ && do {
+		img $1;
+		return;
+	};
+	/^\{(.*)\}/ && do {
+		$bgimg = $1;
+		return;
+	};
+	/^_(.*)/ && do {
+		print "($1) tn\n";
+		return;
+	};
+	s/^\\//;
+	print "($_) n\n";
+}
+
+
+sub main() {
+	preamble;
+	emit_line while (<>);
+	postamble;
+}
+
+main;
+
+
+__END__
+
+=head1 eslaides
+
+eslaides - generate PostScript slideshows from input "*.slides" text files
+
+=head1 SYNOPSYS
+
+eslaides [FILE]
+
+eslaides -h
+
+=cut
+
+# FIXME: Verdana not working
+# FIXME: authorfonttwo