-- TriArithImpl.mesa
-- Bill Gosper, September 24, 1979 6:28 PM

DIRECTORY
TriArith:FROM "TriArith",
AltoDisplay:FROM "AltoDisplay",
BitBltDefs:FROM "BitBltDefs",
FrameDefs:FROM "FrameDefs",
InlineDefs:FROM "InlineDefs",
KeyDefs:FROM "KeyDefs",
MiscDefs:FROM "MiscDefs",
PressDefs:FROM "PressDefs",
SystemDefs:FROM "SystemDefs";

TriArithImpl: PROGRAM IMPORTS TriArith, BitBltDefs, FrameDefs, InlineDefs,
KeyDefs, MiscDefs, PressDefs, SystemDefs
EXPORTS TriArith =
BEGINOPEN TriArith, AltoDisplay, InlineDefs;

wordLength: CARDINAL = 16;
fullY: PUBLIC CARDINAL ← MaxScanLines*21/19;
fullX: PUBLIC CARDINAL ← MaxBitsPerLine*21/19;
midX: PUBLIC CARDINAL ← fullX/2;
midY: PUBLIC CARDINAL ← fullY/2;
WordsPerLine: CARDINAL ← (fullX + wordLength - 1)/wordLength;

pfd: PressDefs.PressFileDescriptor;
ppfd: POINTER TO PressDefs.PressFileDescriptor = @pfd;
fileName: STRING ← "WhoUTrineTomb.Press";
bbt: BitBltDefs.BBTable;
bbptr: PUBLIC BitBltDefs.BBptr ← @bbt;
oldDCBChain:DCBHandle = DCBchainHead↑;
wholeScreen:DCBHandle ← DCBnil;
ScreenVec:TYPE = RECORD [x: INTEGER, y: CARDINAL];
hi1: PUBLIC LONG INTEGER ← LONG[LAST[CARDINAL]] + 1;
longOne: PUBLIC LONG INTEGER ← one*hi1;
stepping: PUBLIC BOOLEAN ← FALSE;
sdown: CARDINAL;
pressColor: CARDINAL ← 0;
multiplier, offset, randum1, randum2: PUBLIC CARDINAL;

LFracDiv: PUBLIC PROCEDURE[num: LONG INTEGER, den: INTEGER] RETURNS[LONG INTEGER] =
BEGINRETURN[IF den < 0 THEN LFCDiv[-num, -den] ELSE LFCDiv[num, den]] END;

LFCDiv: PUBLIC PROCEDURE[num: LONG INTEGER, den: CARDINAL] RETURNS[LONG INTEGER] =
BEGINq: INTEGER; r: LONGNUMBER ← [num[hibits:, lobits: 0]];
[q, r.c] ← DIV[num, den];
RETURN[LOOPHOLE[LONGNUMBER[num[hibits: i[q], lobits: LongDiv[r.lc, den]]]]];
END;

LIIDiv: PUBLIC PROCEDURE[num: LONG INTEGER, den: INTEGER] RETURNS[LONG INTEGER] =
BEGINRETURN[IF den < 0 THEN LICDiv[-num, -den] ELSE LICDiv[num, den]] END;

LICDiv: PUBLIC PROCEDURE[num: LONG INTEGER, den: CARDINAL] RETURNS[LONG INTEGER] =
BEGINq: INTEGER; r: LONGNUMBER ← [li[num]];
[q, r.c] ← DIV[r.i, den];
RETURN[LOOPHOLE[LONGNUMBER[num[hibits: i[q], lobits: LongDiv[r.lc, den]]]]]
--RETURN[LOOPHOLE[[LongDiv[r.lc, den], q]]]
-- dawk, RETURN[LONGNUMBER[num[hibits: i[q], lobits: LongDiv[r.lc, den]]].li]
END;

CSQRT: PUBLIC PROCEDURE[x: LONG CARDINAL] RETURNS[app: CARDINAL] =
BEGINaa: LONG CARDINAL;
app ← LAST[CARDINAL];-- Dorado bug!
UNTIL (aa ← LongMult[app, app]) <= x DO
app ← LongDiv[x/2 + aa/2 + BITAND[1, BITAND[LowHalf[x], LowHalf[aa]]], app]
ENDLOOP;
END;

SIN: PUBLIC PROCEDURE[x: LONG INTEGER] RETURNS[s: LONG INTEGER] =
BEGINIF ABS[HighHalf[x]] < one/20 THEN BEGIN x ← x + x;
RETURN[LL4Mul[x, 2*longOne - LL4Mul[x, x]/3]] END;
s ← 2*SIN[x/3];
RETURN[3*LL4Mul[s, 2*(longOne - 4*(LL4Mul[s, s]/3))]];
END;

LIILongMult: PUBLIC PROCEDURE[x: LONG INTEGER, y: INTEGER] RETURNS[LONG INTEGER] =
BEGINr: LONGNUMBER ← [num[lobits: 0, hibits: i[HighHalf[x]*y]]];
RETURN[r.li + ICLongMult[y, LowHalf[x]]]-- dawk
END;

--FracMul: PUBLIC PROCEDURE[x, y: INTEGER] RETURNS[INTEGER] = ~~INLINE dawk
--BEGINRETURN[HighHalf[FracLongMult[x, y]]] END;

FracMul: PUBLIC PROCEDURE[x, y: INTEGER] RETURNS[INTEGER] =
--INLINE dawk
BEGINr: LONG INTEGER ← ILongMult[x, y]; r ← r + r; RETURN[HighHalf[r + r]]
END;

--FracLongMult: PUBLIC PROCEDURE[x, y: INTEGER] RETURNS[LONG INTEGER] =
--~~INLINE dawk
--BEGINr: LONG INTEGER ← ILongMult[x, y]; r ← r + r; RETURN[r + r]
--END;

LFracMul: PUBLIC PROCEDURE[x: LONG INTEGER, y:INTEGER] RETURNS[LONG INTEGER] =
BEGINx ← ILongMult[HighHalf[x], y]
+ LONG[INTEGER[HighHalf[ICLongMult[y, LowHalf[x]]]]];
x ← x + x; RETURN[x + x]
END;
-- *4 to make ...Mul[...one, one] = ...one

LLFracMul: PUBLIC PROCEDURE[x, y: LONG INTEGER] RETURNS[LONG INTEGER] =
BEGINx ← ILongMult[HighHalf[x], HighHalf[y]]
+ INTEGER[HighHalf[ICLongMult[HighHalf[x], LowHalf[y]]]]
+ INTEGER[HighHalf[ICLongMult[HighHalf[y], LowHalf[x]]]];
x ← x + x; RETURN[x + x]
END;

LL4Mul: PUBLIC PROCEDURE[x, y: LONG INTEGER] RETURNS[LONG INTEGER] =
BEGINRETURN[ILongMult[HighHalf[x], HighHalf[y]]
+ INTEGER[HighHalf[ICLongMult[HighHalf[x], LowHalf[y]]]]
+ INTEGER[HighHalf[ICLongMult[HighHalf[y], LowHalf[x]]]]]
END;

LCM: PUBLIC PROCEDURE[a, b: CARDINAL] RETURNS[LONG CARDINAL] =
BEGINc: CARDINAL ← b MOD a;
RETURN[IF c=0 THEN b ELSE LongMult[b, LongDiv[LCM[c, a], c]]];
END;

Even:PUBLIC PROCEDURE[p: POINTER] RETURNS[POINTER] = --INLINE--
BEGIN RETURN[p + LOOPHOLE[InlineDefs.BITAND[p,1]]]; END;-- dawk

Init:PUBLIC PROCEDURE =
BEGINOPEN FrameDefs;
InitRandom[11213, 5];
InitDisplay;
MakeCodeResident[GlobalFrame[KeyDefs.Keyboard]];
END;

InitDisplay: PUBLIC PROCEDURE =
BEGINOPEN bbptr, SystemDefs;
dcb: DCBHandle; y: CARDINAL ← 0;
maxWords: CARDINAL = fullY*WordsPerLine;
WordsPerLine ← (fullX + wordLength - 1)/wordLength;
midX ← fullX/2;
midY ← fullY/2;
IF wholeScreen = DCBnil
THEN wholeScreen ← Even[AllocateHeapNode[SIZE[DCB]+1]]
ELSE FreeSegment[wholeScreen.bitmap];
wholeScreen↑ ← [next: DCBnil,
resolution: high,
background: white,
indenting: 0,
width: WordsPerLine,
bitmap: SystemDefs.AllocateSegment[maxWords], -- even
height: fullY/2];
MiscDefs.Zero[p: wholeScreen.bitmap, l:maxWords];
InitBitBlt;
FOR dcb ← oldDCBChain, dcb.next UNTIL dcb = DCBnil DO
--CopyBitmap[from: dcb, flx: 0, fty: 0,
--to: wholeScreen,
--tlx: wordLength*(dcb.indenting - wholeScreen.indenting),
--tty: y];
y ← y + 2*dcb.height;
ENDLOOP;
sourcetype ← gray; function ← invert; dbca ← wholeScreen.bitmap;
dbmr ← wholeScreen.width; dh ← 1;
DCBchainHead↑ ← wholeScreen;
END;

CopyBitmap: PROCEDURE[from: DCBHandle, flx, fty: CARDINAL,
to: DCBHandle, tlx, tty: CARDINAL,
bitsWide: CARDINAL ← fullX,
bitsHigh: CARDINAL ← fullY] =
BEGINOPEN bbptr;
sourcetype ← block; dbca ← to.bitmap;
dbmr ← to.width; dlx ← tlx; dty ← tty;
dw ← MIN[bitsWide, wordLength*from.width-flx, wordLength*to.width-tlx];
dh ← MIN[bitsHigh, 2*from.height - fty, 2*to.height - tty];
sbca ← from.bitmap; sbmr ← from.width; slx ← flx; sty ← fty;
BitBltDefs.BITBLT[bbptr];
END;

InitRandom: PUBLIC PROCEDURE[mult,add: CARDINAL] =
BEGINmultiplier ← mult; randum1 ← randum2 ← offset ← add; END;

InitBitBlt: PROCEDURE =
BEGINOPEN BitBltDefs--, SystemDefs--;
--bbptr ← Even[AllocateHeapNode[SIZE[BBTable] + 1]];
bbptr↑ ← BBTable[pad:0,
sourcealt: FALSE,
destalt: FALSE,
sourcetype: ,-- to be supplied
function: invert,
unused: 0,
dbca: wholeScreen.bitmap,
dbmr: wholeScreen.width,
dlx: ,-- to be supplied
dty: ,-- ’’
dw: ,-- ’’
dh: ,-- ’’
sbca: ,-- ’’
sbmr: ,-- ’’
slx: ,-- ’’
sty: ,-- ’’
gray0: 177777B,
gray1: 177777B,
gray2: 177777B,
gray3: 177777B];
END;

Randm1: PUBLIC PROCEDURE[m: CARDINAL] RETURNS[CARDINAL] =
BEGIN RETURN[(randum1 ← (multiplier*randum1+offset)) MOD m]; END;

Randm2: PUBLIC PROCEDURE[m: CARDINAL] RETURNS[CARDINAL] =
BEGIN RETURN[(randum2 ← (multiplier*randum2+offset)) MOD m]; END;

ReMouse: PROCEDURE =
BEGINOPEN KeyDefs, wholeScreen;
redCnt: CARDINAL ← 0;
tem: CARDINAL;
red: CARDINAL ← 4;
DO IF 0 # BITXOR[red, tem ← BITAND[Mouse.buttons, 4]] THEN
IF 0 = (red ← tem) THEN IF (redCnt ← redCnt + 1) = 3 THEN
BEGIN OPEN PressDefs;
background ← black;
IF pressColor = 0 THEN BEGIN pressColor ← 40;
InitPressFileDescriptor[ppfd, fileName]; END;
SetColor[ppfd, 0, 0, 0];--dawk
SetColor[ppfd, --Randm1[201]--pressColor, 255, 255];
stepping ← FALSE;
PutDots[ppfd, 999, 999+2540/4, width*wordLength, fullY, 0, 32*MaxBitsPerLine, 32*MaxScanLines-2540/4, bitmap];
IF (pressColor ← pressColor + 80) = 280 THEN BEGIN
pressColor ← 40;
-- WritePage[ppfd];-- END ELSE background ← white;
redCnt ← 0;
stepping ← TRUE;
END
ELSE stepping ← TRUE;
WHILE BITAND[Mouse.buttons, 2] = 0
DO stepping ← FALSE ENDLOOP;
IF ~stepping THEN EXIT;
IF 0 # BITXOR[sdown, tem ← BITAND[Mouse.buttons, 1]] THEN
IF (sdown ← tem) = 0 THEN EXIT ENDLOOP;
background ← white;
END;

DrawTri: PUBLIC PROCEDURE[p1, p2, p3: ScreenPt] =
BEGINIF p1.y > p2.y THEN
IF p1.y > p3.y THEN
IF p2.y > p3.y THEN DrawT1[p1, p2, p3] ELSE
DrawT1[p1, p3, p2] ELSE
DrawT1[p3, p1, p2] ELSE
IF p2.y > p3.y THEN
IF p1.y > p3.y THEN DrawT1[p2, p1, p3] ELSE
DrawT1[p2, p3, p1] ELSE
DrawT1[p3, p2, p1];
END;

DrawT1: PROCEDURE[p1, p2, p3: ScreenPt] =
BEGINv12: ScreenVec ← [INTEGER[p1.x] - p2.x, INTEGER[p1.y] - p2.y];
v13: ScreenVec ← [INTEGER[p1.x] - p3.x, INTEGER[p1.y] - p3.y];
v23: ScreenVec ← [INTEGER[p2.x] - p3.x, INTEGER[p2.y] - p3.y];
IF p1.y <= fullY THEN
SELECT ICLongMult[v23.x, v12.y] - ICLongMult[v12.x, v23.y] FROM
< 0 => DrawTl[p1, p2, p3, v12, v13, v23];
> 0 => DrawTr[p1, p2, p3, v12, v13, v23];
ENDCASE;
END;

DrawTl: PROCEDURE[p1, p2, p3: ScreenPt, v12, v13, v23: ScreenVec] =
BEGINrx: CARDINAL ← p1.x;--right x
q12, q13, q23: INTEGER; r12, r13, r23: CARDINAL;
s12: INTEGER ← -v12.y;
s13: INTEGER ← -v13.y;
s23: INTEGER ← -v23.y;
[q12, r12] ← DIV[v12.x, v12.y];
[q13, r13] ← DIV[v13.x, v13.y];
[q23, r23] ← DIV[v23.x, v23.y];
ReMouse;
THROUGH [p2.y .. p1.y) DO BEGIN
IF (s12 ← s12 + r12) >= 0 THEN BEGIN
s12 ← s12 - v12.y; p1.x ← p1.x - 1; END;
IF (s13 ← s13 + r13) >= 0 THEN BEGIN
s13 ← s13 - v13.y; rx ← rx - 1; END;
DrawW[p1 ← ScreenPt[p1.x - q12, p1.y - 1],
rx ← rx - q13]; END; ENDLOOP;
THROUGH [p3.y .. p2.y) DO BEGIN
IF (s23 ← s23 + r23) >= 0 THEN BEGIN
s23 ← s23 - v23.y; p2.x ← p2.x - 1; END;
IF (s13 ← s13 + r13) >= 0 THEN BEGIN
s13 ← s13 - v13.y; rx ← rx - 1; END;
DrawW[p2 ← ScreenPt[p2.x - q23, p2.y - 1],
rx ← rx - q13]; END; ENDLOOP;
END;

DrawTr: PROCEDURE[p1, p2, p3: ScreenPt, v12, v13, v23: ScreenVec] =
BEGINrx: CARDINAL ← p1.x;--right x
q12, q13, q23: INTEGER; r12, r13, r23: CARDINAL;
s12: INTEGER ← -v12.y;
s13: INTEGER ← -v13.y;
s23: INTEGER ← -v23.y;
[q12, r12] ← DIV[v12.x, v12.y];
[q13, r13] ← DIV[v13.x, v13.y];
[q23, r23] ← DIV[v23.x, v23.y];
ReMouse;
THROUGH [p2.y .. p1.y) DO BEGIN
IF (s13 ← s13 + r13) >= 0 THEN BEGIN
s13 ← s13 - v13.y; p1.x ← p1.x - 1; END;
IF (s12 ← s12 + r12) >= 0 THEN BEGIN
s12 ← s12 - v12.y; rx ← rx - 1; END;
DrawW[p1 ← ScreenPt[p1.x - q13, p1.y - 1],
rx ← rx - q12]; END; ENDLOOP;
rx ← p2.x;
THROUGH [p3.y .. p2.y) DO BEGIN
IF (s13 ← s13 + r13) >= 0 THEN BEGIN
s13 ← s13 - v13.y; p1.x ← p1.x - 1; END;
IF (s23 ← s23 + r23) >= 0 THEN BEGIN
s23 ← s23 - v23.y; rx ← rx - 1; END;
DrawW[p1 ← ScreenPt[p1.x - q13, p1.y - 1],
rx ← rx - q23]; END; ENDLOOP;
END;

DrawW: PROCEDURE[p: ScreenPt, rx: CARDINAL] = INLINE
BEGINOPEN bbptr;
dlx ← p.x; dty ← p.y; dw ← rx - p.x;
BitBltDefs.BITBLT[bbptr];
END;

PressLogo: PROCEDURE =
BEGINOPEN PressDefs;
SetColor[ppfd, 0, 0, 0];
SetFont[ppfd, "LOGO", 24, 2];
PutText[ppfd, "XEROX", 2540*5/4, 2540*9+2540/3];
SetColor[ppfd, 160, 255, 255];
SetFont[ppfd, "TimesRoman", 12, 0];
PutText[ppfd, " PALO ALTO RESEARCH CENTER", 2540*19/8, 2540*9+2540/3];
SetFont[ppfd, "TimesRoman", 10, 0];
PutText[ppfd, "LIBRARY BULLETIN", 2540*5/4, 2540*9];
PutText[ppfd, "November 1979", 2540*9/2, 2540*9];
SetColor[ppfd, 0, 0, 0];
SetFont[ppfd, "TimesRoman", 8, 1];
PutText[ppfd, "Polygonal Lissajous texture, by Bill Gosper", 2540*13/4, 999];
END;

Finish: PUBLIC PROCEDURE =
BEGINDCBchainHead↑ ← oldDCBChain;
PressDefs.ClosePressFile[ppfd];
SystemDefs.FreeSegment[wholeScreen.bitmap];
wholeScreen ← DCBnil;
END;

END.