"{ Encoding: utf8 }"

"

 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.

"

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

	classVariableNames:'VeryLightGreyForm LightGreyForm GreyForm DarkGreyForm

		VeryDarkGreyForm AdditionalBitmapDirectoryNames

		BlackAndWhiteColorMap DitherPatternArray'

	poolDictionaries:''

	category:'Compatibility-ST80-Graphics-Display Objects'

!

Form subclass:#ImageForm

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:Form

!

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

    WARNING:

	Forms created on some device may not be recreatable, when an

	image is restarted on a display with different display capabilities.

	For example, a 24bit truecolor form will be lost when the image is

	saved and restarted in an 8bit or monochrome display.

	Worse: the information is completely lost.

	With images, the original information is always preserved, although

	the display may be with less resolution, dithered or otherwise

	approximated.

    [See also:]

	Image DeviceDrawable

    [author:]

	Claus Gittinger

"

! !

!Form class methodsFor:'initialization'!

initialize

    "initialize set of dictionaries to look for bitmaps"

    AdditionalBitmapDirectoryNames isNil ifTrue:[

        OperatingSystem isMSWINDOWSlike ifTrue:[

        ] ifFalse:[

            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 after snapIn, to

     have all background bitmaps at hand, when views are restored"

    Form allSubInstancesDo:[:eachForm |

        eachForm graphicsDevice == aDevice ifTrue:[

            "now, try to recreate it"

            eachForm recreate.

        ]

    ]

    "Modified: 5.7.1996 / 17:55:58 / cg"

!

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"

        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"

        Form allSubInstancesDo:[:eachForm |

            eachForm flushDeviceHandles.

        ]

    ]

    "Modified: 15.6.1996 / 15:44:09 / cg"

    "Created: 15.6.1996 / 15:47:50 / cg"

! !

!Form class methodsFor:'instance creation'!

dotOfSize:size

    "create and return a form which contains a dot (filled circle)

     of the given size."

    |f|

    f := self extent:size asPoint onDevice:Screen current.

    f clear.

    f fillCircle:(f center) radius:(f width min:f height) // 2.

    ^ f

    "

     (Form dotOfSize:8) inspect

     (Form dotOfSize:20) inspect

    "

!

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 depth:d

    "create a new, cleared form.

     Smalltalk-80 compatibility"

    ^ self width:ext x height:ext y depth:d

    "Created: 27.1.1997 / 16:08:37 / cg"

    "Modified: 27.1.1997 / 16:08:50 / cg"

!

extent:ext depth:d onDevice:aDevice

    "create a new form on device, aDevice; depth is what device likes most"

    ^ self width:ext x height:ext y depth:d onDevice:aDevice

    "Created: 4.4.1997 / 20:23:32 / cg"

    "Modified: 4.4.1997 / 20:25:28 / cg"

!

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 fromArray:data offset:offs onDevice:aDevice

    "create a new form, take dimensions from ext, bits from data."

    ^ self width:(ext x) height:(ext y) offset:offs fromArray:data onDevice:aDevice

    "Created: 10.4.1997 / 15:36:31 / cg"

!

extent:ext fromArray:data onDevice:aDevice

    "create a new form, take dimensions from ext, bits from data."

    ^ self width:(ext x) height:(ext y) fromArray:data onDevice:aDevice

    "Created: 10.4.1997 / 15:34:34 / cg"

    "Modified: 10.4.1997 / 15:36:04 / cg"

!

extent:ext offset:anOffset

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

     Smalltalk-80 compatibility"

    ^ (self extent:ext) offset:anOffset.

!

extent:ext onDevice:aDevice

    "create a new form on device, aDevice; depth is what device likes most"

    ^ self width:ext x height:ext y onDevice:aDevice

    "Modified: 4.4.1997 / 20:25:07 / cg"

!

width:w height:h

    "create a new form on the default device"

    |scr|

    Screen notNil ifTrue:[scr := Screen current].

    ^ self width:w height:h onDevice:scr

    "Modified: 4.6.1996 / 22:16:33 / cg"

!

width:w height:h depth:d

    "create a new form on the default device"

    |scr|

    Screen notNil ifTrue:[scr := Screen current].

    ^ self width:w height:h depth:d onDevice:scr

    "Modified: 4.6.1996 / 22:16:51 / cg"

!

width:w height:h depth:d onDevice:aDevice

    "create a new form with depth d on device, aDevice"

    ^ (self onDevice:aDevice) width:w height:h depth:d

    "Modified: 18.1.1997 / 18:26:03 / cg"

!

width:w height:h fromArray:anArray

    "create a new form on the default device"

    |scr|

    Screen notNil ifTrue:[scr := Screen current].

    ^ self width:w height:h fromArray:anArray onDevice:scr

    "Modified: / 29-05-2007 / 19:31:14 / cg"

!

width:w height:h fromArray:anArray onDevice:aDevice

    "create a new form on device, aDevice and

     initialize the pixels from anArray"

    ^ (self onDevice:aDevice) width:w height:h fromArray:anArray

    "Modified: 18.1.1997 / 18:26:24 / cg"

!

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

    "create a new form on the default device"

    |scr|

    Screen notNil ifTrue:[scr := Screen current].

    ^ self width:w height:h offset:offs fromArray:anArray onDevice:scr

!

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

    "create a new form on the default device"

    ^ (self onDevice:aDevice) width:w height:h offset:offs fromArray:anArray

    "Modified: 18.1.1997 / 18:26:28 / cg"

    "Created: 10.4.1997 / 15:35:07 / cg"

!

width:w height:h onDevice:aDevice

    "create a new form on device, aDevice; depth is what device likes most"

    ^ (self onDevice:aDevice) width:w height:h

    "Modified: 18.1.1997 / 18:26:31 / cg"

! !

!Form class methodsFor:'Compatibility-ST80'!

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:'Compatibility-Squeak'!

extent:ext depth:d bits:data

    ^ self width:(ext x) height:(ext y) offset:0 fromArray:data

    "Created: / 26-05-2007 / 22:35:12 / cg"

!

extent:ext depth:d fromArray:data offset:offs

    d ~~ 1 ifTrue:[self error:'unsupported depth' mayProceed:true].       

    ^ self width:(ext x) height:(ext y) offset:offs fromArray:data

! !

!Form class methodsFor:'cleanup'!

lowSpaceCleanup

    "cleanup in low-memory situations"

    DitherPatternArray := nil

! !

!Form class methodsFor:'file search'!

findBitmapFile:fileName

    <resource: #obsolete>

    "find the bitmap file in one of the standard places;

     return the pathName or nil"

    |path|

    ((fileName at:1) == $/) ifTrue:[^ fileName].

    (fileName startsWith:'../') ifTrue:[^ fileName].

    (fileName startsWith:'./') ifTrue:[^ fileName].

    fileName asFilename exists ifTrue:[^ fileName].

    path := Smalltalk getBitmapFileName:fileName.

    path notNil ifTrue:[

        ^ path

    ].