"
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
UpRightHandCursor DocumentCursor FolderCursor'
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 Color Image 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
some common cursors ...
[exBegin]
|v b cursors nextCursorAction|
cursors := OrderedCollection new.
cursors add:#arrow.
cursors add:#blank.
cursors add:#bottomLeft.
cursors add:#bottomRight.
cursors add:#caret.
cursors add:#corner.
cursors add:#cross.
cursors add:#crossHair.
cursors add:#document.
cursors add:#down.
cursors add:#downLimitArrow.
cursors add:#execute.
cursors add:#eye.
cursors add:#folder.
cursors add:#fourWay.
cursors add:#hand.
cursors add:#left.
cursors add:#leftHand.
cursors add:#leftLimitArrow.
cursors add:#leftRightArrow.
cursors add:#marker.
cursors add:#normal.
cursors add:#origin.
cursors add:#questionMark.
cursors add:#read.
cursors add:#right.
cursors add:#rightLimitArrow.
cursors add:#stop.
cursors add:#text.
cursors add:#thumbsDown.
cursors add:#thumbsUp.
cursors add:#topLeft.
cursors add:#topRight.
cursors add:#up.
cursors add:#upDownArrow.
cursors add:#upLeftArrow.
cursors add:#upLimitArrow.
cursors add:#upRightArrow.
cursors add:#upRightHand.
cursors add:#wait.
cursors add:#write.
cursors add:#xMarker.
nextCursorAction := [
|sel c|
cursors isEmpty ifTrue:[
v close.
] ifFalse:[
sel := cursors removeFirst.
c := Cursor perform:sel.
b label:sel.
b cursor:c.
]
].
v := StandardSystemView extent:100@100.
b := Button origin:0.0@0.0 corner:1.0@1.0 in:v.
b label:'default'.
b action:nextCursorAction.
v openAndWait.
[exEnd]
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]
a custom cursor with mask:
[exBegin]
|v|
v := StandardSystemView extent:100@100.
v cursor:(
Cursor
extent:16@16
sourceArray:#[
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
2r11111111 2r11111111
2r11111111 2r11111111
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
2r11111111 2r11111111
2r11111111 2r11111111
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000]
maskArray:#[
2r00000000 2r00000000
2r00000000 2r00000000
2r11111111 2r11111111
2r11111111 2r11111111
2r11111111 2r11111111
2r11111111 2r11111111
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
2r11111111 2r11111111
2r11111111 2r11111111
2r11111111 2r11111111
2r11111111 2r11111111
2r00000000 2r00000000
2r00000000 2r00000000]
offset:-8 @ -8).
v open.
[exEnd]
a cursor from an image read from a file:
[exBegin]
|v img|
v := StandardSystemView extent:100@100.
img := Image fromFile:'bitmaps/xpmBitmaps/cursors/mouse.xpm'.
v cursor:(Cursor fromImage:img).
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
]
!
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 builtIn bits isWindows|
device := Display.
isWindows := device platformName = 'WIN32'.
builtIn := device builtInCursorShapes.
(builtIn includes:#folder) ifFalse:[
FolderCursor :=
(Cursor
extent: 16@16
sourceArray: #(
2r0000000000000000
2r0011111000000000
2r0100000100000000
2r1111111111111110
2r1000000000000001
2r1000000000000001
2r1000000000000001
2r1000000000000001
2r1000000000000001
2r1000000000000001
2r1000000000000001
2r1000000000000001
2r1000000000000001
2r1010101010101011
2r0111111111111111
2r0000000000000000)
maskArray: #(
2r0000000000000000
2r0011111000000000
2r0111111100000000
2r1111111111111110
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r0111111111111111
2r0000000000000000)
offset: 0@ -3).
].
(builtIn includes:#document) ifFalse:[
DocumentCursor :=
(Cursor
extent: 16@16
sourceArray: #(
2r0000000000000000
2r0011111111100000
2r0010000000110000
2r0010000000101000
2r0010000000111100
2r0010000000000100
2r0010000000000100
2r0010000000000100
2r0010000000000100
2r0010000000000100
2r0010000000000100
2r0010000000000100
2r0010000000000100
2r0010000000000100
2r0011111111111100
2r0000000000000000)
maskArray: #(
2r0000000000000000
2r0011111111100000
2r0011111111110000
2r0011111111111000
2r0011111111111100
2r0011111111111100
2r0011111111111100
2r0011111111111100
2r0011111111111100
2r0011111111111100
2r0011111111111100
2r0011111111111100
2r0011111111111100
2r0011111111111100
2r0011111111111100
2r0000000000000000)
offset: -2@ -1).
].
(builtIn includes:#origin) ifFalse:[
OriginCursor :=
(Cursor
extent: 16@16
sourceArray: #(
2r0000000000000000
2r0111111111111111
2r0111111111111111
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000)
maskArray: #(
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111000000000000
2r1111000000000000
2r1111000000000000
2r1111000000000000
2r1111000000000000
2r1111000000000000
2r1111000000000000
2r1111000000000000
2r1111000000000000
2r1111000000000000
2r1111000000000000
2r1111000000000000)
offset: -1@ -1).
].
(builtIn includes:#corner) ifFalse:[
CornerCursor :=
(Cursor
extent: 16@16
sourceArray: #(
2r0000000000000110
2r0000000000000110
2r0000000000000110
2r0000000000000110
2r0000000000000110
2r0000000000000110
2r0000000000000110
2r0000000000000110
2r0000000000000110
2r0000000000000110
2r0000000000000110
2r0000000000000110
2r0000000000000110
2r1111111111111110
2r1111111111111110
2r0000000000000000)
maskArray: #(
2r0000000000001111
2r0000000000001111
2r0000000000001111
2r0000000000001111
2r0000000000001111
2r0000000000001111
2r0000000000001111
2r0000000000001111
2r0000000000001111
2r0000000000001111
2r0000000000001111
2r0000000000001111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111)
offset: -14@ -14).
].
(builtIn includes:#read) ifFalse:[
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).
].
(builtIn includes:#write) ifFalse:[
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).
].
(builtIn includes:#wait) ifFalse:[
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).
].
(builtIn includes:#blank) ifFalse:[
BlankCursor :=
(Cursor
extent: 16@16
fromArray: #(
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000)
offset: 0@0).
].
(builtIn includes:#execute) ifFalse:[
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).
].
(builtIn includes:#square) ifFalse:[
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).
].
(builtIn includes:#upLeftArrow) ifFalse:[
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).
].
(builtIn includes:#crossHair) ifFalse:[
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).
].
(builtIn includes:#scrollMarkerH) ifFalse:[
isWindows ifTrue:[
bits := #(
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111110111111111
2r1111110001111111
2r1111110000011111
2r1000000000000111
2r1000000000000001
2r1000000000000111
2r1111110000011111
2r1111110001111111
2r1111110111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111).
] ifFalse:[
bits := #(
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000001000000000
2r0000001110000000
2r0000001111100000
2r0111111111111000
2r0111111111111110
2r0111111111111000
2r0000001111100000
2r0000001110000000
2r0000001000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000).
].
MarkerCursor :=
Cursor
extent: 16@16
sourceArray:bits
maskArray: #(
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000011100000000
2r0000011111000000
2r1111111111110000
2r1111111111111100
2r1111111111111111
2r1111111111111100
2r1111111111110000
2r0000011111000000
2r0000011100000000
2r0000011000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000)
offset: -14@ -7.
].
(builtIn includes:#scrollUp) ifFalse:[
isWindows ifTrue:[
bits := #(
2r1111111111111111
2r1011111111111111
2r1001111111111111
2r1000111111111111
2r1000011111111111
2r1000001111111111
2r1000000111111111
2r1001111111111111
2r1001111111111111
2r1001111111111111
2r1001111111111111
2r1001111111111111
2r1001111111111111
2r1001111111111111
2r1001111111111111
2r1111111111111111).
] ifFalse:[
bits := #(
2r0000000000000000
2r0100000000000000
2r0110000000000000
2r0111000000000000
2r0111100000000000
2r0111110000000000
2r0111111000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0110000000000000
2r0000000000000000).
].
UpCursor :=
Cursor
extent: 16@16
sourceArray:bits
maskArray: #(
2r1100000000000000
2r1110000000000000
2r1111000000000000
2r1111100000000000
2r1111110000000000
2r1111111000000000
2r1111111100000000
2r1111111100000000
2r1111000000000000
2r1111000000000000
2r1111000000000000
2r1111000000000000
2r1111000000000000
2r1111000000000000
2r1111000000000000
2r1111000000000000)
offset: -1@ -1.
].
(builtIn includes:#scrollDown) ifFalse:[
isWindows ifTrue:[
bits := #(
2r1111111111111111
2r1111100111111111
2r1111100111111111
2r1111100111111111
2r1111100111111111
2r1111100111111111
2r1111100111111111
2r1111100111111111
2r1111100111111111
2r1000000111111111
2r1100000111111111
2r1110000111111111
2r1111000111111111
2r1111100111111111
2r1111110111111111
2r1111111111111111).
] ifFalse:[
bits := #(
2r0000000000000000
2r0000011000000000
2r0000011000000000
2r0000011000000000
2r0000011000000000
2r0000011000000000
2r0000011000000000
2r0000011000000000
2r0000011000000000
2r0111111000000000
2r0011111000000000
2r0001111000000000
2r0000111000000000
2r0000011000000000
2r0000001000000000
2r0000000000000000).
].
DownCursor :=
Cursor
extent: 16@16
sourceArray:bits
maskArray: #(
2r0000111100000000
2r0000111100000000
2r0000111100000000
2r0000111100000000
2r0000111100000000
2r0000111100000000
2r0000111100000000
2r0000111100000000
2r1111111100000000
2r1111111100000000
2r0111111100000000
2r0011111100000000
2r0001111100000000
2r0000111100000000
2r0000011100000000
2r0000001100000000)
offset: -7@ -15.
].
(builtIn includes:#scrollLeft) ifFalse:[
isWindows ifTrue:[
bits := #(
2r1111111111111111
2r1000000000000001
2r1100000000000001
2r1110000111111111
2r1111000111111111
2r1111100111111111
2r1111110111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111).
] ifFalse:[
bits := #(
2r0000000000000000
2r0111111111111110
2r0011111111111110
2r0001111000000000
2r0000111000000000
2r0000011000000000
2r0000001000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000).
].
LeftCursor :=
Cursor
extent: 16@16
sourceArray:bits
maskArray: #(
2r1111111111111111
2r1111111111111111
2r0111111111111111
2r0011111111111111
2r0001111100000000
2r0000111100000000
2r0000011100000000
2r0000001100000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000)
offset: -1 @ -1.
].
(builtIn includes:#scrollRight) ifFalse:[
isWindows ifTrue:[
bits := #(
2r1111111111111111
2r1111111110111111
2r1111111110011111
2r1111111110001111
2r1111111110000111
2r1000000000000011
2r1000000000000001
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111
2r1111111111111111).
] ifFalse:[
bits := #(
2r0000000000000000
2r0000000001000000
2r0000000001100000
2r0000000001110000
2r0000000001111000
2r0111111111111100
2r0111111111111110
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000).
].
RightCursor :=
Cursor
extent: 16@16
sourceArray: bits
maskArray: #(
2r0000000011000000
2r0000000011100000
2r0000000011110000
2r0000000011111000
2r1111111111111100
2r1111111111111110
2r1111111111111111
2r1111111111111111
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000)
offset: -15@ -6.
].
(builtIn includes:#scrollMarkerV) ifFalse:[
isWindows ifTrue:[
bits := #(
2r1111111111111111
2r1111111011111111
2r1111111011111111
2r1111110001111111
2r1111110001111111
2r1111100000111111
2r1111100000111111
2r1111000000011111
2r1111000000011111
2r1110000000001111
2r1111110001111111
2r1111110001111111
2r1111110001111111
2r1111110001111111
2r1111110001111111
2r1111111111111111).
] ifFalse:[
bits := #(
2r0000000000000000
2r0000000100000000
2r0000000100000000
2r0000001110000000
2r0000001110000000
2r0000011111000000
2r0000011111000000
2r0000111111100000
2r0000111111100000
2r0001111111110000
2r0000001110000000
2r0000001110000000
2r0000001110000000
2r0000001110000000
2r0000001110000000
2r0000000000000000).
].
XMarkerCursor :=
Cursor
extent: 16@16
sourceArray: bits
maskArray: #(
2r0000000100000000
2r0000001110000000
2r0000001110000000
2r0000011111000000
2r0000011111000000
2r0000111111100000
2r0000111111100000
2r0001111111110000
2r0001111111110000
2r0011111111111000
2r0011111111111000
2r0000011111000000
2r0000011111000000
2r0000011111000000
2r0000011111000000
2r0000011111000000)
offset: -7@ -1.
].
(builtIn includes:#fourWay) ifFalse:[
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.
].
(builtIn includes:#thumbsUp) ifFalse:[
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@ 0).
].
(builtIn includes:#caret) ifFalse:[
CaretCursor := (Cursor
extent: 16@16
sourceArray: #(
2r0000000000000000
2r0000000110000000
2r0000000110000000
2r0000001111000000
2r0000011111100000
2r0000011001100000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000)
maskArray: #(
2r0000000110000000
2r0000001111000000
2r0000001111100000
2r0000011111100000
2r0000111111110000
2r0000111111110000
2r0000011001100000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000
2r0000000000000000)
offset: -8@0).
].
(builtIn includes:#thumbsDown) ifFalse:[
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@ -16).
].
(builtIn includes:#stop) ifFalse:[
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).
].
(builtIn includes:#eyeBullet) ifFalse:[
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).
].
FourWayCursor notNil ifTrue:[FourWayCursor := FourWayCursor onDevice:device].
LeftCursor notNil ifTrue:[LeftCursor := LeftCursor onDevice:device].
RightCursor notNil ifTrue:[RightCursor := RightCursor onDevice:device].
XMarkerCursor notNil ifTrue:[XMarkerCursor := XMarkerCursor onDevice:device].
OriginCursor notNil ifTrue:[OriginCursor := OriginCursor onDevice:device].
CornerCursor notNil ifTrue:[CornerCursor := CornerCursor onDevice:device].
ReadCursor notNil ifTrue:[ReadCursor := ReadCursor onDevice:device].
WriteCursor notNil ifTrue:[WriteCursor := WriteCursor onDevice:device].
WaitCursor notNil ifTrue:[WaitCursor := WaitCursor onDevice:device].
XeqCursor notNil ifTrue:[XeqCursor := XeqCursor onDevice:device].
SquareCursor notNil ifTrue:[SquareCursor := SquareCursor onDevice:device].
NormalCursor notNil ifTrue:[NormalCursor := NormalCursor onDevice:device].
CrossHairCursor notNil ifTrue:[CrossHairCursor := CrossHairCursor onDevice:device].
MarkerCursor notNil ifTrue:[MarkerCursor := MarkerCursor onDevice:device].
UpCursor notNil ifTrue:[UpCursor := UpCursor onDevice:device].
DownCursor notNil ifTrue:[DownCursor := DownCursor onDevice:device].
LeftCursor notNil ifTrue:[LeftCursor := LeftCursor onDevice:device].
RightCursor notNil ifTrue:[RightCursor := RightCursor onDevice:device].
XMarkerCursor notNil ifTrue:[XMarkerCursor := XMarkerCursor onDevice:device].
CaretCursor notNil ifTrue:[CaretCursor := CaretCursor onDevice:device].
ThumbsUpCursor notNil ifTrue:[ThumbsUpCursor := ThumbsUpCursor onDevice:device].
ThumbsDownCursor notNil ifTrue:[ThumbsDownCursor := ThumbsDownCursor onDevice:device].
StopCursor notNil ifTrue:[StopCursor := StopCursor onDevice:device].
EyeCursor notNil ifTrue:[EyeCursor := EyeCursor onDevice:device].
"
Cursor initializeNewCursors
"
"Modified: / 27.9.1998 / 22:23:08 / cg"
!
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
"ST-80 compatibility
create a new bitmap cursor from bits in the array argument.
Here, the offset argument defines the hotSpot, but is given
as the negative of the hotSpot coordinate within the cursor (sigh - ST80 compatibility)."
^ self
extent:extent sourceArray:array maskArray:array offset:offset
"Modified: 22.10.1997 / 23:59:41 / cg"
!
extent:extent sourceArray:sourceArray maskArray:maskArray offset:offset
"create a new bitmap cursor with mask from bits in sourceArray and
maskArray.
The offset argument defines the hotSpot, but is given as the negative
of the hotSpots coordinate within the cursor (sigh - ST80 compatibility)"
|sourceForm maskForm|
sourceForm := Form extent:extent fromArray:sourceArray offset:offset.
sourceArray ~~ maskArray ifTrue:[
maskForm := Form extent:extent fromArray:maskArray offset:offset.
] ifFalse:[
maskForm := sourceForm
].
^ self sourceForm:sourceForm maskForm:maskForm hotSpot:(offset negated)
"Modified: 22.10.1997 / 23:58:36 / cg"
!
fileCursorNamed:cursorName
"return a cursor read from the files 'cursorName_bits.bit' and
'cursorName_mask.bit' - return nil if either file does not exist.
This method is going to be obsoleted in the future."
|cursorBits maskBits fileNamePrefix|
self obsoleteMethodWarning.
fileNamePrefix := 'bitmaps/' , cursorName.
cursorBits := Image fromFile:(fileNamePrefix , '_bits.bit').
cursorBits notNil ifTrue:[
maskBits := Image fromFile:(fileNamePrefix , '_mask.bit').
maskBits notNil ifTrue:[
^ self sourceForm:cursorBits maskForm:maskBits
]
].
^ nil
"Modified: 23.10.1997 / 00:02:07 / cg"
!
fromImage:anImage
"return a new cursor.
Source- and (optional) mask-Bits are taken from anImage;
The cursors hotSpot is the center of the image."
^ self
fromImage:anImage hotSpot:(anImage center)
"
|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: 22.10.1997 / 23:55:01 / cg"
!
fromImage:anImage hotSpot:aPoint
"return a new cursor.
Source- and (optional) mask-Bits are taken from anImage;
The cursors hotSpot is given as an offset from the top-left."
|mask sourceForm maskForm|
sourceForm := anImage asMonochromeFormOn:Screen current.
mask := anImage mask.
mask isNil ifTrue:[
maskForm := sourceForm
] ifFalse:[
maskForm := mask asMonochromeFormOn:Screen current.
].
^ self sourceForm:sourceForm
maskForm:maskForm
hotX:(aPoint x)
hotY:(aPoint y)
"
|i c|
i := Image fromFile:'bitmaps/xpmBitmaps/cursors/ul_br_arrow.xpm'.
c := Cursor fromImage:i hotSpot:(i center).
WindowGroup activeGroup
withCursor:c
do:[(Delay forSeconds:5)wait]
"
"Modified: 22.10.1997 / 23:49:00 / cg"
"Created: 22.10.1997 / 23:51:32 / cg"
!
imageArray:imageBits maskArray:maskBits
"ST-80 compatible cursor creation - the extent is fixed to 16@16"
^ self
imageArray:imageBits
maskArray:maskBits
hotSpot:8@8
"
|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).
cursor showWhile:[
(Delay forSeconds:10) wait
]
"
"Modified: 23.10.1997 / 00:06:09 / cg"
!
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
"Modified: 23.10.1997 / 00:08:37 / cg"
!
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:'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
"
Cursor arrow
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:28:28 / cg"
!
blank
"Answer the instance of me that is an invisible cursor."
^ BlankCursor
"
Cursor blank
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:27:39 / cg"
!
bottomLeft
"return a bottom-left corner cursor"
^ self shape:#bottomLeft on:Display
"
Cursor bottomLeft
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:27:12 / cg"
!
bottomRight
"return a bottom-right corner cursor"
^ self corner
"
Cursor bottomRight
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:27:02 / cg"
!
caret
"return a caret cursor"
^ CaretCursor
"
Cursor caret
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:27:08 / cg"
!
corner
"return a corner (bottom-right) cursor"
CornerCursor isNil ifTrue:[
CornerCursor := self shape:#corner on:Display
].
^ CornerCursor
"
Cursor corner
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:26:53 / cg"
!
cross
"return a cross cursor"
^ self shape:#cross on:Display
"
Cursor cross
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:26:49 / cg"
!
crossHair
"return a crossHair cursor"
CrossHairCursor isNil ifTrue:[
CrossHairCursor := self shape:#crossHair on:Display
].
^ CrossHairCursor
"
Cursor crossHair
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:26:42 / cg"
!
document
"return a document cursor (dragging a document)"
^ DocumentCursor
"
Cursor document
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: / 23.10.1997 / 00:27:08 / cg"
"Created: / 19.5.1998 / 17:17:53 / cg"
!
down
"Answer the instance of me that is the shape of a down-arrow."
^ DownCursor
"
Cursor down
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:26:34 / cg"
!
downLimitArrow
"return a down-arrow-to-limit cursor"
^ self shape:#downLimitArrow on:Display
"
Cursor downLimitArrow
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:26:29 / cg"
!
execute
"return a execute cursor - (the default here is a wait-cursor)"
XeqCursor isNil ifTrue:[
XeqCursor := self shape:#execute on:Display.
].
XeqCursor notNil ifTrue:[
^ XeqCursor
].
^ self wait
"
Cursor execute
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:26:19 / cg"
!
eye
"return an eye cursor"
^ EyeCursor
"
Cursor eye
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:26:06 / cg"
!
folder
"return a folder cursor (dragging a folder)"
^ FolderCursor
"
Cursor folder
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: / 23.10.1997 / 00:27:08 / cg"
"Created: / 19.5.1998 / 17:18:17 / cg"
!
fourWay
"return a four-way arrow cursor"
FourWayCursor isNil ifTrue:[
FourWayCursor := self shape:#fourWay on:Display
].
^ FourWayCursor
"
Cursor fourWay
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:25:34 / cg"
!
hand
"return a hand cursor"
HandCursor isNil ifTrue:[
HandCursor := self shape:#upRightHand on:Display.
HandCursor isNil ifTrue:[
HandCursor := self normal.
]
].
^ HandCursor
"
Cursor hand
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:25:07 / cg"
!
left
"Answer the instance of me that is the shape of an arrow facing to the left."
^ LeftCursor
"
Cursor left
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:24:51 / cg"
!
leftHand
"return a left-hand cursor"
^ self shape:#leftHand
"
Cursor leftHand
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:24:31 / cg"
!
leftLimitArrow
"return a left-arrow-to-limit cursor"
^ self shape:#leftLimitArrow on:Display
"
Cursor leftLimitArrow
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:24:14 / cg"
!
leftRightArrow
"return a left-right-arrow cursor"
LeftRightArrowCursor isNil ifTrue:[
LeftRightArrowCursor := self shape:#leftRightArrow on:Display
].
^ LeftRightArrowCursor
"
Cursor leftRightArrow
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:23:59 / cg"
!
marker
"Answer the instance of me that is the shape of a horizontal arrow."
^ MarkerCursor
"
Cursor marker
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:23:33 / cg"
!
normal
"return the normal cursor; an arrow.
for ST-80 compatibility"
NormalCursor isNil ifTrue:[
NormalCursor := self arrow
].
^ NormalCursor
"
Cursor normal
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:23:12 / cg"
!
origin
"return an origin cursor"
OriginCursor isNil ifTrue:[
OriginCursor := self shape:#origin on:Display
].
^ OriginCursor
"
Cursor origin
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:22:58 / cg"
!
questionMark
"return a question-mark cursor"
|crsr|
crsr := self shape:#questionMark on:Display.
(crsr isNil
or:[crsr id isNil]) ifTrue:[
crsr := self wait
].
^ crsr
"
Cursor questionMark
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: / 27.7.1998 / 20:20:44 / cg"
!
read
"return a reading-file cursor (the default here is a wait-cursor)"
ReadCursor notNil ifTrue:[
^ ReadCursor
].
^ self wait
"
Cursor read
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:22:23 / cg"
!
right
"Answer the instance of me that is the shape of an arrow facing to the right."
^ RightCursor
"
Cursor right
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:22:05 / cg"
!
rightLimitArrow
"return a right-arrow-to-limit cursor"
^ self shape:#rightLimitArrow on:Display
"
Cursor rightLimitArrow
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:15:12 / cg"
"Created: 23.10.1997 / 00:21:21 / cg"
!
stop
"return a stop cursor (the default here is a wait-cursor)"
StopCursor notNil ifTrue:[
^ StopCursor
].
^ self wait
"
Cursor stop
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:20:52 / cg"
!
text
"return a text-cursor"
^ self shape:#text on:Display
"
Cursor text
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:20:37 / cg"
!
thumbsDown
"return a hand cursor - ST-80 compatibility"
ThumbsDownCursor notNil ifTrue:[
^ ThumbsDownCursor
].
^ self hand
"
Cursor thumbsDown
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:20:20 / cg"
!
thumbsUp
"return a hand cursor - ST-80 compatibility"
ThumbsUpCursor notNil ifTrue:[
^ ThumbsUpCursor
].
^ self hand
"
Cursor thumbsUp
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:20:04 / cg"
!
topLeft
"return a top-left corner cursor"
^ self origin
"
Cursor topLeft
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:19:50 / cg"
!
topRight
"return a top-right corner cursor"
^ self shape:#topRight on:Display
"
Cursor topRight
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:19:33 / cg"
!
up
"Answer the instance of me that is the shape of an up-arrow."
^ UpCursor
"
Cursor up
showWhile:[ Delay waitForSeconds:5 ]
"
"Modified: 23.10.1997 / 00:19:14 / cg"
!
upDownArrow
"return an up-down-arrow cursor"
UpDownArrowCursor isNil ifTrue:[
UpDownArrowCursor := self shape:#upDownArrow on:Display
].
^ UpDownArrowCursor
"
Cursor upDownArrow
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:18:53 / cg"
!
upLeftArrow
"return an up-right-arrow cursor"
^ self shape:#upLeftArrow on:Display
"
Cursor upLeftArrow
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:18:37 / cg"
!
upLimitArrow
"return an up-arrow-to-limit cursor"
^ self shape:#upLimitArrow on:Display
"
Cursor upLimitArrow
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:18:19 / cg"
!
upRightArrow
"return an up-right-arrow cursor"
^ self shape:#upRightArrow on:Display
"
Cursor upRightArrow
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:18:03 / cg"
!
upRightHand
"return an up-right-hand cursor"
UpRightHandCursor isNil ifTrue:[
UpRightHandCursor := self shape:#upRightHand on:Display.
UpRightHandCursor isNil ifTrue:[
UpRightHandCursor := self normal
]
].
^ UpRightHandCursor
"
Cursor upRightHand
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:17:46 / cg"
!
wait
"return a wait cursor"
WaitCursor isNil ifTrue:[
WaitCursor := self shape:#wait on:Display
].
^ WaitCursor
"
Cursor wait
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:17:32 / cg"
!
write
"return a writing-file cursor (the default here is a wait-cursor)"
WriteCursor notNil ifTrue:[
^ WriteCursor
].
^ self wait
"
Cursor write
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:17:22 / cg"
!
xMarker
"Answer the instance of me that is displayed when thumb-scrolling on the x-axis."
^ XMarkerCursor
"
Cursor xMarker
showWhile:[ Delay waitForSeconds:3 ]
"
"Modified: 23.10.1997 / 00:16:44 / cg"
! !
!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
].
^ aBlock value
"Modified: / 28.9.1998 / 12:56:59 / 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"
"/ send out a warning: #on: is typically used to create viewa
"/ operating on a model.
"/ Please use #onDevice: to avoid confusion.
self obsoleteMethodWarning:'use #onDevice:'.
^ self onDevice:aDevice
"Modified: 5.6.1997 / 21:04:35 / cg"
!
onDevice: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"
"Created: 28.3.1997 / 13:46:38 / cg"
! !
!Cursor methodsFor:'instance release'!
disposed
"some Cursor has been collected - tell it to the display"
|id|
(id := cursorId) notNil ifTrue:[
cursorId := nil.
device destroyCursor:id.
]
!
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
"set the cursors device"
device := aDevice
!
id:anId
"set the cursors id"
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 deviceSf deviceMf|
"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 := deviceSf := sourceForm asFormOn:aDevice.
].
maskForm notNil ifTrue:[
mF := deviceMf := maskForm asFormOn:aDevice.
] ifFalse:[
mF := sF
].
] ifFalse:[
sourceForm notNil ifTrue:[
sF := sourceForm bits.
deviceSf := sourceForm.
].
maskForm notNil ifTrue:[
mF := maskForm bits.
deviceMf := maskForm.
] ifFalse:[
mF := sF
].
].
(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.
sourceForm := deviceSf.
maskForm := deviceMf.
"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:deviceSf
maskForm:deviceMf
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 methodsFor:'queries'!
isAnimatedCursor
^ false
"Created: 26.6.1997 / 11:12:48 / cg"
! !
!Cursor class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libview/Cursor.st,v 1.64 1999-02-25 23:40:14 cg Exp $'
! !
Cursor initialize!