[Indigo]<DMS>Laurel>6.1>User>KalPack.mesa!1

-- KalPack.mesa, Peter A. Arndt; Laurel 6
--Laurel version of Alto Kaleidoscope
-- config entries: KalPack
-- last revised by: Arndt, January 14, 1982 8:50 AM

-- last revised by: Brotz, January 18, 1982 3:44 PM

-- last revised by: Taft, May 6, 1983 4:00 PM

DIRECTORY

displayCommon USING [bitMapPtr, firstDCB],

DMSTimeDefs USING [currentTime],

dsD: FROM "DisplayDefs" USING [backgtype, bmWidth, ClearRectangle, DCBnil, DCBptr, ScreenYCoord, SetCursor, yOrigin],

Editor USING [RefreshSoThatFirstCharStartsLine],

ImageDefs USING [BcdTime],

inD: FROM "InteractorDefs" USING [GetNewMailCommand, IdleLoop, IndicateCommandBusy, IndicateCommandFinished, leftMargin, mouseX, mouseY, MoveDMCMBoundary, MoveTOCDMBoundary, rightMargin],

Inline USING [BITAND, BITNOT, BITOR, BITSHIFT, BITXOR, LongCOPY],

intCommon USING [displayCommandHouse, dmcmBoundaryPadNbr, dmTextNbr, newMailCommandHouse, newMessagesHouse, tocdmBoundaryPadNbr, tocTextNbr],

IODefs USING [CR, DEL, ESC, GetInputStream, GetOutputStream, LineOverflow, NumberFormat, ReadChar, ReadEditedString, Rubout, SetInputStream, SetOutputStream, SP, WriteChar, WriteDecimal, WriteLine, WriteNumber, WriteString],

LaurelExecDefs USING [FlashTypescriptRegion],

SegmentDefs USING [FileNameError, memConfig],

StreamDefs USING [Append, DiskHandle, NewByteStream, Read, StreamHandle, userAbort, Write],

String USING [AppendDecimal, AppendNumber, AppendString, InvalidNumber, LowerCase, StringToNumber, UpperCase],

Time USING [Append, Unpack];

KalPack: PROGRAM

IMPORTS disC: displayCommon, dsD, Editor, ImageDefs, inD, intC: intCommon, Inline, IODefs, LaurelExecDefs, SegmentDefs, StreamDefs, String, Time =

BEGIN OPEN IODefs;

-- types:
Generator: TYPE = RECORD [a, b, c: INTEGER, periodcount: CARDINAL];

-- constants:
size: CARDINAL = dsD.bmWidth * 16;
wordsPerSL: CARDINAL = dsD.bmWidth;
reflect: CARDINAL = (size - 1) * wordsPerSL;
screenAreaWords: CARDINAL = wordsPerSL * size;

-- variables:
Bitmap: LONG POINTER;
istrm: StreamDefs.StreamHandle ← GetInputStream [];
period: CARDINAL ← 10000;
persistence: CARDINAL ← 5000;
xstateb: Generator ← [1, -1849, 3, ];
xstatee: Generator;
ystateb: Generator ← [1, 1809, 3, ];
ystatee: Generator;

-- variables for spotting and erasing:
ptr: LONG POINTER;
x0, x1, y0, y1: CARDINAL;
x0Words, x1Words, y0Words, y1Words: CARDINAL;
x0Bits, x1Bits, y0Bits, y1Bits: CARDINAL;
x0Ptr, x1Ptr, y0Ptr, y1Ptr: LONG POINTER;

Advance: PROC = INLINE
BEGIN OPEN Inline; -- advance state of Generator records
-- advance the spotting (begin) generators
xstateb.a ← BITXOR [(xstateb.a + xstateb.b), xstateb.b];
ystateb.a ← BITXOR [(ystateb.a + ystateb.b), ystateb.b];
xstateb.periodcount ← ystateb.periodcount ← ystateb.periodcount - 1;
IF ystateb.periodcount = 0 THEN
BEGIN
xstateb.b ← BITXOR [(xstateb.b + xstateb.c), xstateb.c];
ystateb.b ← BITXOR [(ystateb.b + ystateb.c), ystateb.c];
xstateb.periodcount ← ystateb.periodcount ← period;
END;
-- and now advance the erasing generators
xstatee.a ← BITXOR [(xstatee.a + xstatee.b), xstatee.b];
ystatee.a ← BITXOR [(ystatee.a + ystatee.b), ystatee.b];
xstatee.periodcount ← ystatee.periodcount ← ystatee.periodcount - 1;
IF ystatee.periodcount # 0 THEN RETURN;
xstatee.b ← BITXOR [(xstatee.b + xstatee.c), xstatee.c];
ystatee.b ← BITXOR [(ystatee.b + ystatee.c), ystatee.c];
xstatee.periodcount ← ystatee.periodcount ← period;
END;-- of proc Advance

ClearScreen: PROC ={dsD.ClearRectangle [inD.leftMargin, inD.rightMargin, intC.dmTextNbr.topY, intC.dmTextNbr.topY + size];};-- of proc ClearScreen

Confirm: PROC RETURNS [confirmed: BOOLEAN] =
BEGIN
DO
SELECT String.LowerCase [ReadChar []] FROM
’y, CR, ESC, SP => confirmed ← TRUE;
’n, DEL => confirmed ← FALSE;
ENDCASE =>
BEGIN
WriteLine ["Yes (or CR) or No (or DEL)?"L];
LOOP;
END;
EXIT;
ENDLOOP;
WriteLine [IF confirmed THEN "Yes"L ELSE "No"L];
END;-- of proc Confirm

DirtyWork: PROC = INLINE
-- does [most of] the preparation assignments for Erases and Spots
BEGIN OPEN Inline;
temp: CARDINAL;
x1 ← (size - 1) - x0;
y1 ← (size - 1) - y0;
-- assign the global variables:
x0Words ← BITSHIFT [x0, -4];
x1Words ← BITSHIFT [x1, -4];
y0Words ← BITSHIFT [y0, -4];
y1Words ← BITSHIFT [y1, -4];
x0Bits ← BITAND [x0, 17B]; x0Bits ← BITSHIFT [100000B, -x0Bits];
x1Bits ← BITAND [x1, 17B]; x1Bits ← BITSHIFT [100000B, -x1Bits];
y0Bits ← BITAND [y0, 17B]; y0Bits ← BITSHIFT [100000B, -y0Bits];
y1Bits ← BITAND [y1, 17B]; y1Bits ← BITSHIFT [100000B, -y1Bits];
temp ← x0 * wordsPerSL;
x0Ptr ← Bitmap + temp;
x1Ptr ← Bitmap + reflect - temp;
temp ← y0 * wordsPerSL;
y0Ptr ← Bitmap + temp;
y1Ptr ← Bitmap + reflect - temp;
END;-- of proc DirtyWork

Erases: PROC = INLINE
BEGIN OPEN Inline; -- Same as Spots except this erases
bits: UNSPECIFIED;
-- do most of the assigning:
x0 ← BITSHIFT [xstatee.a, -8];
y0 ← BITSHIFT [ystatee.a, -8];
IF x0 >= (size / 2) OR y0 >= (size / 2) THEN RETURN;-- clip to size
IF x0 >= y0 THEN RETURN; -- Discard points in other triangle (octant)
DirtyWork [];
-- and the rest:
x0Bits ← BITNOT [x0Bits];
x1Bits ← BITNOT [x1Bits];
y0Bits ← BITNOT [y0Bits];
y1Bits ← BITNOT [y1Bits];
-- ok, now do the erasing:
ptr ← y0Ptr + x0Words;
LongCOPY[ptr, 1, @bits];
bits ← BITAND [bits, x0Bits]; -- (x0, y0)
LongCOPY[@bits, 1, ptr];
ptr ← x0Ptr + y0Words;
LongCOPY[ptr, 1, @bits];
bits ← BITAND [bits, y0Bits]; -- (y0, x0)
LongCOPY[@bits, 1, ptr];
ptr ← y0Ptr + x1Words;
LongCOPY[ptr, 1, @bits];
bits ← BITAND [bits, x1Bits]; -- (x1, y0)
LongCOPY[@bits, 1, ptr];
ptr ← x1Ptr + y0Words;
LongCOPY[ptr, 1, @bits];
bits ← BITAND [bits, y0Bits]; -- (y0, x1)
LongCOPY[@bits, 1, ptr];
ptr ← y1Ptr + x1Words;
LongCOPY[ptr, 1, @bits];
bits ← BITAND [bits, x1Bits]; -- (x1, y1)
LongCOPY[@bits, 1, ptr];
ptr ← x1Ptr + y1Words;
LongCOPY[ptr, 1, @bits];
bits ← BITAND [bits, y1Bits]; -- (y1, x1)
LongCOPY[@bits, 1, ptr];
ptr ← y1Ptr + x0Words;
LongCOPY[ptr, 1, @bits];
bits ← BITAND [bits, x0Bits]; -- (x0, y1)
LongCOPY[@bits, 1, ptr];
ptr ← x0Ptr + y1Words;
LongCOPY[ptr, 1, @bits];
bits ← BITAND [bits, y1Bits]; -- (y1, x0)
LongCOPY[@bits, 1, ptr];
END;-- of proc Erases

FillDisplay: PROC = INLINE
BEGIN OPEN Inline; -- advance state of Generator records
xstateb.a ← BITXOR [(xstateb.a + xstateb.b), xstateb.b];
ystateb.a ← BITXOR [(ystateb.a + ystateb.b), ystateb.b];
xstateb.periodcount ← ystateb.periodcount ← ystateb.periodcount - 1;
IF ystateb.periodcount # 0 THEN RETURN;
xstateb.b ← BITXOR [(xstateb.b + xstateb.c), xstateb.c];
ystateb.b ← BITXOR [(ystateb.b + ystateb.c), ystateb.c];
xstateb.periodcount ← ystateb.periodcount ← period;
END;-- of proc FillDisplay

Kal: PROC =
BEGIN
background: dsD.backgtype = disC.firstDCB.background;
ctLoops: CARDINAL = 200;
dmcm: dsD.ScreenYCoord;
newMail: STRING = intC.newMessagesHouse.text;
state: {noMail, waitingForConfirm, null} ← noMail;
time: CARDINAL;
tocdm: dsD.ScreenYCoord;

Salutations ["Kal version 6.3"L];
IF SegmentDefs.memConfig.AltoType IN [AltoI..AltoIIXM] AND
~SegmentDefs.memConfig.useXM THEN
{WriteString["Sorry, your machine is incapable of running Kal."]; RETURN};
ReadKalDotParams [];
[tocdm, dmcm] ← SetUpScreen [];
StartKalDisplay [];
time ← DMSTimeDefs.currentTime.lowbits + 60;
DO
WHILE istrm.endof [istrm] DO
THROUGH [0 .. ctLoops) DO -- Main loop (all INLINE)
Advance []; -- Advance and put 8 spots, then erase 8 spots
Spots [];
Erases [];
ENDLOOP;
IF StreamDefs.userAbort THEN GOTO Leave;
IF DMSTimeDefs.currentTime.lowbits >= time THEN
BEGIN
IF (time ← DMSTimeDefs.currentTime.lowbits + 60) < 60 THEN time ← LAST [CARDINAL];
inD.IdleLoop []; inD.IdleLoop [];-- do clock update, mail check
SELECT state FROM
waitingForConfirm => LaurelExecDefs.FlashTypescriptRegion [];
noMail => IF newMail.length # 0 AND newMail [0] = ’Y THEN
BEGIN-- new mail
WriteString ["You have new mail; shall I stop? "L];
LaurelExecDefs.FlashTypescriptRegion [];
state ← waitingForConfirm;
END;
ENDCASE;
END;
ENDLOOP;
IF state = waitingForConfirm THEN
{IF NOT Confirm [] THEN {state ← null; LOOP;} ELSE EXIT;};
SELECT String.UpperCase [ReadChar []] FROM
’Q, DEL =>
BEGIN
WriteString ["Quit [confirm] "L];
IF Confirm [] THEN EXIT;
LOOP;
END;
’? => {WriteLine ["? Commands: Q (quit)"L]; LOOP;};
ENDCASE;
ReadParams [istrm, @xstateb, @ystateb ! Rubout => {WriteChar [CR]; CONTINUE; -- ... -- }];
ClearScreen []; -- the parameters have [probably] changed
StartKalDisplay [];
REPEAT
Leave => NULL;
ENDLOOP;
IF StreamDefs.userAbort THEN StreamDefs.userAbort ← FALSE
ELSE SaveParams [];
ResetScreen [tocdm, dmcm, background];
IF state = waitingForConfirm AND intC.tocTextNbr.haveToc THEN
BEGIN-- get new mail, then move the cursor over "Display"
inD.IndicateCommandBusy [intC.newMailCommandHouse];
inD.GetNewMailCommand [intC.newMailCommandHouse, TRUE];
inD.IndicateCommandFinished [intC.newMailCommandHouse];
inD.mouseX↑ ← intC.displayCommandHouse.leftX + 24;
inD.mouseY↑ ← intC.displayCommandHouse.bottomY - 4;
END;
END;-- of proc Kal

ReadN: PROC [default: UNSPECIFIED, signed: BOOLEAN] RETURNS [UNSPECIFIED, CHARACTER] =
BEGIN OPEN String; -- read number, echo default if ESC typed.
ENABLE InvalidNumber, LineOverflow => {WriteChar [’?]; RETRY;};

atomfound: PROC [c: CHARACTER] RETURNS [BOOLEAN] = {RETURN [c = SP OR c = CR OR c = ESC];};-- of proc atomfound

s: STRING ← [10];
saveNumber: STRING ← [10];
lastch: CHARACTER;
IF signed THEN AppendDecimal [s, default]
ELSE AppendNumber [s, default, 10];
AppendString [saveNumber, s];
[lastch] ← ReadEditedString [s, atomfound, TRUE];
IF s.length = 0 AND lastch = SP THEN WriteString [saveNumber];
WriteChar [IF lastch = CR THEN CR ELSE SP];
RETURN [IF s.length # 0 THEN StringToNumber [s, 10] ELSE default, lastch];
END;-- of proc ReadN

ReadKalDotParams: PROC =
BEGIN OPEN StreamDefs;
parstream: StreamHandle = NewByteStream ["Kal.params"L, Read ! SegmentDefs.FileNameError =>
GOTO NoParamsFile];
ReadParams [parstream, @xstateb, @ystateb];
parstream.destroy [parstream];
EXITS
NoParamsFile => NULL;
END;-- of proc ReadKalDotParams

ReadParams: PROC [istrm: StreamDefs.StreamHandle, xs, ys: POINTER TO Generator] =
BEGIN -- Get new parameters from keyboard (usually)
lastch: CHARACTER;
currentStream: StreamDefs.StreamHandle = GetInputStream [];
SetInputStream [istrm];
WriteDecimal [xs.a]; WriteChar [SP]; -- Write old values
WriteDecimal [xs.b]; WriteChar [SP];
WriteDecimal [xs.c]; WriteChar [SP];
WriteNumber [period, NumberFormat [10, FALSE, TRUE, 0]]; WriteChar [SP];
WriteNumber [persistence, NumberFormat [10, FALSE, TRUE, 0]]; WriteChar [SP];
WriteDecimal [ys.a]; WriteChar [SP];
WriteDecimal [ys.b]; WriteChar [SP];
WriteDecimal [ys.c];
WriteLine [". New a, b, c, period, persistence, a’, b’, c’:"L];
BEGIN
[xs.a, lastch] ← ReadN [xs.a, TRUE]; IF lastch = CR THEN GOTO Nomore;
[xs.b, lastch] ← ReadN [xs.b, TRUE]; IF lastch = CR THEN GOTO Nomore;
[xs.c, lastch] ← ReadN [xs.c, TRUE]; IF lastch = CR THEN GOTO Nomore;
[period, lastch] ← ReadN [period, FALSE]; IF lastch = CR THEN GOTO Nomore;
[persistence, lastch] ← ReadN [persistence, FALSE];
IF lastch = CR THEN GOTO Oldkal; -- Set up for old kal if exactly 5 parameters
[ys.a, lastch] ← ReadN [ys.a, TRUE]; IF lastch = CR THEN GOTO Nomore;
[ys.b, lastch] ← ReadN [ys.b, TRUE]; IF lastch = CR THEN GOTO Nomore;
[ys.c, lastch] ← ReadN [ys.c, TRUE]; IF lastch = CR THEN GOTO Nomore;
WriteChar [CR];
EXITS
Nomore => NULL;
Oldkal => -- Old kaleidoscope
BEGIN
ys.a ← Inline.BITSHIFT [xs.a, 8];
ys.b ← Inline.BITSHIFT [xs.b, 8];
ys.c ← Inline.BITSHIFT [xs.c, 8];
END;
END;
SetInputStream [currentStream];
END;-- of proc ReadParams

ResetScreen: PROC [tocdm, dmcm: dsD.ScreenYCoord, background: dsD.backgtype] =
BEGIN
ClearScreen [];
Editor.RefreshSoThatFirstCharStartsLine [firstChar: intC.dmTextNbr.lines.firstCharIndex, firstLine: intC.dmTextNbr.lines, mnp: intC.dmTextNbr];
SetBackground [background];
inD.MoveTOCDMBoundary [intC.tocdmBoundaryPadNbr, tocdm];
inD.MoveDMCMBoundary [intC.dmcmBoundaryPadNbr, dmcm];
END;-- of proc ResetScreen

Salutations: PROC [version: STRING] =
BEGIN OPEN Time;
time: STRING ← [20];
WriteChar [CR];
WriteString [version];
WriteString [", of "L];
Append [time, Unpack [ImageDefs.BcdTime []]];
time.length ← time.length - 3;-- remove the seconds
WriteLine [time];
time.length ← 0;
Append [time, Unpack []];
WriteLine [time];
WriteChar [CR];
END;-- of proc Salutations

SaveParams: PROC =
-- writes the current parameters to Kal.params if the user desires
BEGIN
WriteString ["Shall I save the current parameters? "L];
IF Confirm [] THEN
BEGIN OPEN StreamDefs;
diskH: DiskHandle = NewByteStream ["Kal.params"L, Append + Write];
output: StreamHandle = GetOutputStream [];
SetOutputStream [diskH];
WriteDecimal [xstateb.a]; WriteChar [SP];
WriteDecimal [xstateb.b]; WriteChar [SP];
WriteDecimal [xstateb.c]; WriteChar [SP];
WriteDecimal [LOOPHOLE [period]]; WriteChar [SP];
WriteDecimal [LOOPHOLE [persistence]]; WriteChar [SP];
WriteDecimal [ystateb.a]; WriteChar [SP];
WriteDecimal [ystateb.b]; WriteChar [SP];
WriteDecimal [ystateb.c]; WriteChar [CR];
SetOutputStream [output];
diskH.destroy [diskH];
END;
END;-- of proc SaveParams

SetBackground: PROC [background: dsD.backgtype] =
BEGIN
FOR chain: dsD.DCBptr ← disC.firstDCB, chain.next UNTIL chain = dsD.DCBnil DO
chain.background ← background;
ENDLOOP;
END;-- of proc SetBackground

SetUpScreen: PROC RETURNS [tocdm, dmcm: dsD.ScreenYCoord] =
BEGIN
tocdm ← intC.tocdmBoundaryPadNbr.topY;
dmcm ← intC.dmcmBoundaryPadNbr.topY;
inD.MoveTOCDMBoundary [intC.tocdmBoundaryPadNbr, 90];
inD.MoveDMCMBoundary [intC.dmcmBoundaryPadNbr, (intC.dmTextNbr.topY + 480)];
SetBackground [black];
Bitmap ← LOOPHOLE [((intC.dmTextNbr.topY - dsD.yOrigin) * dsD.bmWidth) + disC.bitMapPtr];
ClearScreen [];
dsD.SetCursor [charArrow];
END;-- of proc SetUpScreen

Spots: PROC = INLINE
BEGIN OPEN Inline; -- Draw 8 spots with kaleidoscopic symmetry
bits: UNSPECIFIED;
-- assign the global variables:
x0 ← BITSHIFT [xstateb.a, -8];
y0 ← BITSHIFT [ystateb.a, -8];
IF x0 >= (size / 2) OR y0 >= (size / 2) THEN RETURN;-- clip to size
IF x0 >= y0 THEN RETURN; -- Discard points in other triangle (octant)
DirtyWork [];
-- ok, now do the spotting:
ptr ← y0Ptr + x0Words;
LongCOPY[ptr, 1, @bits];
bits ← BITOR [bits, x0Bits]; -- (x0, y0)
LongCOPY[@bits, 1, ptr];
ptr ← x0Ptr + y0Words;
LongCOPY[ptr, 1, @bits];
bits ← BITOR [bits, y0Bits]; -- (y0, x0)
LongCOPY[@bits, 1, ptr];
ptr ← y0Ptr + x1Words;
LongCOPY[ptr, 1, @bits];
bits ← BITOR [bits, x1Bits]; -- (x1, y0)
LongCOPY[@bits, 1, ptr];
ptr ← x1Ptr + y0Words;
LongCOPY[ptr, 1, @bits];
bits ← BITOR [bits, y0Bits]; -- (y0, x1)
LongCOPY[@bits, 1, ptr];
ptr ← y1Ptr + x1Words;
LongCOPY[ptr, 1, @bits];
bits ← BITOR [bits, x1Bits]; -- (x1, y1)
LongCOPY[@bits, 1, ptr];
ptr ← x1Ptr + y1Words;
LongCOPY[ptr, 1, @bits];
bits ← BITOR [bits, y1Bits]; -- (y1, x1)
LongCOPY[@bits, 1, ptr];
ptr ← y1Ptr + x0Words;
LongCOPY[ptr, 1, @bits];
bits ← BITOR [bits, x0Bits]; -- (x0, y1)
LongCOPY[@bits, 1, ptr];
ptr ← x0Ptr + y1Words;
LongCOPY[ptr, 1, @bits];
bits ← BITOR [bits, y1Bits]; -- (y1, x0)
LongCOPY[@bits, 1, ptr];
END;-- of proc Spots

StartKalDisplay: PROC =
-- performs the initial spotting to establish the display
BEGIN
i: CARDINAL;
xstateb.periodcount ← ystateb.periodcount ← period;
xstatee ← xstateb;
ystatee ← ystateb;
-- Run the b(egin) generators ahead:
FOR i IN [1 .. persistence] DO
FillDisplay [];
Spots [];
IF ~istrm.endof [istrm] THEN EXIT;-- what? why?
ENDLOOP;
END;-- of proc StartKalDisplay

-- mainline code:
Kal [];
END.-- of program KalPack