RandomDemoImpl.mesa
Copyright © 1984, 1986 by Xerox Corporation. All rights reserved.
Created by: Jacobi, September 19, 1984 10:03:05 am PDT
Last Edited by: Christian Jacobi, August 12, 1986 3:50:22 pm PDT
DIRECTORY
Basics,
RandomDemo,
Random,
Process,
RuntimeError USING [UNCAUGHT],
CedarProcess,
Commander USING [CommandProc, Register],
VFonts,
Imager,
ImagerTerminal,
ViewerSpecs,
Idle,
Rope,
Real,
Terminal;
RandomDemoImpl:
CEDAR
MONITOR
IMPORTS Basics, CedarProcess, Imager, ImagerTerminal, Process, Commander, RuntimeError, Terminal, ViewerSpecs, VFonts, Random, Real, Idle, Rope
EXPORTS RandomDemo =
BEGIN
quit: ERROR = CODE;
chunkSize: CARDINAL = 50;
RegRec:
TYPE =
RECORD[
proc: PROC ← NoOp,
weight: INT ← 100,
b1: INT ← 100,
b2: INT ← 100,
time: INT ← 1000
];
Chunk:
TYPE =
RECORD[
nextFree: CARDINAL ← 0,
x: ARRAY [0..chunkSize) OF RegRec
];
Bunch: TYPE = REF BunchRec;
BunchRec:
TYPE =
RECORD [
cnt: INT ← 0,
list: LIST OF REF Chunk,
debug: BOOL ← FALSE,
debugRec: RegRec
];
painters, erasers: Bunch;
screenW: PUBLIC NAT ← ViewerSpecs.bwScreenWidth;
screenH: PUBLIC NAT ← ViewerSpecs.bwScreenHeight;
screenw: PUBLIC NAT ← ViewerSpecs.bwScreenWidth-1;
screenh: PUBLIC NAT ← ViewerSpecs.bwScreenHeight-1;
context: PUBLIC Imager.Context;
vt: PUBLIC Terminal.Virtual;
timeCredit: INT ← 0; --of the currently running client procedure
stop: PUBLIC BOOL ← FALSE; --client procedure must return (because its time is over)
endProgram: BOOL ← FALSE; --demo must stop because some key is hit
inside: BOOL ← FALSE; --whether module is occupied MONITORED
savedVt: Terminal.Virtual; --the outside virtual terminal to be restored
debug: BOOL ← FALSE; --debugging mode prevents catching errors
NoOp:
PROC = {
--dummy fill procedure guarantees at least one fill procedure is registered
};
Clear:
PUBLIC
PROC [] = {
--also registered, so that at least one clear procedure is registered
--also used as internal proc; does not halt
Imager.SetColor[context, Imager.white];
Imager.MaskBox[context, [xmin: 0, ymin: 0, xmax: screenW, ymax: screenH]];
Imager.SetColor[context, Imager.black];
};
RtoI:
PROC [r:
REAL]
RETURNS [
INT] = {
--transforms probability into percents
--internal proc does not halt
RETURN [Real.RoundI[r*100]]
};
Maybe:
PROC [i:
INT]
RETURNS [
BOOL] =
INLINE {
--returns true approximately in i percent of the calls
--internal proc does not halt
RETURN [i>=Random.ChooseInt[max: 99]]
};
ResetRegistration:
PROC [] = {
painters ← NEW[BunchRec ← [cnt: 0, list: LIST[NEW[Chunk]]]];
erasers ← NEW[BunchRec ← [cnt: 0, list: LIST[NEW[Chunk]]]];
Register[proc: NoOp, clearProc: FALSE, b1: 0, b2: 1, weight: 0.1];
Register[proc: Clear, clearProc: TRUE, b1: 1, b2: 0, weight: 1];
};
Register:
PUBLIC
ENTRY
PROC [proc:
PROC, clearProc:
BOOL, b1:
REAL, b2:
REAL, weight:
REAL, time:
INT�] = {
ENABLE UNWIND => NULL;
bunch: Bunch ← IF clearProc THEN erasers ELSE painters;
c: REF Chunk ← bunch.list.first;
IF time<0 THEN time ← IF clearProc THEN 1000 ELSE 3000;
IF bunch.cnt>LAST[NAT] OR proc=NIL THEN RETURN;
bunch.cnt ← bunch.cnt+1;
time ← MIN[time, 120000]; --2 minutes max
c.x[c.nextFree] ← RegRec[proc, RtoI[weight], RtoI[b1], RtoI[b2], time];
c.nextFree ← c.nextFree+1;
IF c.nextFree>=chunkSize
THEN {
c ← NEW[Chunk];
bunch.list ← CONS[c, bunch.list]
};
};
RandomProc:
PROC [b: Bunch]
RETURNS [r: RegRec] = {
--selects randomly and weighted a procedure
RandomEntry:
PROC [b: Bunch]
RETURNS [RegRec] = {
--selects randomly a procedure; but weight is still ignored
lst: LIST OF REF Chunk ← b.list;
n: INT = IF b.cnt>0 THEN Random.ChooseInt[max: b.cnt-1] ELSE 0;
IF b.debug THEN RETURN [b.debugRec];
IF n<lst.first.nextFree THEN RETURN [ lst.first.x[n] ]
ELSE {
index: CARDINAL = (n-lst.first.nextFree) MOD chunkSize;
lstIndex: CARDINAL = (n-lst.first.nextFree) / chunkSize;
FOR i:
CARDINAL
IN [0..lstIndex)
DO
lst ← lst.rest
ENDLOOP;
RETURN [ lst.first.x[index] ];
};
};
FOR i:
NAT
IN [0..20)
DO
r ← RandomEntry[b];
IF Maybe[r.weight] THEN EXIT;
ENDLOOP;
};
rememberForDebug: PROC ← NIL;
Call:
PROC [entry: RegRec] = {
--cals registered procedure
IF ~endProgram
THEN {
Terminal.Select[vt];
timeCredit ←
IF entry.time=0 THEN Random.ChooseInt[max: 6000]
ELSE Random.ChooseInt[max: entry.time]+entry.time/2;
stop ← FALSE;
rememberForDebug ← entry.proc;
Imager.DoSave[context, entry.proc !
quit => CONTINUE;
RuntimeError.UNCAUGHT => IF ~debug THEN CONTINUE;
];
};
};
paint.b1 percentage of any clear before usage
paint.b2 percentage of the clear after usage beeing simple
erase.b1 percentage of normally use [means NOT directly followed by clear again]
erase.b2 percentage of beeing followed directly by a simple clear
DemoInside:
PROC = {
ENABLE RuntimeError.UNCAUGHT => Terminal.Select[savedVt];
mustClearSimple: BOOL ← FALSE;
paint, erase: RegRec;
paint ← RandomProc[painters];
Call[paint];
DO
IF endProgram THEN EXIT;
mustClearSimple ← Maybe[paint.b2]; --previous paint!
erase ← RandomProc[erasers];
paint ← RandomProc[painters];
IF Maybe[paint.b1]
THEN {
IF mustClearSimple THEN Clear[]
ELSE {
Call[erase];
IF endProgram THEN EXIT;
IF Maybe[100-erase.b1] THEN LOOP;
IF Maybe[erase.b2] THEN Clear[];
}
};
InternalSetRandCharMode[];
Call[paint];
ENDLOOP;
};
StartDemo:
ENTRY
PROC
RETURNS [ok:
BOOL←
FALSE] = {
ENABLE UNWIND => NULL;
IF inside THEN RETURN [ok←FALSE];
endProgram ← FALSE;
savedVt ← Terminal.Current[];
[] ← Terminal.SetBWBitmapState[vt, displayed ! Terminal.CantDoIt => GOTO sorry];
InitScreenBits[];
context ← ImagerTerminal.BWContext[vt, TRUE];
Imager.SetColor[context, Imager.black];
Imager.SetFont[context, VFonts.DefaultFont[]];
ok ← TRUE;
Terminal.Select[vt];
EXITS sorry => NULL;
};
FinishDemo:
PROC = {
--NOT ENTRY; called on unwinds...
WHILE Idle.IsIdle[] DO Process.Pause[Process.MsecToTicks[100]] ENDLOOP;
IF savedVt#NIL AND Terminal.Current[]#savedVt THEN Terminal.Select[savedVt];
IF vt#
NIL
AND vt#savedVt
AND Terminal.Current[]#vt
THEN
[] ← Terminal.SetBWBitmapState[vt, none];
inside ← FALSE; --last line! because this returnes monitor
};
ImageProc: Idle.ImageProc =
TRUSTED {
b: Terminal.FrameBuffer ← Terminal.GetBWFrameBuffer[vt];
RETURN [
NEW[Idle.BitmapRep ← [
base: LOOPHOLE[b.base],
raster: b.wordsPerLine,
width: b.width,
height: b.height
]]]
};
DemoCommand: Commander.CommandProc = {
Demo:
PROC [idle:
BOOL] = {
ENABLE UNWIND => FinishDemo[];
ok: BOOL;
ok ← StartDemo[];
IF ok
THEN {
IF idle THEN Idle.Sleep[ImageProc];
TRUSTED {Process.Detach[FORK WatcherProcess[]]};
DemoInside[];
FinishDemo[];
};
};
idle: BOOL ← Rope.Match["*idle*", cmd.commandLine, FALSE];
IF Rope.Match["*debug*", cmd.commandLine, FALSE] THEN debug ← TRUE;
IF idle THEN debug ← FALSE;
debug ← ~idle AND Rope.Match["*debug*", cmd.commandLine, FALSE];
IF Rope.Match["*reset*", cmd.commandLine,
FALSE]
THEN {
ResetRegistration[]; RETURN
};
Demo[idle];
};
WatcherProcess:
PROC[] = {
ENABLE RuntimeError.
UNCAUGHT => {
--happens when vt is nilled out
stop ← endProgram ← TRUE;
GOTO oops
};
interval: NAT = 200;
CedarProcess.SetPriority[CedarProcess.Priority[foreground]];
DO
Process.Pause[Process.MsecToTicks[interval]];
IF timeCredit>=0 THEN timeCredit ← timeCredit-interval ELSE stop ← TRUE;
IF vt.GetKeys[]#ALL[up] THEN EXIT;
ENDLOOP;
stop ← endProgram ← TRUE
EXITS oops => NULL;
};
--########################################
Rand:
PUBLIC
PROC [max:
CARDINAL]
RETURNS [
CARDINAL] = {
IF stop THEN ERROR quit;
RETURN[Random.ChooseInt[max: max]]
};
Pause:
PUBLIC
PROC [milliSeconds:
INT] = {
IF milliSeconds<=0 THEN Process.Yield[]
ELSE
WHILE milliSeconds>0
DO
IF stop THEN ERROR quit;
Process.Pause[Process.MsecToTicks[MIN[milliSeconds, 100]]];
milliSeconds ← milliSeconds-100
ENDLOOP;
IF stop THEN ERROR quit;
};
randChar: CHAR ← 'a;
letterMode: INT ← 0;
RandChar:
PUBLIC
PROC []
RETURNS [c:
CHAR] = {
IF stop THEN ERROR quit;
SELECT letterMode
FROM
0 => c ← 'A+Rand[23];
1 => c ← 'a+Rand[23];
2 => c ← '0+Rand[10];
3 => c ← ' +1+Rand[95];
4, 5 => c ← randChar;
ENDCASE => c ← ' +1+Rand[95];
};
InternalSetRandCharMode:
PUBLIC
PROC [] =
INLINE {
letterMode ← Random.ChooseInt[max: 5];
IF letterMode=4 OR letterMode=5 THEN randChar ← ' +1+Random.ChooseInt[max: 95]
};
SetRandCharMode:
PUBLIC
PROC [] = {
IF stop THEN ERROR quit;
InternalSetRandCharMode[];
};
--########################################
Mode: TYPE = RandomDemo.Mode;
screenAddr: LONG CARDINAL;
wPL: CARDINAL;
bpw1: CARDINAL = Basics.bitsPerWord-1;
bpw1x: CARDINAL = LAST[CARDINAL]-bpw1;
InitScreenBits:
PROC [] =
TRUSTED {
b: Terminal.FrameBuffer ← Terminal.GetBWFrameBuffer[vt];
screenAddr ← LOOPHOLE[b.base];
wPL ← b.wordsPerLine;
};
InternalSetBit:
PROC [x, y:
INTEGER, mode: Mode] =
TRUSTED
INLINE {
t:
LONG
POINTER
TO
WORD ←
LOOPHOLE[
screenAddr
+ Basics.LongMult[LOOPHOLE[y, CARDINAL], wPL]
+ Basics.BITSHIFT[x, -Basics.logBitsPerWord]
];
t^ ←
SELECT mode
FROM
set => Basics.BITOR[t^, Basics.BITSHIFT[1, bpw1-Basics.BITAND[x, bpw1]]],
xor => Basics.BITXOR[t^, Basics.BITSHIFT[1, bpw1-Basics.BITAND[x, bpw1]]],
clr => Basics.BITAND[t^, LAST[CARDINAL]-LOOPHOLE[Basics.BITSHIFT[1, bpw1-Basics.BITAND[x, bpw1]], CARDINAL]],
ENDCASE => ERROR;
};
DrawDot:
PUBLIC
PROC [x, y:
INTEGER, mode: Mode] = {
IF stop THEN ERROR quit;
IF x>=0
AND x<screenW
AND y>=0
AND y<screenH
THEN
InternalSetBit[x, y, mode];
};
DrawLine:
PUBLIC
PROC [x1, y1, x2, y2:
INTEGER, mode: Mode] = {
--simple bresenham algorithm! both endpoints must be in visible area
t, q, s, dc, dxabs, dyabs: INTEGER;
IF stop THEN ERROR quit;
IF x1<0 OR x2<0 OR y1<0 OR y2<0 THEN RETURN;
IF x1>=screenW OR x2>=screenW OR y1>=screenH OR y2>=screenH THEN RETURN;
dxabs ← ABS[x2-x1]; dyabs ← ABS[y2-y1];
IF dxabs>=dyabs
THEN {
IF x1>x2 THEN {t←x1; x1←x2; x2←t; t←y1; y1←y2; y2←t};
IF y1<=y2 THEN dc𡤁 ELSE dc←-1;
s ← dxabs-dyabs; q ← dxabs/2-s;
FOR t
IN [x1..x2]
DO
InternalSetBit[t, y1, mode];
IF q<0 THEN q←q+dyabs ELSE {q←q-s; y1 ← y1+dc}
ENDLOOP;
}
ELSE {
IF y1>y2 THEN {t←x1; x1←x2; x2←t; t←y1; y1←y2; y2←t};
IF x1<=x2 THEN dc𡤁 ELSE dc←-1;
s ← dyabs-dxabs; q ← dyabs/2-s;
FOR t
IN [y1..y2]
DO
InternalSetBit[x1, t, mode];
IF q<0 THEN q←q+dxabs ELSE {q←q-s; x1 ← x1+dc}
ENDLOOP;
};
};
--########################################
vt ← Terminal.Create[! Terminal.CantDoIt => CONTINUE];
ResetRegistration[];
Commander.Register["///Commands/RandomDemo", DemoCommand, "Nice animation"];
END.