#!perl5
use SGMLS;			# Use the SGMLS package.
use SGMLS::Output;		# Use stack-based output.
$debug = 0;
#
# Document Handlers.
#
$prolog = qq{%!PS-Adobe-3.0
%%Orientation: landscape
%%Pages: (atend)
%%BeginProlog
/inch { 72 mul } def
statusdict /manualfeed true put
% fonts and font sizes
/font /Times-Bold findfont def
/ttfont /Courier-Bold findfont def
/headersize 30 def
/rawsize 24 def
/bodysize 40 def
/lead 5 def
/bodylead bodysize lead add def
/rawlead rawsize 3 add def
/headerfont { font headersize scalefont setfont } def
/ttheaderfont { ttfont headersize scalefont setfont } def
/bodyfont { font bodysize scalefont setfont } def
/rawfont { font rawsize scalefont setfont } def
% page layout
/pagetop 8 inch def
/pagewidth 10 inch def
/pagebase pagetop bodylead sub def
/headerindent .25 inch def
/itemindent .5 inch def
/topline { 0 inch pagetop lead lead add sub moveto 
	   2 setlinewidth
	   pagewidth headerindent add  0 inch rlineto stroke  } def
/showtitle { 90 rotate 0.5 inch -8.5 inch translate
	     headerfont 0 inch pagetop moveto show
	     topline
	     /itemy pagebase bodylead sub def } def
/showsection { headerfont headerindent pagebase moveto show  } def
/showpageno { headerfont pagewidth pagetop moveto show  } def
/showitem { headerfont itemindent itemy moveto show
	    /itemy itemy bodylead sub def } def
/showurl { ttheaderfont itemindent itemy moveto show
	    /itemy itemy bodylead sub def } def
/showraw { rawfont itemindent itemy moveto show
	    /itemy itemy rawlead sub def } def
/finishpage { showpage } def
%%EndProlog
};
$debug && ($prolog="PROLOG HERE\n");
sgml('start', sub { output $prolog; $pageno=1;} );
$epilog=qq{%%Trailer
%%Pages: _
%%EOF
};
sgml('end', sub {
    $epilog =~ s/_/$pageno/;
    output $epilog;
});

#
# Element Handlers.
#

$lastcdata = "";
sub inittag { $lastcdata = ""; }
# Element: SLIDESHOW
sgml('<SLIDESHOW>', \&inittag);	# could do prolog here instead
sgml('</SLIDESHOW>', "");

sgml('sdata', sub { $lastcdata .= $_[0]; $debug && print STDERR  "LS: {{$lastcdata}}\n";});
sgml('cdata', sub { $lastcdata .= $_[0]; $debug && print STDERR  "LC: {{$lastcdata}}\n";});
# Element: TITLE
sgml('<TITLE>', \&inittag);
sgml('</TITLE>', sub { $savetitle = $lastcdata; $debug && print STDERR  "GOT TITLE:{{$savetitle}}\n";});

# Element: AUTHOR
sgml('<AUTHOR>', \&inittag);
sgml('</AUTHOR>', sub { $saveauthor = $lastcdata; $debug && print STDERR  "GOT AUTHOR:{{$saveauthor}}\n";});

# Element: DATE
sgml('<DATE>', \&inittag);
sgml('</DATE>', sub { $savedate = $lastcdata; $debug && print STDERR  "GOT DATE:{{$savedate}}\n";});

sgml('<SLIDE>', sub {  &inittag;
    output "%%Page: $pageno\n";
    output "($savetitle) showtitle\n";
    output "($pageno) showpageno\n"; $pageno++;
    $debug && print STDERR  "GOT SLIDE\n";});
sgml('</SLIDE>', sub { 
    output "finishpage\n";
    $debug && print STDERR  "GOT /SLIDE:{{$lastcdata}}\n";});


# Element: HEADER
sgml('</HEADER>', sub { output qq{($lastcdata) showsection\n}; $debug && print STDERR  "GOT HEADER:{{$lastcdata}}\n";});
sgml('<HEADER>', \&inittag);
# Element: BULLET
sgml('</BULLET>', sub { output qq{(·$lastcdata) showitem\n}; $debug && print STDERR  "GOT BULLET:{{$lastcdata}}\n";});
sgml('<BULLET>', \&inittag);
# Element: SUBBULLET
sgml('</SUBBULLET>', sub { output qq{(  $lastcdata) showitem\n}; $debug && print STDERR  "GOT SUBBULLET:{{$lastcdata}}\n";});
sgml('<SUBBULLET>', \&inittag);
# Element: URL
sgml('</URL>', sub { output qq{($lastcdata) showurl\n}; $debug && print STDERR  "GOT URL:{{$lastcdata}}\n";});
sgml('<URL>', \&inittag);
# Element: RAW
sgml('</RAW>', sub { $lastcdata =~ s/([(\\)])/\\\1/g; 
output qq{($lastcdata) showraw\n}; $debug && print STDERR  "GOT RAW:{{$lastcdata}}\n";});
sgml('<RAW>', \&inittag);

# Element: EPS
sub handle_eps {
    my @bbox, $llx, $lly, $urx, $ury, $wx, $wy;
    my $bbline, $content, $filename;
    # cheat, for now $lastcdata is the filename
    # output qq{($lastcdata) showurl\n};
    $debug && print STDERR  "GOT EPS:{{$lastcdata}}\n";
    $filename = $lastcdata;
    # strip out postscript comments
    $content = `sed -e 's/%.*$//' $filename`;
    # but grab the bounding box directly
    $bbline = `grep %%BoundingBox $filename`;
    @bbox = ($bbline =~ m/%%BoundingBox: (\d+) (\d+) (\d+) (\d+)/);
    ($llx, $lly, $urx, $ury) = @bbox;
    $wx = $urx - $llx;
    $wy = $ury - $lly;
    $debug && print STDERR "GOT bbox:{{".join(",",@bbox)."}}\n";
    # having extracted that, seems we should strip out all the other
    # comments, at least in xv output, but perhaps that's because it is
    # only weakly EPSF? Perhaps cheat and do it in the `cat` above?
    #
    # from EPSF Format, V3.0, appendix H of the PostScript LRM 2nd ed.
    output "save\n";
    output "itemindent $llx sub itemy $ury sub translate\n";
    output "userdict dup maxlength dict copy begin\n";
    output "/showpage { } def\n";
    output "0 setgray 0 setlinecap 1 setlinewidth\n";
    output "0 setlinejoin 10 setmiterlimit [] 0 setdash newpath\n";
    output "%%BeginDocument $filename\n";
    output $content;
    output "%%EndDocument\n";
    output "end\n";
    output "restore\n";
    output "/itemy itemy $ury sub def\n"; # update itemy for later lines
};
sgml('</EPS>', \&handle_eps);
sgml('<EPS>', \&inittag);


#
# Default handlers (uncomment these if needed).  Right now, these are set
# up to gag on any unrecognised elements, sdata, processing-instructions,
# or entities.
#
# sgml('start_element',sub { die "Unknown element: " . $_[0]->name; });
# sgml('end_element','');
# sgml('cdata',sub { output $_[0]; });
# sgml('sdata',sub { die "Unknown SDATA: " . $_[0]; });
# sgml('re',"\n");
# sgml('pi',sub { die "Unknown processing instruction: " . $_[0]; });
# sgml('entity',sub { die "Unknown external entity: " . $_[0]->name; });
# sgml('start_subdoc',sub { die "Unknown subdoc entity: " . $_[0]->name; });
# sgml('end_subdoc','');
# sgml('conforming','');

1;
