"
 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

This class provides output to postscript printers;
to use it, evaluate Smalltalk at:#Printer put:PostscriptPrinterStream
(usually in -rc file).

$Header: /cvs/stx/stx/libbasic2/Attic/PSPrStr.st,v 1.4 1993-10-13 02:13:03 claus Exp $
'!

!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
    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
! !