<> <> <> <> 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_1000] = { 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> 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; ]; }; }; <> <> <> <> 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=0 AND y> 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_1 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_1 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.