"
COPYRIGHT (c) 1989 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.
"
GraphicsMedium subclass:#Form
instanceVariableNames:'depth localColorMap offset data fileName'
classVariableNames:'VeryLightGreyForm LightGreyForm GreyForm DarkGreyForm
VeryDarkGreyForm AdditionalBitmapDirectoryNames
BlackAndWhiteColorMap DitherPatternArray'
poolDictionaries:''
category:'Graphics-Display Objects'
!
!Form class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1989 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
"
Instances of this class represent forms (i.e. bit- and pixmaps)
which can be created on a drawing device.
In X, these device resources are XPixmaps.
Not all devices will support forms.
NOTICE:
the Form class is a historic leftover and now only used for real
device forms (i.e. on devices which support downloading bitmaps).
In your application, you should always use Image, both for compatibility
with ST-80 and for device independence, since Form may not be supported
by all devices.
[See also:]
Image DeviceDrawable
[author:]
Claus Gittinger
"
! !
!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 device notNil) ifTrue:[
"now, try to recreate it"
aDrawable recreate.
]
]
]
"Created: 18.6.1996 / 13:04:59 / cg"
!
initialize
"initialize set of dictionaries to look for bitmaps"
AdditionalBitmapDirectoryNames isNil ifTrue:[
AdditionalBitmapDirectoryNames := #('/usr/lib/X11/bitmaps').
"want to be informed when returning from snapshot"
ObjectMemory addDependent:self.
]
!
reinitializeAllOn:aDevice
"recreate all forms on aDevice; called by Workstation, to
have all background bitmaps at hand, when views are restored"
Lobby do:[:aDrawable |
(aDrawable device == aDevice) ifTrue:[
aDrawable isForm ifTrue:[
"now, try to recreate it"
aDrawable recreate.
]
]
]
!
update:something with:aParameter from:changedObject
"sent just before snapOut and just after a snapIn"
(something == #save) ifTrue:[
"get all bits from the device into saveable arrays"
Lobby do:[:aDrawable |
aDrawable isForm ifTrue:[
aDrawable getBits
]
]
].
(something == #restarted) ifTrue:[
"remove all left-over device info"
Lobby do:[:aDrawable |
aDrawable isForm ifTrue:[
aDrawable flushDeviceHandles.
Lobby registerChange:aDrawable
]
]
]
"Modified: 15.6.1996 / 15:44:09 / cg"
"Created: 15.6.1996 / 15:47:50 / cg"
! !
!Form class methodsFor:'instance creation'!
extent:ext
"create a new, cleared form, take dimensions from ext.
Smalltalk-80 compatibility"
|newForm|
newForm := self width:(ext x) height:(ext y).
newForm fill:(Color colorId:0).
newForm paint:(Color colorId:1).
^ newForm
!
extent:ext fromArray:data
"create a new form, take dimensions from ext, bits from data.
Smalltalk-80 compatibility."
^ self width:(ext x) height:(ext y) offset:0@0 fromArray:data
!
extent:ext fromArray:data offset:offs
"create a new form, take dimensions from ext, bits from data.
Smalltalk-80 compatibility."
^ self width:(ext x) height:(ext y) offset:offs fromArray:data
!
extent:ext offset:anOffset
"create a new, cleared form, take dimensions from ext.
Smalltalk-80 compatibility"
^ (self extent:ext) offset:anOffset.
!
width:w height:h
"create a new form on the default device"
^ self width:w height:h on:Screen current
"Modified: 4.6.1996 / 22:16:33 / cg"
!
width:w height:h depth:d
"create a new form on the default device"
^ self width:w height:h depth:d on:Screen current
"Modified: 4.6.1996 / 22:16:51 / cg"
!
width:w height:h depth:d on:aDevice
"create a new form with depth d on device, aDevice"
^ (self on:aDevice) width:w height:h depth:d
!
width:w height:h fromArray:anArray
"create a new form on the default device"
^ self width:w height:h fromArray:anArray on:Screen current
"Modified: 4.6.1996 / 22:17:05 / cg"
!
width:w height:h fromArray:anArray on:aDevice
"create a new form on device, aDevice and
initialize the pixels from anArray"
^ (self on:aDevice) width:w height:h fromArray:anArray
!
width:w height:h offset:offs fromArray:anArray
"create a new form on the default device"
^ (self on:Screen current) width:w height:h offset:offs fromArray:anArray
!
width:w height:h on:aDevice
"create a new form on device, aDevice; depth is what device likes most"
^ (self on:aDevice) width:w height:h
! !
!Form class methodsFor:'ST-80 compatibility'!
and
"return a constant usable as bitblt-combinationrule.
In ST-80rel2.x, these used to be numeric constants; in ST/X,
these are symbolic."
^ #and
"Modified: 2.5.1996 / 11:41:23 / cg"
!
black
"ST80 compatibility;
In old st80, you could use `Form black' for drawing
- here we return the black color."
^ Color black
"Modified: 2.5.1996 / 11:44:17 / cg"
!
darkGray
"ST80 compatibility;
In old st80, you could use `Form darkGray' for drawing
- here we return the darkGray color."
^ Color darkGray
"Modified: 2.5.1996 / 11:44:06 / cg"
!
darkGrey
"ST80 compatibility;
In old st80, you could use `Form darkGrey' for drawing
- here we return the darkGrey color."
^ Color darkGray
"Modified: 28.5.1996 / 20:47:54 / cg"
!
gray
"ST80 compatibility;
In old st80, you could use `Form gray' for drawing
- here we return the grey color."
^ Color gray
"Modified: 2.5.1996 / 11:43:44 / cg"
!
grey
"ST80 compatibility;
In old st80, you could use `Form grey' for drawing
- here we return the grey color."
^ Color grey
"Modified: 2.5.1996 / 11:43:17 / cg"
!
lightGray
"ST80 compatibility;
In old st80, you could use `Form lightGray' for drawing
- here we return the lightGray color."
^ Color lightGray
"Created: 2.5.1996 / 11:40:07 / cg"
"Modified: 2.5.1996 / 11:43:21 / cg"
!
lightGrey
"ST80 compatibility;
In old st80, you could use `Form lightGray' for drawing
- here we return the lightGray color."
^ Color lightGray
"Modified: 28.5.1996 / 20:53:28 / cg"
!
over
"return a constant usable as bitblt-combinationrule.
In ST-80rel2.x, these used to be numeric constants; in ST/X,
these are symbolic."
^ #copy
"Modified: 2.5.1996 / 11:41:31 / cg"
!
paint
"return a constant usable as bitblt-combinationrule.
In ST-80rel2.x, these used to be numeric constants; in ST/X,
these are symbolic."
^ #copy
"Modified: 2.5.1996 / 11:41:40 / cg"
!
reverse
"return a constant usable as bitblt-combinationrule.
In ST-80rel2.x, these used to be numeric constants; in ST/X,
these are symbolic."
^ #xor
"Modified: 2.5.1996 / 11:41:45 / cg"
!
under
"return a constant usable as bitblt-combinationrule.
In ST-80rel2.x, these used to be numeric constants; in ST/X,
these are symbolic."
^ #or
"Modified: 2.5.1996 / 11:41:49 / cg"
!
white
"ST80rel2.x compatibility;
In old st80, you could use `Form white' for drawing
- here we return the white color."
^ Color white
"Modified: 2.5.1996 / 11:42:50 / cg"
! !
!Form class methodsFor:'cleanup'!
lowSpaceCleanup
"cleanup in low-memory situations"
DitherPatternArray := nil
! !
!Form class methodsFor:'file search'!
findBitmapFile:fileName
"find the bitmap file in one of the standard places;
return the pathName or nil"
|aStream path|
((fileName at:1) == $/) ifTrue:[^ fileName].
(fileName startsWith:'../') ifTrue:[^ fileName].
(fileName startsWith:'./') ifTrue:[^ fileName].
fileName asFilename exists ifTrue:[^ fileName].
aStream := Smalltalk bitmapFileStreamFor:fileName.
aStream notNil ifTrue:[
path := aStream pathName.
aStream close.
^ path
].
AdditionalBitmapDirectoryNames notNil ifTrue:[
AdditionalBitmapDirectoryNames do:[:aPath |
path := aPath , '/' , fileName.
(OperatingSystem isReadable:path) ifTrue:[
^ path
]
]
].
^ nil
! !
!Form class methodsFor:'fileIn/Out'!
fromFile:filename
"create a new form taking the bits from a file on the default device.
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 devive as argument."
^ self fromFile:filename on:Screen current
!
fromFile:filename on:aDevice
"create a new form on device, aDevice and
initialize the pixels from the file filename"
^ (self on:aDevice) readFromFile:filename
!
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;
if it is different from the displays resolution, magnify or
shrink the picture (but only in integer magnification steps).
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:resolution:on: and pass the devive as argument."
^ self fromFile:filename resolution:dpi on:Screen current
!
fromFile:filename resolution:dpi on:aDevice
"create a new form on device, aDevice and
initialize the pixels from the file filename;
the data in the file is assumed to be for dpi resolution;
if it is different from the displays resolution, magnify or
shrink the picture (but only in integer magnification steps)"
^ (self on:aDevice) readFromFile:filename resolution:dpi
!
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 devive as argument."
^ self fromFile:fileName on:Screen current
! !
!Form class methodsFor:'obsolete instance creation'!
darkGreyFormOn:aDevice
"return a darkGrey form"
|f|
((aDevice == Display) and:[DarkGreyForm notNil]) ifTrue:[
^ DarkGreyForm
].
f := self width:8 height:4 fromArray:(self darkGreyFormBits) on:aDevice.
(aDevice == Display) ifTrue:[
DarkGreyForm := f
].
^ f
!
grey:percent on:aDevice
"return a form for dithering"
(percent < 20) ifTrue:[^ Color black on:aDevice].
(percent < 40) ifTrue:[^ self darkGreyFormOn:aDevice].
(percent < 60) ifTrue:[^ self mediumGreyFormOn:aDevice].
(percent < 80) ifTrue:[^ self lightGreyFormOn:aDevice].
^ Color white on:aDevice
!
lightGreyFormOn:aDevice
"return a lightGrey form"
|f|
((aDevice == Display) and:[LightGreyForm notNil]) ifTrue:[
^ LightGreyForm
].
f := self width:8 height:4 fromArray:(self lightGreyFormBits) on:aDevice.
(aDevice == Display) ifTrue:[
LightGreyForm := f
].
^ f
!
mediumGreyFormOn:aDevice
"return a grey form"
|f|
((aDevice == Display) and:[GreyForm notNil]) ifTrue:[
^ GreyForm
].
f := self width:8 height:4 fromArray:(self greyFormBits) on:aDevice.
(aDevice == Display) ifTrue:[
GreyForm := f
].
^ f
!
veryDarkGreyFormOn:aDevice
"return a veryDarkGrey form"
|f|
((aDevice == Display) and:[VeryDarkGreyForm notNil]) ifTrue:[
^ VeryDarkGreyForm
].
f := self width:8 height:4 fromArray:(self veryDarkGreyFormBits) on:aDevice.
(aDevice == Display) ifTrue:[
VeryDarkGreyForm := f
].
^ f
!
veryLightGreyFormOn:aDevice
"return a veryLightGrey form"
|f|
((aDevice == Display) and:[VeryLightGreyForm notNil]) ifTrue:[
^ VeryLightGreyForm
].
f := self width:8 height:4 fromArray:(self veryLightGreyFormBits) on:aDevice.
(aDevice == Display) ifTrue:[
VeryLightGreyForm := f
].
^ f
! !
!Form class methodsFor:'obsolete patterns'!
darkGreyFormBits
"return a pattern usable to simulate darkGray on monochrome device"
^ #(2r10111011
2r11101110
2r10111011
2r11101110)
!
grey12Bits
"return a pattern with 12% grey, usable for dithering"
^ #(2r00010001
2r00000000
2r01000100
2r00000000)
!
grey25Bits
"return a pattern with 25% grey, usable for dithering"
^ #(2r00010001
2r01000100
2r00010001
2r01000100)
!
grey37Bits
"return a pattern with 37% grey, usable for dithering"
^ #(2r00010001
2r10101010
2r01000100
2r10101010)
!
grey50Bits
"return a pattern with 50% grey, usable for dithering"
^ #(2r01010101
2r10101010
2r01010101
2r10101010)
!
grey6Bits
"return a pattern with 6% grey, usable for dithering"
^ #(2r00000001
2r00000000
2r00010000
2r00000000)
!
greyFormBits
"return a pattern usable to simulate gray on monochrome device"
^ #(2r01010101
2r10101010
2r01010101
2r10101010)
!
lightGreyFormBits
"return a pattern usable to simulate lightGray on monochrome device"
^ #(2r01000100
2r00010001
2r01000100
2r00010001
2r01000100)
!
veryDarkGreyFormBits
"return a pattern usable to simulate veryDarkGray on monochrome device"
^ #(2r01110111
2r11111111
2r11011101
2r11111111)
!
veryLightGreyFormBits
"return a pattern usable to simulate veryDarkGray on monochrome device"
^ #(2r10001000
2r00000000
2r00100010
2r00000000)
! !
!Form methodsFor:'ST-80 compatibility'!
displayOn:aGC at:aPoint
"draw in aGC.
Smalltalk-80 (2.x) compatibility"
^ self displayOn:aGC x:aPoint x y:aPoint y rule:#copy
"Modified: 12.5.1996 / 20:16:15 / cg"
!
displayOn:aGC at:aPoint rule:rule
"draw in aGC.
Smalltalk-80 (2.x) compatibility"
self displayOn:aGC x:aPoint x y:aPoint y rule:rule
"Modified: 12.5.1996 / 20:16:02 / cg"
!
displayOn:aGC rule:rule
"draw in aGC.
Smalltalk-80 (2.x) compatibility"
^ self displayOn:aGC x:0 y:0 rule:rule
"Modified: 12.5.1996 / 20:15:41 / cg"
!
displayOn:aGC x:x y:y
"draw in aGC.
Smalltalk-80 (2.x) compatibility"
^ self displayOn:aGC x:x y:y rule:#copy
"Created: 12.5.1996 / 20:15:05 / cg"
!
displayOn:aGC x:x y:y rule:rule
"draw in aGC.
Smalltalk-80 (2.x) compatibility"
|f|
f := aGC function.
aGC function:rule.
aGC displayOpaqueForm:self x:x y:y.
aGC function:f.
"Created: 12.5.1996 / 20:15:26 / cg"
!
offset
"set the offset.
Smalltalk-80 compatibility"
^ offset
!
offset:org
"set the offset.
Smalltalk-80 compatibility"
offset := org
! !
!Form methodsFor:'accessing'!
bits
"return a ByteArray filled with my bits -
for depth 8 forms, 1 pixel/byte is filled;
for depth 1 forms, 8 pixels/byte are filled
for depth 4 forms, 2 pixels/byte are filled.
Padding is done to the next byte-boundary
(i.e. for width==13 and depth==1 it will return 2 bytes per scanline)"
|bytesPerLine "{ Class: SmallInteger }"
bytesPerLineIn "{ Class: SmallInteger }"
inData tmpData info
srcIndex "{ Class: SmallInteger }"
dstIndex "{ Class: SmallInteger }"
buffer|
data notNil ifTrue:[
^ data
].
drawableId isNil ifTrue:[
fileName notNil ifTrue:[
^ (self on:Screen current) bits
].
^ nil
].
bytesPerLine := (width * depth + 31) // 32 * 4.
inData := ByteArray uninitializedNew:(bytesPerLine * height).
info := device getBitsFrom: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:[
"
different padding - have to copy over row-wise
"
tmpData := inData.
inData := ByteArray uninitializedNew:(bytesPerLine * height).
srcIndex := 1.
dstIndex := 1.
1 to:height do:[:hi |
inData replaceFrom:dstIndex to:(dstIndex + bytesPerLine - 1)
with:tmpData startingAt:srcIndex.
dstIndex := dstIndex + bytesPerLine.
srcIndex := srcIndex + bytesPerLineIn
]
] ifFalse:[
"
same padding - copy over all in one chunk
"
(bytesPerLine * height) ~~ inData size ifTrue:[
tmpData := inData.
inData := ByteArray uninitializedNew:(bytesPerLine * height).
inData replaceFrom:1 to:bytesPerLine * height with:tmpData startingAt:1
]
].
"
have to reverse bytes, if not msbFirst ?
"
(info at:#bitOrder) ~~ #msbFirst ifTrue:[
buffer := ByteArray new:bytesPerLine.
dstIndex := 1.
1 to:height do:[:hi |
buffer replaceFrom:1 to:bytesPerLine with:inData startingAt:dstIndex.
buffer reverse.
inData replaceFrom:dstIndex to:dstIndex+bytesPerLine-1 with:buffer startingAt:1.
dstIndex := dstIndex + bytesPerLine
]
].
^ inData.
!
bits:aByteArray
"set the forms bits;
for depth-8 forms, 1 pixel/byte is expected;
for depth-1 forms, 8 pixels/byte are expected
for depth-4 forms, 2 pixels/byte are expected.
Padding is expected to the next byte-boundary
(i.e. for width==13 and depth==1 2 bytes per scanline are expected)"
data := aByteArray
"Modified: 23.4.1996 / 10:06:01 / cg"
!
bitsPerSample
"for compatibility with Image class ..."
^ Array with:depth
!
colorMap
"return the receivers colormap"
^ localColorMap
!
colorMap:anArray
"set the receivers colormap"
localColorMap := anArray
!
depth
"return the receivers depth"
^ depth
!
filename
"return the filename, from which the receiver was created,
or nil, if it was not read from a file"
^ fileName
!
forgetBits
"for image, which also keeps the bits - so there is
no need to hold them again here"
data := nil
!
mask
"for compatibility with images; forms have no mask/alpha channel"
^ nil
"Created: 21.6.1996 / 12:52:42 / cg"
!
photometric
"for compatibility with Image class ..."
depth == 1 ifTrue:[
localColorMap isNil ifTrue:[
^ #whiteIs0
].
((localColorMap at:1) = Color white) ifTrue:[
((localColorMap at:2) = Color black) ifTrue:[
^ #whiteIs0
].
].
((localColorMap at:1) = Color black) ifTrue:[
((localColorMap at:2) = Color white) ifTrue:[
^ #blackIs0
].
].
].
^ #palette
"Modified: 17.6.1996 / 11:45:16 / cg"
!
samplesperPixel
"for compatibility with Image class ..."
^ 1
!
valueAt:aPoint
"return the pixel at aPoint; the coordinates start with 0@0
in the upper left, increasing to the lower right"
^ self at:aPoint
"Modified: 23.4.1996 / 10:06:55 / cg"
!
valueAt:aPoint put:value
"set the pixel at aPoint; the coordinates start with 0@0
in the upper left, increasing to the lower right."
^ self at:aPoint put:value
"
|f|
f := Form width:10 height:10 depth:1.
f clear.
1 to:10 do:[:i |
f valueAt:(i @ i) put:1
].
f inspect
"
"Modified: 23.4.1996 / 10:12:48 / cg"
! !
!Form methodsFor:'binary storage'!
readBinaryContentsFrom: stream manager: manager
"tell the newly restored Form about restoration"
super readBinaryContentsFrom: stream manager: manager.
device := Screen current.
fileName := nil.
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."
data isNil ifTrue:[
data := self bits.
super storeBinaryDefinitionOn: stream manager: manager.
data := nil.
^ self
].
super storeBinaryDefinitionOn: stream manager: manager
"Modified: 23.4.1996 / 09:30:47 / cg"
! !
!Form methodsFor:'converting'!
asForm
"convert & return the receiver into a Form instance - nothing to be done here"
^ self
"Modified: 23.4.1996 / 10:14:11 / cg"
!
asImage
"convert & return the receiver into an Image instance"
^ Image fromForm:self
"Modified: 23.4.1996 / 10:13:56 / cg"
! !
!Form methodsFor:'copying'!
postCopy
"redefined to copy the colorMap as well"
super postCopy.
localColorMap := localColorMap copy.
data := data copy
"Modified: 23.4.1996 / 10:14:46 / cg"
!
shallowCopyForFinalization
"redefined for faster creation of finalization copies
(only device, gcId and drawableId are needed)"
|aCopy|
aCopy := DeviceFormHandle basicNew.
aCopy setDevice:device id:drawableId gcId:gcId.
^ aCopy
! !
!Form methodsFor:'editing'!
edit
"open an imageEditor on the receiver"
ImageEditView openOnImage:self
"
(Form fromFile:'bitmaps/SBrowser.xbm') edit
"
"Modified: 23.4.1996 / 10:16:02 / cg"
!
show
"open an imageView on the receiver"
ImageView openOnImage:self
"
(Form fromFile:'bitmaps/SBrowser.xbm') show
"
"Modified: 23.4.1996 / 10:16:12 / cg"
! !
!Form methodsFor:'getting a device form'!
asFormOn:aDevice
"convert & return the receiver into a Form instance
and associate it to a device (i.e. download its bits).
Added for protocol compatibility with Image."
aDevice == device ifTrue:[
^ self
].
^ self on:aDevice
"Modified: 23.4.1996 / 10:17:26 / cg"
!
asMonochromeFormOn:aDevice
"added for protocol compatiblity with Image"
aDevice == device ifTrue:[
depth == 1 ifTrue:[
^ self
].
].
(depth == 1) ifTrue:[
^ self on:aDevice
].
^ nil
"Modified: 23.4.1996 / 10:18:42 / cg"
!
on:aDevice
"associate the receiver to a device (i.e. download its bits);
return a deviceForm (possibly different from the receiver)."
aDevice == device ifTrue:[
^ self
].
"create a new form ..."
data notNil ifTrue:[
^ self class width:width height:height fromArray:data on:aDevice
].
fileName notNil ifTrue:[
^ self class fromFile:fileName on:aDevice
].
^ self width:width height:height on:aDevice
"Modified: 23.4.1996 / 10:18:05 / cg"
! !
!Form methodsFor:'image manipulations'!
darkened
"return a darkened version of the receiver.
Added for protocol compatibility with Color and Image.
Here, the receiver is returned as a kludge
- actually should return a darkened image (or Color black ?) .."
^ self
"Modified: 23.4.1996 / 10:19:52 / cg"
!
flipHorizontal
"return a new form flipped horizontally"
|dstY newForm nRows "{ Class: SmallInteger }" |
newForm := ((self class) on:device)
width:width
height:height
depth:depth.
"expand rows"
dstY := height - 1.
nRows := dstY // 2.
0 to:nRows do:[:srcY |
newForm copyFrom:self
x:0 y:srcY
toX:0 y:dstY
width:width height:1.
dstY := dstY - 1
].
newForm colorMap:localColorMap.
^ newForm
!
flipVertical
"return a new form flipped vertically"
|dstX newForm nCols "{ Class: SmallInteger }" |
newForm := ((self class) on:device)
width:width
height:height
depth:depth.
"expand cols"
dstX := width - 1.
nCols := dstX // 2.
0 to:nCols do:[:srcX |
newForm copyFrom:self
x:srcX y:0
toX:dstX y:0
width:1 height:height.
dstX := dstX - 1
].
newForm colorMap:localColorMap.
^ newForm
!
hardMagnifiedBy:extent
"return a new form magnified by extent, aPoint.
This method handles non-integral factors."
"
since Form will be replaced by Image in the long run,
and this operation is slow anyway, use the implementation
in Image for this."
^ ((Image fromForm:self) magnifiedBy:extent) asFormOn:device.
"
(Form fromFile:'OutputOn.64') magnifiedBy:0.5@0.5
(Form fromFile:'OutputOn.64') magnifiedBy:1.5@1.5
"
!
lightened
"return a lightened version of the receiver.
Added for protocol compatibility with Color and Image.
Here, the receiver is returned as a kludge
- actually should return a lightened image (or Color white ?) .."
^ self
"Modified: 23.4.1996 / 10:20:14 / cg"
!
magnifiedBy:extent
"return a new form magnified by extent, aPoint.
If non-integral magnify is asked for, pass the work on to 'hardMagnifiedBy:'"
|mX mY dstX dstY newForm ext
factor "{ Class: SmallInteger }"
n "{ Class: SmallInteger }" |
ext := extent asPoint.
mX := ext x.
mY := ext y.
((mX = 1) and:[mY = 1]) ifTrue:[^ self].
((mX isMemberOf:SmallInteger) and:[mY isMemberOf:SmallInteger]) ifFalse:[
^ self hardMagnifiedBy:ext
].
newForm := ((self class) on:device)
width:(width * mX)
height:(height * mY)
depth:depth.
"expand rows"
(mY > 1) ifTrue:[
dstY := 0.
n := height.
factor := mY.
0 to:(n - 1) do:[:srcY |
1 to:factor do:[:i |
newForm copyFrom:self
x:0 y:srcY
toX:0 y:dstY
width:width height:1.
dstY := dstY + 1
]
]
].
"expand cols"
(mX > 1) ifTrue:[
n := width.
factor := mX.
dstX := (n * factor) - 1.
(n - 1) to:0 by:-1 do:[:srcX |
1 to:factor do:[:i |
newForm copyFrom:newForm
x:srcX y:0
toX:dstX y:0
width:1 height:(height * mY).
dstX := dstX - 1
]
]
].
newForm colorMap:localColorMap.
^ newForm
"
(ArrowButton upArrowButtonForm:#iris on:Display) magnifiedBy:(2 @ 2)
(Form fromFile:'bitmaps/SBrowser.xbm') magnifiedBy:(2 @ 2)
(Form fromFile:'bitmaps/SBrowser.xbm') magnifiedBy:(0.4 @ 0.4)
"
!
magnifiedTo:anExtent
"return a new form magnified to have the size specified by extent.
This may distort the image if the arguments ratio is not the images ratio.
See also #magnifiedPreservingRatioTo: and #magnifiedBy:"
^ self magnifiedBy:(anExtent / self extent)
"Created: 18.4.1996 / 16:17:52 / cg"
!
magnifyBy:scale
"obsolete: has been renamed to magnifiedBy: for ST-80 compatibility
and name consistency ..."
self obsoleteMethodWarning.
^ self magnifiedBy:scale
! !
!Form methodsFor:'initialization'!
initGC
"stop server from sending exposure events for Forms -
(will fill up stream-queue on some stupid (i.e. sco) systems"
super initGC.
self setGraphicsExposures:false
"Modified: 11.6.1996 / 21:21:34 / cg"
!
initialize
super initialize.
depth := 1.
foreground isNil ifTrue:[
foreground := paint := Color colorId:1.
].
background isNil ifTrue:[
background := bgPaint := Color colorId:0
]
"Modified: 11.6.1996 / 21:17:05 / cg"
!
recreate
"reconstruct the form after a snapin"
data notNil ifTrue:[
"
create one from data
"
(depth == 1 or:[depth == device depth]) ifTrue:[
drawableId := device createBitmapFromArray:data width:width height:height.
Lobby registerChange:self.
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.
drawableId notNil ifTrue:[
^ self
].
'FORM: cannot recreate file form: ' errorPrint. fileName errorPrintCR.
].
^ self.
"
create an empty one
"
depth == 1 ifTrue:[
drawableId := device createBitmapWidth:width height:height
] ifFalse:[
drawableId := device createPixmapWidth:width height:height depth:device depth
].
Lobby registerChange:self
"Modified: 15.6.1996 / 16:18:12 / cg"
! !
!Form methodsFor:'inspecting'!
inspectorClass
"redefined to launch an ImageInspector
(instead of the default InspectorView)."
^ ImageInspectorView
! !
!Form methodsFor:'printing & storing'!
storeOn:aStream
"append an ascii representation of the receiver to aStream,
from which a copy of the receiver can be reconstructed"
aStream nextPutAll:'(Form width:'.
width storeOn:aStream.
aStream nextPutAll:' height:'.
height storeOn:aStream.
aStream nextPutAll:' fromArray:('.
self bits storeOn:aStream.
aStream nextPutAll:'))'
"Modified: 23.4.1996 / 10:21:10 / cg"
! !
!Form methodsFor:'private'!
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
]
]
"
Form allInstances:[:f |
f beImmediateForm
]
"
"Created: 7.2.1996 / 16:04:18 / cg"
!
flushDeviceHandles
"flush device handles (sent after a restart)"
drawableId := nil.
gcId := nil.
"Created: 15.6.1996 / 15:44:28 / cg"
!
getBits
"if the receiver was not created from a file, or
an array (i.e. it was drawn), read the pixels from the
device into a local data array. This has to be done before
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 := 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.
"
|pathName|
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."
|dpiH mag dev|
(self readFromFile:filename) isNil ifTrue:[^ nil].
"if the device is within +- 50% of dpi, no magnify is needed"
dev := device.
dev isNil ifTrue:[
"should not happen ..."
dev := Screen current
].
dpiH := 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)"
device := nil.
drawableId := nil.
gcId := nil.
"Modified: 15.6.1996 / 15:43:39 / cg"
!
width:w height:h
"actual create of a monochrome form"
((w == 0) or:[h == 0]) ifTrue:[
self error:'invalid form extent'.
^ nil
].
width := w.
height := h.
depth := 1.
offset := 0@0.
drawableId := device createBitmapWidth:w height:h.
drawableId isNil ifTrue:[^ nil].
BlackAndWhiteColorMap isNil ifTrue:[
BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
].
localColorMap := BlackAndWhiteColorMap.
realized := true.
Lobby registerChange:self.
!
width:w height:h depth:d
"actual create of an arbitrary deep form (but, must be supported by device)"
width := w.
height := h.
offset := 0@0.
drawableId := device createPixmapWidth:w height:h depth:d.
drawableId isNil ifTrue:[^ nil].
realized := true.
depth := d.
Lobby registerChange:self.
!
width:w height:h fromArray:anArray
"actual create of a monochrome form from array.
This method is somewhat more complicated as it should be due to
supporting both byte-wise (ST/X-type) and short-word-wise (ST-80-type)
Arrays; in the later case, the shorts are first converted to bytes in
a ByteArray, then passed to the device."
|bytes bits
srcPerRow "{ Class: SmallInteger }"
dstPerRow "{ Class: SmallInteger }"
srcStart "{ Class: SmallInteger }"
srcIndex "{ Class: SmallInteger }"
dstIndex "{ Class: SmallInteger }"
hi "{ Class: SmallInteger }" |
bytes := anArray.
anArray size ~~ (((w + 7) // 8) * h) ifTrue:[
anArray size == (((w + 15) // 16) * h) ifTrue:[
"I want the bytes but got shorts (ST-80)"
bytes := ByteArray uninitializedNew:(((w + 7) // 8) * h).
srcPerRow := (w + 15) // 16.
dstPerRow := (w + 7) // 8.
srcStart := 1.
dstIndex := 1.
hi := h.
1 to:hi do:[:hi |
srcIndex := srcStart.
bits := anArray at:srcIndex.
1 to:dstPerRow do:[:di |
di odd ifTrue:[
bits := anArray at:srcIndex.
bytes at:dstIndex put:(bits bitShift:-8)
] ifFalse:[
bytes at:dstIndex put:(bits bitAnd:16rFF).
srcIndex := srcIndex + 1
].
dstIndex := dstIndex + 1
].
srcStart := srcStart + srcPerRow
]
]
].
width := w.
height := h.
depth := 1.
offset := 0@0.
drawableId := device createBitmapFromArray:bytes width:w height:h.
drawableId isNil ifTrue:[^ nil].
data := bytes.
BlackAndWhiteColorMap isNil ifTrue:[
BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
].
localColorMap := BlackAndWhiteColorMap.
realized := true.
Lobby registerChange:self.
!
width:w height:h offset:offs fromArray:anArray
"actual create of a monochrome form from array"
self width:w height:h fromArray:anArray.
offset := offs
! !
!Form methodsFor:'queries '!
bounds
"return my bounds (added to make forms usable as VisualComponents)"
^ Rectangle left:0 top:0 width:width height:height
"Modified: 13.5.1996 / 10:26:13 / cg"
!
colorFromValue:pixel
localColorMap notNil ifTrue:[
^ localColorMap at:(pixel + 1)
].
depth == 1 ifTrue:[
pixel == 0 ifTrue:[^ Color white].
^ Color black
].
^ Color black
"Created: 28.6.1996 / 16:10:13 / cg"
"Modified: 28.6.1996 / 16:10:23 / cg"
!
heightOn:aGC
"return my height, if displayed on aGC;
since my height is independent of the device (the number of pixels),
return the pixel-height"
^ height
"Created: 12.5.1996 / 21:35:33 / cg"
"Modified: 13.5.1996 / 10:26:09 / cg"
!
isForm
"return true, if the receiver is some kind of form;
true is returned here - the method is redefined from Object."
^ true
!
isImageOrForm
"return true, if the receiver is some kind of image or form;
true is returned here - the method is redefined from Object."
^ true
!
widthOn:aGC
"return my width, if displayed on aGC;
since my width is independent of the device (the number of pixels),
return the pixel-width"
^ width
"Created: 12.5.1996 / 21:35:29 / cg"
"Modified: 13.5.1996 / 10:26:05 / cg"
! !
!Form class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libview/Form.st,v 1.57 1996-06-28 14:11:12 cg Exp $'
! !
Form initialize!