#! /usr/local/bin/perl
# -*- perl -*-
# util/cim2ps.  Generated from cim2ps.in by configure.

eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
    if 0;

# Copyright (C) 1996 Sverre Hvammen Johansen
# Department of Informatics, University of Oslo.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

$TextHeight=25.5;
$TextWidth=18;
$LineLeng=88;
$NumLines=72;
$NoNum="false";
$NoHead="false";
$SplitLongLines="true";

$LandScape="false";
# $TextHeight=16.8;
# $TextWidth=26.7;
# $LineLeng=136;
# $NumLines=48;

# Scanner for Simula

if($#ARGV>0) { die "Illegal number of arguments\n"; }
if($#ARGV==0) {
    $fileName=$ARGV[0];
    $fileName=~s/([()\\])/\\$1/g;
}
$case="prog";
$line=1;
while (<>) {
    $nl=chop($_);
    if ($nl ne "\n") { $_= $_ . $nl;}
    if (/^(%|#)/) { 
        push(@type,"directive");
	push(symb,"$_");
    } else {
#	push(@type,"indent");
#	push(@symb,0);
#        s/^( |\t)*(.*)/$2/;
        s/^(.*)( |\t)$/$1/;
        while(/([a-z]\w*|2r[01][01_]*|4r[0-3][0-3_]*|8r[0-7][0-7_]*|16r[\da-f][\da-f_]*|((\d[\d_]*)?\.\d[\d_]*|\d[\d_])?&&?(\+|-)?\d[\d_]*|(\d[\d_]*)?\.\d[\d_]*|\d[\d_]*|\/\/|\*\*|&&|:=|:-|<=|>=|<>|==|=\/=|.)/ogi) {
            push(@words, $1);
        }
        while(@words) {
            $word=shift(@words);
            if ($case eq "prog") {
		if ($word eq "!") {
		    $symb="!";
		    $case="comment";
		}
		elsif ($word eq "\"") {
		    $symb="\"";
		    $case="text";
		}
		elsif ($word eq "'") {
		    $symb="\'";
		    $case="char";
		}
		elsif ($word=~/^(activate|after|and|array|at|before|begin|boolean|character|class|delay|do|else|eq|eqv|external|false|for|ge|go|goto|gt|hidden|if|imp|in|inner|inspect|integer|is|label|le|long|lt|name|ne|new|none|not|notext|or|otherwise|prior|procedure|protected|qua|reactivate|real|ref|short|step|switch|text|then|this|to|true|until|value|virtual|when|while)$/oi) {
		    push(type,"key_word");
		    push(@symb,"$word");
		}
		elsif ($word=~/^comment$/i) {
		    $symb="$word";
		    $case="comment";
		}
		elsif ($word=~/^end$/i) {
		    push(@type,"key_word");
		    push(@symb,"$word");
		    $symb="";
		    $case="endcomment";
		}
		elsif ($word=~/^[a-z0-9]/i) {
		    push(@type,"prog");
		    push(@symb,"$word");
		}
		elsif ($word=~/\S/i) {
		    if ($word eq ";") {$par=0;}
		    elsif ($word eq "(") {$par=$par+1;}
		    elsif ($word eq ")") {$par=$par-1;}
		    if ($word eq ":-" && $par==1) {
			push(@type,"prog");
			push(@symb,":");
			push(@type,"prog");
			push(@symb,"-");
		    } else {
			push(@type,"prog");
			push(@symb,"$word");
		    }
		} else {
		    push(@type,"comment");
		    push(@symb,"$word");
		}
	    }
	    elsif ($case eq "char") {
		$symb.=$word;
		if ($word eq "'") {
		    push(@type,"prog");
		    push(@symb,"$symb");
		    $case="prog";
		}
	    }
	    elsif ($case eq "text") {
		$symb.=$word;
		if ($word eq "\"") {
		    push(@type,"prog");
		    push(@symb,"$symb");
		    $case="prog";
		}
	    }
	    elsif ($case eq "comment") {
		if ($word eq ";") {
		    $symb.=$word;
		    push(@type,"comment");
		    push(@symb,"$symb");
		    $case="prog";
		} else {
		    $symb.=$word;
		}
	    }
	    elsif ($case eq "endcomment") {
		if ($word eq ";") {
		    $par=0;
		    push(@type,"comment");
		    push(@symb,"$symb");
		    push(@type,"prog");
		    push(@symb,"$word");
		    $case="prog";
		}
		elsif ($word=~/^end$/i) {
		    push(@type,"comment");
		    push(@symb,"$symb");
		    push(@type,"key_word");
		    push(@symb,"$word");
		    $symb="";
		}
		elsif ($word=~/^(else|when|otherwise)$/i) {
		    push(@type,"comment");
		    push(@symb,"$symb");
		    push(@type,"key_word");
		    push(@symb,"$word");
		    $case="prog";
		} else {
		    push(@type,"comment");
		    push(@symb,"$word");
		}
	    }
	}
    }
    if ($case eq "char" || $case eq "text") {
	$case="prog";
    }
    if ($case eq "comment" || $case eq "endcomment") {
	push(@type,"comment");
	push(@symb,"$symb");
	$symb="";
    }
    push(@type,"nl");
    push(@symb,$line++);
}

# Printing Postscrip code

print "%!PS-Adobe-3.0 EPSF-3.0\n";
print "% cim2ps by Sverre Hvammen Johansen\n";
print "%%BoundingBox: 0 0 595 842\n";
print "%%Pages: (atend)\n";
print "%%EndComments\n";
print "%%BeginProlog\n";
print "\n";
print "/MakeISOlatin1 {  % string MakeISOlatin1 -\n";
print "  dup findfont    % Turn font with given name into an ISO Latin1 font.\n";
print "  dup length dict begin\n";
print "    { 1 index /FID ne {def} {pop pop} ifelse } forall\n";
print "    /Encoding ISOLatin1Encoding def\n";
print "    currentdict\n";
print "  end\n";
print "  definefont pop\n";
print "} def\n";
print "\n";
print "/centershow {  % string centershow -   % Write a centered string\n";
print "  dup stringwidth pop\n";
print "  neg 0.5 mul  0  rmoveto  show\n";
print "} def\n";
print "\n";
print "/rightshow {  % string rightshow -   % Write a right-justified string\n";
print "  dup stringwidth pop\n";
print "  neg 0 rmoveto  show\n";
print "} def\n";
print "\n";
print "/SetCM {  % - SetCM -  % Use cm as measure.\n";
print "  72 2.54 div dup scale  % Use cm as scale\n";
print "} def\n";
print "\n";
print "\n";
print "/N {\n";
print "  /LineDist TextHeight NumLines div def\n";
print "  /Courier findfont dup setfont\n";
print "    TextWidth\n";
print "    (M) stringwidth pop LineLeng mul\n";
print "    div scalefont setfont\n";
print "  0.01 setlinewidth\n";
print "} def\n";
print "\n";
print "\n";
print "/PN {\n";
print "  /LineDist TextHeight NumLines div def\n";
print "  /Courier findfont dup setfont\n";
print "    TextWidth\n";
print "    (M) stringwidth pop LineLeng mul\n";
print "    div scalefont setfont\n";
print "  0.01 setlinewidth\n";
print "  show\n";
print "} def\n";
print "\n";
print "\n";
print "/PB {\n";
print "  /LineDist TextHeight NumLines div def\n";
print "  /Courier-Bold findfont dup setfont\n";
print "    TextWidth\n";
print "    (M) stringwidth pop LineLeng mul\n";
print "    div scalefont setfont\n";
print "  0.01 setlinewidth\n";
print "  show\n";
print "} def\n";
print "\n";
print "\n";
print "/PO {\n";
print "  /LineDist TextHeight NumLines div def\n";
print "  /Courier-Oblique findfont dup setfont\n";
print "    TextWidth\n";
print "    (M) stringwidth pop LineLeng mul\n";
print "    div scalefont setfont\n";
print "  0.01 setlinewidth\n";
print "  show\n";
print "} def\n";
print "\n";
print "\n";
print "/PBO {\n";
print "  /LineDist TextHeight NumLines div def\n";
print "  /Courier-BoldOblique findfont dup setfont\n";
print "    TextWidth\n";
print "    (M) stringwidth pop LineLeng mul\n";
print "    div scalefont setfont\n";
print "  0.01 setlinewidth\n";
print "  show\n";
print "} def\n";
print "\n";
print "\n";
print "/PLN {  % string PLN -  % Print line number.\n";
print "  NoNum { pop }\n";
print "        { gsave NumSep neg 0 rmoveto\n";
print "            /Helvetica findfont NumsFSize scalefont setfont\n";
print "            rightshow grestore } ifelse\n";
print "  0 LineDist neg rmoveto\n";
print "} def\n";
print "\n";
print "/NPag {  % string string string NPag -  % Start a new page.\n";
print "SetCM A4rotate N\n";
print "  NoHead { pop pop pop }\n";
print "        { LeftMarg  BotMarg TextHeight add HeadSep add  moveto\n";
print "          gsave\n";
print "            /Helvetica findfont HeadFSize scalefont setfont\n";
print "            gsave show  /LeftX currentpoint pop def grestore\n";
print "            TextWidth 0 rmoveto\n";
print "            exch  dup stringwidth pop neg 0 rmoveto\n";
print "            gsave show grestore\n";
print "            LeftX currentpoint pop sub 2 div 0 rmoveto centershow\n";
print "          grestore\n";
print "          0  HeadFSize 2 div neg  rmoveto\n";
print "          TextWidth 0 rlineto  stroke } ifelse\n";
print "  LeftMarg  BotMarg TextHeight add  moveto\n";
print "} def\n";
print "\n";
print "/A4rotate { LandScape {   21 0 translate   90 rotate } { } ifelse } def\n";
print "\n";
print "/Courier MakeISOlatin1 /Courier-Bold MakeISOlatin1\n";
print "/Courier-Oblique MakeISOlatin1   /Courier-BoldOblique MakeISOlatin1\n";
print "/Helvetica MakeISOlatin1\n";
print "\n";
print "/TextHeight $TextHeight  def\n";
print "/TextWidth  $TextWidth    def\n";
print "/NumSep      0.2  def\n";
print "/LeftMarg    1.8  def\n";
print "/BotMarg     1.5  def\n";
print "/HeadSep     1.1  def\n";
print "/HeadFSize   0.4  def\n";
print "/NumsFSize   0.18 def\n";
print "/NoNum      $NoNum def\n";
print "/NoHead     $NoHead def\n";
print "\n";
print "/LineLeng $LineLeng def\n";
print "/NumLines $NumLines def\n";
print "/LandScape $LandScape def\n";
print "%%EndProlog\n";

($seq,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$mon = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Okt,Nov,Dec)[$mon];

$n=$#symb;

$printedLineNumb=0;
$lineNumb=1;
$antChar=0;
$pages=0;

sub printNewPage {
	$pages++;
	$page_line=1;
	if($pages != 1) { print "showpage\n"; }
	print "%%Page: $pages $pages\n";
	print "(Page $pages) ($mday-$mon-$year    ";
	printf ("%2d:%2d",$hour,$min);
	print ") ($fileName) NPag\n";
}

sub printNewLine {
    $antChar=0;
    print "grestore (";
    if($printedLineNumb!=$lineNumb) { print "$lineNumb"; }
    $printedLineNumb=$lineNumb;
    print ") PLN \n";
    $page_line++;
    if($page_line > $NumLines) { 
	printNewPage();
    }
    print "gsave ";

}

sub printText {
    local($text)=shift;
    local($type)=shift;
    local($length)=length($text);
    if($SplitLongLines eq "true" && $antChar+$length > $LineLeng) {
	local($text1)=substr($text,0,$LineLeng-$antChar);
	$antChar=0;
	$text1=~s/([()\\])/\\$1/g;
	print "($text1) $type ";	
	printNewLine();
	printText(substr($text,$LineLeng-$antChar,$length-
			 ($LineLeng-$antChar)),$type);
    } else
    {
	$antChar+=$length;
	$text=~s/([()\\])/\\$1/g;
	print "($text) $type ";	
    }
}

printNewPage();
print "gsave ";

for($i=0;$i<=$n;$i++) {
    if($type[$i] eq "nl") {
	printNewLine();
	$lineNumb++;
    } else
    {
	if($type[$i] eq "key_word") {
	    printText($symb[$i],"PB");
	} 
	elsif($type[$i] eq "comment") {
	    if($symb[$i] eq "\f") {
		if($i>0 && $type[$i-1] ne "nl") {
		    $page_line=$NumLines;
		    printNewLine();
		} else
		{
		    print "grestore ";
		    printNewPage();
		    print "gsave ";
		}
	    } else
	    {
		printText($symb[$i],"PO");
	    }
	}
	elsif($type[$i] eq "directive") {
	    if($symb[$i]=~/^% .*/) {
		printText($symb[$i],"PO");
	    } else
	    {
		printText($symb[$i],"PBO");
	    }
	} else
	{
	    printText($symb[$i],"PN");
	}
    }
	    
}
	
print "grestore\nshowpage\n";
print "%%Trailer\n";
print "%%Pages: $pages\n";