Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Path: utzoo!watmath!clyde!rutgers!seismo!mcvax!ukc!man.psy!mucs!miw From: miw@mucs.UUCP Newsgroups: comp.lang.smalltalk Subject: Another Smalltalk goodie Message-ID: <858@mucs.ux.cs.man.ac.uk> Date: Fri, 6-Feb-87 08:49:27 EST Article-I.D.: mucs.858 Posted: Fri Feb 6 08:49:27 1987 Date-Received: Mon, 9-Feb-87 02:12:33 EST Organization: Dept. of Computer Science, University of Manchester, UK. Lines: 214 Keywords: Smalltalk, PostScript, goodie This is the fourth Manchester Smalltalk goodie. It provides a mechanism for writing out Forms or bits of the screen in PostScript format. The comment at the head of the file describes the operation in more detail. Mario ------------------------------------------------------------------------ Dept. of Computer Science ARPA: miw%uk.ac.man.cs.ux@cs.ucl.ac.uk The University USENET: mcvax!ukc!man.cs.ux!miw Manchester M13 9PL JANET: miw@uk.ac.man.cs.ux U.K. 061-273 7121 x 5699 ------------------------------------------------------------------------ ---------------------------------------------------------------- "This package enables one to write Forms out in PostScript format. Two mechanism are provided: 1. Ability to write out a Form using aForm psWriteOn: 'aFileName' 2. Ability to dump a section of the display screen. Hit shift-control-d: you will be asked to designate an area of the screen, whether you want the cursor to appear in the screen dump, and what file name to write to. " 'From Smalltalk-80, version 2, of April 1, 1983 on 23 January 1987 at 6:49:57 pm'! !Character class methodsFor: 'accessing untypeable characters'! lf "Answer the Character representing a line feed." ^self value: 10! ! !Form methodsFor: 'fileIn/Out'! dumpHexBytesOn: aFile invert: invert "write out the bitmap data to the file in hex, rounding up to byte boundaries, and complementing the bits if necessary" | count bytesPerLine word byte | count _ 0. bytesPerLine _ width + 7 // 8. height timesRepeat: [(bytesPerLine // 2) timesRepeat: [word _ bits at: (count _ count + 1). invert ifTrue: [word _ word bitXor: -1]. aFile nextPutAll: word printHexWord]. bytesPerLine even "do the last byte" ifFalse: [byte _ (bits at: (count _ count + 1)) bitShift: -8. invert ifTrue: [byte _ byte bitXor: -1]. aFile nextPutAll: byte printHexByte]. aFile lf. Processor yield].! ! !SmallInteger methodsFor: 'printing'! printHexByte "print the receiver as two hex chars" | s | s _ String new: 2. s at: 1 put: (Character digitValue: ((self bitAnd: 16rF0) bitShift: -4)). s at: 2 put: (Character digitValue: (self bitAnd: 16r0F)). ^s! printHexWord "print the receiver as four hex chars" | s | s _ String new: 4. s at: 1 put: (Character digitValue: ((self bitAnd: 16rF000) bitShift: -12)). s at: 2 put: (Character digitValue: ((self bitAnd: 16r0F00) bitShift: -8)). s at: 3 put: (Character digitValue: ((self bitAnd: 16r00F0) bitShift: -4)). s at: 4 put: (Character digitValue: (self bitAnd: 16r000F)). ^s! ! !WriteStream methodsFor: 'character writing'! lf "Append a linefeed character to the receiver." self nextPut: Character lf! ! !Form methodsFor: 'conversion to/from PostScript'! psWriteFileOn: fileName "Saves the receiver on the file fileName in PostScript format" " Form fromUser psWriteOn: 'mypic.ps' " self psWriteFileOn: fileName scaleFactor: 1 "seems a reasonable default"! psWriteFileOn: fileName scaleFactor: scaleFactor "Saves the receiver on the file fileName in PostScript format, mapping one Smalltalk bitmap pixel onto 'scaleFactor' PostScript pixels" | file | file _ FileStream fileNamed: fileName. file text. file nextPutAll: '%!!'. file lf. "write the PostScript prologue for this image on the stream. The transformation matrix is chosen so that the reference point of the image is at bottom left." "There are two sensible choices for the transformation matrix: [width 0 0 height 0 0] (for inclusion in TeX files), and [width 0 0 -height 0 height] (for straight output to a PostScript device)" file nextPutAll: ((width*scaleFactor) printString, ' ', (height*scaleFactor) printString, ' scale'). file lf. "assume a unix file" file nextPutAll: (width printString, ' ' , height printString, ' 1 [', width printString, ' 0 0 ', height negated printString, ' 0 ', height printString, '] {<'). file lf. "now dump the image data" self dumpHexBytesOn: file invert: true. "and end the thing off" file nextPutAll: '>} image'; lf. file nextPutAll: 'showpage'. file lf. file close! psWriteOn: fileName "Saves the receiver on the file fileName in PostScript format" " Form fromUser psWriteOn: 'mypic.ps' " self psWriteOn: fileName scaleFactor: 1 "seems a reasonable default"! ! !InputState methodsFor: 'private'! doScreenDump | activeProcess currentCursor currentPoint area rect filename | activeProcess _ ScheduledControllers activeControllerProcess. (Processor includes: activeProcess) ifTrue: [activeProcess suspend]. currentCursor _ Sensor currentCursor. currentPoint _ Sensor cursorPoint. rect _ Rectangle fromUser. area _ Form fromDisplay: rect. BinaryChoice message: 'OR in cursor?' displayAt: Sensor cursorPoint centered: true ifTrue: [area copyBits: currentCursor boundingBox from: currentCursor at: currentPoint - rect origin clippingBox: area boundingBox rule: Form paint mask: Form black] ifFalse: []. filename _ FillInTheBlank request: 'Enter filename for bitmap' initialAnswer: 'filename.ps'. filename isEmpty ifFalse: [[Transcript show: 'dumping to file ', filename, '...'. area psWriteFileOn: filename. Transcript show: 'done' ; cr] forkAt: Processor userSchedulingPriority]. (Processor includes: activeProcess) ifFalse: [ScheduledControllers activeControllerProcess resume]! keyAt: keyNumber put: value | index mask | index _ keyNumber < 8r200 ifTrue: [KeyboardMap at: keyNumber + 1] ifFalse: [keyNumber]. index < 8r200 ifTrue: "Not a potential special character" [value ~= 0 ifTrue: [(ctrlState ~= 0 and: [index = LetterCKey or: [index = $d asciiValue]]) ifTrue: [index = LetterCKey ifTrue: [lshiftState ~= 0 ifTrue: [self forkEmergencyEvaluatorAt: Processor userInterruptPriority] ifFalse: [[ScheduledControllers interruptName: 'User Interrupt'] fork]] ifFalse: [lshiftState ~= 0 ifTrue: [[self doScreenDump] forkAt: Processor userInterruptPriority]]] ifFalse: [^keyboardQueue nextPut: (KeyboardEvent code: keyNumber meta: metaState)]]] ifFalse: [index = CtrlKey ifTrue: [ctrlState _ value bitShift: 1] ifFalse: [index = LshiftKey ifTrue: [lshiftState _ value] ifFalse: [index = RshiftKey ifTrue: [rshiftState _ value] ifFalse: [index = LockKey ifTrue: [lockState _ value bitShift: 2] ifFalse: [(index >= BitMin and: [index <= BitMax]) ifTrue: [mask _ 1 bitShift: index - BitMin. value = 1 ifTrue: [bitState _ bitState bitOr: mask] ifFalse: [bitState _ bitState bitAnd: -1 - mask]] ifFalse: [value ~= 0 ifTrue: [keyboardQueue nextPut: (KeyboardEvent code: keyNumber meta: metaState)]]]]]]. metaState _ (ctrlState bitOr: (lshiftState bitOr: rshiftState)) bitOr: lockState]! ! !ProcessorScheduler methodsFor: 'accessing'!includes: aProcess "Has aProcess been suspended?" ^(quiescentProcessLists at: aProcess priority) includes: aProcess! ! ---------------------------------------------------------------- -- ------------------------------------------------------------------------ Dept. of Computer Science ARPA: miw%uk.ac.man.cs.ux@cs.ucl.ac.uk The University USENET: mcvax!ukc!man.cs.ux!miw Manchester M13 9PL JANET: miw@uk.ac.man.cs.ux U.K. 061-273 7121 x 5699 ------------------------------------------------------------------------