"
COPYRIGHT (c) 1992 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 WaitCursor CrossHairCursor OriginCursor CornerCursor
SquareCursor FourWayCursor UpDownArrowCursor LeftRightArrowCursor
ThumbsUpCursor ThumbsDownCursor ReadCursor WriteCursor XeqCursor
StopCursor EyeCursor BlankCursor MarkerCursor UpCursor DownCursor
LeftCursor RightCursor XMarkerCursor CaretCursor'
poolDictionaries:''
category:'Graphics-Support'
!
!Cursor class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1992 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
"
I represents cursors in a device independent manner.
Normally, cursors are defined at view creation time,
via
'aView cursor:aCursor'.
[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 device cursors
(dont use it: this will be moved to the device)
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
...
[see also:]
DeviceWorkstation
DisplaySurface
Font Cursor Color Form
( introduction to view programming :html: programming/viewintro.html#CURSOR )
[author:]
Claus Gittinger
"
!
examples
"
get a standard cursor:
Cursor wait
Cursor stop
Cursor normal
create a custom cursor:
Cursor extent:16@16
fromArray:#[ 2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
2r11111111 2r11111111
2r11111111 2r11111111
2r00000000 2r00000000
2r00000000 2r00000000
2r11111111 2r11111111
2r11111111 2r11111111
2r00000000 2r00000000
2r00000000 2r00000000
2r11111111 2r11111111
2r11111111 2r11111111
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000]
offset:-8@ -8
define a cursor for a view:
[exBegin]
|v|
v := StandardSystemView extent:100@100.
v cursor:Cursor stop.
v open.
[exEnd]
with above custom cursor:
[exBegin]
|v|
v := StandardSystemView extent:100@100.
v cursor:(
Cursor extent:16@16
fromArray:#[ 2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
2r11111111 2r11111111
2r11111111 2r11111111
2r00000000 2r00000000
2r00000000 2r00000000
2r11111111 2r11111111
2r11111111 2r11111111
2r00000000 2r00000000
2r00000000 2r00000000
2r11111111 2r11111111
2r11111111 2r11111111
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000]
offset:-8@ -8).
v open.
[exEnd]
with multiple views:
[exBegin]
|v1 v2 top|
top := StandardSystemView new.
top extent:300@300.
v1 := View origin:0.0@0.0 corner:1.0@0.5 in:top.
v1 viewBackground:(Color grey:75).
v1 cursor:Cursor thumbsUp.
v2 := View origin:0.0@0.5 corner:1.0@1.0 in:top.
v2 viewBackground:(Color white).
v2 cursor:Cursor wait.
top open.
[exEnd]
show a cursor (in the active ST/X view) for a while:
[exBegin]
Cursor wait
showWhile:[
Delay waitForSeconds:5
]
[exEnd]
show a cursor in all views belonging to a windowGroup:
(have to wait until top is visible to access windowGroup)
[exBegin]
|v1 v2 top|
top := StandardSystemView new.
top extent:300@300.
v1 := View origin:0.0@0.0 corner:1.0@0.5 in:top.
v1 viewBackground:(Color grey:75).
v1 cursor:(Cursor normal).
v2 := View origin:0.0@0.5 corner:1.0@1.0 in:top.
v2 viewBackground:(Color white).
v2 cursor:(Cursor crossHair).
top openAndWait.
Delay waitForSeconds:3.
top windowGroup
withCursor:Cursor wait
do:[
Delay waitForSeconds:5
]
[exEnd]
show a cursor in a single view for a while:
[exBegin]
|v1 v2 top|
top := StandardSystemView new.
top extent:300@300.
v1 := View origin:0.0@0.0 corner:1.0@0.5 in:top.
v1 viewBackground:(Color grey:75).
v1 cursor:(Cursor normal).
v2 := View origin:0.0@0.5 corner:1.0@1.0 in:top.
v2 viewBackground:(Color white).
v2 cursor:(Cursor crossHair).
top openAndWait.
Delay waitForSeconds:3.
v1 withCursor:Cursor wait
do:[
Delay waitForSeconds:5
]
[exEnd]
"
! !
!Cursor class methodsFor:'initialization'!
flushDeviceCursors
"unassign all cursors from their device"
Lobby notNil ifTrue:[
Lobby do:[:aCursor |
aCursor restored.
Lobby registerChange:aCursor
]
]
!
initialize
Lobby isNil ifTrue:[
Lobby := Registry new.
"want to be informed when returning from snapshot"
ObjectMemory addDependent:self
]
!
update:something with:aParameter from:changedObject
"sent when restarted after a snapIn"
(something == #restarted) ifTrue:[
self flushDeviceCursors
]
"Created: 15.6.1996 / 15:18:47 / cg"
! !
!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)
!
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 := Image fromFile:('bitmaps/' , cursorName , '_bits.bit').
cursorBits notNil ifTrue:[
maskBits := Image fromFile:('bitmaps/' , cursorName , '_mask.bit').
maskBits notNil ifTrue:[
^ self sourceForm:cursorBits maskForm:maskBits
]
].
^ nil
"Modified: 1.1.1970 / 13:57:27 / cg"
!
fromImage:anImage
"return a new cursor.
Source- and (optional) mask-Bits are taken from anImage;
hotSpot is center"
|mask sourceForm maskForm|
anImage depth ~~ 1 ifTrue:[
sourceForm := anImage asMonochromeFormOn:Screen current.
] ifFalse:[
sourceForm := anImage asFormOn:Screen current.
].
mask := anImage mask.
mask isNil ifTrue:[
maskForm := sourceForm
] ifFalse:[
mask depth ~~ 1 ifTrue:[
maskForm := mask asMonochromeFormOn:Screen current.
] ifFalse:[
maskForm := mask asFormOn:Screen current
]
].
^ self sourceForm:sourceForm
maskForm:maskForm
hotX:(anImage width // 2)
hotY:(anImage height // 2)
"
|i c|
i := Image fromFile:'bitmaps/xpmBitmaps/cursors/ul_br_arrow.xpm'.
c := Cursor fromImage:i.
WindowGroup activeGroup
withCursor:c
do:[(Delay forSeconds:5)wait]
"
"Modified: 4.3.1997 / 14:23:43 / cg"
!
imageArray:imageBits maskArray:maskBits
"ST-80 compatible cursor creation - the extent is fixed to 16@16"
"name is ignored ..."
^ self imageArray:imageBits maskArray:maskBits hotSpot:8@8
!
imageArray:imageBits maskArray:maskBits hotSpot:hot
"ST-80 compatible cursor creation - the extent is fixed to 16@16"
^ self
extent:16@16
sourceArray:imageBits
maskArray:maskBits
offset:hot negated
"
|cursor|
cursor := Cursor
imageArray: #(
2r0000000000000000
2r0000000100001110
2r0000000100001110
2r0000000100001110
2r0000000100000000
2r0000000100000000
2r0000000100000000
2r0111111111111110
2r0000000100000000
2r0000000100000000
2r0000000100000000
2r0000000100000000
2r0000000100000000
2r0000000100000000
2r0000000100000000
2r0000000000000000)
maskArray: #(
2r0000001110011111
2r0000001110011111
2r0000001110011111
2r0000001110011111
2r0000001110011111
2r0000001110000000
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r0000001110000000
2r0000001110000000
2r0000001110000000
2r0000001110000000
2r0000001110000000
2r0000001110000000
2r0000001110000000)
hotSpot: 8@8.
WindowGroup activeGroup
withCursor:cursor
do:[(Delay forSeconds:10)wait]
"
!
imageArray:imageBits maskArray:maskBits hotSpot:hot name:aString
"ST-80 compatible cursor creation - the extent is fixed to 16@16"
"name is ignored ..."
^ self imageArray:imageBits maskArray:maskBits hotSpot:hot
!
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 isNil ifTrue:[
self initialize
].
Lobby do:[:aCursor |
(aCursor shape == aShape) ifTrue:[
^ aCursor
]
].
newCursor := self basicNew setShape:aShape.
Lobby register:newCursor.
^ newCursor
!
shape:aShape on:aDevice
"return one of the standard cursors already associated to aDevice.
This is the same as '(Cursor shape:aShape) on:aDevice' but somwehat faster."
|newCursor oldCursor|
"first look if not already known"
Lobby isNil ifTrue:[
self initialize
].
Lobby do:[:aCursor |
(aCursor shape == aShape) ifTrue:[
(aCursor graphicsDevice == aDevice) ifTrue:[^ aCursor].
oldCursor := aCursor
].
].
"found one with same shape, but different device"
oldCursor notNil ifTrue:[
^ oldCursor newOn:aDevice
].
newCursor := self basicNew setShape:aShape.
Lobby register:newCursor.
^ newCursor
"Modified: 5.7.1996 / 17:58:06 / cg"
!
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 isNil ifTrue:[
self initialize
].
Lobby do:[:aCursor |
(aCursor sourceForm == sourceForm) ifTrue:[
(aCursor maskForm == maskForm) ifTrue:[
(aCursor hotX == hotX) ifTrue:[
(aCursor hotY == hotY) ifTrue:[
^ aCursor
]
]
]
]
].
(sourceForm isNil or:[maskForm isNil]) ifTrue:[^ nil].
newCursor := self basicNew setSourceForm:sourceForm
maskForm:maskForm
hotX:hotX
hotY:hotY.
Lobby register:newCursor.
^ newCursor
! !
!Cursor class methodsFor:'class initialization'!
initializeNewCursors
"Create the new cursors
Cursor blank
Cursor down
Cursor execute
Cursor left
Cursor marker
Cursor normal
Cursor read
Cursor right
Cursor square
Cursor up
Cursor wait
Cursor write
Cursor thumbsUp
Cursor thumbsDown
Cursor xMarker
Cursor caret
Cursor stop
Cursor eye"
|device|
" claus: already there in ST/X"
"/ OriginCursor :=
"/ (Cursor
"/ extent: 16@16
"/ fromArray: #(
"/ 2r1111111111111111
"/ 2r1111111111111111
"/ 2r1100000000000000
"/ 2r1100000000000000
"/ 2r1100000000000000
"/ 2r1100000000000000
"/ 2r1100000000000000
"/ 2r1100000000000000
"/ 2r1100000000000000
"/ 2r1100000000000000
"/ 2r1100000000000000
"/ 2r1100000000000000
"/ 2r1100000000000000
"/ 2r1100000000000000
"/ 2r1100000000000000
"/ 2r1100000000000000)
"/ offset: -2@ -2).
"/
" claus: already there in ST/X"
"/ CornerCursor :=
"/ (Cursor
"/ extent: 16@16
"/ fromArray: #(
"/ 2r0000000000000011
"/ 2r0000000000000011
"/ 2r0000000000000011
"/ 2r0000000000000011
"/ 2r0000000000000011
"/ 2r0000000000000011
"/ 2r0000000000000011
"/ 2r0000000000000011
"/ 2r0000000000000011
"/ 2r0000000000000011
"/ 2r0000000000000011
"/ 2r0000000000000011
"/ 2r0000000000000011
"/ 2r0000000000000011
"/ 2r1111111111111111
"/ 2r1111111111111111)
"/ offset: -14@ -14).
"original from SMACK:"
"/ ReadCursor :=
"/ (Cursor
"/ extent: 16@16
"/ fromArray: #(
"/ 2r0000110000000110
"/ 2r0001001000001001
"/ 2r0001001000001001
"/ 2r0010000000010000
"/ 2r0100000000100000
"/ 2r1111101111100000
"/ 2r1000010000100000
"/ 2r1000010000100000
"/ 2r1011010110100000
"/ 2r0111101111000000
"/ 2r0000000000000000
"/ 2r0000000000000000
"/ 2r0000000000000000
"/ 2r0000000000000000
"/ 2r0000000000000000
"/ 2r0000000000000000)
"/ offset: 0@0).
"claus: added mask"
ReadCursor := (Cursor
extent: 16@16
sourceArray: #(
2r0
2r0000110000000110
2r0001001000001001
2r0001001000001001
2r0010000000010000
2r0100000000100000
2r1111101111100000
2r1000010000100000
2r1000010000100000
2r1011010110100000
2r0111101111000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000)
maskArray: #(
2r0001111000001111
2r0001111000011111
2r0011111000011111
2r0011100000111100
2r0111000000111000
2r1111111111110000
2r1111111111110000
2r1111111111110000
2r1111111111110000
2r1111111111110000
2r1111111111100000
2r0111111111000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000)
offset: -5 @ -7).
"original from SMACK:"
"/ WriteCursor := (Cursor
"/ extent: 16@16
"/ fromArray: #(
"/ 2r0000000000000110
"/ 2r0000000000001111
"/ 2r0000000000010110
"/ 2r0000000000100100
"/ 2r0000000001001000
"/ 2r0000000010010000
"/ 2r0000000100100000
"/ 2r0000001001000011
"/ 2r0000010010000010
"/ 2r0000100100000110
"/ 2r0001001000001000
"/ 2r0010010000001000
"/ 2r0111100001001000
"/ 2r0101000010111000
"/ 2r0110000110000000
"/ 2r1111111100000000)
"/ offset: 0@0).
"claus: added mask"
WriteCursor := (Cursor
extent: 16@16
sourceArray: #(
2r0000000000000110
2r0000000000001111
2r0000000000010110
2r0000000000100100
2r0000000001001000
2r0000000010010000
2r0000000100100000
2r0000001001000011
2r0000010010000010
2r0000100100000110
2r0001001000001000
2r0010010000001000
2r0111100001001000
2r0101000010111000
2r0110000110000000
2r1111111100000000)
maskArray: #(
2r0000000000000111
2r0000000000001111
2r0000000000011110
2r0000000000111100
2r0000000001111000
2r0000000011110000
2r0000000111100001
2r0000001111000110
2r0000011110000110
2r0000111100001110
2r0001111000001100
2r0011110001001100
2r0111100011111000
2r0111000110111000
2r0111111110000000
2r1111111100000000)
offset: 0@ -15).
"original from SMACK:"
"/ WaitCursor :=
"/ (Cursor
"/ extent: 16@16
"/ fromArray: #(
"/ 2r1111111111111111
"/ 2r1000000000000001
"/ 2r0100000000000010
"/ 2r0010000000000100
"/ 2r0001110000111000
"/ 2r0000111101110000
"/ 2r0000011011100000
"/ 2r0000001111000000
"/ 2r0000001111000000
"/ 2r0000010110100000
"/ 2r0000100010010000
"/ 2r0001000110001000
"/ 2r0010001101000100
"/ 2r0100111111110010
"/ 2r1011111111111101
"/ 2r1111111111111111)
"/ offset: -8@ -8).
"claus: added mask"
WaitCursor :=
(Cursor
extent: 16@16
sourceArray: #(
2r1111111111111111
2r1000000000000001
2r0100000000000010
2r0010000000000100
2r0001110000111000
2r0000111101110000
2r0000011011100000
2r0000001111000000
2r0000001111000000
2r0000010110100000
2r0000100010010000
2r0001000110001000
2r0010001101000100
2r0100111111110010
2r1011111111111101
2r1111111111111111)
maskArray: #(
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r0111111111111110
2r0011111111111100
2r0001111111111000
2r0000111111110000
2r0000011111100000
2r0000011111100000
2r0000111111110000
2r0001111111111000
2r0011111111111100
2r0111111111111110
2r1111111111111111
2r1111111111111111
2r1111111111111111)
offset: -8@ -8).
BlankCursor := Cursor new.
"original from SMACK:"
"/ XeqCursor :=
"/ (Cursor
"/ extent: 16@16
"/ fromArray: #(
"/ 2r1000000000010000
"/ 2r1100000000010000
"/ 2r1110000000111000
"/ 2r1111000111111111
"/ 2r1111100011000110
"/ 2r1111110001000100
"/ 2r1111111001111100
"/ 2r1111000001101100
"/ 2r1101100011000110
"/ 2r1001100010000010
"/ 2r0000110000000000
"/ 2r0000110000000000
"/ 2r0000011000000000
"/ 2r0000011000000000
"/ 2r0000001100000000
"/ 2r0000001100000000)
"/ offset: 0@0).
"claus: added mask"
XeqCursor :=
(Cursor
extent: 16@16
sourceArray: #(
2r1000000000010000
2r1100000000010000
2r1110000000111000
2r1111000111111111
2r1111100011000110
2r1111110001000100
2r1111111001111100
2r1111000001101100
2r1101100011000110
2r1001100010000010
2r0000110000000000
2r0000110000000000
2r0000011000000000
2r0000011000000000
2r0000001100000000
2r0000001100000000)
maskArray: #(
2r1100000000111000
2r1110000000111000
2r1111000111111111
2r1111100111111111
2r1111110011111111
2r1111111001111110
2r1111111101111100
2r1111100001111110
2r1101110011100111
2r1001110011000010
2r0000111000000000
2r0000111000000000
2r0000011100000000
2r0000011100000000
2r0000001110000000
2r0000001110000000)
offset: 0@0).
"claus: already there in ST/X"
"/ SquareCursor :=
"/ (Cursor
"/ extent: 16@16
"/ fromArray: #(
"/ 2r0000000000000000
"/ 2r0000000000000000
"/ 2r0000000000000000
"/ 2r0000000000000000
"/ 2r0000000000000000
"/ 2r0000001111000000
"/ 2r0000001111000000
"/ 2r0000001111000000
"/ 2r0000001111000000
"/ 2r0000000000000000
"/ 2r0000000000000000
"/ 2r0000000000000000
"/ 2r0000000000000000
"/ 2r0000000000000000
"/ 2r0000000000000000
"/ 2r0000000000000000)
"/ offset: -8@ -8).
"original from SMACK:"
"/ NormalCursor :=
"/ (Cursor
"/ extent: 16@16
"/ fromArray: #(
"/ 2r1000000000000000
"/ 2r1100000000000000
"/ 2r1110000000000000
"/ 2r1111000000000000
"/ 2r1111100000000000
"/ 2r1111110000000000
"/ 2r1111111000000000
"/ 2r1111100000000000
"/ 2r1111100000000000
"/ 2r1001100000000000
"/ 2r0000110000000000
"/ 2r0000110000000000
"/ 2r0000011000000000
"/ 2r0000011000000000
"/ 2r0000001100000000
"/ 2r0000001100000000)
"/ offset: 0@0).
"claus: added mask"
NormalCursor :=
(Cursor
extent: 16@16
sourceArray: #(
2r1000000000000000
2r1100000000000000
2r1110000000000000
2r1111000000000000
2r1111100000000000
2r1111110000000000
2r1111111000000000
2r1111100000000000
2r1111100000000000
2r1001100000000000
2r0000110000000000
2r0000110000000000
2r0000011000000000
2r0000011000000000
2r0000001100000000
2r0000001100000000)
maskArray: #(
2r1100000000000000
2r1110000000000000
2r1111000000000000
2r1111100000000000
2r1111110000000000
2r1111111000000000
2r1111111100000000
2r1111110000000000
2r1111110000000000
2r1001110000000000
2r0000111000000000
2r0000111000000000
2r0000011100000000
2r0000011100000000
2r0000001110000000
2r0000001110000000)
offset: 0@0).
"original from SMACK:"
"/ CrossHairCursor :=
"/ (Cursor
"/ extent: 16@16
"/ fromArray: #(
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r1111111111111110
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0)
"/ offset: -7@ -7).
"claus: added mask"
"no: already there in ST/X"
"/ CrossHairCursor :=
"/ (Cursor
"/ extent: 16@16
"/ sourceArray: #(
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r1111111111111110
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0000000100000000
"/ 2r0)
"/ maskArray: #(
"/ 2r0000000110000000
"/ 2r0000000110000000
"/ 2r0000000110000000
"/ 2r0000000110000000
"/ 2r0000000110000000
"/ 2r0000000110000000
"/ 2r0000000110000000
"/ 2r1111111111111110
"/ 2r1111111111111110
"/ 2r0000000110000000
"/ 2r0000000110000000
"/ 2r0000000110000000
"/ 2r0000000110000000
"/ 2r0000000110000000
"/ 2r0000000110000000
"/ 2r0)
"/ offset: -7@ -7).
MarkerCursor :=
Cursor
extent: 16@16
fromArray: #(
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000001000000000
2r0000001110000000
2r0000001111100000
2r1111111111111000
2r1111111111111110
2r1111111111111000
2r0000001111100000
2r0000001110000000
2r0000001000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000)
offset: -7@ -7.
UpCursor :=
Cursor
extent: 16@16
fromArray: #(
2r1000000000000000
2r1100000000000000
2r1110000000000000
2r1111000000000000
2r1111100000000000
2r1111110000000000
2r1100000000000000
2r1100000000000000
2r1100000000000000
2r1100000000000000
2r1100000000000000
2r1100000000000000
2r1100000000000000
2r1100000000000000
2r1100000000000000
2r1100000000000000)
offset: 0@ -7.
DownCursor :=
Cursor
extent: 16@16
fromArray: #(
2r0000110000000000
2r0000110000000000
2r0000110000000000
2r0000110000000000
2r0000110000000000
2r0000110000000000
2r0000110000000000
2r0000110000000000
2r0000110000000000
2r0000110000000000
2r1111110000000000
2r0111110000000000
2r0011110000000000
2r0001110000000000
2r0000110000000000
2r0000010000000000)
offset: -5@ -7.
LeftCursor :=
Cursor
extent: 16@16
fromArray: #(
2r1111111111111111
2r0111111111111111
2r0011110000000000
2r0001110000000000
2r0000110000000000
2r0000010000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000)
offset: -7@0.
RightCursor :=
Cursor
extent: 16@16
fromArray: #(
2r0000000000100000
2r0000000000110000
2r0000000000111000
2r0000000000111100
2r1111111111111110
2r1111111111111111
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000)
offset: -7@ -5.
XMarkerCursor :=
Cursor
extent: 16@16
fromArray: #(
2r0
2r0000000100000000
2r0000000100000000
2r0000001110000000
2r0000001110000000
2r0000011111000000
2r0000011111000000
2r0000111111100000
2r0000111111100000
2r0001111111110000
2r0000001110000000
2r0000001110000000
2r0000001110000000
2r0000001110000000
2r0000001110000000
2r0000001110000000)
offset: -7@ -7.
"original from SMACK:"
"/ FourWayCursor :=
"/ Cursor
"/ extent: 16@16
"/ fromArray: #(
"/ 2r0000000100000000
"/ 2r0000001110000000
"/ 2r0000011111000000
"/ 2r0000111111100000
"/ 2r0001001110010000
"/ 2r0011001110011000
"/ 2r0111111111111100
"/ 2r1111111111111110
"/ 2r0111111111111100
"/ 2r0011001110011000
"/ 2r0001001110010000
"/ 2r0000111111100000
"/ 2r0000011111000000
"/ 2r0000001110000000
"/ 2r0000000100000000
"/ 2r0000000000000000)
"/ offset: -7@ -7.
"/
"claus: added mask"
FourWayCursor :=
Cursor
extent: 16@16
sourceArray: #(
2r0000000100000000
2r0000001110000000
2r0000011111000000
2r0000111111100000
2r0001001110010000
2r0011001110011000
2r0111111111111100
2r1111111111111110
2r0111111111111100
2r0011001110011000
2r0001001110010000
2r0000111111100000
2r0000011111000000
2r0000001110000000
2r0000000100000000
2r0000000000000000)
maskArray: #(
2r0000001110000000
2r0000011111000000
2r0000111111100000
2r0001111111110000
2r0010111111101000
2r0111111111111100
2r1111111111111110
2r1111111111111110
2r1111111111111110
2r0111111111111100
2r0010111111101000
2r0001111111110000
2r0000111111100000
2r0000011111000000
2r0000001110000000
2r0000000000000000)
offset: -7@ -7.
ThumbsUpCursor := (Cursor
extent: 16@16
sourceArray: #(
2r0000000000100000
2r0000000001010000
2r0000000010010000
2r0000000011110000
2r0000000100010000
2r0000000100010000
2r0001111100011000
2r0010000100000110
2r0100000000000000
2r0111111000000000
2r0100000000000000
2r0111111000000000
2r0100000000000000
2r0011111000001110
2r0001000000010000
2r0001111111100000)
maskArray: #(
2r0000000000100000
2r0000000001110000
2r0000000011110000
2r0000000011110000
2r0000000111110000
2r0000000111110000
2r0001111111111000
2r0011111111111110
2r0111111111111110
2r0111111111111110
2r0111111111111110
2r0111111111111110
2r0111111111111110
2r0011111111111110
2r0001111111110000
2r0001111111100000)
offset: -8@ -8).
CaretCursor := (Cursor
extent: 16@16
fromArray: #(
2r0000000110000000
2r0000000110000000
2r0000001111000000
2r0000011111100000
2r0000011001100000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000)
offset: -8@0).
ThumbsDownCursor := (Cursor
extent: 16@16
sourceArray: #(
2r0001111111100000
2r0001000000010000
2r0011111000001110
2r0100000000000000
2r0111111000000000
2r0100000000000000
2r0111111000000000
2r0100000000000000
2r0010000100000110
2r0001111100011000
2r0000000100010000
2r0000000100010000
2r0000000011110000
2r0000000010010000
2r0000000001010000
2r0000000000100000)
maskArray: #(
2r0001111111100000
2r0001111111110000
2r0011111111111110
2r0111111111111110
2r0111111111111110
2r0111111111111110
2r0111111111111110
2r0111111111111110
2r0011111111111110
2r0001111111111000
2r0000000111110000
2r0000000111110000
2r0000000011110000
2r0000000011110000
2r0000000001110000
2r0000000000100000)
offset: -8@ -8).
StopCursor := (Cursor
extent: 16@16
sourceArray: #(
2r0000000000000000
2r0000011111000000
2r0001111111110000
2r0011111111111000
2r0011111111111000
2r0111111111111100
2r0111111111111100
2r0100000000000100
2r0100000000000100
2r0111111111111100
2r0111111111111100
2r0011111111111000
2r0011111111111000
2r0001111111110000
2r0000011111000000
2r0000000000000000
)
maskArray: #(
2r0000011111000000
2r0001111111110000
2r0011111111111000
2r0111111111111100
2r0111111111111100
2r1111111111111110
2r1111111111111110
2r1111111111111110
2r1111111111111110
2r1111111111111110
2r1111111111111110
2r0111111111111100
2r0111111111111100
2r0011111111111000
2r0001111111110000
2r0000011111000000
)
offset: -8 @ -8).
EyeCursor := (Cursor
extent: 16@16
sourceArray: #(
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000011111000000
2r0001111111110000
2r0011000000011000
2r0110001110001100
2r1100011111000110
2r1100011111000110
2r0110001110001100
2r0011000000011000
2r0001111111110000
2r0000011111000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
)
maskArray: #(
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000011111000000
2r0001111111110000
2r0011111111111000
2r0111111111111100
2r1111111111111110
2r1111111111111110
2r0111111111111100
2r0011111111111000
2r0001111111110000
2r0000011111000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
)
offset: -8 @ -8).
device := Display.
FourWayCursor := FourWayCursor on:device.
LeftCursor := LeftCursor on:device.
RightCursor := RightCursor on:device.
XMarkerCursor := XMarkerCursor on:device.
"/ OriginCursor := OriginCursor on:device.
"/ CornerCursor := CornerCursor on:device.
ReadCursor := ReadCursor on:device.
WriteCursor := WriteCursor on:device.
WaitCursor := WaitCursor on:device.
XeqCursor := XeqCursor on:device.
"/ SquareCursor := SquareCursor on:device.
NormalCursor := NormalCursor on:device.
"/ CrossHairCursor := CrossHairCursor on:device.
MarkerCursor := MarkerCursor on:device.
UpCursor := UpCursor on:device.
DownCursor := DownCursor on:device.
LeftCursor := LeftCursor on:device.
RightCursor := RightCursor on:device.
XMarkerCursor := XMarkerCursor on:device.
CaretCursor := CaretCursor on:device.
ThumbsUpCursor := ThumbsUpCursor on:device.
ThumbsDownCursor := ThumbsDownCursor on:device.
StopCursor := StopCursor on:device.
EyeCursor := EyeCursor on:device.
"Cursor initializeNewCursors"
"Modified: 29.5.1996 / 15:03:44 / cg"
! !
!Cursor class methodsFor:'cleanup'!
releaseResourcesOnDevice:aDevice
"this is sent when a display connection is closed,
to release all cached Cursors from that device"
Lobby unregisterAllForWhich:[:aCursor | aCursor graphicsDevice == aDevice]
"Created: 16.1.1997 / 16:43:59 / cg"
! !
!Cursor class methodsFor:'default access'!
defaultFgColor:fgColor defaultBgColor:bgColor
"set the default colors used for cursors"
DefaultFgColor := fgColor.
DefaultBgColor := bgColor
! !
!Cursor class methodsFor:'standard cursors'!
arrow
"return an arrow (up-left-arrow) cursor"
^ self shape:#upLeftArrow on:Display
!
blank
"Answer the instance of me that is an invisible cursor."
^BlankCursor!
bottomLeft
"return a bottom-left corner cursor"
^ self shape:#bottomLeft on:Display
!
bottomRight
"return a bottom-right corner cursor"
^ self corner
!
caret
"return a caret cursor"
^ CaretCursor!
corner
"return a corner cursor"
CornerCursor isNil ifTrue:[
CornerCursor := self shape:#corner on:Display
].
^ CornerCursor
!
cross
"return a cross cursor"
^ self shape:#cross on:Display
!
crossHair
"return a crossHair cursor"
CrossHairCursor isNil ifTrue:[
CrossHairCursor := self shape:#crossHair on:Display
].
^ CrossHairCursor
!
down
"Answer the instance of me that is the shape of a down-arrow."
^DownCursor!
downLimitArrow
"return a down-arrow-to-limit cursor"
^ self shape:#downLimitArrow on:Display
!
execute
"return a execute cursor - (the default here is a wait-cursor)"
XeqCursor notNil ifTrue:[
^ XeqCursor
].
^ self wait
!
eye
"return an eye cursor"
^ EyeCursor
!
fourWay
"return a four-way arrow cursor"
FourWayCursor isNil ifTrue:[
FourWayCursor := self shape:#fourWay on:Display
].
^ FourWayCursor
!
hand
"return a hand cursor"
HandCursor isNil ifTrue:[
HandCursor := self shape:#upRightHand on:Display
].
^ HandCursor
!
left
"Answer the instance of me that is the shape of an arrow facing to the left."
^LeftCursor!
leftHand
"return a left-hand cursor"
^ self shape:#leftHand
!
leftLimitArrow
"return a left-arrow-to-limit cursor"
^ self shape:#leftLimitArrow on:Display
!
leftRightArrow
"return a left-right-arrow cursor"
LeftRightArrowCursor isNil ifTrue:[
LeftRightArrowCursor := self shape:#leftRightArrow on:Display
].
^ LeftRightArrowCursor
!
marker
"Answer the instance of me that is the shape of a horizontal arrow."
^MarkerCursor!
normal
"return the normal cursor; an arrow.
for ST-80 compatibility"
NormalCursor isNil ifTrue:[
NormalCursor := self arrow on:Display
].
^ NormalCursor
!
origin
"return an origin cursor"
OriginCursor isNil ifTrue:[
OriginCursor := self shape:#origin on:Display
].
^ OriginCursor
!
questionMark
"return a question-mark cursor"
^ self shape:#questionMark on:Display
!
read
"return a reading-file cursor (the default here is a wait-cursor)"
ReadCursor notNil ifTrue:[
^ ReadCursor
].
^ self wait
!
right
"Answer the instance of me that is the shape of an arrow facing to the right."
^RightCursor!
rightLimitArrowOn
"return a right-arrow-to-limit cursor"
^ self shape:#rightLimitArrow on:Display
!
stop
"return a stop cursor (the default here is a wait-cursor)"
StopCursor notNil ifTrue:[
^ StopCursor
].
^ self wait
!
text
"return a text-cursor"
^ self shape:#text on:Display
!
thumbsDown
"return a hand cursor - ST-80 compatibility"
ThumbsDownCursor notNil ifTrue:[
^ ThumbsDownCursor
].
^ self hand
!
thumbsUp
"return a hand cursor - ST-80 compatibility"
ThumbsUpCursor notNil ifTrue:[
^ ThumbsUpCursor
].
^ self hand
!
topLeft
"return a top-left corner cursor"
^ self origin
!
topRight
"return a top-right corner cursor"
^ self shape:#topRight on:Display
!
up
"Answer the instance of me that is the shape of an up-arrow."
^UpCursor!
upDownArrow
"return an up-down-arrow cursor"
UpDownArrowCursor isNil ifTrue:[
UpDownArrowCursor := self shape:#upDownArrow on:Display
].
^ UpDownArrowCursor
!
upLeftArrow
"return an up-right-arrow cursor"
^ self shape:#upLeftArrow on:Display
!
upLimitArrow
"return an up-arrow-to-limit cursor"
^ self shape:#upLimitArrow on:Display
!
upRightArrow
"return an up-right-arrow cursor"
^ self shape:#upRightArrow on:Display
!
upRightHand
"return an up-right-hand cursor"
^ self shape:#upRightHand
!
wait
"return a wait cursor"
WaitCursor isNil ifTrue:[
WaitCursor := self shape:#wait on:Display
].
^ WaitCursor
!
write
"return a writing-file cursor (the default here is a wait-cursor)"
WriteCursor notNil ifTrue:[
^ WriteCursor
].
^ self wait
!
xMarker
"Answer the instance of me that is displayed when thumb-scrolling on the x-axis."
^XMarkerCursor! !
!Cursor methodsFor:'ST-80 displaying'!
displayOn:aGC at:origin clippingBox:aRectangle rule:aRule mask:aMask
"ST-80 compatibility;
limited functionality: can only display bitmap cursors (yet)"
sourceForm notNil ifTrue:[
sourceForm displayOn:aGC at:origin clippingBox:aRectangle
rule:aRule mask:aMask
]
!
show
"ST-80 mimicri: change cursors in active groups views to the receiver."
|wg|
(wg := WindowGroup activeGroup) notNil ifTrue:[
wg showCursor:self
]
"Modified: 13.1.1997 / 20:10:01 / cg"
!
showIn:aView
"ST-80 mimicri: install the receiver as aViews cursor"
aView cursor:self
!
showIn:aView while:aBlock
"ST-80 mimicri: change aViews cursors to the receiver, while evaluationg aBlock.
Return the value as returned by aBlock."
|savedCursor|
savedCursor := aView cursor.
aView cursor:self.
^ aBlock valueNowOrOnUnwindDo:[aView cursor:savedCursor]
!
showWhile:aBlock
"ST-80 mimicri: change all views cursors to the receiver.
Return the value as returned by aBlock."
|wg|
(wg := WindowGroup activeGroup) notNil ifTrue:[
^ wg withCursor:self do:aBlock
] ifFalse:[
aBlock value
]
"Modified: 13.1.1997 / 20:10:25 / cg"
! !
!Cursor methodsFor:'accessing'!
device
"return the device I am associated with"
^ device
!
foreground:fgColor background:bgColor
"set the cursor colors"
device colorCursor:cursorId foreground:fgColor background:bgColor
!
graphicsDevice
"same as #device, for ST-80 compatibility naming.
Return the device I am associated with."
^ device
"Created: 28.5.1996 / 18:39:01 / cg"
!
hotX
"return the hotspots x-coordinate of the receiver"
^ hotX
!
hotY
"return the hotspots y-coordinate of the receiver"
^ hotY
!
id
"return the cursors deviceId"
^ cursorId
!
maskForm
"return the mask-form of the receiver"
^ maskForm
!
maskForm:aForm
"set the mask-form of the receiver"
maskForm := aForm
!
shape
"return the shape"
^ shape
!
sourceForm
"return the source-form of the receiver"
^ sourceForm
!
sourceForm:aForm
"set the source-form of the receiver"
sourceForm := aForm
! !
!Cursor methodsFor:'copying'!
postCopy
sourceForm := sourceForm copy.
maskForm := maskForm copy.
device := cursorId := nil
! !
!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"
aDevice isNil ifTrue:[
"this may not happen"
self error:'nil device'
].
"if I am already assigned to that device ..."
(device == aDevice) ifTrue:[^ self].
"first look if not already there"
Lobby do:[:aCursor |
(aCursor graphicsDevice == 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
]
]
]
]
]
]
].
^ self newOn:aDevice
"Modified: 5.7.1996 / 17:58:00 / cg"
! !
!Cursor methodsFor:'instance release'!
disposed
"some Cursor has been collected - tell it to the x-server"
cursorId notNil ifTrue:[
device destroyCursor:cursorId.
]
!
shallowCopyForFinalization
"redefined to return a lightweight copy
- all we need is the device handle"
^ self class basicNew setDevice:device id:cursorId
"Modified: 20.4.1996 / 23:23:19 / cg"
! !
!Cursor methodsFor:'private'!
device:aDevice
device := aDevice
!
id:anId
"set the cursors deviceId"
cursorId := anId
!
newOn:aDevice
"create a new Cursor representing the same cursor as
myself on aDevice. Dont search the lobby."
|newCursor id sF mF w h|
"ask that device for the cursor"
shape notNil ifTrue:[
id := aDevice createCursorShape:shape.
id isNil ifTrue:[
'Cursor [warning]: no cursor with shape:' errorPrint. shape errorPrintCR.
^ self
].
] ifFalse:[
aDevice needDeviceFormsForCursor ifTrue:[
sourceForm notNil ifTrue:[
sF := sourceForm asFormOn:aDevice.
].
maskForm notNil ifTrue:[
mF := maskForm asFormOn:aDevice.
].
(sF notNil and:[mF notNil]) ifTrue:[
sourceForm := sF.
maskForm := mF.
].
] ifFalse:[
sourceForm notNil ifTrue:[
sF := sourceForm bits
].
maskForm notNil ifTrue:[
mF := maskForm bits.
].
].
(sF isNil or:[mF isNil]) ifTrue:[
'Cursor [warning]: cursor has no form' errorPrintCR.
^ self
].
w := sourceForm width.
h := sourceForm height.
id := aDevice createCursorSourceForm:sF
maskForm:mF
hotX:hotX
hotY:hotY
width:w
height:h.
id isNil ifTrue:[
'Cursor [warning]: cannot create pixmap cursor' errorPrintCR.
^ self
].
].
"goody for IRIXs red cursor"
DefaultFgColor notNil ifTrue:[
aDevice colorCursor:id foreground:DefaultFgColor
background:DefaultBgColor
].
device isNil ifTrue:[
"receiver was not associated - do it now"
device := aDevice.
cursorId := id.
"must re-register, the old registration had a nil cursorId in it"
Lobby registerChange:self.
^ self
].
"receiver was already associated to another device - need a new cursor"
newCursor := self class basicNew.
shape notNil ifTrue:[
newCursor setShape:shape.
] ifFalse:[
newCursor setSourceForm:sourceForm
maskForm:maskForm
hotX:hotX
hotY:hotY
].
newCursor setDevice:aDevice id:id.
Lobby register:newCursor.
^ newCursor
"Modified: 10.1.1997 / 19:08:20 / cg"
!
restored
"set both device and id"
device := nil.
cursorId := nil
! !
!Cursor methodsFor:'private accessing'!
setDevice:aDevice id:anId
"set the device and deviceId of the receiver"
device := aDevice.
cursorId := anId
!
setShape:aShapeSymbol
"set the shape"
shape := aShapeSymbol.
!
setSourceForm:sForm maskForm:mForm hotX:hx hotY:hy
"set the forms and hotspot"
sourceForm := sForm.
maskForm := mForm.
hotX := hx.
hotY := hy.
! !
!Cursor class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libview/Cursor.st,v 1.46 1997-03-04 13:24:02 cg Exp $'
! !
Cursor initialize!