--- a/Form.st Fri Apr 24 11:28:08 2015 +0200
+++ b/Form.st Fri Oct 02 15:37:52 2015 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -9,10 +11,14 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+'From Smalltalk/X, Version:6.2.5.0 on 24-04-2015 at 14:12:54' !
+
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
GraphicsMedium subclass:#Form
- instanceVariableNames:'depth localColorMap offset data fileName'
+ instanceVariableNames:'depth localColorMap offset data maskedPixelsAre0'
classVariableNames:'VeryLightGreyForm LightGreyForm GreyForm DarkGreyForm
VeryDarkGreyForm AdditionalBitmapDirectoryNames
BlackAndWhiteColorMap DitherPatternArray'
@@ -20,13 +26,6 @@
category:'Compatibility-ST80-Graphics-Display Objects'
!
-DeviceHandle subclass:#DeviceFormHandle
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- privateIn:Form
-!
-
Form subclass:#ImageForm
instanceVariableNames:''
classVariableNames:''
@@ -86,23 +85,6 @@
!Form class methodsFor:'initialization'!
-flushDeviceForms
- "recreate all forms on aDevice; called by Workstation, to
- have all background bitmaps at hand, when views are restored"
-
- Lobby do:[:aDrawable |
- aDrawable isForm ifTrue:[
- (aDrawable graphicsDevice notNil) ifTrue:[
- "now, try to recreate it"
- aDrawable recreate.
- ]
- ]
- ]
-
- "Created: 18.6.1996 / 13:04:59 / cg"
- "Modified: 5.7.1996 / 17:56:02 / cg"
-!
-
initialize
"initialize set of dictionaries to look for bitmaps"
@@ -118,16 +100,14 @@
!
reinitializeAllOn:aDevice
- "recreate all forms on aDevice; called by Workstation, to
+ "recreate all forms on aDevice; called by Workstation after snapIn, to
have all background bitmaps at hand, when views are restored"
- Lobby do:[:aDrawable |
- (aDrawable graphicsDevice == aDevice) ifTrue:[
- aDrawable isForm ifTrue:[
- "now, try to recreate it"
- aDrawable recreate.
- ]
- ]
+ Form allSubInstancesDo:[:eachForm |
+ eachForm graphicsDevice == aDevice ifTrue:[
+ "now, try to recreate it"
+ eachForm recreate.
+ ]
]
"Modified: 5.7.1996 / 17:55:58 / cg"
@@ -138,28 +118,23 @@
(something == #save) ifTrue:[
"get all bits from the device into saveable arrays"
- Lobby do:[:aDrawable |
- aDrawable isForm ifTrue:[
- (PrimitiveFailureSignal , DeviceWorkstation drawingOnClosedDeviceSignal) handle:[:ex |
- 'Form [warning]: cannot fetch form bits from device' errorPrintCR
- ] do:[
- |dev|
-
- ((dev := aDrawable device) isNil
- or:[dev isPersistentInSnapshot]) ifTrue:[
- aDrawable getBits
- ]
+ Form allSubInstancesDo:[:eachForm |
+ (PrimitiveFailureSignal , DeviceWorkstation drawingOnClosedDeviceSignal) handle:[:ex |
+ 'Form [warning]: cannot fetch form bits from device' errorPrintCR
+ ] do:[
+ |dev|
+
+ ((dev := eachForm graphicsDevice) notNil
+ and:[dev isPersistentInSnapshot]) ifTrue:[
+ eachForm getBits
]
]
]
].
(something == #restarted) ifTrue:[
"remove all left-over device info"
- Lobby do:[:aDrawable |
- aDrawable isForm ifTrue:[
- aDrawable flushDeviceHandles.
- Lobby registerChange:aDrawable
- ]
+ Form allSubInstancesDo:[:eachForm |
+ eachForm flushDeviceHandles.
]
]
@@ -396,7 +371,7 @@
In old st80, you could use `Form grey' for drawing
- here we return the grey color."
- ^ Color gray
+ ^ Color grey
"Modified: 2.5.1996 / 11:43:17 / cg"
!
@@ -542,18 +517,6 @@
"Modified: 19.12.1996 / 13:59:09 / cg"
!
-fromFile:filename on:aDevice
- "create a new form on device, aDevice and
- initialize the pixels from the file filename"
-
- <resource:#obsolete>
-
- self obsoleteMethodWarning:'please use Image>>fromFile:'.
- ^ (self onDevice:aDevice) readFromFile:filename
-
- "Modified: 5.6.1997 / 21:05:59 / cg"
-!
-
fromFile:filename resolution:dpi
"create a new form taking the bits from a file on the default device
the data in the file is assumed to be for dpi resolution;
@@ -586,22 +549,6 @@
^ (self onDevice:aDevice) readFromFile:filename resolution:dpi
"Modified: 5.6.1997 / 21:05:54 / cg"
-!
-
-readFrom:fileName
- "same as Form>>fromFile: - for ST-80 compatibility.
- WARNING:
- Please do no longer use this, since it will not work
- correctly in multi-display applications (creates the form on the
- default Display).
- Use #fromFile:on: and pass the device as argument."
-
- <resource:#obsolete>
-
- self obsoleteMethodWarning:'please use Image>>fromFile:'.
- ^ (self onDevice:Screen current) readFromFile:fileName.
-
- "Modified: 19.12.1996 / 13:59:50 / cg"
! !
!Form class methodsFor:'obsolete instance creation'!
@@ -892,26 +839,6 @@
!Form methodsFor:'Compatibility-ST80'!
-destroy
- "destroy my underlying device resource(s)"
-
- |id|
-
- (id := gcId) notNil ifTrue:[
- gcId := nil.
- device destroyGC:id.
- ].
-
- (id := drawableId) notNil ifTrue:[
- drawableId := nil.
- device destroyPixmap:id.
- ].
-
- Lobby unregister:self.
-
- "Modified: 2.4.1997 / 19:39:52 / cg"
-!
-
displayAt:aPoint
"show the receiver on the current display screen"
@@ -999,7 +926,7 @@
!
magnify:aRectangle by:scale smoothing:smooth
- ^ ((Image fromSubForm:aRectangle in:self) magnifiedBy:scale) asFormOn:device.
+ ^ ((Image fromSubForm:aRectangle in:self) magnifiedBy:scale) asFormOn:self graphicsDevice.
! !
!Form methodsFor:'accessing'!
@@ -1024,10 +951,7 @@
data notNil ifTrue:[
^ data
].
- drawableId isNil ifTrue:[
- fileName notNil ifTrue:[
- ^ (self onDevice:Screen current) bits
- ].
+ self drawableId isNil ifTrue:[
^ nil
].
@@ -1044,7 +968,7 @@
bytesPerLine := (width * spaceBitsPerPixel + 31) // 32 * 4.
inData := ByteArray uninitializedNew:(bytesPerLine * height).
- info := device getBitsFromPixmapId:drawableId x:0 y:0 width:width height:height into:inData.
+ info := self graphicsDevice getBitsFromPixmapId:self drawableId x:0 y:0 width:width height:height into:inData.
bytesPerLineIn := (info at:#bytesPerLine). "what I got"
bytesPerLine := (width * depth + 7) // 8. "what I want"
(bytesPerLine ~~ bytesPerLineIn) ifTrue:[
@@ -1135,9 +1059,7 @@
colorMap:anArrayOrColorMap
"set the receivers colormap"
- localColorMap := anArrayOrColorMap
-
- "Modified: 7.3.1997 / 21:26:11 / cg"
+ localColorMap := anArrayOrColorMap.
!
depth
@@ -1146,21 +1068,6 @@
^ depth
!
-fileName
- "return the filename, from which the receiver was created,
- or nil, if it was not read from a file"
-
- ^ fileName
-!
-
-filename
- "return the filename, from which the receiver was created,
- or nil, if it was not read from a file"
-
- "/ going to be obsoleted - use #fileName
- ^ fileName
-!
-
forgetBits
"for image, which also keeps the bits - so there is
no need to hold them again here"
@@ -1176,6 +1083,14 @@
"Created: 21.6.1996 / 12:52:42 / cg"
!
+maskedPixelsAre0
+ ^ maskedPixelsAre0
+!
+
+maskedPixelsAre0:something
+ maskedPixelsAre0 := something.
+!
+
photometric
"for compatibility with Image class ..."
@@ -1202,7 +1117,7 @@
"Modified: 17.6.1996 / 11:45:16 / cg"
!
-samplesperPixel
+samplesPerPixel
"for compatibility with Image class ..."
^ 1
@@ -1237,7 +1152,85 @@
"Modified: 23.4.1996 / 10:12:48 / cg"
! !
-
+!Form methodsFor:'binary storage'!
+
+readBinaryContentsFrom: stream manager: manager
+ "tell the newly restored Form about restoration"
+
+ width := manager nextObject.
+ height := manager nextObject.
+ depth := manager nextObject.
+ offset := manager nextObject.
+ data := manager nextObject.
+
+"/ super readBinaryContentsFrom: stream manager: manager.
+"/ device := nil. "/ Screen current.
+
+ self restored.
+"/ self recreate.
+"/ Lobby register:self.
+
+ "
+ |f|
+
+ f := Form fromFile:'bitmaps/SBrowser.xbm'.
+ f storeBinaryOn:'foo.bos'.
+
+ (Form readBinaryFrom:'foo.bos') inspect
+ "
+!
+
+storeBinaryDefinitionOn: stream manager: manager
+ "store a binary representation of the receiver on stream.
+ This is an internal interface for binary storage mechanism.
+ Redefined to store the actual bits, even if I have been loaded
+ from a file, and to ommit all device related stuff."
+
+ |bits|
+
+ manager putIdOfClass:(self class) on:stream.
+ manager putIdOf:width on:stream.
+ manager putIdOf:height on:stream.
+ manager putIdOf:depth on:stream.
+ manager putIdOf:offset on:stream.
+ (bits := data) isNil ifTrue:[
+ bits := self bits.
+ ].
+ manager putIdOf:bits on:stream.
+
+"/ savedDevice := device.
+"/ (savedData := data) isNil ifTrue:[
+"/ data := self bits.
+"/ ].
+"/ device := nil.
+"/ super storeBinaryDefinitionOn:stream manager:manager.
+"/ data := savedData.
+"/ device := savedDevice.
+
+ "Modified: 23.4.1996 / 09:30:47 / cg"
+! !
+
+!Form methodsFor:'comanche processing'!
+
+asHtmlElementIn: htmlContainer
+ "answer my HTML representation (String),
+ as I would look like inside htmlContainer"
+
+ ^'<IMG SRC="', self comancheUrl, '">'
+!
+
+asHttpResponseTo: request
+ ^HttpResponse fromMIMEDocument: self asWebImage
+!
+
+asWebImage
+ "return a MIMEDocument"
+ | aStream |
+ aStream _ (RWBinaryOrTextStream on: '').
+ GIFReadWriter putForm: (self asFormOfDepth: 8) onStream: aStream.
+ aStream reset.
+ ^MIMEDocument contentType: MIMEDocument contentTypeGif content: aStream
+! !
!Form methodsFor:'converting'!
@@ -1267,20 +1260,15 @@
"kludge: have to unregister. Otherwise the form will be destroyed when
we are garbage collected"
- Lobby unregister:self.
- Lobby registerChange:imageForm.
+ gc finalizationLobby
+ unregister:gc;
+ registerChange:imageForm graphicsContext.
+
^ imageForm.
! !
!Form methodsFor:'copying'!
-executor
- "redefined for faster creation of finalization copies
- (only device, gcId and drawableId are needed)"
-
- ^ DeviceFormHandle basicNew setDevice:device id:drawableId gcId:gcId.
-!
-
postCopy
"redefined to copy the colorMap as well"
@@ -1312,7 +1300,7 @@
and associate it to a device (i.e. download its bits).
Added for protocol compatibility with Image."
- aDevice == device ifTrue:[
+ aDevice == self graphicsDevice ifTrue:[
^ self
].
^ self onDevice:aDevice
@@ -1324,12 +1312,10 @@
asMonochromeFormOn:aDevice
"added for protocol compatiblity with Image"
- aDevice == device ifTrue:[
- depth == 1 ifTrue:[
+ depth == 1 ifTrue:[
+ aDevice == self graphicsDevice ifTrue:[
^ self
].
- ].
- (depth == 1) ifTrue:[
^ self onDevice:aDevice
].
^ nil
@@ -1378,7 +1364,7 @@
"associate the receiver to a device (i.e. download its bits);
return a deviceForm (possibly different from the receiver)."
- aDevice == device ifTrue:[
+ aDevice == self graphicsDevice ifTrue:[
^ self
].
aDevice isNil ifTrue:[^ self].
@@ -1389,10 +1375,6 @@
"/ 'Form [info]: create from data' printCR.
^ self class width:width height:height fromArray:data onDevice:aDevice
].
- fileName notNil ifTrue:[
- "/ 'Form [info]: create from file' printCR.
- ^ (Image fromFile:fileName) asFormOn:aDevice
- ].
'Form [warning]: no bit data in #onDevice: - returning a black form.' infoPrintCR.
^ (self class width:width height:height onDevice:aDevice) clear
@@ -1407,6 +1389,19 @@
^ self
!
+clearMaskedPixels:maskForm
+ "clear any masked pixels.
+ This will allow faster drawing in the future."
+
+ "black is 0 in mask - masked bits are 0"
+ gc
+ foreground:Color allColor background:Color noColor;
+ function:#and;
+ copyPlaneFrom:maskForm x:0 y:0 toX:0 y:0 width:width height:height.
+
+ maskedPixelsAre0 := true.
+!
+
darkened
"return a darkened version of the receiver.
Added for protocol compatibility with Color and Image.
@@ -1476,7 +1471,7 @@
|dstX newForm |
- newForm := (self class onDevice:device)
+ newForm := (self class onDevice:self graphicsDevice)
width:width
height:height
depth:depth.
@@ -1518,7 +1513,7 @@
|dstY newForm |
- newForm := (self class onDevice:device)
+ newForm := (self class onDevice:self graphicsDevice)
width:width
height:height
depth:depth.
@@ -1564,7 +1559,7 @@
and this operation is slow anyway, use the implementation
in Image for this."
- ^ ((Image fromForm:self) magnifiedBy:extent) asFormOn:device.
+ ^ ((Image fromForm:self) magnifiedBy:extent) asFormOn:self graphicsDevice.
"
(Form fromFile:'OutputOn.64') magnifiedBy:0.5@0.5
@@ -1598,7 +1593,7 @@
^ self hardMagnifiedBy:ext
].
- newForm := (self class onDevice:device)
+ newForm := (self class onDevice:self graphicsDevice)
width:(width * mX)
height:(height * mY)
depth:depth.
@@ -1634,17 +1629,6 @@
!Form methodsFor:'initialization'!
-createGC
- "physically create a device GC.
- Since we do not need a gc-object for the drawable until something is
- really drawn, none is created up to the first draw.
- This method is sent, when the first drawing happens.
- Redefined here to create a bitmap GC (some devices (i.e. windows) require
- different GC's for different canvases."
-
- self createGCForBitmap.
-!
-
initGC
"stop server from sending exposure events for Forms -
(will fill up stream-queue on some stupid (i.e. sco) systems"
@@ -1652,12 +1636,15 @@
"/ depth-1 forms draw differently ...
depth == 1 ifTrue:[
- foreground isNil ifTrue:[
- foreground := paint := Color colorId:1.
- ].
- background isNil ifTrue:[
- background := bgPaint := Color colorId:0
- ]
+ |fg bg|
+ self foreground isNil ifTrue:[
+ fg := Color colorId:1.
+ ].
+ self background isNil ifTrue:[
+ bg := Color colorId:0
+ ].
+ "nil colors will not be set"
+ self setPaint:fg on:bg.
].
super initGC.
self setGraphicsExposures:false
@@ -1666,44 +1653,28 @@
!
initialize
- foreground := paint := Color colorId:1.
- background := bgPaint := Color colorId:0.
depth := 1.
-
+ maskedPixelsAre0 := false.
super initialize.
!
recreate
"reconstruct the form after a snapin or a migration"
- self device isNil ifTrue:[^ self].
+ self graphicsDevice isNil ifTrue:[^ self].
data notNil ifTrue:[
"
create one from data
"
- (depth == 1 or:[depth == device depth]) ifTrue:[
- self createBitmapFromArray:data width:width height:height.
- Lobby registerChange:self.
- self drawableId notNil ifTrue:[
+ (depth == 1 or:[depth == self graphicsDevice depth]) ifTrue:[
+ gc createBitmapFromArray:data width:width height:height.
+ gc drawableId notNil ifTrue:[
^ self
]
].
'FORM: cannot recreate form' errorPrintCR.
].
- fileName notNil ifTrue:[
- "
- create one from a file (mhmh - this seems X-specific and will vanish)
- "
- self readFromFile:fileName.
-
-"/ drawableId := device createBitmapFromFile:fileName for:self.
-"/ Lobby registerChange:self.
- self drawableId notNil ifTrue:[
- ^ self
- ].
- 'FORM: cannot recreate file form: ' errorPrint. fileName errorPrintCR.
- ].
^ self.
@@ -1711,11 +1682,10 @@
"/ create an empty one
"/ "
"/ depth == 1 ifTrue:[
-"/ drawableId := device createBitmapWidth:width height:height
+"/ drawableId := self graphicsDevice createBitmapWidth:width height:height
"/ ] ifFalse:[
-"/ drawableId := device createPixmapWidth:width height:height depth:device depth
+"/ drawableId := self graphicsDevice createPixmapWidth:width height:height depth:self graphicsDevice depth
"/ ].
-"/ Lobby registerChange:self
"Modified: 15.6.1996 / 16:18:12 / cg"
!
@@ -1725,9 +1695,17 @@
The sender has to take care that the Form has been
unregistered from (Finalization-)Lobby"
- device := drawableId := gcId := nil.
+ self setDevice:nil id:nil gcId:nil
! !
+!Form methodsFor:'misc ui support'!
+
+inspectorClass
+ "redefined to launch an ImageInspector
+ (instead of the default InspectorView)."
+
+ ^ ImageInspectorView
+! !
!Form methodsFor:'printing & storing'!
@@ -1750,16 +1728,11 @@
beImmediateForm
"read the pixels from the device into a local data array.
- This makes certain that a fileName form is independent of
- its fileName.
To make the image smaller (i.e. not keep all those bitmaps),
this is NOT done by default."
data isNil ifTrue:[
data := self bits.
- data notNil ifTrue:[
- fileName := nil
- ]
]
"
@@ -1774,8 +1747,10 @@
flushDeviceHandles
"flush device handles (sent after a restart)"
- drawableId := nil.
- gcId := nil.
+ self setDevice:self graphicsDevice id:nil gcId:nil.
+ gc notNil ifTrue:[
+ gc registerChange.
+ ].
"Created: 15.6.1996 / 15:44:28 / cg"
!
@@ -1787,90 +1762,11 @@
an image is saved, or the receiver is storedBinary, since
the information present in the device is lost after restart/reload"
- (data isNil and:[fileName isNil]) ifTrue:[
+ data isNil ifTrue:[
data := self bits
]
!
-readFromFile:fn
- "read a monochrome form from a file (in xbm-format).
- The fileName argument, fn should be a relative pathname
- such as bitmaps/foo.xbm and the corresponding file
- will be searched in the standard places (i.e. along the SEARCHPATH).
- Notice, when saving an image, only that fileName is kept with the
- form, and the file is reloaded at image startup time.
- You should therefore make certain, that the file is present at image
- reload time. (this is done to make the image smaller ...)
- If you dont like that behavior (or your application should be able to
- restart fully standAlone), send #beImmediateForm to all instances of
- Form - this will set the data instance variable to a ByteArray containing
- the actual bits and will therefore no longer depend on the file being present.
- "
-
- <resource:#obsolete>
-
- |pathName|
-
- "/ this method is a historic leftover; it uses
- "/ the X-libs bitmap file reading function, which is not
- "/ available with other windowing systems ...
- self obsoleteMethodWarning:'use Image fromFile:'.
-
- pathName := self class findBitmapFile:fn.
- pathName notNil ifTrue:[
- drawableId := device createBitmapFromFile:pathName for:self.
- drawableId isNil ifTrue:[^ nil].
-
-"/ fileName := pathName. "/ keep the actual name (wrong)
- fileName := fn. "/ keep the relative name (better - SEARCHPATH may be different at restart)
-
- offset := 0@0.
- realized := true.
- BlackAndWhiteColorMap isNil ifTrue:[
- BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
- ].
- localColorMap := BlackAndWhiteColorMap.
- Lobby registerChange:self.
- ^ self
- ].
- ^ nil
-
- "Modified: 7.2.1996 / 16:04:25 / cg"
-!
-
-readFromFile:filename resolution:dpi
- "read a monochrome form from a file, which is assumed to have data for a dpi-resolution;
- if the actual resolution of the device differs, magnify the form.
- Read the comment in #readFromFile: on what happenes if the file is no longer present
- after an image reload."
-
- <resource:#obsolete>
-
- |dpiH mag dev|
-
- (self readFromFile:filename) isNil ifTrue:[^ nil].
-
- "if the device is within +- 50% of dpi, no magnify is needed"
- dev := self device.
- dev isNil ifTrue:[
- "should not happen ..."
- dev := Screen current
- ].
- dpiH := dev isNil ifTrue:[90] ifFalse:[dev horizontalPixelPerInch].
- ((dpi >= (dpiH * 0.75)) and:[dpi <= (dpiH * 1.5)]) ifTrue:[^ self].
- mag := (dpiH / dpi) rounded.
- mag == 0 ifTrue:[
- ^ self
- ].
- ^ self magnifiedBy:(mag @ mag)
-
- "
- Form fromFile:'SBrowser.icn' resolution:50
- "
-
- "Modified: 7.2.1996 / 16:03:45 / cg"
-!
-
restored
"flush device data, when restored (sent after a binaryLoad)"
@@ -2040,9 +1936,9 @@
^ localColorMap at:(pixel + 1)
].
depth == 1 ifTrue:[
- pixel == 0 ifTrue:[^ White].
+ pixel == 0 ifTrue:[^ self whiteColor].
].
- ^ Black
+ ^ self blackColor
"Created: 28.6.1996 / 16:10:13 / cg"
"Modified: 13.1.1997 / 23:06:25 / cg"
@@ -2101,45 +1997,6 @@
"Modified: 13.5.1996 / 10:26:05 / cg"
! !
-!Form::DeviceFormHandle class methodsFor:'documentation'!
-
-documentation
-"
- This is used as a finalization handle for forms - in previous systems,
- a shallowCopy of a form was responsible to destroy the underlying
- devices bitmap. To make the memory requirements smaller and to speed up
- bitmap creation a bit, this lightweight class is used now, which only
- keeps the device handle for finalization.
-
- [see also:]
- DeviceHandle Form
-
- [author:]
- Claus Gittinger
-
-"
-! !
-
-!Form::DeviceFormHandle methodsFor:'finalization'!
-
-finalize
- "the Form for which I am a handle has been collected - tell it to the x-server"
-
- |id|
-
- drawableId notNil ifTrue:[
- (id := gcId) notNil ifTrue:[
- gcId := nil.
- device destroyGC:id.
- ].
- id := drawableId.
- drawableId := nil.
- device destroyPixmap:id.
- ]
-
- "Created: 25.9.1997 / 10:03:05 / stefan"
-! !
-
!Form::ImageForm class methodsFor:'documentation'!
documentation
@@ -2178,7 +2035,7 @@
!Form class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Form.st,v 1.152 2014-07-08 21:15:46 cg Exp $'
+ ^ '$Header$'
! !