"

 COPYRIGHT (c) 1992-93 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.

"

Object subclass:#Cursor

       instanceVariableNames:'shape sourceForm maskForm hotX hotY

                              device cursorId'

       classVariableNames:   'lobby

                              DefaultFgColor DefaultBgColor

                              NormalCursor HandCursor ArrowCursor

                              ReadCursor WriteCursor WaitCursor

                              XeqCursor CrossHairCursor OriginCursor

                              CornerCursor SquareCursor FourWayCursor

                              UpDownArrowCursor LeftRightArrowCursor'

       poolDictionaries:''

       category:'Graphics-Support'

!

Cursor comment:'

COPYRIGHT (c) 1992-93 by Claus Gittinger

             All Rights Reserved

%W% %E%

see Cursor class documentation for info.

rewritten from XCursor summer 92 by claus

'!

!Cursor class methodsFor:'documentation'!

documentation

    "

I represents cursors in a device independent manner.

Instance variables:

shape           <Symbol>        a shape (i.e. #arrow, #hand, ...) or nil

sourceForm      <Form>          if shape is nil, the source bits

maskForm        <Form>          if shape is nil, the mask bits

hotX            <SmallInteger>  if shape is nil, the hotSpot x of the cursor

hotY            <SmallInteger>  if shape is nil, the hotSpot y of the cursor

device          <aDevice>       the device, if associated to one

cursorId        <anObject>      the device-specific id if device is nonNil

class variables:

lobby           <Registry>      keeps track of known cursors

DefaultFgColor  <Color>         default foreground color for cursors (usually black)

DefaultBgColor  <Color>         default background color for cursors (usually white)

NormalCursor    <Cursor>        cached instance of normal (arrow) cursor

 ...

    "

! !

!Cursor class methodsFor:'initialization'!

initialize

    lobby isNil ifTrue:[

        lobby := Registry new.

        "want to be informed when returning from snapshot"

        ObjectMemory addDependent:self

    ]

!

flushDeviceCursors

    "unassign all cursors from their device"

    lobby contentsDo:[:aCursor |

        aCursor resetDevice.

        lobby changed:aCursor

    ]

!

update:something

    "sent when restarted after a snapIn"

    (something == #restarted) ifTrue:[

        self flushDeviceCursors

    ]

! !

!Cursor class methodsFor:'default access'!

defaultFgColor:fgColor defaultBgColor:bgColor

    "set the default colors used for cursors"

    DefaultFgColor := fgColor.

    DefaultBgColor := bgColor

! !

!Cursor class methodsFor:'instance creation'!

extent:extent fromArray:array offset:offset

    "create a new bitmap cursor from bits in the array argument

     - ST-80 compatibility"

    |sourceForm|

    sourceForm := Form extent:extent fromArray:array offset:offset.

    ^ self sourceForm:sourceForm maskForm:sourceForm hotSpot:(offset negated)

!

extent:extent sourceArray:sourceArray maskArray:maskArray offset:offset

    "create a new bitmap cursor with mask from bits in sourceArray and

     maskArray"

    |sourceForm maskForm|

    sourceForm := Form extent:extent fromArray:sourceArray offset:offset.

    maskForm := Form extent:extent fromArray:maskArray offset:offset.

    ^ self sourceForm:sourceForm maskForm:maskForm hotSpot:(offset negated)

!

sourceForm:aForm

    "return a new cursor.

     Source- and mask-Bits are taken from aForm; hotSpot is center"

    ^ self sourceForm:aForm

             maskForm:aForm

                 hotX:(aForm width // 2)

                 hotY:(aForm height // 2)

!

sourceForm:sourceForm maskForm:maskForm

    "return a new cursor. hotSpot is center"

    ^ self sourceForm:sourceForm

             maskForm:maskForm

                 hotX:(sourceForm width // 2)

                 hotY:(sourceForm height // 2)

!

sourceForm:sourceForm maskForm:maskForm hotSpot:aPoint

    "return a new cursor"

    ^ self sourceForm:sourceForm

             maskForm:maskForm

                 hotX:(aPoint x)

                 hotY:(aPoint y)

!

sourceForm:sourceForm maskForm:maskForm hotX:hotX hotY:hotY

    "return a new cursor"

    |newCursor|

    "first look if not already known"

    lobby contentsDo:[:aCursor |

        (aCursor sourceForm == sourceForm) ifTrue:[

            (aCursor maskForm == maskForm) ifTrue:[

                (aCursor hotX == hotX) ifTrue:[

                    (aCursor hotY == hotY) ifTrue:[

                        ^ aCursor

                    ]

                ]

            ]

        ]

    ].

    newCursor := self basicNew sourceForm:sourceForm maskForm:maskForm

                                     hotX:hotX hotY:hotY on:nil.

    lobby register:newCursor.

    ^ newCursor

!

shape:aShape 

    "return one of the standard cursors.

     Each display may offer different shapes - see for example XWorkstation

     for details (however a basic minimum set should be supported by all)"

    |newCursor|

    "first look if not already known"

    lobby contentsDo:[:aCursor |

        (aCursor shape == aShape) ifTrue:[

            ^ aCursor

        ]

    ].

    newCursor := self basicNew shape:aShape on:nil.

    lobby register:newCursor.

    ^ newCursor

!

fileCursorNamed:cursorName

    "return a cursor read from the files 'cursorName_bits.bit' and

     'cursorName_mask.bit' - return nil if file does not exist"

    |cursorBits maskBits|

    cursorBits := Form fromFile:(cursorName , '_bits.bit').

    cursorBits notNil ifTrue:[

        maskBits := Form fromFile:(cursorName , '_mask.bit').

        maskBits notNil ifTrue:[

            ^ self sourceForm:cursorBits maskForm:maskBits

        ]

    ].

    ^ nil

! !

!Cursor class methodsFor:'standard cursors'!

normal

    "return the normal cursor; an arrow.

     for ST-80 compatibility"

    NormalCursor isNil ifTrue:[

        NormalCursor := self arrow

    ].

    ^ NormalCursor

!

hand

    "return a hand cursor"

    HandCursor isNil ifTrue:[

        HandCursor := self shape:#upRightHand

    ].

    ^ HandCursor

!

upRightHand

    "return an up-right-hand cursor"

    ^ self shape:#upRightHand

!

leftHand

    "return a left-hand cursor"

    ^ self shape:#leftHand

!

upDownArrow

    "return an up-down-arrow cursor"

    UpDownArrowCursor isNil ifTrue:[

        UpDownArrowCursor := self shape:#upDownArrow

    ].

    ^ UpDownArrowCursor

!

leftRightArrow

    "return a left-right-arrow cursor"

    LeftRightArrowCursor isNil ifTrue:[

        LeftRightArrowCursor := self shape:#leftRightArrow

    ].

    ^ LeftRightArrowCursor

!

upLimitArrow

    "return an up-arrow-to-limit cursor"

    ^ self shape:#upLimitArrow

!

downLimitArrow

    "return a down-arrow-to-limit cursor"

    ^ self shape:#downLimitArrow

!

leftLimitArrow

    "return a left-arrow-to-limit cursor"

    ^ self shape:#leftLimitArrow

!

rightLimitArrowOn

    "return a right-arrow-to-limit cursor"

    ^ self shape:#rightLimitArrow

!

text

    "return a text-cursor"

    ^ self shape:#text

!

arrow

    "return an arrow (up-left-arrow) cursor"

    ^ self shape:#upLeftArrow

!

upLeftArrow

    "return an up-right-arrow cursor"

    ^ self shape:#upLeftArrow

!

upRightArrow

    "return an up-right-arrow cursor"

    ^ self shape:#upRightArrow

!

questionMark

    "return a question-mark cursor"

    ^ self shape:#questionMark

!

cross

    "return a cross cursor"

    ^ self shape:#cross

!

origin

    "return an origin cursor"

    OriginCursor isNil ifTrue:[

        OriginCursor := self shape:#origin

    ].

    ^ OriginCursor

!

corner 

    "return a corner cursor"

    CornerCursor isNil ifTrue:[

        CornerCursor := self shape:#corner 

    ].

    ^ CornerCursor

!

crossHair

    "return a crossHair cursor"

    CrossHairCursor isNil ifTrue:[

        CrossHairCursor := self shape:#crossHair

    ].

    ^ CrossHairCursor

!

fourWay 

    "return a four-way arrow cursor"

    FourWayCursor isNil ifTrue:[

        FourWayCursor := self shape:#fourWay 

    ].

    ^ FourWayCursor

!

wait

    "return a wait cursor"

    WaitCursor isNil ifTrue:[

        WaitCursor := self shape:#wait

    ].

    ^ WaitCursor

!

read

    "return a reading-file cursor"

    ReadCursor isNil ifTrue:[

        ReadCursor := self shape:#wait

    ].

    ^ ReadCursor

!

write

    "return a writing-file cursor"

    WriteCursor isNil ifTrue:[

        WriteCursor := self shape:#wait

    ].

    ^ WriteCursor

!

execute

    "return a execute cursor - ST-80 compatibility"

    XeqCursor isNil ifTrue:[

        XeqCursor := self shape:#wait

    ].

    ^ XeqCursor

! !

!Cursor methodsFor:'instance release'!

disposed

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

    cursorId notNil ifTrue:[

        device destroyCursor:cursorId.

    ]

! !

!Cursor methodsFor:'accessing'!

id

    "return the cursors deviceId"

    ^ cursorId

!

device

    "return the device I am associated with"

    ^ device

!

shape

    "return the shape"

    ^ shape

!

shape:aShapeSymbol on:aDevice

    "set the shape and device of the receiver"

    shape := aShapeSymbol.

    device := aDevice

!

sourceForm:sForm maskForm:mForm hotX:hx hotY:hy on:aDevice

    "set the forms, hotspot and device of the receiver"

    sourceForm := sForm.

    maskForm := mForm.

    hotX := hx.

    hotY := hy.

    device := aDevice

!

sourceForm

    "return the source-form of the receiver"

    ^ sourceForm

!

sourceForm:aForm

    "set the source-form of the receiver"

    sourceForm := aForm

!

maskForm

    "return the mask-form of the receiver"

    ^ maskForm

!

maskForm:aForm

    "set the mask-form of the receiver"

    maskForm := aForm

!

hotX

    "return the hotspots x-coordinate of the receiver"

    ^ hotX

!

hotX:aNumber

    "set the hotspots x-coordinate of the receiver"

    hotX := aNumber

!

hotY

    "return the hotspots y-coordinate of the receiver"

    ^ hotY

!

hotY:aNumber

    "set the hotspots y-coordinate of the receiver"

    hotY := aNumber

!

foreground:fgColor background:bgColor

    "set the cursor colors"

    device colorCursor:cursorId foreground:fgColor background:bgColor

! !

!Cursor methodsFor:'creating a device cursor'!

on:aDevice

    "create a new Cursor representing the same cursor as

     myself on aDevice; if one already exists, return the one"

    |newCursor index id|

    aDevice isNil ifTrue:[

        "this may not happen"

        self error:'nil device'

    ].

    "if Iam already assigned to that device ..."

    (device == aDevice) ifTrue:[^ self].

    "first look if not already there"

    lobby contentsDo:[:aCursor |

        (aCursor device == aDevice) ifTrue:[

            shape notNil ifTrue:[

                (aCursor shape == shape) ifTrue:[

                    ^ aCursor

                ]

            ] ifFalse:[

                (aCursor sourceForm == sourceForm) ifTrue:[

                    (aCursor maskForm == maskForm) ifTrue:[

                        (aCursor hotX == hotX) ifTrue:[

                            (aCursor hotY == hotY) ifTrue:[

                                ^ aCursor

                            ]

                        ]

                    ]