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