[Cyan]<Cedar6.0>Viewers>CursorsImpl.mesa!4

CursorsImpl.mesa

Russ Atkinson (RRA) May 6, 1986 10:51:40 pm PDT

Doug Wyatt, March 30, 1985 3:48:41 pm PST

DIRECTORY

Basics USING [BITNOT, BITOR],

Cursors USING [ClientCursor, CornerSide, CursorArray, CursorHandle, CursorInfo, CursorRec, CursorType, PredefinedCursor],

ImagerBackdoor USING [DrawBits],

Interminal USING [SetCursorOffset, SetCursorPattern],

Process USING [Detach, InitializeCondition, MsecToTicks, Ticks],

PseudoCursors USING [PseudoCursor],

TerminalDefs USING [Cursor],

ViewerClasses USING [PaintProc, Viewer, ViewerClass, ViewerClassRec],

ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass],

ViewerPrivate USING [];

CursorsImpl: CEDAR MONITOR

IMPORTS Basics, ImagerBackdoor, Interminal, Process, ViewerOps

EXPORTS Cursors, PseudoCursors, ViewerPrivate

= BEGIN OPEN Cursors;

global variables and types

ClientCursorArray: TYPE = ARRAY ClientCursor OF CursorHandle;

X: BOOL = TRUE;

O: BOOL = FALSE;

PackedCursor: TYPE = PACKED ARRAY [0..16*16) OF BOOL;

global: Global = NEW[GlobalData ← []];

Global: TYPE = REF GlobalData;

GlobalData: TYPE = RECORD [

info: CursorInfo ← [last, 0, 0, FALSE],

bits: CursorArray ← ALL[WORD.LAST],

clientCursors: REF ClientCursorArray ← NEW[ClientCursorArray ← ALL[NIL]],

lastUsedCursor: CursorType ← LAST[PredefinedCursor],

initialHourglass: PackedCursor ← [

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]

];

Cursors procedures

GetCursor: PUBLIC ENTRY PROC RETURNS [CursorType] ~ {

RETURN [global.info.type];

};

GetCursorInfo: PUBLIC ENTRY PROC RETURNS [CursorInfo] ~ {

RETURN [global.info]

};

SetCursor: PUBLIC ENTRY PROC [type: CursorType] = TRUSTED {

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, 177777B, 177777B];

};

blank => {

global.info ← [blank, 0,0, FALSE];

global.bits ← [

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, 037774B, 017770B,

007760B, 003740B, 001700B, 000600B];

};

pointLeft => {

global.info ← [pointLeft, 0,-7, FALSE];

global.bits ← [

000000B, 000000B, 020000B, 060000B,

016000B, 036000B, 077777B, 177777B,

177777B, 077777B, 036000B, 016000B,

060000B, 020000B, 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, 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;

};

Interminal.SetCursorPattern[global.bits];

Interminal.SetCursorOffset[global.info.hotX, global.info.hotY];

};

InvertCursor: PUBLIC ENTRY PROC = {

FOR n: CARDINAL IN [0..SIZE[CursorArray]) DO

global.bits[n] ← Basics.BITNOT[global.bits[n]];

ENDLOOP;

Interminal.SetCursorPattern[global.bits];

global.info.inverted ← ~ global.info.inverted;

};

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

]];

RETURN[global.lastUsedCursor];

};

AddCursorCorner: PUBLIC ENTRY PROC [cornerSide: CornerSide] = {

i: CARDINAL[0..15];

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] ← Basics.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] ← Basics.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] ← Basics.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] ← Basics.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] ← Basics.BITOR[global.bits[i], 140000B];

ENDLOOP;

};

rightSide => {

FOR i IN [0..16) DO

global.bits[i] ← Basics.BITOR[global.bits[i], 000003B];

ENDLOOP;

};

ENDCASE;

Interminal.SetCursorPattern[global.bits];

Interminal.SetCursorOffset[global.info.hotX, global.info.hotY];

};

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;

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;

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;

Interminal.SetCursorPattern[LOOPHOLE[global.theHG]]; -- update displayed cursor

};

Pseudo Cursors

PseudoCursor: TYPE = PseudoCursors.PseudoCursor;

DataRec: TYPE = RECORD [

bits: REF TerminalDefs.Cursor,

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[TerminalDefs.Cursor];

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 TerminalDefs.Cursor] = {

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 => {

ImagerBackdoor.DrawBits[context: context, base: LOOPHOLE[d.bits], wordsPerLine: 1, sMin: 0, fMin: 0, sSize: 16, fSize: 16, tx: 0, ty: 16];

};

ENDCASE;

};

ViewerOps.RegisterViewerClass[

$PsuedoCursor,

NEW[ViewerClasses.ViewerClassRec ← [

paint: PseudoCursorPaint,

tipTable: NIL

]]

];

END.