PostscriptPrinterStream.st
author Claus Gittinger <cg@exept.de>
Sat, 10 Feb 1996 16:33:26 +0100
changeset 186 bc1b056b097c
parent 179 38773360f4b7
child 222 15d1c9a82bc6
permissions -rw-r--r--
added #supportsPostscript query

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

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

    For now, only Helvetica, Courier and Times fonts in italic, roman and bold
    are supported.

    It does not support graphics and other fancy features of Postscript, but
    provides a compatible interface to line-printing 
    (see other subclasses of PrinterStream).

    To output graphics, you need the PSGraphicsContext (and friend-) classes.
    These provide protocol similar to the one provided by display graphicContexts.
"
! !

!PostscriptPrinterStream class methodsFor:'initialization'!

fontNames
    ^ #('/Helvetica-Oblique'
	'/Helvetica-Bold'
	'/Helvetica'
	'/Times-Italic'
	'/Times-Bold'
	'/Times'
	'/Courier-Oblique'
	'/Courier-Bold'
	'/Courier' )
!

initialize
    |tmpString t fontNr|

    Normal isNil ifTrue:[
	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 class methodsFor:'queries'!

printerTypeName
    "return a descriptive name"

    ^ 'postscript printer'
!

supportsPostscript
    "return true if this is a postscript printer"

    ^ true

    "Created: 10.2.1996 / 16:23:23 / cg"
! !

!PostscriptPrinterStream methodsFor:'access writing'!

bold
    self flushLine.
    fStyle := Bold.
    self setFont
!

courier
    self flushLine.
    fFamily := Courier.
    self setFont
!

cr
    "send line termination"

    self flushLine.
    xPos := LeftX.
    colNr := 0.
    yPos := yPos - FontHeight.
    lineNr := lineNr + 1.
    lineNr > LinesPerPage ifTrue:[
	self nextPage
    ]
!

helvetica
    self flushLine.
    fFamily := Helvetica.
    self setFont
!

italic
    self flushLine.
    fStyle := Italic.
    self setFont
!

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
!

normal
    self flushLine.
    fStyle := Normal.
    self setFont
!

times
    self flushLine.
    fFamily := Times.
    self setFont
! !

!PostscriptPrinterStream methodsFor:'open/close'!

endPrint
    self endPage.
    super nextPutAll:Trailer.
    super endPrint
!

startPrint
    Prolog isNil ifTrue:[
	self class initialize
    ].
    fFamily := Courier.
    fStyle := Normal.
    super writingTo:PrintCommand.
    super nextPutAllUntranslated:Prolog.
    self startPage
! !

!PostscriptPrinterStream methodsFor:'private'!

endPage
    self flushLine.
    super nextPutAllUntranslated:PageTrailer
!

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 := ''
!

nextPage
    self endPage.
    self startPage
!

setFont
    |fontNumber|
    fontNumber := fFamily + fStyle.
    super nextPutAllUntranslated:fontNumber printString.
    super nextPutAllUntranslated:' F'. 
    super nextPutUntranslated:(Character cr)
!

startPage
    super nextPutAllUntranslated:PageProlog.
    self setFont.
    yPos := TopY.
    xPos := LeftX.
    lineBuffer := ''.
    lineNr := 1.
    colNr := 0
! !

!PostscriptPrinterStream class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic2/PostscriptPrinterStream.st,v 1.17 1996-02-10 15:32:43 cg Exp $'
! !
PostscriptPrinterStream initialize!