"

 COPYRIGHT (c) 1988 by Claus Gittinger

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

PrinterStream subclass:#PostscriptPrinterStream

       instanceVariableNames:'xPos yPos lineBuffer colNr lineNr

                              fFamily fStyle'

       classVariableNames:'Prolog Trailer

                           PageProlog PageTrailer

                           FontHeight FontWidth LeftX TopY LinesPerPage

                           Italic Bold Normal 

                           Courier Times Helvetica'

       poolDictionaries:''

       category:'Streams-External'

!

PostscriptPrinterStream comment:'

COPYRIGHT (c) 1988 by Claus Gittinger

             All Rights Reserved

'!

!PostscriptPrinterStream class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1988 by Claus Gittinger

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

version

"

"

!

documentation

"

    This class provides simple text output to postscript printers;

    to use it, evaluate 

	Smalltalk at:#Printer put:PostscriptPrinterStream

    (usually in -rc file).

    It does not support graphics and other fancy features of Postscript, but

    provides a compatible interface to line-printing (see other subclasses of

    PrinterStream).

"

! !

!PostscriptPrinterStream class methodsFor:'initialization'!

fontNames

    ^ #('/Helvetica-Oblique'

        '/Helvetica-Bold'

        '/Helvetica'

        '/Times-Italic'

        '/Times-Bold'

        '/Times'

        '/Courier-Oblique'

        '/Courier-Bold'

        '/Courier' )

!

initialize

    |tmpString t fontNr|

    super initialize.

    Normal := 0.

    Bold := 1.

    Italic := 2.

    Courier := 0.

    Times := 3.

    Helvetica := 6.

    LinesPerPage := 66.

    FontHeight := 200.

    FontWidth := 120.

    LeftX := 900.

    TopY := 14900.

    tmpString :=

'%!!PS-Adobe-1.0

%%Creator: Smalltalk

%%DocumentFonts: Courier-Oblique Courier-Bold Courier Times-Italic Times-Bold Times

save/SmalltalkJob exch def

/StartSmalltalkDoc{$smalltalk begin}def

/$smalltalk 50 dict def $smalltalk begin

/EndSmalltalkDoc{end}def

/S/show load def

/X{exch 0 rmoveto S}def

/Y{exch 0 exch rmoveto S}def

/B{3 1 roll moveto S}def

/F{$fd exch get setfont}def

/StartPage{/svpg save def .05 dup scale}def

/EndPage{svpg restore showpage}def

/DoPreFeed{/statusdict where{pop

 statusdict/prefeed known{statusdict exch/prefeed exch put 0}if}if pop}def

/Landscape{90 rotate 0 -15840 translate}def

/SetUpFonts

 {dup/$fd exch array def{findfont exch scalefont $fd 3 1 roll put}repeat}def

/InitGaudy{/TwoColumn exch def /BarLength exch def

 /ftD /Times-Bold findfont 12 UP scalefont def

 /ftF /Times-Roman findfont 14 UP scalefont def

 /ftP /Helvetica-Bold findfont 30 UP scalefont def}def

/U{1440 mul}def

/UP{U 72 div}def

/LB{/pts exch UP def /charcolor exch def /boxcolor exch def /font exch def

 /label exch def /dy exch def /dx exch def /lly exch def /llx exch def

 gsave boxcolor setgray

 llx lly moveto dx 0 rlineto 0 dy rlineto dx neg 0 rlineto closepath fill

 /lines label length def

 /yp lly dy add dy lines pts mul sub 2 div sub pts .85 mul sub def

 font setfont charcolor setgray

 label {dup stringwidth pop 2 div llx dx 2 div add exch sub yp moveto show

   /yp yp pts sub def}forall grestore}def

/Gaudy{/Page exch def /Date exch def /File exch def /Comment exch def

 .25 U 10.2 U BarLength .1 sub U .25 U [File] ftF .97 0 14 LB

 .25 U 10.45 U BarLength .1 sub U .25 U [Comment] ftF 1 0 14 LB

 .25 U 10.2 U 1 U .5 U Date ftD .7 0 12 LB

 BarLength .75 sub U 10.2 U 1 U .5 U [Page] ftP .7 1 30 LB

 TwoColumn{BarLength 2 div .19 add U 10.2 U moveto 0 -10 U rlineto stroke}if

}def

end

StartSmalltalkDoc % end fixed prolog

'.

    fontNr := 8.

    t := ''.

    self fontNames do:[:aName |

        t := t , (fontNr printString) , ' ' 

               , (FontHeight printString) , ' '

               , aName , (Character nl) asString.

        fontNr := fontNr - 1

    ].

    tmpString := tmpString , t.

    tmpString := tmpString , '9 SetUpFonts

'.

    Prolog := tmpString.

    PageProlog :=

'StartPage

'.

    PageTrailer :=

'EndPage

'.

    Trailer :=

'EndSmalltalkDoc

SmalltalkJob restore

'

! !

!PostscriptPrinterStream methodsFor:'open/close'!

startPrint

    Prolog isNil ifTrue:[

        self class initialize

    ].

    fFamily := Courier.

    fStyle := Normal.

    super writingTo:PrintCommand.

    super nextPutAllUntranslated:Prolog.

    self startPage

!

endPrint

    self endPage.

    super nextPutAll:Trailer.

    super endPrint

! ! 

!PostscriptPrinterStream methodsFor:'private'!

startPage

    super nextPutAllUntranslated:PageProlog.

    self setFont.

    yPos := TopY.

    xPos := LeftX.

    lineBuffer := ''.

    lineNr := 1.

    colNr := 0

!

endPage

    self flushLine.

    super nextPutAllUntranslated:PageTrailer

!

nextPage

    self endPage.

    self startPage

!

setFont

    |fontNumber|

    fontNumber := fFamily + fStyle.

    super nextPutAllUntranslated:fontNumber printString.

    super nextPutAllUntranslated:' F'. 

    super nextPutUntranslated:(Character cr)

!

flushLine

    (lineBuffer size > 0) ifTrue:[

        super nextPutAllUntranslated:(xPos printString ).

        super nextPutAllUntranslated:' '.

        super nextPutAllUntranslated:(yPos printString).

        super nextPutAllUntranslated:'('.

        super nextPutAllUntranslated:lineBuffer.

        super nextPutAllUntranslated:')B'.

        super nextPutUntranslated:(Character cr).

        xPos := xPos + (FontWidth * lineBuffer size).

        colNr := colNr + lineBuffer size

    ].

    lineBuffer := ''

! !

!PostscriptPrinterStream methodsFor:'access writing'!

cr

    "send line termination"

    self flushLine.

    xPos := LeftX.

    colNr := 0.

    yPos := yPos - FontHeight.

    lineNr := lineNr + 1.

    lineNr > LinesPerPage ifTrue:[

        self nextPage

    ]

!

nextPut:aCharacter

    (aCharacter == Character cr) ifTrue:[

        ^ self cr

    ].

    (aCharacter == $( ) ifTrue:[

        lineBuffer := lineBuffer , '\(' .

        ^ self

    ].

    (aCharacter == $) ) ifTrue:[

        lineBuffer := lineBuffer , '\)' .

        ^ self

    ].

    (aCharacter == $\ ) ifTrue:[

        lineBuffer := lineBuffer , '\\' .

        ^ self

    ].

    (aCharacter == Character tab ) ifTrue:[

        self flushLine.

        colNr := ((colNr + 8) // 8) * 8. 

        xPos := LeftX + (colNr * FontWidth).

        ^ self

    ].

    lineBuffer := lineBuffer copyWith:aCharacter

!

courier

    self flushLine.

    fFamily := Courier.

    self setFont

!

times

    self flushLine.

    fFamily := Times.

    self setFont

!

helvetica

    self flushLine.

    fFamily := Helvetica.

    self setFont

!

italic

    self flushLine.

    fStyle := Italic.

    self setFont

!

bold

    self flushLine.

    fStyle := Bold.

    self setFont

!

normal

    self flushLine.

    fStyle := Normal.

    self setFont

! !