CursorsImpl.mesa
Copyright Ó 1985, 1986, 1987, 1988, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) May 6, 1986 10:51:40 pm PDT
Doug Wyatt, January 4, 1990 2:37:27 pm PST
Pier, August 20, 1992 12:02 pm PDT
Bier, August 5, 1992 12:30 pm PDT
Willie-s, August 29, 1991 6:07 pm PDT
Michael Plass, February 25, 1992 1:45 pm PST
Christian Jacobi, March 3, 1992 2:41 pm PST
DIRECTORY
Atom, Basics, Basics16, Commander, CommanderOps, Cursors, CursorTypes, Imager, ImagerColor, ImagerSample, IO, MultiCursors, MultiCursorsExtras, Process, PseudoCursors, RefTab, Rope, ViewerClasses, ViewerOps, ViewerPrivate, ViewersWorld, ViewersWorldClasses, ViewersWorldInstance, ViewersWorldRefType, ViewersWorldTypes;
CursorsImpl:
CEDAR
MONITOR
IMPORTS Atom, Commander, CommanderOps, Imager, ImagerColor, ImagerSample, IO, Basics, Basics16, Process, RefTab, Rope, ViewerOps, ViewersWorldInstance
EXPORTS Cursors, MultiCursors, MultiCursorsExtras, PseudoCursors, ViewerPrivate, ViewersWorldRefType
= BEGIN
Global Variables And Types
CursorType: TYPE ~ MultiCursors.CursorType;
ClientCursor: TYPE ~ MultiCursors.ClientCursor;
CornerSide: TYPE ~ MultiCursors.CornerSide;
CursorInfo: TYPE ~ MultiCursors.CursorInfo;
CursorArray: TYPE = CursorTypes.CursorArray;
CursorArrayRef: TYPE = CursorTypes.CursorArrayRef;
Cursor32Array: TYPE = CursorTypes.Cursor32Array;
Cursor32ArrayRef: TYPE = CursorTypes.Cursor32ArrayRef;
ClientCursorArray: TYPE = ARRAY ClientCursor OF CursorHandle;
CursorTypeArray: TYPE = ARRAY CursorType OF CursorHandle;
CursorHandle: TYPE ~ REF CursorRec; -- use these for user-defined cursors
CursorRec:
TYPE ~
RECORD [
info: CursorInfo,
bits: CursorArray
];
BigClientCursorArray: TYPE = ARRAY ClientCursor OF BigCursorHandle;
BigCursorTypeArray: TYPE = ARRAY CursorType OF BigCursorHandle;
BigCursorHandle: TYPE = REF BigCursorRec;
BigCursorRec:
TYPE =
RECORD [
info: CursorInfo,
bits: Cursor32ArrayRef
];
VWorld: TYPE = ViewersWorld.Ref;
ViewersWorldObj: PUBLIC TYPE = ViewersWorldTypes.ViewersWorldObj;
X: BOOL = TRUE;
O: BOOL = FALSE;
PackedCursor: TYPE = PACKED ARRAY [0..16*16) OF BOOL;
KAP for PCedar November 18, 1988
Halfword: TYPE = CARD16;
NotYetImplemented: SIGNAL = CODE;
global: Global; -- initialization moved to InitSmallCursors. KAP. August 20, 1992.
Global: TYPE = REF GlobalData;
GlobalData:
TYPE =
RECORD [
info: CursorInfo ¬ [last, 0, 0, FALSE],
bits: CursorArray ¬ ALL[CARD16.LAST],
clientCursors: REF CursorTypeArray ¬ NEW[CursorTypeArray ¬ ALL[NIL]],
bigClientCursors: REF BigCursorTypeArray ¬ NEW[BigCursorTypeArray ¬ ALL[NIL]],
isABigCursor: ARRAY CursorType OF BOOL ¬ ALL[FALSE],
lastUsedCursor: CursorType ¬ $none,
DKW: formerly LAST[PredefinedCursor], but PredefinedCursor is now wrong since $none was added after $textPointer
initialHourglass: PackedCursor ¬ [
X, X, X, X, X, X, X, X, X, X, X, X, X, X, X, X,
X, X, X, X, X, X, X, X, X, X, X, X, X, X, X, X,
O, X, X, X, X, X, X, X, X, X, X, X, X, X, X, O,
O, O, X, X, X, X, X, X, X, X, X, X, X, X, O, O,
O, O, O, X, X, X, X, X, X, X, X, X, X, O, O, O,
O, O, O, O, X, X, X, X, X, X, X, X, O, O, O, O,
O, O, O, O, O, X, X, X, X, X, X, O, O, O, O, O,
O, O, O, O, O, O, X, X, X, X, O, O, O, O, O, O,
O, O, O, O, O, O, X, O, O, X, O, O, O, O, O, O,
O, O, O, O, O, X, O, O, O, O, X, O, O, O, O, O,
O, O, O, O, X, O, O, O, O, O, O, X, O, O, O, O,
O, O, O, X, O, O, O, O, O, O, O, O, X, O, O, O,
O, O, X, O, O, O, O, O, O, O, O, O, O, X, O, O,
O, X, O, O, O, O, O, O, O, O, O, O, O, O, X, O,
X, O, O, O, O, O, O, O, O, O, O, O, O, O, O, X,
X, X, X, X, X, X, X, X, X, X, X, X, X, X, X, X
],
invertSand: BOOL ¬ TRUE,
sand: BOOL ¬ TRUE,
sandArray: ARRAY [1..15) OF CARDINAL ¬ ALL[0],
sandUsed, tick, totalTicks, savedTicks: CARDINAL ¬ 0,
theHG: PackedCursor ¬ ALL[FALSE],
waitTime: Process.Ticks ¬ Process.MsecToTicks[100]
];
patternToAtom:
ARRAY CursorType
OF
ATOM;
High-Level Cursor Routines (for old single-cursor and new multi-cursor worlds)
SetACursorColor:
PUBLIC
PROC [color: Imager.Color, cursor:
ATOM, vWorld: VWorld ¬
NIL] = {
red, green, and blue should be between 0 and 255. "cursor" describes which cursor to recolor. The values of red, green, and blue should not be gamma-corrected.
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
vWorld.class.setCursorColor[vWorld.screenServerData, color, cursor];
};
GetACursorColor:
PUBLIC
PROC [cursor:
ATOM, vWorld: VWorld ¬
NIL]
RETURNS [color: Imager.Color] = {
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
color ¬ vWorld.class.getCursorColor[vWorld.screenServerData, cursor];
};
InvertCursor: PUBLIC ENTRY PROC = {
vWorld: ViewersWorld.Ref ← ViewersWorldInstance.GetWorld[];
global.bits ← GetCursorPatternOnly[];
FOR n: CARDINAL IN [0..16) DO
global.bits[n] ← Basics16.BITNOT[global.bits[n]];
ENDLOOP;
SetCursorPatternOnly[global.bits];
global.info.inverted ← ~ global.info.inverted; -- only makes sense in a one-cursor system
};
InvertCursor:
PUBLIC
ENTRY
PROC = {
InvertACursor[NIL];
};
InvertACursor:
PUBLIC
PROC [cursor:
ATOM, vWorld: VWorld ¬
NIL] = {
pattern: CursorArray;
bigPattern: Cursor32ArrayRef;
isBig: BOOL ¬ FALSE;
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
IF HasBigPattern[cursor, vWorld]
THEN {
bigPattern ¬ GetABigCursorPatternOnly[cursor, vWorld];
FOR n:
CARDINAL
IN [0..32)
DO
bigPattern[n] ¬ Basics.BITNOT[bigPattern[n]];
ENDLOOP;
SetABigCursorPatternOnly[bigPattern, cursor, vWorld];
}
ELSE {
pattern ¬ GetACursorPatternOnly[cursor, vWorld];
FOR n:
CARDINAL
IN [0..16)
DO
pattern[n] ¬ Basics16.BITNOT[pattern[n]];
ENDLOOP;
SetACursorPatternOnly[pattern, cursor, vWorld];
};
};
SetCursor:
PUBLIC
PROC [type: CursorType] = {
SetACursor[type, NIL];
<<
SetACursor:
PUBLIC
ENTRY
PROC [type: CursorType, cursor:
ATOM, vWorld: VWorld ¬
NIL] =
TRUSTED {
IF global.isABigCursor[type]
THEN {
global.info ¬ global.bigClientCursors[type].info;
global.bits ← global.bigClientCursors[type].bits;
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
vWorld.class.setBigCursorPattern[vWorld.screenServerData, global.info.hotX, global.info.hotY, global.bigClientCursors[type].bits, patternToAtom[type], cursor];
}
ELSE {
SELECT type
FROM
global.info.type => RETURN;
bullseye => {
global.info ¬ [bullseye, -7,-7, FALSE];
global.bits ¬ [
003700B, 007740B, 014060B, 030030B,
060014B, 140006B, 141606B, 141606B,
141606B, 140006B, 060014B, 030030B,
014060B, 007740B, 003700B, 000000B];
};
hourGlass => {
global.info ¬ [hourGlass, -7,-7, FALSE];
global.bits ¬ [
177777B, 100001B, 040002B, 034034B,
017170B, 007560B, 003740B, 001700B,
001100B, 002440B, 004220B, 010610B,
021704B, 047762B, 177777B, 177777B];
};
menu => {
global.info ¬ [menu, 0,-7, FALSE];
global.bits ¬ [
000000B, 000000B, 000000B, 001000B,
003001B, 007003B, 036007B, 177776B,
177776B, 036007B, 007003B, 003001B,
001000B, 000000B, 000000B, 000000B];
};
scrollUpDown => {
global.info ¬ [scrollUpDown, -7,-7, FALSE];
global.bits ¬ [
000400B, 001600B, 003700B, 007740B,
017760B, 001600B, 001600B, 001600B,
001600B, 001600B, 001600B, 017760B,
007740B, 003700B, 001600B, 000400B];
};
textPointer => {
global.info ¬ [textPointer, 0,0, FALSE];
global.bits ¬ [
100000B, 140000B, 160000B, 170000B,
174000B, 176000B, 177000B, 170000B,
154000B, 114000B, 006000B, 006000B,
003000B, 003000B, 001400B, 001400B];
};
activate => {
global.info ¬ [activate, -7,-7, FALSE];
global.bits ¬ [
177777B, 177777B, 140003B, 140003B,
140003B, 140003B, 140003B, 140003B,
140003B, 140003B, 140003B, 140003B,
140003B, 140003B, 177777B, 177777B];
};
blank => {
global.info ¬ [blank, 0,0, FALSE];
global.bits ¬ [
000000B, 000000B, 000000B, 000000B,
000000B, 000000B, 000000B, 000000B,
000000B, 000000B, 000000B, 000000B,
000000B, 000000B, 000000B, 000000B];
};
confirm => {
global.info ¬ [confirm, 0,0, FALSE];
global.bits ¬ [
000000B, 000000B, 167227B, 105324B,
105326B, 105264B, 167224B, 000000B,
000000B, 073642B, 022266B, 023652B,
022442B, 072242B, 000000B, 000000B];
};
crossHairsCircle => {
global.info ¬ [crossHairsCircle, -7,-7, FALSE];
global.bits ¬ [
001700B, 007760B, 014630B, 030614B,
060606B, 040602B, 140603B, 177177B,
177177B, 140603B, 040602B, 060606B,
030614B, 014630B, 007760B, 001700B];
};
ftp => {
global.info ¬ [ftp, -7,-7, FALSE];
global.bits ¬ [
000177B, 076077B, 040037B, 040017B,
070007B, 043703B, 040401B, 040400B,
000400B, 100436B, 140421B, 160421B,
170036B, 174020B, 176020B, 177020B];
};
typeKey => {
global.info ¬ [typeKey, -7,-7, FALSE];
global.bits ¬ [
002000B, 074000B, 140000B, 012767B,
012525B, 053566B, 111113B, 163100B,
000000B, 000000B, 154000B, 053520B,
062520B, 053360B, 155440B, 000140B];
};
move => {
global.info ¬ [move, -7,-7, FALSE];
global.bits ¬ [
000000B, 000000B, 000000B, 014030B,
016070B, 017170B, 017770B, 015730B,
014630B, 014030B, 014030B, 014030B,
014030B, 000000B, 000000B, 000000B];
};
mouseBlue => {
global.info ¬ [mouseBlue, -2,0, FALSE];
global.bits ¬ [
037770B, 020010B, 025350B, 025350B,
025350B, 025350B, 025350B, 020010B,
020010B, 020010B, 020010B, 020010B,
020010B, 020010B, 020010B, 037770B];
};
mouseRed => {
global.info ¬ [mouseRed, -2,0, FALSE];
global.bits ¬ [
037770B, 020010B, 027250B, 027250B,
027250B, 027250B, 027250B, 020010B,
020010B, 020010B, 020010B, 020010B,
020010B, 020010B, 020010B, 037770B];
};
mouseYellow => {
global.info ¬ [mouseYellow, -2,0, FALSE];
global.bits ¬ [
037770B, 020010B, 025650B, 025650B,
025650B, 025650B, 025650B, 020010B,
020010B, 020010B, 020010B, 020010B,
020010B, 020010B, 020010B, 037770B];
};
grow => {
global.info ¬ [grow, 0,0, FALSE];
global.bits ¬ [
000000B, 000000B, 000000B, 003740B,
007760B, 006060B, 014000B, 014370B,
014370B, 014030B, 006060B, 007760B,
003740B, 000000B, 000000B, 000000B];
};
pointDown => {
global.info ¬ [pointDown, -7,-15, FALSE];
global.bits ¬ [
001700B, 001700B, 001700B, 001700B,
001700B, 001700B, 001700B, 001700B,
001700B, 001700B, 037774B, 017770B,
007760B, 003740B, 001700B, 000600B];
};
pointLeft => {
global.info ¬ [pointLeft, 0,-7, FALSE];
global.bits ¬ [
000000B, 000000B, 002000B, 006000B,
016000B, 036000B, 077777B, 177777B,
177777B, 077777B, 036000B, 016000B,
006000B, 002000B, 000000B, 000000B];
};
pointRight => {
global.info ¬ [pointRight, -15,-7, FALSE];
global.bits ¬ [
000000B, 000000B, 000040B, 000060B,
000070B, 000074B, 177776B, 177777B,
177777B, 177776B, 000074B, 000070B,
000060B, 000040B, 000000B, 000000B];
};
pointUp => {
global.info ¬ [pointUp, -7,0, FALSE];
global.bits ¬ [
000600B, 001700B, 003740B, 007760B,
017770B, 037774B, 001700B, 001700B,
001700B, 001700B, 001700B, 001700B,
001700B, 001700B, 001700B, 001700B];
};
questionMark => {
global.info ¬ [questionMark, -7,-7, FALSE];
global.bits ¬ [
017000B, 037600B, 060600B, 140300B,
140300B, 060300B, 000600B, 001400B,
003000B, 006000B, 006000B, 006000B,
000000B, 000000B, 006000B, 006000B];
};
retry => {
global.info ¬ [retry, -7,-7, FALSE];
global.bits ¬ [
036370B, 021200B, 021200B, 036347B,
024200B, 022200B, 021370B, 000000B,
000000B, 175721B, 021052B, 021044B,
021704B, 021204B, 021104B, 021044B];
};
scrollDown => {
global.info ¬ [scrollDown, -7,-7, FALSE];
global.bits ¬ [
007760B, 007760B, 007760B, 007760B,
007760B, 007760B, 007760B, 007760B,
007760B, 077776B, 037774B, 017770B,
007760B, 003740B, 001700B, 000600B];
};
scrollLeft => {
global.info ¬ [scrollLeft, -7,-7, FALSE];
global.bits ¬ [
000000B, 001000B, 003000B, 007000B,
017777B, 037777B, 077777B, 177777B,
177777B, 077777B, 037777B, 017777B,
007000B, 003000B, 001000B, 000000B];
};
scrollLeftRight => {
global.info ¬ [scrollLeftRight, -7,-7, FALSE];
global.bits ¬ [
000000B, 000000B, 000000B, 004020B,
014030B, 034034B, 077776B, 177777B,
177777B, 077776B, 034034B, 014030B,
004020B, 000000B, 000000B, 000000B];
};
scrollUp => {
global.info ¬ [scrollUp, -7,-7, FALSE];
global.bits ¬ [
000600B, 001700B, 003740B, 007760B,
017770B, 037774B, 077776B, 007760B,
007760B, 007760B, 007760B, 007760B,
007760B, 007760B, 007760B, 007760B];
};
scrollRight => {
global.info ¬ [scrollRight, -7,-7, FALSE];
global.bits ¬ [
000000B, 000100B, 000140B, 000160B,
177770B, 177774B, 177776B, 177777B,
177777B, 177776B, 177774B, 177770B,
000160B, 000140B, 000100B, 000000B];
};
ENDCASE => {
global.info ¬ global.clientCursors[type].info;
global.bits ¬ global.clientCursors[type].bits;
};
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
vWorld.class.setCursorPattern[vWorld.screenServerData, global.info.hotX, global.info.hotY, global.bits, patternToAtom[type], cursor];
};
};
>>
SetACursor:
PUBLIC
ENTRY
PROC [type: CursorType, cursor:
ATOM, vWorld: VWorld ¬
NIL] =
TRUSTED {
IF global.isABigCursor[type]
THEN {
global.info ¬ global.bigClientCursors[type].info;
global.bits ← global.bigClientCursors[type].bits;
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
vWorld.class.setBigCursorPattern[vWorld.screenServerData, global.info.hotX, global.info.hotY, global.bigClientCursors[type].bits, patternToAtom[type], cursor];
}
ELSE {
global.info ¬ global.clientCursors[type].info;
global.bits ¬ global.clientCursors[type].bits;
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
vWorld.class.setCursorPattern[vWorld.screenServerData, global.info.hotX, global.info.hotY, global.clientCursors[type].bits, patternToAtom[type], cursor];
};
};
GetCursor:
PUBLIC
PROC
RETURNS [CursorType] ~ {
RETURN [global.info.type];
RETURN[GetACursor[NIL]];
};
GetACursor:
PUBLIC
PROC [cursor:
ATOM, vWorld: VWorld ¬
NIL]
RETURNS [CursorType] = {
atom: ATOM;
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
atom ¬ vWorld.class.getCursorPattern[vWorld.screenServerData, cursor].patternName;
RETURN[PatternFromAtom[atom]];
};
GetCursorInfo:
PUBLIC
ENTRY
PROC
RETURNS [CursorInfo] ~ {
RETURN [global.info]; -- only makes sense in a one-cursor world
};
CursorPatternResult: TYPE = MultiCursorsExtras.CursorPatternResult;
GetPatternFromName:
PUBLIC
PROC [type: CursorType]
RETURNS [result: CursorPatternResult, smallPattern: CursorArrayRef, bigPattern: Cursor32ArrayRef, hotX, hotY:
INTEGER ¬ 0] = {
info: CursorInfo;
IF type > global.lastUsedCursor THEN RETURN[none, NIL, NIL];
IF global.isABigCursor[type]
THEN {
result ← big;
bigPattern ← global.bigClientCursors[type].bits;
info ← global.bigClientCursors[type].info;
}
ELSE {
result ← small;
smallPattern ← NEW[CursorArray];
smallPattern^ ¬ global.clientCursors[type].bits;
info ← global.clientCursors[type].info;
};
hotX ¬ info.hotX;
hotY ¬ info.hotY;
};
InitGlobalCursor:
PROC [type: CursorType, info: CursorInfo, bits: CursorArray] = {
IF type>global.lastUsedCursor THEN ERROR; -- safety check. global.lastUsedCursor should be at none when this routine is called
global.clientCursors[type] ¬
NEW[CursorRec ¬ [
info,
bits
]];
global.isABigCursor[type] ¬ FALSE;
};
NewCursor:
PUBLIC
ENTRY
PROC [bits: CursorArray, hotX, hotY:
INTEGER ¬ 0]
RETURNS [CursorType] = {
global.lastUsedCursor ¬ SUCC[global.lastUsedCursor];
global.clientCursors[global.lastUsedCursor] ¬
NEW[CursorRec ¬ [
[global.lastUsedCursor, hotX, hotY, FALSE],
bits
]];
global.isABigCursor[global.lastUsedCursor] ¬ FALSE;
RETURN[global.lastUsedCursor];
};
NewBigCursor:
PUBLIC
ENTRY PROC [bits: Cursor32ArrayRef, hotX, hotY:
INTEGER ¬ 0]
RETURNS [CursorType] = {
global.lastUsedCursor ¬ SUCC[global.lastUsedCursor];
global.bigClientCursors[global.lastUsedCursor] ¬
NEW[BigCursorRec ¬ [
[global.lastUsedCursor, hotX, hotY, FALSE],
bits
]];
global.isABigCursor[global.lastUsedCursor] ¬ TRUE;
RETURN[global.lastUsedCursor];
};
AddCursorCorner:
PUBLIC
PROC [cornerSide: CornerSide] = {
AddACursorCorner[cornerSide, NIL];
};
AddACursorCorner:
PUBLIC
ENTRY PROC [cornerSide: CornerSide, cursor:
ATOM, vWorld: VWorld ¬
NIL] = {
Adds lines on top, sides, or both to currently displayed cursor
i: CARDINAL[0..15];
patternName: ATOM;
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
IF HasBigPattern[cursor, vWorld] THEN RETURN -- for now
ELSE {
[global.info.hotX, global.info.hotY, global.bits, patternName] ¬ vWorld.class.getCursorPattern[vWorld.screenServerData, cursor];
SELECT cornerSide
FROM
upperLeft => {
global.info.hotX ¬ global.info.hotY ¬ 0;
global.bits[0] ¬ 177777B;
global.bits[1] ¬ 177777B;
FOR i
IN [2..16)
DO
global.bits[i] ¬ Basics16.BITOR[global.bits[i], 140000B];
ENDLOOP;
};
upperRight => {
global.info.hotX ¬ -15;
global.info.hotY ¬ 0;
global.bits[0] ¬ 177777B;
global.bits[1] ¬ 177777B;
FOR i
IN [2..16)
DO
global.bits[i] ¬ Basics16.BITOR[global.bits[i], 000003B];
ENDLOOP;
};
lowerLeft => {
global.info.hotX ¬ 0;
global.info.hotY ¬ -15;
global.bits[14] ¬ 177777B;
global.bits[15] ¬ 177777B;
FOR i
IN [0..14)
DO
global.bits[i] ¬ Basics16.BITOR[global.bits[i], 140000B];
ENDLOOP;
};
lowerRight => {
global.info.hotX ¬ global.info.hotY ¬ -15;
global.bits[14] ¬ 177777B;
global.bits[15] ¬ 177777B;
FOR i
IN [0..14)
DO
global.bits[i] ¬ Basics16.BITOR[global.bits[i], 000003B];
ENDLOOP;
};
upperSide => {
global.bits[0] ¬ 177777B;
global.bits[1] ¬ 177777B;
};
lowerSide => {
global.bits[14] ¬ 177777B;
global.bits[15] ¬ 177777B;
};
leftSide => {
FOR i
IN [0..16)
DO
global.bits[i] ¬ Basics16.BITOR[global.bits[i], 140000B];
ENDLOOP;
};
rightSide => {
FOR i
IN [0..16)
DO
global.bits[i] ¬ Basics16.BITOR[global.bits[i], 000003B];
ENDLOOP;
};
ENDCASE;
vWorld.class.setCursorPattern[vWorld.screenServerData, global.info.hotX, global.info.hotY, global.bits, $Unnamed, cursor];
};
};
ViewerPrivate procedures
See HourGlass.mesa for instructions on how to use these procedures.
Here's how to modify the cursor: change the global.initialHourglass array below to anything
you like for an initial cursor. Count the number of bits (of global.sand) contained in the top
and change the constant grains to this number. global.sandArray will also need to be changed
in InitializeHourglass. The first seven numbers tell how many grains there are to start in
the top rows of the hourglass (not counting the sides). The last seven numbers tell how
many empty places (slots for global.sand grains) there are in the bottom rows of the hourglass.
The algorithm that moves the grains will carefully skip over any grains you initially put
in the bottom. Other fun things to play with are the constants that control how steep
(slope) the global.sand piles up in the bottom, or drains from the top. Happy hacking, /Scott.
grains: CARDINAL = 56;
initGrains: CARDINAL = 3;
InitializeHourglass:
PUBLIC
PROC [ticks:
CARDINAL] =
TRUSTED {
global.savedTicks ¬ ticks;
global.sandUsed ¬ global.tick ¬ 0;
global.totalTicks ¬ ticks;
global.theHG ¬ global.initialHourglass;
global.sandArray ¬ [14, 12, 10, 8, 6, 4, 2, 2, 3, 6, 7, 10, 11, 14];
global.sand ¬ TRUE;
};
TickHourglass:
PUBLIC
PROC =
TRUSTED {
incr: INTEGER;
n, m: CARDINAL;
topSlope: CARDINAL = 3;
bottomSlope: CARDINAL = 2;
IF (global.tick¬global.tick+1) > global.totalTicks
THEN {
wrap around
IF global.invertSand
THEN global.sand ¬ ~global.sand
ELSE global.theHG ¬ global.initialHourglass;
global.sandUsed ¬ global.tick ¬ 0;
global.totalTicks ¬ global.savedTicks;
global.sandArray ¬ [14, 12, 10, 8, 6, 4, 2, 2, 3, 6, 7, 10, 11, 14];
RETURN;
}
ELSE
THROUGH [global.sandUsed..MIN[global.tick*grains/global.totalTicks, grains]) DO
Take a grain out of the top non-empty row of global.sand, favoring the middle.
FOR n
DECREASING
IN [2..8)
DO
IF global.sandArray[n] >= global.sandArray[n-1]+topSlope THEN EXIT;
REPEAT
FINISHED =>
FOR n
IN [1..8)
DO
IF global.sandArray[n]#0 THEN EXIT;
ENDLOOP;
ENDLOOP;
global.sandArray[n] ¬ global.sandArray[n]-1;
m ¬ (n*16)+7;
incr ¬ 1;
UNTIL global.theHG[m]=global.sand
DO
m ¬ m+incr;
incr ¬ -incr + (IF incr<0 THEN 1 ELSE -1);
ENDLOOP;
global.theHG[m] ¬ ~global.sand;
Put a grain in one of the top non-empty rows of global.sand, favoring the middle,
and using the slope as a determinant of the global.sand stacking angle.
IF global.sandUsed < initGrains
THEN global.theHG[
SELECT global.sandUsed
FROM
0 => (9*16)+7,
1 => (11*16)+7,
ENDCASE => (13*16)+7] ¬ global.sand
ELSE {
FOR n
IN [8..14)
DO
IF global.sandArray[n] >= global.sandArray[n+1]+bottomSlope THEN EXIT;
REPEAT
FINISHED =>
FOR n
DECREASING
IN [8..15)
DO
IF global.sandArray[n]#0 THEN EXIT;
ENDLOOP;
ENDLOOP;
global.sandArray[n] ¬ global.sandArray[n]-1;
m ¬ (n*16)+7;
incr ¬ 1;
WHILE global.theHG[m]=global.sand
DO
m ¬ m+incr;
incr ¬ -incr + (IF incr<0 THEN 1 ELSE -1);
ENDLOOP;
global.theHG[m] ¬ global.sand;
};
global.sandUsed ¬ global.sandUsed+1;
ENDLOOP;
SetCursorPatternOnly[CursorFromPackedCursor[global.theHG]]; -- update displayed cursor
};
CursorFromPackedCursor:
PROC [packed: PackedCursor]
RETURNS [cursor: CursorArray] = {
word16: CARD16;
FOR i:
NAT
IN [0..15]
DO
word16 ¬ IF packed[i*16] THEN 1 ELSE 0;
FOR j:
NAT
IN [1..15]
DO
word16 ¬ Basics16.BITLSHIFT[word16, 1];
IF packed[i*16+j] THEN word16 ¬ word16 + 1;
ENDLOOP;
cursor[i] ¬ word16;
ENDLOOP;
};
Pseudo Cursors
PseudoCursor: TYPE = PseudoCursors.PseudoCursor;
DataRec:
TYPE =
RECORD [
bits: REF CursorArray,
newData: BOOL ¬ FALSE,
paint: PROCESS ¬ NIL,
timeout: CONDITION
];
Create:
PUBLIC
PROC [parent: ViewerClasses.Viewer, x, y:
INTEGER ¬ 0]
RETURNS [PseudoCursor] = {
data: REF DataRec ¬ NEW[DataRec];
data.bits ¬ NEW[CursorArray];
TRUSTED { Process.InitializeCondition[@data.timeout, global.waitTime] };
RETURN[ViewerOps.CreateViewer[flavor: $PsuedoCursor, info: [parent: parent, wx: x, wy: y, ww: 16, wh: 16, data: data, border: FALSE], paint: FALSE]];
};
Set:
PUBLIC
ENTRY
PROC [pseudoCursor: PseudoCursor, bits:
REF CursorArray] = {
ENABLE UNWIND => {};
IF pseudoCursor #
NIL
THEN
WITH pseudoCursor.data
SELECT
FROM
d:
REF DataRec => {
IF bits=NIL THEN d.bits ¬ ALL[0] ELSE d.bits ¬ bits;
d.newData ¬ TRUE;
IF d.paint=
NIL
THEN
TRUSTED {
Process.Detach[d.paint ¬ FORK PaintProcess[pseudoCursor]];
};
};
ENDCASE;
};
PaintProcess:
ENTRY
PROC [pseudoCursor: PseudoCursor] = {
ENABLE UNWIND => {};
WITH pseudoCursor.data
SELECT
FROM
d:
REF DataRec => {
WHILE d.newData
DO
d.newData ¬ FALSE;
ViewerOps.PaintViewer[pseudoCursor, client, FALSE, $Update];
WAIT d.timeout;
ENDLOOP;
d.paint ¬ NIL;
};
ENDCASE;
};
PseudoCursorPaint: ViewerClasses.PaintProc = {
IF self #
NIL
THEN
WITH self.data
SELECT
FROM
d:
REF DataRec =>
TRUSTED {
sm: ImagerSample.RasterSampleMap ~ ImagerSample.ObtainUnsafeDescriptor[size: [16, 16], bitsPerSample: 1, bitsPerLine: 16, base: [word: LOOPHOLE[d.bits], bit: 0], ref: d.bits, words: WORDS[CursorArray]];
Imager.DrawBitmap[context: context, bitmap: sm, position: [0, 16]];
ImagerSample.ReleaseDescriptor[sm];
};
ENDCASE;
};
Lower-Level Routines. Use with Care
SetACursorOffset:
PUBLIC
PROC [deltaX, deltaY:
INTEGER, enableTracking:
BOOL ¬
TRUE, cursor:
ATOM, vWorld: VWorld ¬
NIL] = {
Offsets origin of cursor bitmap by the specified number of screen points
enableTracking ← FALSE to disable automatic cursor tracking.
pattern: CursorArray;
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
pattern ¬ vWorld.class.getCursorPattern[vWorld.screenServerData, cursor].cursorPattern;
vWorld.class.setCursorPattern[vWorld.screenServerData, deltaX, deltaY, pattern, cursor];
};
SetCursorOffset:
PUBLIC
PROC [deltaX, deltaY:
INTEGER, enableTracking:
BOOL ¬
TRUE] = {
Offsets origin of [the default mouse] cursor bitmap by the specified number of screen points
enableTracking ← FALSE to disable automatic cursor tracking.
vWorld: ViewersWorld.Ref ¬ ViewersWorldInstance.GetWorld[];
pattern: CursorArray ¬ vWorld.class.getCursorPattern[vWorld.screenServerData, NIL].cursorPattern;
vWorld.class.setCursorPattern[vWorld.screenServerData, deltaX, deltaY, pattern, NIL];
};
GetACursorOffset:
PUBLIC
PROC [cursor:
ATOM, vWorld: VWorld ¬
NIL]
RETURNS [deltaX, deltaY:
INTEGER ¬ 0, trackingEnabled:
BOOL ¬
TRUE] = {
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
[deltaX, deltaY, ----] ¬ vWorld.class.getCursorPattern[vWorld.screenServerData, cursor];
};
GetCursorOffset:
PUBLIC
PROC
RETURNS[deltaX, deltaY:
INTEGER, trackingEnabled:
BOOL ¬
TRUE] = {
Get the origin offset of the [default mouse] cursor.
vWorld: ViewersWorld.Ref ¬ ViewersWorldInstance.GetWorld[];
[deltaX, deltaY, ----] ¬ vWorld.class.getCursorPattern[vWorld.screenServerData, NIL];
};
SetACursorPosition:
PUBLIC
PROC [posX, posY:
INTEGER, enableTracking:
BOOL ¬
TRUE, cursor:
ATOM, vWorld: VWorld ¬
NIL] = {
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
SIGNAL NotYetImplemented;
};
SetCursorPosition:
PUBLIC
PROC[posX, posY:
INTEGER, enableTracking:
BOOL ¬
TRUE] = {
Sets the cursor position directly to the desired value (useful for cursor gridding)
enableTracking ← FALSE to disable automatic cursor tracking.
Position may not be in synch with Inscript fetches.
vWorld: ViewersWorld.Ref ¬ ViewersWorldInstance.GetWorld[];
SIGNAL NotYetImplemented;
};
GetACursorPosition:
PUBLIC
PROC [cursor:
ATOM, vWorld: VWorld ¬
NIL]
RETURNS [deltaX, deltaY:
INTEGER ¬ 0, trackingEnabled:
BOOL ¬
TRUE] = {
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
SIGNAL NotYetImplemented;
};
GetCursorPosition:
PUBLIC
PROC
RETURNS [deltaX, deltaY:
INTEGER ¬ 0, trackingEnabled:
BOOL ¬
TRUE] = {
Returns the current cursor position.
Position may not be in synch with Inscript fetches.
SIGNAL NotYetImplemented;
};
SetAMousePosition:
PUBLIC
PROC [x, y:
INTEGER, display:
REF ¬
NIL, cursor:
ATOM, vWorld: VWorld ¬
NIL] = {
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
vWorld.class.setMousePosition[vWorld.screenServerData, x, y, display, cursor];
};
GetAMousePosition:
PUBLIC
PROC [cursor:
ATOM, vWorld: VWorld ¬
NIL]
RETURNS [x, y:
INTEGER, display:
REF ¬
NIL] = {
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
RETURN vWorld.class.getMousePosition[vWorld.screenServerData, cursor];
};
DefaultMouseGrain:
PUBLIC
PROC
RETURNS [ticks:
CARD16 ¬ 173, dots:
INTEGER ¬ 173] = {
SIGNAL NotYetImplemented;
};
Recording grain hints. These are provided by higher levels at the time those levels are created. Subsequent recorded events will be entered at the specified grain. Unless the higher levels are running in more or less real time, these hints will not be too valuable.
SetAMouseGrain:
PUBLIC
PROC [ticks:
CARD16, dots:
INTEGER, cursor:
ATOM, vWorld: VWorld ¬
NIL] = {
SIGNAL NotYetImplemented;
};
SetMouseGrain:
PUBLIC
PROC [ticks:
CARD16, dots:
INTEGER] = {
SIGNAL NotYetImplemented;
};
SetACursorPattern:
PUBLIC
PROC [cursorPattern: CursorArray, deltaX, deltaY:
INTEGER, cursor:
ATOM, vWorld: VWorld ¬
NIL] = {
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
vWorld.class.setCursorPattern[vWorld.screenServerData, deltaX, deltaY, cursorPattern, $Unnamed, cursor];
};
SetCursorPattern:
PUBLIC
PROC [cursorPattern: CursorArray, deltaX, deltaY:
INTEGER] = {
Changes the cursor bit array and the offset of the hot spot.
vWorld: ViewersWorld.Ref ¬ ViewersWorldInstance.GetWorld[];
vWorld.class.setCursorPattern[vWorld.screenServerData, deltaX, deltaY, cursorPattern, $Unnamed, NIL];
};
SetABigCursorPattern:
PUBLIC
PROC [cursorPattern: Cursor32ArrayRef, deltaX, deltaY:
INTEGER, cursor:
ATOM, vWorld: VWorld ¬
NIL] = {
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
vWorld.class.setBigCursorPattern[vWorld.screenServerData, deltaX, deltaY, cursorPattern, $Unnamed, cursor];
};
HasBigPattern:
PUBLIC
PROC [cursor:
ATOM, vWorld: VWorld ¬
NIL]
RETURNS [
BOOL] = {
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
RETURN[vWorld.class.isBigCursorPattern[vWorld.screenServerData, cursor]];
};
GetACursorPattern:
PUBLIC
PROC [cursor:
ATOM, vWorld: VWorld ¬
NIL]
RETURNS [cursorPattern: CursorArray, deltaX, deltaY:
INTEGER] = {
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
[deltaX, deltaY, cursorPattern] ¬ vWorld.class.getCursorPattern[vWorld.screenServerData, cursor];
};
GetCursorPattern:
PUBLIC
PROC
RETURNS [cursorPattern: CursorArray, deltaX, deltaY:
INTEGER] = {
Fetches the cursor bit array, and the offset of the hot spot.
vWorld: ViewersWorld.Ref ¬ ViewersWorldInstance.GetWorld[];
[deltaX, deltaY, cursorPattern] ¬ vWorld.class.getCursorPattern[vWorld.screenServerData, NIL];
};
GetABigCursorPattern:
PUBLIC
PROC [cursor:
ATOM, vWorld: VWorld ¬
NIL]
RETURNS [cursorPattern: Cursor32ArrayRef, deltaX, deltaY:
INTEGER ¬ 0] = {
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
[deltaX, deltaY, cursorPattern] ¬ vWorld.class.getBigCursorPattern[vWorld.screenServerData, cursor];
};
SetACursorPatternOnly:
PUBLIC
PROC [cursorPattern: CursorArray, cursor:
ATOM, vWorld: VWorld ¬
NIL] = {
deltaX, deltaY: INTEGER;
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
[deltaX, deltaY, ----] ¬ vWorld.class.getCursorPattern[vWorld.screenServerData, cursor];
vWorld.class.setCursorPattern[vWorld.screenServerData, deltaX, deltaY, cursorPattern, cursor];
};
SetCursorPatternOnly:
PUBLIC
PROC [cursorPattern: CursorArray] = {
changes the cursor bit array
vWorld: ViewersWorld.Ref ¬ ViewersWorldInstance.GetWorld[];
deltaX, deltaY: INTEGER;
[deltaX, deltaY, ----] ¬ vWorld.class.getCursorPattern[vWorld.screenServerData, NIL];
vWorld.class.setCursorPattern[vWorld.screenServerData, deltaX, deltaY, cursorPattern, NIL];
};
SetABigCursorPatternOnly:
PUBLIC
PROC [cursorPattern: Cursor32ArrayRef, cursor:
ATOM, vWorld: VWorld ¬
NIL] = {
deltaX, deltaY: INTEGER;
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
[deltaX, deltaY, ----] ¬ vWorld.class.getCursorPattern[vWorld.screenServerData, NIL];
vWorld.class.setBigCursorPattern[vWorld.screenServerData, deltaX, deltaY, cursorPattern, cursor];
};
GetACursorPatternOnly:
PUBLIC
PROC [cursor:
ATOM, vWorld: VWorld ¬
NIL]
RETURNS [cursorPattern: CursorArray] = {
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
cursorPattern ¬ vWorld.class.getCursorPattern[vWorld.screenServerData, cursor].cursorPattern;
};
GetCursorPatternOnly:
PUBLIC
PROC
RETURNS [cursorPattern: CursorArray] = {
fetches the cursor bit array
vWorld: ViewersWorld.Ref ¬ ViewersWorldInstance.GetWorld[];
cursorPattern ¬ vWorld.class.getCursorPattern[vWorld.screenServerData, NIL].cursorPattern;
};
GetABigCursorPatternOnly:
PUBLIC
PROC [cursor:
ATOM, vWorld: VWorld ¬
NIL]
RETURNS [cursorPattern: Cursor32ArrayRef] = {
IF vWorld = NIL THEN vWorld ¬ ViewersWorldInstance.GetWorld[];
cursorPattern ¬ vWorld.class.getBigCursorPattern[vWorld.screenServerData, cursor].cursorPattern;
};
CursorColorCommand: Commander.CommandProc = {
colorName: Rope.ROPE ¬ CommanderOps.NextArgument[cmd];
cursorName: Rope.ROPE ¬ CommanderOps.NextArgument[cmd];
cursorAtom: ATOM ¬ Atom.MakeAtom[cursorName];
rgb: ImagerColor.RGB;
vWorld: ViewersWorld.Ref ¬ ViewersWorldInstance.GetWorld[];
color: Imager.Color;
rgb ¬
SELECT
TRUE
FROM
Rope.Equal[colorName, "red", FALSE] => [1,0,0],
Rope.Equal[colorName, "orange", FALSE] => [R: 0.976, G: 0.452, B: 0.0],
Rope.Equal[colorName, "yellow", FALSE] => [1,1,0],
Rope.Equal[colorName, "green", FALSE] => [0,1,0],
Rope.Equal[colorName, "blue", FALSE] => [0,0,1],
Rope.Equal[colorName, "purple", FALSE] => [R: 0.81, G: 0.011, B: 0.941],
Rope.Equal[colorName, "black", FALSE] => [0,0,0],
ENDCASE => [0,0,0];
color ¬ ImagerColor.ColorFromRGB[rgb];
SetACursorColor[color, cursorAtom, vWorld];
};
CursorPatternCommand: Commander.CommandProc = {
patternName: Rope.ROPE ¬ CommanderOps.NextArgument[cmd];
cursorRope: Rope.ROPE;
pattern: ViewerClasses.CursorType;
cursorAtom: ATOM;
pattern ¬
SELECT
TRUE
FROM
Rope.Equal[patternName, "activate"] => activate,
Rope.Equal[patternName, "blank"] => blank,
Rope.Equal[patternName, "bullseye"] => bullseye,
Rope.Equal[patternName, "confirm"] => confirm,
Rope.Equal[patternName, "crossHairsCircle"] => crossHairsCircle,
Rope.Equal[patternName, "ftp"] => ftp,
Rope.Equal[patternName, "typeKey"] => typeKey,
Rope.Equal[patternName, "hourGlass"] => hourGlass,
Rope.Equal[patternName, "move"] => move,
Rope.Equal[patternName, "menu"] => menu,
Rope.Equal[patternName, "mouseRed"] => mouseRed,
Rope.Equal[patternName, "mouseYellow"] => mouseYellow,
Rope.Equal[patternName, "mouseBlue"] => mouseBlue,
Rope.Equal[patternName, "grow"] => grow,
Rope.Equal[patternName, "pointDown"] => pointDown,
Rope.Equal[patternName, "pointLeft"] => pointLeft,
Rope.Equal[patternName, "pointRight"] => pointRight,
Rope.Equal[patternName, "pointUp"] => pointUp,
Rope.Equal[patternName, "questionMark"] => questionMark,
Rope.Equal[patternName, "retry"] => retry,
Rope.Equal[patternName, "scrollDown"] => scrollDown,
Rope.Equal[patternName, "scrollLeft"] => scrollLeft,
Rope.Equal[patternName, "scrollLeftRight"] => scrollLeftRight,
Rope.Equal[patternName, "scrollRight"] => scrollRight,
Rope.Equal[patternName, "scrollUp"] => scrollUp,
Rope.Equal[patternName, "scrollUpDown"] => scrollUpDown,
Rope.Equal[patternName, "textPointer"] => textPointer,
Rope.Equal[patternName, "none"] => none,
Rope.Equal[patternName, "last"] => last,
ENDCASE => textPointer;
cursorRope ¬ CommanderOps.NextArgument[cmd];
cursorAtom ¬ IF cursorRope = NIL THEN NIL ELSE Atom.MakeAtom[cursorRope];
SetACursor[pattern, cursorAtom, NIL];
cmd.out.PutF[" Setting cursor %g to pattern %g\n", [atom[cursorAtom]], [rope[IF pattern = textPointer THEN "textPointer" ELSE patternName]] ];
};
PatternFromAtom:
PROC [atom:
ATOM]
RETURNS [pattern: CursorType] = {
val: REF;
success: BOOL ¬ FALSE;
[success, val] ¬ RefTab.Fetch[atomToPattern, atom];
pattern ¬
IF
NOT success
THEN none
ELSE NARROW[val, REF CursorType];
};
atomToPattern: RefTab.Ref ¬ RefTab.Create[271];
BuildCursorNameTables:
PROC [] = {
AssociatePatternAndAtom:
PROC [pattern: CursorType, atom:
ATOM] = {
patternToAtom[pattern] ¬ atom;
[] ¬ RefTab.Store[atomToPattern, atom, NEW[CursorType ¬ pattern]];
};
AssociatePatternAndAtom[activate, $activate];
AssociatePatternAndAtom[blank, $blank];
AssociatePatternAndAtom[bullseye, $bullseye];
AssociatePatternAndAtom[confirm, $confirm];
AssociatePatternAndAtom[crossHairsCircle, $crossHairsCircle];
AssociatePatternAndAtom[ftp, $ftp];
AssociatePatternAndAtom[typeKey, $typeKey];
AssociatePatternAndAtom[hourGlass, $hourGlass];
AssociatePatternAndAtom[move, $move];
AssociatePatternAndAtom[menu, $menu];
AssociatePatternAndAtom[mouseRed, $mouseRed];
AssociatePatternAndAtom[mouseYellow, $mouseYellow];
AssociatePatternAndAtom[mouseBlue, $mouseBlue];
AssociatePatternAndAtom[grow, $grow];
AssociatePatternAndAtom[pointDown, $pointDown];
AssociatePatternAndAtom[pointLeft, $pointLeft];
AssociatePatternAndAtom[pointRight, $pointRight];
AssociatePatternAndAtom[pointUp, $pointUp];
AssociatePatternAndAtom[questionMark, $questionMark];
AssociatePatternAndAtom[retry, $retry];
AssociatePatternAndAtom[scrollDown, $scrollDown];
AssociatePatternAndAtom[scrollLeft, $scrollLeft];
AssociatePatternAndAtom[scrollLeftRight, $scrollLeftRight];
AssociatePatternAndAtom[scrollRight, $scrollRight];
AssociatePatternAndAtom[scrollUp, $scrollUp];
AssociatePatternAndAtom[scrollUpDown, $scrollUpDown];
AssociatePatternAndAtom[textPointer, $textPointer];
AssociatePatternAndAtom[none, $none];
FOR i: CursorType
IN (textPointer..last)
DO
AssociatePatternAndAtom[i, Atom.MakeAtom[IO.PutFR1["Custom%g", [integer[ORD[i]-27]] ]] ];
ENDLOOP;
AssociatePatternAndAtom[last, $last];
};
InitSmallCursors:
PROC [] =
TRUSTED {
global ¬ NEW[GlobalData ¬ []]; -- used to set up the calls to SetCursorPattern, etc. See SetACursor for an example of use.
FOR type: CursorType
IN [activate..textPointer]
DO
SELECT type
FROM
activate => {
InitGlobalCursor[type, [activate, -7,-7, FALSE],
[
177777B, 177777B, 140003B, 140003B,
140003B, 140003B, 140003B, 140003B,
140003B, 140003B, 140003B, 140003B,
140003B, 140003B, 177777B, 177777B]];
};
blank => {
InitGlobalCursor[type, [blank, 0,0, FALSE],
[
000000B, 000000B, 000000B, 000000B,
000000B, 000000B, 000000B, 000000B,
000000B, 000000B, 000000B, 000000B,
000000B, 000000B, 000000B, 000000B]];
};
bullseye => {
InitGlobalCursor[type, [bullseye, -7,-7, FALSE],
[
003700B, 007740B, 014060B, 030030B,
060014B, 140006B, 141606B, 141606B,
141606B, 140006B, 060014B, 030030B,
014060B, 007740B, 003700B, 000000B]];
};
confirm => {
InitGlobalCursor[type, [confirm, 0,0, FALSE],
[
000000B, 000000B, 167227B, 105324B,
105326B, 105264B, 167224B, 000000B,
000000B, 073642B, 022266B, 023652B,
022442B, 072242B, 000000B, 000000B]];
};
crossHairsCircle => {
InitGlobalCursor[type, [crossHairsCircle, -7,-7, FALSE],
[
001700B, 007760B, 014630B, 030614B,
060606B, 040602B, 140603B, 177177B,
177177B, 140603B, 040602B, 060606B,
030614B, 014630B, 007760B, 001700B]];
};
ftp => {
InitGlobalCursor[type, [ftp, -7,-7, FALSE],
[
000177B, 076077B, 040037B, 040017B,
070007B, 043703B, 040401B, 040400B,
000400B, 100436B, 140421B, 160421B,
170036B, 174020B, 176020B, 177020B]];
};
typeKey => {
InitGlobalCursor[type, [typeKey, -7,-7, FALSE],
[
002000B, 074000B, 140000B, 012767B,
012525B, 053566B, 111113B, 163100B,
000000B, 000000B, 154000B, 053520B,
062520B, 053360B, 155440B, 000140B]];
};
hourGlass => {
InitGlobalCursor[type, [hourGlass, -7,-7, FALSE],
[
177777B, 100001B, 040002B, 034034B,
017170B, 007560B, 003740B, 001700B,
001100B, 002440B, 004220B, 010610B,
021704B, 047762B, 177777B, 177777B]];
};
move => {
InitGlobalCursor[type, [move, -7,-7, FALSE],
[
000000B, 000000B, 000000B, 014030B,
016070B, 017170B, 017770B, 015730B,
014630B, 014030B, 014030B, 014030B,
014030B, 000000B, 000000B, 000000B]];
};
menu => {
InitGlobalCursor[type, [menu, 0,-7, FALSE],
[
000000B, 000000B, 000000B, 001000B,
003001B, 007003B, 036007B, 177776B,
177776B, 036007B, 007003B, 003001B,
001000B, 000000B, 000000B, 000000B]];
};
mouseRed => {
InitGlobalCursor[type, [mouseRed, -2,0, FALSE],
[
037770B, 020010B, 027250B, 027250B,
027250B, 027250B, 027250B, 020010B,
020010B, 020010B, 020010B, 020010B,
020010B, 020010B, 020010B, 037770B]];
};
mouseYellow => {
InitGlobalCursor[type, [mouseYellow, -2,0, FALSE],
[
037770B, 020010B, 025650B, 025650B,
025650B, 025650B, 025650B, 020010B,
020010B, 020010B, 020010B, 020010B,
020010B, 020010B, 020010B, 037770B]];
};
mouseBlue => {
InitGlobalCursor[type, [mouseBlue, -2,0, FALSE],
[
037770B, 020010B, 025350B, 025350B,
025350B, 025350B, 025350B, 020010B,
020010B, 020010B, 020010B, 020010B,
020010B, 020010B, 020010B, 037770B]];
};
grow => {
InitGlobalCursor[type, [grow, 0,0, FALSE],
[
000000B, 000000B, 000000B, 003740B,
007760B, 006060B, 014000B, 014370B,
014370B, 014030B, 006060B, 007760B,
003740B, 000000B, 000000B, 000000B]];
};
pointDown => {
InitGlobalCursor[type, [pointDown, -7,-15, FALSE],
[
001700B, 001700B, 001700B, 001700B,
001700B, 001700B, 001700B, 001700B,
001700B, 001700B, 037774B, 017770B,
007760B, 003740B, 001700B, 000600B]];
};
pointLeft => {
InitGlobalCursor[type, [pointLeft, 0,-7, FALSE],
[
000000B, 000000B, 002000B, 006000B,
016000B, 036000B, 077777B, 177777B,
177777B, 077777B, 036000B, 016000B,
006000B, 002000B, 000000B, 000000B]];
};
pointRight => {
InitGlobalCursor[type, [pointRight, -15,-7, FALSE],
[
000000B, 000000B, 000040B, 000060B,
000070B, 000074B, 177776B, 177777B,
177777B, 177776B, 000074B, 000070B,
000060B, 000040B, 000000B, 000000B]];
};
pointUp => {
InitGlobalCursor[type, [pointUp, -7,0, FALSE],
[
000600B, 001700B, 003740B, 007760B,
017770B, 037774B, 001700B, 001700B,
001700B, 001700B, 001700B, 001700B,
001700B, 001700B, 001700B, 001700B]];
};
questionMark => {
InitGlobalCursor[type, [questionMark, -7,-7, FALSE],
[
017000B, 037600B, 060600B, 140300B,
140300B, 060300B, 000600B, 001400B,
003000B, 006000B, 006000B, 006000B,
000000B, 000000B, 006000B, 006000B]];
};
retry => {
InitGlobalCursor[type, [retry, -7,-7, FALSE],
[
036370B, 021200B, 021200B, 036347B,
024200B, 022200B, 021370B, 000000B,
000000B, 175721B, 021052B, 021044B,
021704B, 021204B, 021104B, 021044B]];
};
scrollDown => {
InitGlobalCursor[type, [scrollDown, -7,-7, FALSE],
[
007760B, 007760B, 007760B, 007760B,
007760B, 007760B, 007760B, 007760B,
007760B, 077776B, 037774B, 017770B,
007760B, 003740B, 001700B, 000600B]];
};
scrollLeft => {
InitGlobalCursor[type, [scrollLeft, -7,-7, FALSE],
[
000000B, 001000B, 003000B, 007000B,
017777B, 037777B, 077777B, 177777B,
177777B, 077777B, 037777B, 017777B,
007000B, 003000B, 001000B, 000000B]];
};
scrollLeftRight => {
InitGlobalCursor[type, [scrollLeftRight, -7,-7, FALSE],
[
000000B, 000000B, 000000B, 004020B,
014030B, 034034B, 077776B, 177777B,
177777B, 077776B, 034034B, 014030B,
004020B, 000000B, 000000B, 000000B]];
};
scrollRight => {
InitGlobalCursor[type, [scrollRight, -7,-7, FALSE],
[
000000B, 000100B, 000140B, 000160B,
177770B, 177774B, 177776B, 177777B,
177777B, 177776B, 177774B, 177770B,
000160B, 000140B, 000100B, 000000B]];
};
scrollUp => {
InitGlobalCursor[type, [scrollUp, -7,-7, FALSE],
[
000600B, 001700B, 003740B, 007760B,
017770B, 037774B, 077776B, 007760B,
007760B, 007760B, 007760B, 007760B,
007760B, 007760B, 007760B, 007760B]];
};
scrollUpDown => {
InitGlobalCursor[type, [scrollUpDown, -7,-7, FALSE],
[
000400B, 001600B, 003700B, 007740B,
017760B, 001600B, 001600B, 001600B,
001600B, 001600B, 001600B, 017760B,
007740B, 003700B, 001600B, 000400B]];
};
textPointer => {
InitGlobalCursor[type, [textPointer, 0,0, FALSE],
[
100000B, 140000B, 160000B, 170000B,
174000B, 176000B, 177000B, 170000B,
154000B, 114000B, 006000B, 006000B,
003000B, 003000B, 001400B, 001400B]];
};
ENDCASE => NULL;
ENDLOOP;
};
InitSmallCursors[];
BuildCursorNameTables[];
ViewerOps.RegisterViewerClass[
$PsuedoCursor,
NEW[ViewerClasses.ViewerClassRec ¬ [
paint: PseudoCursorPaint,
tipTable: NIL
]]
];
Commander.Register["CursorColor", CursorColorCommand, "CursorColor <red, orange, yellow, green, blue, purple, or black> <cursor name>\n e.g., CursorColor blue Mouse\n Gives the named cursor the named color"];
Commander.Register["CursorPattern", CursorPatternCommand, "CursorPattern <activate, blank, bullseye, confirm, crossHairsCircle, ftp, typeKey, hourGlass, move, menu, mouseRed, mouseYellow, mouseBlue, grow, pointDown, pointLeft, pointRight, pointUp, questionMark, retry, scrollDown, scrollLeft, scrollLeftRight, scrollRight, scrollUp, scrollUpDown, textPointer, none, or last> <cursor name>\n e.g., CursorPattern scrollLeft /dev/mouse1\n Gives the named cursor the named pattern"];
END.