From f2e5d496d6c9141835b36d2e96f1a0db0b25c08b Mon Sep 17 00:00:00 2001 From: EuAndreh Date: Wed, 30 Apr 2025 11:37:06 -0300 Subject: Import existing Perl code --- Makefile | 88 +++++++++++ deps.mk | 3 + mkdeps.sh | 7 + src/eslaides | 501 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 599 insertions(+) create mode 100644 Makefile create mode 100644 deps.mk create mode 100755 mkdeps.sh create mode 100755 src/eslaides diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..c919089 --- /dev/null +++ b/Makefile @@ -0,0 +1,88 @@ +.POSIX: +DATE = 1970-01-01 +VERSION = 0.1.0 +NAME = eslaides +NAME_UC = $(NAME) +LANGUAGES = en +## Installation prefix. Defaults to "/usr". +PREFIX = /usr +BINDIR = $(PREFIX)/bin +LIBDIR = $(PREFIX)/lib +INCLUDEDIR = $(PREFIX)/include +SRCDIR = $(PREFIX)/src/$(NAME) +SHAREDIR = $(PREFIX)/share +LOCALEDIR = $(SHAREDIR)/locale +MANDIR = $(SHAREDIR)/man +EXEC = ./ +## Where to store the installation. Empty by default. +DESTDIR = +LDLIBS = + + + +.SUFFIXES: + + + +all: +include deps.mk + +sources = \ + $(sources.sh) \ + + +derived-assets = \ + +side-assets = \ + + + +## Default target. Builds all artifacts required for testing +## and installation. +all: $(derived-assets) + + + +check-unit: + + +check-integration: + + +## Run all tests. Each test suite is isolated, so that a parallel +## build can run tests at the same time. The required artifacts +## are created if missing. +check: check-unit check-integration + + + +## Remove *all* derived artifacts produced during the build. +## A dedicated test asserts that this is always true. +clean: + rm -rf $(derived-assets) $(side-assets) + + +## Installs into $(DESTDIR)$(PREFIX). Its dependency target +## ensures that all installable artifacts are crafted beforehand. +install: all + mkdir -p \ + '$(DESTDIR)$(BINDIR)' \ + '$(DESTDIR)$(SRCDIR)' \ + + cp $(sources.sh) '$(DESTDIR)$(BINDIR)' + cp $(sources) '$(DESTDIR)$(SRCDIR)' + + +## Uninstalls from $(DESTDIR)$(PREFIX). This is a perfect mirror +## of the "install" target, and removes *all* that was installed. +## A dedicated test asserts that this is always true. +uninstall: + rm -rf \ + '$(DESTDIR)$(SRCDIR)' \ + + for f in $(sources.sh); do \ + rm -f '$(DESTDIR)$(BINDIR)'/"$${f#src/}"; \ + done + + +ALWAYS: diff --git a/deps.mk b/deps.mk new file mode 100644 index 0000000..c9f12e7 --- /dev/null +++ b/deps.mk @@ -0,0 +1,3 @@ +sources.sh = \ + src/eslaides \ + diff --git a/mkdeps.sh b/mkdeps.sh new file mode 100755 index 0000000..72b2857 --- /dev/null +++ b/mkdeps.sh @@ -0,0 +1,7 @@ +#!/bin/sh +set -eu + +export LANG=POSIX.UTF-8 + + +find src/* -type f -perm -111 | varlist 'sources.sh' 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 -- cgit v1.2.3