'From Squeak3.1alpha of 5 February 2001 [latest update: #3689] on 22 February 2001 at 9:17:41 am'! "Change Set: geePrinting Date: 22 February 2001 Author: Bob Arning Various improvements to get GeeMail printing back to a usable level"! Canvas subclass: #PostscriptCanvas instanceVariableNames: 'origin clipRect currentColor currentFont morphLevel gstateStack fontMap usedFonts psBounds topLevelMorph initialScale savedMorphExtent currentTransformation printSpecs ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Postscript Canvases'! Object subclass: #PrintSpecifications instanceVariableNames: 'landscapeFlag drawAsBitmapFlag scaleToFitPage ' classVariableNames: 'DefaultSpecs ' poolDictionaries: '' category: 'Morphic-GeeMail'! !AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 09:14'! getMenu: shiftKeyState | menu | menu _ MenuMorph new defaultTarget: self. menu addUpdating: #showPageBreaksString action: #togglePageBreaks; addUpdating: #keepScrollbarString action: #toggleKeepScrollbar; addLine; add: 'Print...' action: #printPSToFile; addLine; add: 'make a book of me' action: #convertToBook. ^menu! ! !GeeBookMorph class methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 09:07'! includeInNewMorphMenu ^ false! ! !GeeBookPageMorph class methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 09:07'! includeInNewMorphMenu ^ false! ! !GeePrinter methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 08:00'! bounds | w ratio | w _ pasteUp width. self printSpecs scaleToFitPage ifTrue: [ ^0@0 extent: w@(w * self hOverW) rounded. ]. ratio _ 8.5 @ 11. self printSpecs landscapeFlag ifTrue: [ ratio _ ratio transposed ]. ^0@0 extent: (ratio * 72) rounded! ! !GeePrinter methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 07:43'! doPrintToPrinter "fileName _ ('gee.',Time millisecondClockValue printString,'.eps') asFileName." DSCPostscriptCanvasToDisk morphAsPostscript: self rotated: self printSpecs landscapeFlag specs: self printSpecs ! ! !GeePrinterDialogMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 07:36'! getChoice: aSymbol aSymbol == #landscapeFlag ifTrue: [^printSpecs landscapeFlag]. aSymbol == #drawAsBitmapFlag ifTrue: [^printSpecs drawAsBitmapFlag]. aSymbol == #scaleToFitPage ifTrue: [^printSpecs scaleToFitPage]. ! ! !GeePrinterDialogMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 07:51'! rebuild self removeAllMorphs. self addARow: { (StringMorph contents: 'PostScript Printing Options') lock. }. self addARow: { self simpleToggleButtonFor: self attribute: #landscapeFlag help: 'Print in landscape mode'. (StringMorph contents: ' Landscape') lock. }. self addARow: { self simpleToggleButtonFor: self attribute: #drawAsBitmapFlag help: 'Print as a bitmap'. (StringMorph contents: ' Bitmap') lock. }. self addARow: { self simpleToggleButtonFor: self attribute: #scaleToFitPage help: 'Scale printing to fill page'. (StringMorph contents: ' Scale to fit') lock. }. self addARow: { self printButton. self previewButton. self cancelButton. }.! ! !GeePrinterDialogMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 07:50'! toggleChoice: aSymbol aSymbol == #landscapeFlag ifTrue: [ printSpecs landscapeFlag: printSpecs landscapeFlag not ]. aSymbol == #drawAsBitmapFlag ifTrue: [ printSpecs drawAsBitmapFlag: printSpecs drawAsBitmapFlag not ]. aSymbol == #scaleToFitPage ifTrue: [ printSpecs scaleToFitPage: printSpecs scaleToFitPage not ]. ! ! !GeePrinterDialogMorph class methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 09:08'! includeInNewMorphMenu ^ false! ! !GeePrinterPage methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 09:05'! fullDrawPostscriptOn: aCanvas | s | s _ TextMorph new beAllFont: (TextStyle default fontOfSize: 30); contentsAsIs: ' Drawing page ',pageNumber printString,' of ',totalPages printString,' '. s layoutChanged; fullBounds. s _ AlignmentMorph newRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; addMorph: s; color: Color yellow. s position: Display center - (s width // 2 @ 0). World addMorphFront: s. World displayWorld. printSpecs drawAsBitmapFlag ifTrue: [ aCanvas paintImage: self pageAsForm at: 0@0 ] ifFalse: [ aCanvas translateTo: bounds origin negated clippingTo: (0@0 extent: bounds extent) during: [ :c | pasteUp fullDrawForPrintingOn: c ]. ]. s delete. ! ! !PostscriptCanvas methodsFor: 'initialization' stamp: 'RAA 2/22/2001 09:02'! initializeFontMap "Initialize the dictionary mapping message names to actions for C code generation." | pairs | fontMap _ Dictionary new: 5. pairs _ #( 'Palatino' 'Palatino-Roman' 'NewYork' 'Helvetica' 'NewYork-Bold' 'Helvetica-Bold' 'ComicBold' 'Helvetica-Narrow-Bold' 'ComicPlainB-Bold' 'Helvetica-Narrow-Bold' 'ComicPlain' 'Helvetica-Narrow' ). 1 to: pairs size by: 2 do: [:i | fontMap at: (pairs at: i) put: (pairs at: i + 1)]. ! ! !PostscriptCanvas methodsFor: 'drawing support' stamp: 'RAA 2/22/2001 09:04'! mapFontName: fontName ^ fontMap at: fontName ifAbsent: [fontName]. ! ! !PostscriptCanvas methodsFor: 'drawing support' stamp: 'RAA 2/22/2001 09:04'! postscriptFontNameForFont: font | fontName answer | fontName _ font familyName asString. font emphasis == 1 ifTrue:[ fontName _ fontName,'-Bold'. ]. answer _ self mapFontName: fontName. ^answer ! ! !DSCPostscriptCanvas methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 07:47'! writePSIdentifierRotated: rotateFlag | morphExtent pageExtent scaledBox | target print:'%!!PS-Adobe-2.0'; cr; print:'%%Pages: (atend)'; cr. "Define initialScale so that the morph will fit the page rotated or not" savedMorphExtent _ morphExtent _ rotateFlag ifTrue: [psBounds extent transposed] ifFalse: [psBounds extent]. pageExtent _ self defaultImageableArea extent asFloatPoint. initialScale _ (printSpecs isNil or: [printSpecs scaleToFitPage]) ifTrue: [ pageExtent x/morphExtent x min: pageExtent y/morphExtent y ] ifFalse: [ 1.0 ]. target print:'% initialScale: '; write:initialScale; cr. scaledBox _ self pageBBox rounded. target print: '%%BoundingBox: '; write: scaledBox rounded; cr. rotateFlag ifTrue: [ target print: '90 rotate'; cr; write: self defaultMargin * initialScale; space; write: (self defaultMargin + scaledBox height * initialScale) negated; print: ' translate'; cr ] ifFalse: [ target write: self defaultMargin * initialScale; space; write: (self defaultMargin * initialScale); print: ' translate'; cr ]. target print: '%%EndComments'; cr. ! ! !DSCPostscriptCanvasToDisk methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 07:41'! morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset ^self morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset specs: nil ! ! !DSCPostscriptCanvasToDisk methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 07:41'! morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset specs: specsOrNil self reset. psBounds _ offset extent: aMorph bounds extent. topLevelMorph _ aMorph. self writeHeaderRotated: rotateFlag. self fullDrawMorph: aMorph. ^self close ! ! !DSCPostscriptCanvasToDisk class methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 07:41'! morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset ^self morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset specs: nil ! ! !DSCPostscriptCanvasToDisk class methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 07:40'! morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset specs: specsOrNil | newFileName stream | ^[ (self new morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset) close ] on: PickAFileToWriteNotification do: [ :ex | newFileName _ FillInTheBlank request: 'Name of file to write:' initialAnswer: 'xxx',Time millisecondClockValue printString,'.eps'. newFileName isEmptyOrNil ifFalse: [ stream _ FileStream fileNamed: newFileName. stream ifNotNil: [ex resume: stream]. ]. ]. ! ! !DSCPostscriptCanvasToDisk class methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 07:43'! morphAsPostscript: aMorph rotated: rotateFlag specs: specsOrNil ^ self morphAsPostscript: aMorph rotated: rotateFlag offsetBy: self baseOffset specs: specsOrNil ! ! !PrintSpecifications methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 07:35'! initialize landscapeFlag _ false. scaleToFitPage _ false. drawAsBitmapFlag _ false. ! ! !PrintSpecifications methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 07:35'! scaleToFitPage ^scaleToFitPage ifNil: [false]! ! !PrintSpecifications methodsFor: 'as yet unclassified' stamp: 'RAA 2/22/2001 07:35'! scaleToFitPage: aBoolean scaleToFitPage _ aBoolean! !