Kal:
CEDAR
PROGRAM
IMPORTS Basics, BasicTime, CedarProcess, FS, IdleBackdoor, Imager, ImagerBackdoor, ImagerBox, ImagerFont, ImagerPixelMap, ImagerTerminal, ImagerTransformation, IO, Process, Random, Real, RealFns, Rope, Terminal, ThisMachine, TIPUser, ViewerOps
=
{
ROPE: TYPE = Rope.ROPE;
Viewer: TYPE = ViewerClasses.Viewer;
PixelMap: TYPE = ImagerPixelMap.PixelMap;
PixelArray: TYPE = ImagerPixelArray.PixelArray;
Font: TYPE = ImagerFont.Font;
Transformation: TYPE = ImagerTransformation.Transformation;
Generator: TYPE = REF GeneratorRep;
GeneratorRep: TYPE = RECORD [a, b, c, countLow, countHigh: CARDINAL];
TextData:
TYPE =
RECORD [
texts: TextList,
numTexts: NAT,
totalProbability: REAL];
TextList: TYPE = LIST OF Text;
Text:
TYPE =
RECORD [
text: ROPE,
bounds: Imager.Box,
cumProb: REAL
];
Request: TYPE = REF RequestRep;
RequestRep:
TYPE =
RECORD [
proc: PROC [data: REF ANY, context: Imager.Context],
data: REF ANY];
td: TextData;
font: Font ← NIL;
rs: Random.RandomStream ← Random.Create[seed: -1];
Milliseconds: TYPE = INT;
OneSecond: Milliseconds = 1000;
Root3Quarters: REAL ← RealFns.SqRt[0.75];
symmetry: CARDINAL ← 8;
periodLow: CARDINAL ← 10000;
periodHigh: CARDINAL ← 10000;
persistence: CARDINAL ← 5000;
halfBMin: INTEGER ← (LAST[CARDINAL]-2000)/2;
halfBMax: INTEGER ← (LAST[CARDINAL]-1500)/2;
halfCMin: INTEGER ← 0;
halfCMax: INTEGER ← (LAST[CARDINAL]-1)/2;
AtATime: NAT ← 64;
upTextMin: Milliseconds ← 10*OneSecond;
upTextMax: Milliseconds ← 60*OneSecond;
downTextMin: Milliseconds ← 1*OneSecond;
downTextMax: Milliseconds ← 6*OneSecond;
pmBoundsCheck: BOOL ← TRUE;
runningPriority: CedarProcess.Priority ← background;
xStateB: Generator ← NEW [GeneratorRep ← [1, 65536-1849, 3, , ]];
xStateE: Generator ← NEW [GeneratorRep];
yStateB: Generator ← NEW [GeneratorRep ← [1, 65536-1809, 3, , ]];
yStateE: Generator ← NEW [GeneratorRep];
pausePeriod: Process.Ticks ← 0;
retraces: NAT ← 1;
machineName: ROPE ← ThisMachine.Name[];
sfvcFlavor: ATOM ← $KaleidoscopeViewerClass;
sfvc: ViewerClasses.ViewerClass ←
NEW [ViewerClasses.ViewerClassRec ← [
flavor: sfvcFlavor,
notify: NotifySFV,
paint: PaintSFV,
tipTable: TIPUser.InstantiateNewTIPTable["StarFielder.TIP"]
]];
sfv: Viewer;
okToGo: BOOL ← FALSE;
going: BOOL ← FALSE;
NotifySFV:
PROC [self: Viewer, input:
LIST
OF
REF
ANY] = {
a: ATOM ← NARROW[input.first];
SELECT a
FROM
$Start => {okToGo ← TRUE; IF NOT going THEN TRUSTED {Process.Detach[FORK Viewit[]]}};
$Stop => okToGo ← FALSE;
ENDCASE => ERROR;
};
PaintSFV:
PROC [self: Viewer, context: Imager.Context, whatChanged:
REF
ANY, clear:
BOOL]
RETURNS [quit:
BOOL ←
FALSE]
--ViewerClasses.PaintProc-- = {
IF whatChanged =
NIL
THEN sfvPM ← PixelMapFromViewer[self]
ELSE
WITH whatChanged
SELECT
FROM
r: Request => r.proc[r.data, context];
ENDCASE => ERROR;
};
sfvPM: PixelMap;
icConsumer: PROC [context: Imager.Context, pm: PixelMap];
Satisfy:
PROC [data:
REF
ANY, context: Imager.Context] = {
icConsumer[context, sfvPM];
};
Viewit:
PROC = {
r: Request;
GiveContext:
PROC [to:
PROC [context: Imager.Context, pm: PixelMap]] = {
TRUSTED {icConsumer ← to};
ViewerOps.PaintViewer[viewer: sfv, hint: client, clearClient: FALSE, whatChanged: r];
};
TRUSTED {
CedarProcess.SetPriority[runningPriority];
r ← NEW [RequestRep ← [Satisfy, NIL]]};
going ← TRUE;
Dewit[giveContext: GiveContext, xp0: 0, yp0: 0, xp1: sfv.cw, yp1: sfv.ch, Stop: StopViewing, inverse: FALSE, vt: Terminal.Current[]];
going ← FALSE;
};
StopViewing:
PROC
RETURNS [
BOOL] =
{RETURN [NOT okToGo]};
Kalidle:
PROC [parent:
REF
ANY, clientData:
REF
ANY ←
NIL,
mouseButton: Menus.MouseButton ← red, shift, control:
BOOL ←
FALSE]
--Buttons.ButtonProc-- = {
symmetry ←
SELECT shift
FROM
FALSE => 8,
TRUE => 12,
ENDCASE => ERROR;
Sleepit[NOT control]};
Sleepit:
PROC [logout:
BOOL] = {
[] ← IdleBackdoor.UseAlternateVT[vtProc: DoForVT, logout: logout];
};
vtContext: Imager.Context;
vtPM: PixelMap;
GiveVTContext:
PROC [to:
PROC [context: Imager.Context, pm: PixelMap]] =
{to[vtContext, vtPM]};
DoForVT:
PROC [vt: Terminal.Virtual] = {
Doit:
PROC = {
Dewit[giveContext: GiveVTContext, xp0: 0, yp0: 0, xp1: vt.bwWidth, yp1: vt.bwHeight, Stop: KeyTyped, inverse: TRUE, vt: vt];
};
vt.Select[];
[] ← vt.SetBWBitmapState[allocated];
[vtContext, vtPM] ← ContextAndPMFromVT[vt];
[] ← vt.SetBWBitmapState[displayed];
CedarProcess.DoWithPriority[runningPriority, Doit];
[] ← vt.SetBWBitmapState[none];
};
KeyTyped:
PROC
RETURNS [stop:
BOOL] = {
stop ← IdleBackdoor.KeyTyped[IdleBackdoor.defaultKeyFilter]};
upText, downText, T: Milliseconds ← 0;
curText: Text;
cto: Vector2.VEC;
cts: REAL;
FloorLog2:
PROC [n:
CARDINAL]
RETURNS [log:
INTEGER] = {
log ←
SELECT n
FROM
< 2B => 0,
< 4B => 1,
< 10B => 2,
< 20B => 3,
< 40B => 4,
< 100B => 5,
< 200B => 6,
< 400B => 7,
< 1000B => 8,
< 2000B => 9,
< 4000B => 10,
< 10000B => 11,
< 20000B => 12,
< 40000B => 13,
< 100000B => 14,
ENDCASE => 15};
TwoToThe:
ARRAY [0 .. 15]
OF
CARDINAL = [
00001H, 00002H, 00004H, 00008H,
00010H, 00020H, 00040H, 00080H,
00100H, 00200H, 00400H, 00800H,
01000H, 02000H, 04000H, 08000H];
Advance:
PROC [gen: Generator] =
TRUSTED {
gen.a ← Basics.BITXOR[gen.a + gen.b, gen.b];
IF (gen.countLow ← gen.countLow - 1) = 0
THEN {
gen.b ← Basics.BITXOR[gen.b + gen.c, gen.c];
gen.countLow ← periodLow;
IF (gen.countHigh ← gen.countHigh - 1) = 0
THEN {
rs ← Random.Create[seed: gen.c];
[] ← rs.NextInt[];
gen.c ← rs.ChooseInt[0, halfCMax]*2+1;
gen.countHigh ← periodHigh;
};
};
};
Dewit:
PROC [giveContext:
PROC [to:
PROC [context: Imager.Context, pm: PixelMap]], x
p0, y
p0, x
p1, y
p1:
INTEGER,
Stop:
PROC
RETURNS [
BOOL], inverse:
BOOL, vt: Terminal.Virtual] = {
sMin, fMin: INTEGER; --bounds of used area
sMid, fMid: INTEGER; --center of used area
radius: LONG CARDINAL; --of used area
radiusTimesRootThreeQuarters: LONG CARDINAL;
max: INTEGER; --maximum z - zmin
PickText:
PROC [T: Milliseconds] = {
p: REAL ← Choose[0, td.totalProbability*0.999];
tl: TextList;
FOR tl ← td.texts, tl.rest WHILE p > tl.first.cumProb DO NULL ENDLOOP;
curText ← tl.first;
upText ← T + rs.ChooseInt[upTextMin, upTextMax];
downText ← upText + rs.ChooseInt[downTextMin, downTextMax];
cts ← (xp1 - xp0)/(curText.bounds.xmax - curText.bounds.xmin)/2;
cto ← [
x: Choose[
xp0 - cts*curText.bounds.xmin,
xp1 - cts*curText.bounds.xmax],
y: Choose[
yp0 - cts*curText.bounds.ymin,
yp1 - cts*curText.bounds.ymax]];
};
DrawText:
PROC [context: Imager.Context, pm: PixelMap] = {
InnerDoit:
PROC = {
context.SetXY[cto];
context.TranslateT[cto];
context.ScaleT[cts];
context.SetFont[font];
context.ShowRope[curText.text];
};
Imager.DoSave[context, InnerDoit];
};
pmBounds: DeviceBounds;
DeviceBounds: TYPE = RECORD [sMin, fMin, sMax, fMax: INTEGER];
Spots: PROC [pm: PixelMap, u, v: CARDINAL, val: BOOL] ← SELECT symmetry FROM 8 => Spots8, 12 => Spots12, ENDCASE => ERROR;
Spots8:
PROC [pm: PixelMap, u, v:
CARDINAL, val:
BOOL] =
TRUSTED {
BitArrayPtr: TYPE = LONG POINTER TO PACKED ARRAY [0..0) OF BOOL;
SetBit:
PROC [f, s:
NAT, val:
BOOL] =
TRUSTED
INLINE {
s ← sMin + s;
f ← fMin + f;
IF pmBoundsCheck AND
s < pmBounds.sMin OR
f < pmBounds.fMin OR
s > pmBounds.sMax OR
f > pmBounds.fMax THEN ERROR;
LOOPHOLE[pm.refRep.pointer + Basics.LongMult[(s - pm.sOrigin), pm.refRep.rast], BitArrayPtr][f - pm.fOrigin] ← val;
};
ur: NAT ← Basics.HighHalf[radius*u];
vr: NAT ← Basics.HighHalf[radius*v];
IF ur < vr
THEN {
cur: NAT ← max - ur;
cvr: NAT ← max - vr;
SetBit[ ur, vr, val];
SetBit[ ur, cvr, val];
SetBit[cur, vr, val];
SetBit[cur, cvr, val];
SetBit[ vr, ur, val];
SetBit[ vr, cur, val];
SetBit[cvr, ur, val];
SetBit[cvr, cur, val];
};
};
Spots12:
PROC [pm: PixelMap, u, v:
CARDINAL, val:
BOOL] =
TRUSTED {
BitArrayPtr: TYPE = LONG POINTER TO PACKED ARRAY [0..0) OF BOOL;
SetBit:
PROC [f, s:
INTEGER, val:
BOOL] =
TRUSTED
INLINE {
s ← sMid + s;
f ← fMid + f;
IF pmBoundsCheck AND
s < pmBounds.sMin OR
f < pmBounds.fMin OR
s > pmBounds.sMax OR
f > pmBounds.fMax THEN ERROR;
LOOPHOLE[pm.refRep.pointer + Basics.LongMult[(s - pm.sOrigin), pm.refRep.rast], BitArrayPtr][f - pm.fOrigin] ← val;
};
vh: CARDINAL ← Basics.BITSHIFT[v, -1];
ur: NAT ← Basics.HighHalf[radius*u];
vr: NAT ← Basics.HighHalf[radius*vh];
urH: NAT ← Basics.BITSHIFT[ur, -1];
vrH: NAT ← Basics.BITSHIFT[vr, -1];
urRTQ: NAT ← Basics.HighHalf[radiusTimesRootThreeQuarters*u];
vrRTQ: NAT ← Basics.HighHalf[radiusTimesRootThreeQuarters*vh];
IF v < u
THEN {
SetBit[ ur - vrH, vrRTQ, val];
SetBit[-ur + vrH, vrRTQ, val];
SetBit[ ur - vrH, -vrRTQ, val];
SetBit[-ur + vrH, -vrRTQ, val];
SetBit[ urH + vrH, urRTQ - vrRTQ, val];
SetBit[-urH - vrH, urRTQ - vrRTQ, val];
SetBit[ urH + vrH, -urRTQ + vrRTQ, val];
SetBit[-urH - vrH, -urRTQ + vrRTQ, val];
SetBit[ urH - vr, urRTQ, val];
SetBit[-urH + vr, urRTQ, val];
SetBit[ urH - vr, -urRTQ, val];
SetBit[-urH + vr, -urRTQ, val];
};
};
SetBounds:
PROC [pm: PixelMap] = {
dr: ImagerPixelMap.DeviceRectangle ← pm.BoundedWindow[];
pmBounds ← [sMin: dr.sMin, fMin: dr.fMin, sMax: dr.sMin + dr.sSize - 1, fMax: dr.fMin + dr.fSize - 1];
};
whiteBit: BOOL ← inverse;
blackBit: BOOL ← NOT whiteBit;
foregroundColor: Imager.Color ← IF inverse THEN Imager.black ELSE Imager.white;
backgroundColor: Imager.Color ← IF inverse THEN Imager.white ELSE Imager.black;
DrawInit:
PROC [context: Imager.Context, pm: PixelMap] = {
Imager.SetColor[context, backgroundColor];
Imager.MaskRectangle[context, [xp0, yp0, xp1 - xp0, yp1 - yp0]];
SetBounds[pm];
FOR i:
CARDINAL
IN [1 .. persistence]
DO
Advance[xStateB];
Advance[yStateB];
Spots[pm, xStateB.a, yStateB.a, whiteBit];
ENDLOOP;
};
DrawFinal:
PROC [context: Imager.Context, pm: PixelMap] = {
SetBounds[pm];
FOR i:
CARDINAL
IN [1 .. persistence]
DO
Advance[xStateE];
Advance[yStateE];
Spots[pm, xStateE.a, yStateE.a, blackBit];
ENDLOOP;
};
prevUp: BOOL ← FALSE;
DrawDelta:
PROC [context: Imager.Context, pm: PixelMap] = {
shouldUp: BOOL ← (T >= upText) AND (T < downText);
SetBounds[pm];
THROUGH [0 .. AtATime)
DO
Advance[xStateE]; Advance[yStateE];
Spots[pm, xStateE.a, yStateE.a, blackBit];
Advance[xStateB]; Advance[yStateB];
Spots[pm, xStateB.a, yStateB.a, whiteBit];
ENDLOOP;
IF shouldUp # prevUp
THEN {
Imager.SetColor[context, IF shouldUp THEN foregroundColor ELSE backgroundColor];
DrawText[context, pm]};
prevUp ← shouldUp;
IF T >= downText THEN PickText[T];
};
oldP: BasicTime.Pulses;
SELECT symmetry
FROM
8 => radius ← MIN[xp1 - xp0, yp1 - yp0]/2;
12 => radius ← MIN[xp1 - xp0, Real.FixC[(yp1 - yp0)/Root3Quarters]]/2;
ENDCASE => ERROR;
max ← radius*2 - 1;
sMin ← yp0 + (yp1 - yp0 - (max+1))/2;
fMin ← xp0 + (xp1 - xp0 - (max+1))/2;
sMid ← (yp0 + yp1)/2;
fMid ← (xp0 + xp1)/2;
radiusTimesRootThreeQuarters ← Real.RoundC[Root3Quarters*radius];
PickText[T ← 0];
RandomizeB[];
xStateB.countLow ← periodLow;
yStateB.countLow ← periodLow;
xStateB.countHigh ← periodHigh;
yStateB.countHigh ← periodHigh;
xStateE^ ← xStateB^;
yStateE^ ← yStateB^;
giveContext[DrawInit];
oldP ← BasicTime.GetClockPulses[];
FOR i:
INT ← 0, i+1
WHILE
NOT Stop[]
DO
newP: BasicTime.Pulses;
giveContext[DrawDelta];
IF pausePeriod # 0 THEN Process.Pause[pausePeriod];
FOR i:
NAT
IN [0 .. retraces)
DO
Terminal.WaitForBWVerticalRetrace[vt];
ENDLOOP;
newP ← BasicTime.GetClockPulses[];
IF newP > oldP
THEN {
Dt: Milliseconds ← BasicTime.PulsesToMicroseconds[newP - oldP]/1000;
T ← T + Dt};
oldP ← newP;
ENDLOOP;
giveContext[DrawFinal];
};
PMContext:
PROC [pm: PixelMap]
RETURNS [context: Imager.Context] = {
bm: ImagerBackdoor.Bitmap ←
NEW [ImagerBackdoor.BitmapRep ← [
ref: pm.refRep.ref,
base: pm.refRep.pointer,
wordsPerLine: pm.refRep.rast,
width: pm.refRep.rast*Basics.bitsPerWord,
height: pm.refRep.lines]];
IF pm.refRep.lgBitsPerPixel # 0 OR pm.sMin # 0 OR pm.fMin # 0 THEN ERROR;
context ← ImagerBackdoor.BitmapContext[bm];
Imager.ConcatT[context, ImagerTransformation.Invert[ImagerBackdoor.GetT[context]]];
};
ContextAndPMFromVT:
PROC [vt: Terminal.Virtual]
RETURNS [context: Imager.Context, pm: PixelMap] = {
pm ← PixelMapFromVT[vt];
context ← ImagerTerminal.BWContext[vt, TRUE];
};
PixelMapFromVT:
PROC [vt: Terminal.Virtual]
RETURNS [pm: PixelMap] = {
fb: Terminal.FrameBuffer ← vt.GetBWFrameBuffer[];
IF fb.bitsPerPixel # 1 THEN ERROR;
pm ← [
sOrigin: 0, fOrigin: 0,
sMin: 0, fMin: 0,
sSize: fb.height, fSize: fb.width,
refRep:
NEW [ImagerPixelMap.PixelMapRep ← [
ref: fb.vm,
pointer: fb.base,
words: fb.vm.words,
lgBitsPerPixel: 0,
rast: fb.wordsPerLine,
lines: fb.height]]
];
};
PixelMapFromViewer:
PROC [v: Viewer]
RETURNS [pm: PixelMap] = {
vx1, vx2, vy1, vy2: INTEGER;
height: NAT;
pm ← PixelMapFromVT[Terminal.Current[]];
height ← pm.sSize;
[vx1, vy1] ← ViewerOps.UserToScreenCoords[v, 0, 0];
[vx2, vy2] ← ViewerOps.UserToScreenCoords[v, v.cw, v.ch];
vy1 ← height - vy1;
vy2 ← height - vy2;
IF vy1 > vy2 THEN {y: INTEGER ← vy1; vy1 ← vy2; vy2 ← y};
pm ← pm.Clip[[sMin: vy1, fMin: vx1, sSize: vy2-vy1, fSize: vx2 - vx1]];
pm ← pm.ShiftMap[s: -vy1, f: -vx1];
};
Floor:
PROC [r:
REAL]
RETURNS [i:
INT] = {
d: INT ← 1 - Real.Fix[r];
i ← Real.Fix[r+d]-d};
Ceiling:
PROC [r:
REAL]
RETURNS [i:
INT] = {
d: INT ← 1 + Real.Fix[r];
i ← Real.Fix[r-d]+d};
ReadTextData:
PROC [fileName:
ROPE]
RETURNS [td: TextData] = {
from: IO.STREAM ← FS.StreamOpen[fileName];
last: TextList ← NIL;
td ← [
texts: NIL,
numTexts: 0,
totalProbability: 0];
DO
prob: REAL;
text: ROPE;
this: TextList;
[] ← from.SkipWhitespace[];
IF from.EndOf[] THEN EXIT;
prob ← from.GetReal[];
text ← from.GetRopeLiteral[];
text ← Replace[text, "<machine name>", machineName];
td.numTexts ← td.numTexts + 1;
this ←
LIST[ [
text: text,
bounds: ImagerBox.BoxFromExtents[font.RopeBoundingBox[text]],
cumProb: td.totalProbability ← td.totalProbability + prob] ];
IF last = NIL THEN td.texts ← this ELSE last.rest ← this;
last ← this;
ENDLOOP;
from.Close[];
};
Choose:
PROC [min, max:
REAL]
RETURNS [r:
REAL] =
{r ← min + (rs.ChooseInt[0, 10000]/1.0E4) * (max-min)};
Replace:
PROC [in, what, with:
ROPE]
RETURNS [new:
ROPE] = {
start, len: INT;
ousLen: INT ← what.Length[];
new ← in;
WHILE (start ← new.Index[s2: what]) < (len ← new.Length[])
DO
new ← new.Substr[len: start].Cat[with, new.Substr[start: start+ousLen, len: len - (start+ousLen)]];
ENDLOOP;
};
CreateViewer:
PROC = {
sfv ← ViewerOps.CreateViewer[flavor: sfvcFlavor, info: [name: "Kaleidoscope"]]};
RandomizeB:
PROC = {
DO
xStateB.b ← rs.ChooseInt[halfBMin, halfBMax]*2 + 1;
yStateB.b ← rs.ChooseInt[halfBMin, halfBMax]*2 + 1;
IF xStateB.b # yStateB.b THEN EXIT;
ENDLOOP;
};
RandomizeC:
PROC = {
xStateB.c ← rs.ChooseInt[halfCMin, halfCMax]*2 + 1;
yStateB.c ← rs.ChooseInt[halfCMin, halfCMax]*2 + 1;
};
Start:
PROC = {
ViewerOps.RegisterViewerClass[flavor: sfvcFlavor, class: sfvc];
font ← ImagerFont.Find["Xerox/PressFonts/TimesRoman-MRR"];
td ← ReadTextData["Kal.texts"];
};
Start[];
}.
abcdefghijklmnopqrstuvwxyz1234567890-=\[]←',./
ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$%~&*()—+|{}^:"<>?
蝩C%gfh). "`z{bP +
![ ]H*({ '`˧de