"

 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.

"

DeviceDrawable subclass:#Form

       instanceVariableNames:'depth localColorMap offset data fileName'

       classVariableNames:'VeryLightGreyForm LightGreyForm GreyForm 

			   DarkGreyForm VeryDarkGreyForm

			   AdditionalBitmapDirectoryNames

			   BlackAndWhiteColorMap DitherPatternArray'

       poolDictionaries:''

       category:'Graphics-Display Objects'

!

Form comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

'!

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

"

!

version

"

"

!

documentation

"

    Instances of this class represent forms (i.e. bit- and pixmaps)

    which can be created on the drawing device. In X, these 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 (for example: PostscriptPrinters).

"

! !

!Form class methodsFor:'initialization'!

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

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

		Lobby changed:aDrawable 

	    ]

	]

    ]

! !

!Form methodsFor:'inspecting'!

inspectorClass

    "redefined to launch an ImageInspector

     (instead of the default InspectorView)."

    ^ ImageInspectorView

! !

!Form class methodsFor:'cleanup'!

lowSpaceCleanup

    "cleanup in low-memory situations"

    DitherPatternArray := nil

! !

!Form methodsFor:'copying'!

postCopy

    super postCopy.

    localColorMap := localColorMap copy.

    data := data copy

! !

!Form methodsFor:'instance release'!

    "some Form has been collected - tell it to the x-server"

    drawableId notNil ifTrue:[

	gcId notNil ifTrue:[

	    device destroyGC:gcId.

	    gcId := nil

	].

	device destroyPixmap:drawableId.

	drawableId := 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:'private instance creation'!

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

!

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

!

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

!

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

!

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

!

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

! !

!Form class methodsFor:'ST-80 compatibility'!

over

    "return a constant usable as bitblt-combinationrule"

    ^ #copy

!

paint

    "return a constant usable as bitblt-combinationrule"

    ^ #copy

!

under

    "return a constant usable as bitblt-combinationrule"

    ^ #or

!

reverse

    "return a constant usable as bitblt-combinationrule"

    ^ #xor

!

and

    "return a constant usable as bitblt-combinationrule"

    ^ #and

! !

!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 offset:anOffset

    "create a new, cleared form, take dimensions from ext.

     Smalltalk-80 compatibility"

    ^ (self extent:ext) offset:anOffset.

!

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

!

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

!

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 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

    "create a new form on the default device"

    ^ (self on:Display) width:w height:h

!

width:w height:h depth:d

    "create a new form on the default device"

    ^ (self on:Display) width:w height:h depth:d

!

width:w height:h fromArray:anArray

    "create a new form on the default device"

    ^ (self on:Display) width:w height:h fromArray:anArray

!

width:w height:h offset:offs fromArray:anArray

    "create a new form on the default device"

    ^ (self on:Display) width:w height:h offset:offs fromArray:anArray

!

white

    "ST80 compatibility;

     in st80, return a white form - here we return white color"

    ^ Color white

!

black

    "ST80 compatibility;

     in st80, return a black form - here we return black color"

    ^ Color black

!

gray

    "ST80 compatibility;

    in st80, return a grey form - here we return grey color"

    ^ self grey

!

grey

    "ST80 compatibility;

    in st80, return a grey form - here we return grey color"

    ^ Color grey

!

lightGrey

    "ST80 compatibility;

    in st80, return a lightGrey form - here we return lightGrey color"

    ^ Color lightGrey

!

darkGrey

    "ST80 compatibility;

    in st80, return a darkGrey form - here we return darkGrey color"

    ^ Color darkGrey

!

darkGray

    "ST80 compatibility;

    in st80, return a darkGrey form - here we return darkGrey color"

    ^ Color darkGrey

! !

!Form class methodsFor:'patterns'!

ditherBitsForXin64:x

    "return a dither pattern for x/64; x in 1..63"

    |sel|

    DitherPatternArray isNil ifTrue:[

	DitherPatternArray := Array new:63.

	1 to:63 do:[:i |

	    "

	     compute the selector as #'dither<n>in64'

	    "

	    sel := ('dither' , i printString , 'in64') asSymbol.

	    DitherPatternArray at:i put:(self perform:sel)

	]

    ].

    ^ DitherPatternArray at:x

!

dither1in64

    "return a pattern for dithering"

    ^ #[2r10000000

	2r00000000

	2r00000000

	2r00000000

	2r00000000

	2r00000000

	2r00000000

	2r00000000]

!

dither2in64

    "return a pattern for dithering"

    ^ #[2r10000000

	2r00000000

	2r00000000

	2r00000000

	2r00001000

	2r00000000

	2r00000000

	2r00000000]

!

dither3in64

    "return a pattern for dithering"

    ^ #[2r10000000

	2r00000000

	2r00000000

	2r00000000

	2r10001000

	2r00000000