DIRECTORY Basics, BasicTime, Buttons, ColorDisplayFace, FS, IdleBackdoor, Imager, ImagerBox, ImagerColor, ImagerColorMap, ImagerDitherContext, ImagerFont, ImagerInterpress, ImagerPixelMap, ImagerTerminal, IO, Menus, PaintPM, PopUpButtons, PrincOps, Process, Random, Real, RealFns, Rope, Terminal, ThisMachine, TIPUser, UserProfile, Vector2, ViewerClasses, ViewerOps;

ColorKal: CEDAR MONITOR
IMPORTS Basics, BasicTime, ColorDisplayFace, FS, IdleBackdoor, Imager, ImagerBox, ImagerColor, ImagerColorMap, ImagerDitherContext, ImagerFont, ImagerInterpress, ImagerPixelMap, ImagerTerminal, IO, PaintPM, PopUpButtons, Process, Random, Real, RealFns, Rope, Terminal, ThisMachine, UserProfile
=

{

LORA: TYPE = LIST OF REF ANY;
ROPE: TYPE = Rope.ROPE;
Viewer: TYPE = ViewerClasses.Viewer;
PixelMap: TYPE = ImagerPixelMap.PixelMap;
Font: TYPE = ImagerFont.Font;
ConstantColor: TYPE = Imager.ConstantColor;
ColorMap: TYPE = PaintPM.ColorMap;
ColorSequence: TYPE = PaintPM.ColorSequence;
ColorMapEntryList: TYPE = LIST OF ImagerColorMap.MapEntry;

PixelBits: TYPE = [2 .. 8];
Direction: TYPE = {forward, backward};

Generator: TYPE = REF GeneratorRep;
GeneratorRep: TYPE = RECORD [a, b, c, countLow, countHigh, lastC: 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
];

Control: TYPE = REF ControlPrivate;
ControlPrivate: TYPE = RECORD [
shouldGo: BOOL _ FALSE,
direction: Direction _ forward,
ipSize: REAL--inches-- _ 3.0,
wantIP, wantFlip, hold: BOOL _ FALSE,
BitsPerPixel: PixelBits _ 4,
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,
upTextMin: Milliseconds _ 10*OneSecond,
upTextMax: Milliseconds _ 60*OneSecond,
downTextMin: Milliseconds _ 1*OneSecond,
downTextMax: Milliseconds _ 6*OneSecond,
doText: BOOL _ TRUE,
xStateB: Generator _ NEW [GeneratorRep _ [1, 65536-1849, 3, , , ]],
xStateE: Generator _ NEW [GeneratorRep],
yStateB: Generator _ NEW [GeneratorRep _ [1, 65536-1809, 3, , , ]],
yStateE: Generator _ NEW [GeneratorRep],
cStateB: Generator _ NEW [GeneratorRep _ [1, 65536-1889, 3, , , ]],
cStateE: Generator _ NEW [GeneratorRep],
pausePeriod: Process.Ticks _ 0,
holdPeriod: Process.Ticks _ Process.MsecToTicks[500],
erase: BOOL _ TRUE,
runningPriority: Process.Priority _ Process.priorityBackground,
AtATime: NAT _ 64,
retraces: NAT _ 1
];

td: TextData;
font: Font _ NIL;
rs: Random.RandomStream _ Random.Create[seed: -1];

Milliseconds: TYPE = INT;
OneSecond: Milliseconds = 1000;

Root3Quarters: REAL _ RealFns.SqRt[0.75];

black: Imager.Color _ Imager.black;
white: Imager.Color _ Imager.white;

going: BOOL _ FALSE;
machineName: ROPE _ ThisMachine.Name[];
ctl: Control _ NEW [ControlPrivate _ []];

ButtonControl: PROC [viewer: Viewer, instanceData, classData: REF ANY, key: REF ANY] --PopUpButtons.PopUpButtonProc-- = {
OPEN ctl;
SELECT key FROM
$MakeIP => wantIP _ TRUE;
$FlipDirection => wantFlip _ TRUE;
$TogglePause => hold _ NOT hold;
ENDCASE => {args: LORA = NARROW[key];
shouldGo _ NOT going;
IF shouldGo AND OKToGo[] THEN {
symmetry _ SELECT args.first FROM
$Square => 8,
$Hexagon => 12,
ENDCASE => ERROR;
BitsPerPixel _ SELECT args.rest.first FROM
$Bpp8 => 8,
$Bpp4 => 4,
$Bpp2 => 2,
ENDCASE => ERROR;
TRUSTED {Process.Detach[FORK Viewit[]]};
};
};
};

StopGoing: ENTRY PROC = {going _ FALSE};
OKToGo: ENTRY PROC RETURNS [go: BOOL] = {IF go _ NOT going THEN going _ TRUE};

StopViewing: PROC RETURNS [BOOL] =
{OPEN ctl; RETURN [NOT shouldGo]};

Kalidle: PROC [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift, control: BOOL _ FALSE] --Buttons.ButtonProc-- = {
OPEN ctl;
symmetry _ SELECT shift FROM
FALSE => 8,
TRUE => 12,
ENDCASE => ERROR;
BitsPerPixel _ SELECT mouseButton FROM red => 8, yellow => 4, blue => 4, ENDCASE => ERROR --8--;
[] _ IdleBackdoor.UseAlternateVT[vtProc: DoForVT, logout: NOT control];
};

vtContext: Imager.Context;
vtPM: PixelMap;
curMap: ColorMap _ NIL;
curList: ColorMapEntryList _ NIL;

GiveVTContext: PROC [to: PROC [context: Imager.Context, pm: PixelMap]] =
{to[vtContext, vtPM]};

Viewit: PROC = {
OPEN ctl;
TRUSTED {
Process.SetPriority[runningPriority];
};
VTWork[Terminal.Current[], StopViewing !UNWIND => StopGoing[]];
StopGoing[];
};

DoForVT: PROC [vt: Terminal.Virtual] = {
context: Imager.Context;
vt.Select[];
[] _ vt.SetBWBitmapState[allocated];
[] _ vt.SetBWBitmapState[displayed];
context _ ImagerTerminal.BWContext[vt: vt, pixelUnits: TRUE];
Imager.SetColor[context, Imager.white];
Imager.MaskRectangle[context, [0, 0, vt.bwWidth, vt.bwHeight]];
VTWork[vt, KeyTyped];
};

KeyTyped: PROC RETURNS [stop: BOOL] = {
stop _ IdleBackdoor.KeyTyped[IdleBackdoor.defaultKeyFilter]};

useImagerDitherContext: BOOL _ TRUE;
useImagerColorMap: BOOL _ TRUE;

VTWork: PROC [vt: Terminal.Virtual, Stop: PROC RETURNS [BOOL]] = {
OPEN ctl;
SimpleSet: PROC [a, b: Terminal.ChannelValue _ 0, red, green, blue: Terminal.ColorValue, shared: BOOL _ TRUE] = {
Terminal.SetColor[vt: vt, aChannelValue: a, bChannelValue: b, red: red, green: green, blue: blue];
};
WithContext: PROC = {
IF useImagerColorMap THEN ImagerColorMap.Change[vt, WithVT] ELSE WithVT[SimpleSet];
};
WithVT: PROC [set: ImagerColorMap.MapProc] = {
vt _ vt;
FOR cml: ColorMapEntryList _ curList, cml.rest WHILE cml # NIL DO
set[a: cml.first.mapIndex, b: 0, red: cml.first.red, green: cml.first.green, blue: cml.first.blue];
ENDLOOP;
vt _ vt;
Dewit[giveContext: GiveVTContext, xp0: 0, yp0: 0, xp1: vtPM.fSize, yp1: vtPM.sSize, bpp: BitsPerPixel, Stop: Stop, vt: vt, entries: curMap];
vt _ vt;
};
[vtContext, vtPM] _ StartDeviceAndPM[vt, BitsPerPixel];
[curList, curMap] _ DefineColorMap[BitsPerPixel];
IF useImagerDitherContext THEN ImagerDitherContext.DoWithDitherMap[context: vtContext, mapEntries: curList, action: WithContext] ELSE WithContext[];
};

SampleMap: PROC [bpp: NAT, offset: NAT _ 0] = {
square: NAT _ TwoToThe[bpp];
side: NAT _ TwoToThe[bpp/2];
IF bpp # TwoToThe[vtPM.refRep.lgBitsPerPixel] THEN ERROR;
FOR s: NAT IN [0 .. vtPM.sSize) DO
FOR f: NAT IN [0 .. vtPM.fSize) DO
index: NAT _ ((s*side/vtPM.sSize) + (f*side/vtPM.fSize)*side + offset) MOD square;
ImagerPixelMap.PutPixel[vtPM, s+vtPM.sMin, f+vtPM.fMin, index];
ENDLOOP;
Process.CheckForAbort[];
ENDLOOP;
};

upText, downText, T: Milliseconds _ 0;
curText: Text;
cto: Vector2.VEC;
cts: REAL;

FloorLog2: PROC [n: CARDINAL] RETURNS [log: INTEGER] = {
log _ SELECT n FROM
<      1B =>  ERROR,
<      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 {
OPEN ctl;
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.lastC _ gen.c;
gen.c _ rs.ChooseInt[0, halfCMax]*2+1;
gen.countHigh _ periodHigh;
};
};
};

Retard: PROC [gen: Generator] = TRUSTED {
OPEN ctl;
IF gen.countLow = periodLow THEN {
IF gen.countHigh = periodHigh THEN {
gen.countHigh _ 0;
gen.c _ gen.lastC;
rs _ Random.Create[seed: gen.c];
[] _ rs.NextInt[]; --actually, we'd like PrevInt, but can't have it...
gen.lastC _ rs.ChooseInt[0, halfCMax]*2+1;
};
gen.countHigh _ gen.countHigh + 1;
gen.countLow _ 0;
gen.b _ CARDINAL[Basics.BITXOR[gen.b, gen.c]] - gen.c;
};
gen.countLow _ gen.countLow + 1;
gen.a _ CARDINAL[Basics.BITXOR[gen.a, gen.b]] - gen.b;
};

Dewit: PROC [giveContext: PROC [to: PROC [context: Imager.Context, pm: PixelMap]], xp0, yp0, xp1, yp1, bpp: INTEGER, Stop: PROC RETURNS [BOOL], vt: Terminal.Virtual, entries: ColorMap] = {
OPEN ctl;
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
valMax: LONG CARDINAL _ TwoToThe[bpp] - 1;
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, val: CARDINAL] _ SELECT symmetry FROM 8 => Spots8, 12 => Spots12, ENDCASE => ERROR;
Spots8: PROC [pm: PixelMap, u, v, val: CARDINAL] = TRUSTED {
ur: NAT _ Basics.HighHalf[radius*u];
vr: NAT _ Basics.HighHalf[radius*v];
IF ur < vr THEN {
cur: NAT _ max - ur;
cvr: NAT _ max - vr;
ImagerPixelMap.PutPixel[pm, sMin+ vr, fMin+ ur, val];
ImagerPixelMap.PutPixel[pm, sMin+cvr, fMin+ ur, val];
ImagerPixelMap.PutPixel[pm, sMin+ vr, fMin+cur, val];
ImagerPixelMap.PutPixel[pm, sMin+cvr, fMin+cur, val];
ImagerPixelMap.PutPixel[pm, sMin+ ur, fMin+ vr, val];
ImagerPixelMap.PutPixel[pm, sMin+cur, fMin+ vr, val];
ImagerPixelMap.PutPixel[pm, sMin+ ur, fMin+cvr, val];
ImagerPixelMap.PutPixel[pm, sMin+cur, fMin+cvr, val];
};
};
Spots12: PROC [pm: PixelMap, u, v, val: CARDINAL] = TRUSTED {
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 {OPEN IPME: ImagerPixelMap;
IPME.PutPixel[pm, sMid+vrRTQ,	fMid+ur   - vrH,	val];
IPME.PutPixel[pm, sMid+vrRTQ,	fMid-ur   + vrH,	val];
IPME.PutPixel[pm, sMid-vrRTQ,	fMid+ur   - vrH,	val];
IPME.PutPixel[pm, sMid-vrRTQ,	fMid-ur   + vrH,	val];
IPME.PutPixel[pm, sMid+urRTQ - vrRTQ, fMid+urH + vrH,	val];
IPME.PutPixel[pm, sMid+urRTQ - vrRTQ, fMid-urH - vrH,	val];
IPME.PutPixel[pm, sMid-urRTQ + vrRTQ, fMid+urH + vrH,	val];
IPME.PutPixel[pm, sMid-urRTQ + vrRTQ, fMid-urH - vrH,	val];
IPME.PutPixel[pm, sMid+urRTQ,	fMid+urH - vr,	val];
IPME.PutPixel[pm, sMid+urRTQ,	fMid-urH + vr,	val];
IPME.PutPixel[pm, sMid-urRTQ,	fMid+urH - vr,	val];
IPME.PutPixel[pm, sMid-urRTQ,	fMid-urH + vr,	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];
};
DrawInit: PROC [context: Imager.Context, pm: PixelMap] = {
Imager.SetColor[context, PickColor[context, entries, 0]];
Imager.MaskRectangle[context, [xp0, yp0, xp1 - xp0, yp1 - yp0]];
SetBounds[pm];
FOR i: CARDINAL IN [1 .. persistence] DO
Advance[xStateB];
Advance[yStateB];
Advance[cStateB];
Spots[pm, xStateB.a, yStateB.a, Basics.HighHalf[valMax*cStateB.a] + 1];
ENDLOOP;
};
DrawFinal: PROC [context: Imager.Context, pm: PixelMap] = {
SetBounds[pm];
IF erase THEN FOR i: CARDINAL IN [1 .. persistence] DO
Advance[xStateE];
Advance[yStateE];
Advance[cStateE];
Spots[pm, xStateE.a, yStateE.a, 0];
ENDLOOP;
};
prevUp: BOOL _ FALSE;
DrawDelta: PROC [context: Imager.Context, pm: PixelMap] = {
shouldUp: BOOL _ (T >= upText) AND (T < downText);
SetBounds[pm];
IF wantIP THEN {
ipm: ImagerInterpress.Ref = ImagerInterpress.Create["///ColorKal.ip"];
scale: REAL = ipSize*Imager.metersPerInch/MAX[pm.sSize, pm.fSize];
PaintIt: PROC [context: Imager.Context] = {
PaintPM.PaintPixelMap[context, pm, curMap, 0];
};
wantIP _ FALSE;
ipm.DoPage[PaintIt, scale];
ipm.Close[];
};
SELECT direction FROM
forward => {
THROUGH [0 .. AtATime) DO
IF erase THEN {
Advance[xStateE]; Advance[yStateE]; Advance[cStateE];
Spots[pm, xStateE.a, yStateE.a, 0];
};
Advance[xStateB]; Advance[yStateB]; Advance[cStateB];
Spots[pm, xStateB.a, yStateB.a, Basics.HighHalf[valMax*cStateB.a] + 1];
ENDLOOP;
};
backward => {
THROUGH [0 .. AtATime) DO
Spots[pm, xStateB.a, yStateB.a, 0];
Retard[xStateB]; Retard[yStateB]; Retard[cStateB];
IF erase THEN {
Spots[pm, xStateE.a, yStateE.a, Basics.HighHalf[valMax*cStateE.a] + 1];
Retard[xStateE]; Retard[yStateE]; Retard[cStateE];
};
ENDLOOP;
};
ENDCASE => ERROR;
IF doText AND shouldUp # prevUp THEN {
index: NAT _ rs.ChooseInt[1, entries.length-1];
Imager.SetColor[context, PickColor[context, entries, IF shouldUp THEN index ELSE 0]];
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;
cStateB.countLow _ periodLow;
xStateB.countHigh _ periodHigh;
yStateB.countHigh _ periodHigh;
cStateB.countHigh _ periodHigh;
xStateE^ _ xStateB^;
yStateE^ _ yStateB^;
cStateE^ _ cStateB^;
giveContext[DrawInit];
oldP _ BasicTime.GetClockPulses[];
FOR i: INT _ 0, i+1 WHILE NOT Stop[] DO
newP: BasicTime.Pulses;
IF wantFlip THEN {
direction _ SELECT direction FROM
forward => backward,
backward => forward,
ENDCASE => ERROR;
wantFlip _ FALSE;
};
IF hold THEN Process.Pause[holdPeriod] ELSE 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];
};

PickColor: PROC [context: Imager.Context, entries: ColorMap, index: NAT] RETURNS [color: ConstantColor] = {
color _ entries[index];
};

StartDeviceAndPM: PROC [vt: Terminal.Virtual, bpp: INT] RETURNS [context: Imager.Context, pm: PixelMap] = {
OPEN ctl;
fb: Terminal.FrameBuffer;
IF ColorDisplayFace.displayType = none THEN [] _ ColorDisplayFace.SetDisplayType[profiledDisplayType];
[] _ Terminal.SetColorBitmapState[vt: vt, newState: displayed, newMode: [full: FALSE, bitsPerPixelChannelA: bpp, bitsPerPixelChannelB: 0], newVisibility: aOnly];
context _ ImagerTerminal.ColorContext[vt: vt, pixelUnits: TRUE];
IF vt.GetColorMode[].bitsPerPixelChannelA # bpp THEN ERROR;
fb _ vt.GetColorFrameBufferA[];
pm _ FbPm[fb];
};

profiledDisplayType: ColorDisplayFace.ColorDisplayType;

FbPm: PROC [fb: Terminal.FrameBuffer] RETURNS [pm: PixelMap] = {
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: FloorLog2[fb.bitsPerPixel],
rast: fb.wordsPerLine,
lines: fb.height]]
];
IF fb.bitsPerPixel # TwoToThe[pm.refRep.lgBitsPerPixel] THEN ERROR;
};

DefineColorMap: PROC [bpp: PixelBits] RETURNS [list: ColorMapEntryList, seq: ColorMap] = {
OPEN ctl;
length: NAT = TwoToThe[bpp];
IF (cmLists[bpp] = NIL) # (cmSeqs[bpp] = NIL) THEN ERROR;
IF cmLists[bpp] # NIL THEN RETURN [cmLists[bpp], cmSeqs[bpp]];
seq _ MakeEntries[length];
list _ NIL;
FOR i: INT IN [0 .. length) DO
rgb: ImagerColor.RGB _ MapRound[i, bpp];
list _ CONS
[
[
mapIndex: i,
red: Floor[rgb.R*255.99],
green: Floor[rgb.G*255.99],
blue: Floor[rgb.B*255.99]
],
list
];
seq[i] _ ImagerColor.ColorFromRGB[rgb, cal];
ENDLOOP;
cmLists[bpp] _ list;
cmSeqs[bpp] _ seq;
};
cal: ImagerColor.RGBCalibration _ ImagerColor.GetDefaultCalibration[];
cmLists: ARRAY PixelBits OF ColorMapEntryList _ ALL[NIL];
cmSeqs: ARRAY PixelBits OF ColorMap _ ALL[NIL];


FixC: PROC [r: REAL] RETURNS [c: CARDINAL] = {c _ Real.FixC[r]};

MapRound: PROC [i, bpp: NAT] RETURNS [rgb: ImagerColor.RGB] = {
last: NAT _ TwoToThe[bpp]-1;
SELECT i FROM
 = 000 => rgb _ [0, 0, 0];
<= last => rgb _ ImagerColor.RGBFromHSV[[H: (i-1.0)/last, S: 1, V: 1]];
ENDCASE => ERROR};

MapCopy: PROC [i, bpp: NAT] RETURNS [c: ConstantColor] = {
c _ fromMap[i];
};
fromMap: ColorMap _ NIL;

MakeEntries: PROC [length: NAT] RETURNS [entries: ColorMap] =
{entries _ NEW[ColorSequence[length]]};

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] = {
OPEN ctl;
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;
};

CreateButton: PROC = {
ctlButton _
PopUpButtons.MakeClass[[
proc: ButtonControl,
choices: LIST[
[LIST[$Square, $Bpp8], "Start/stop with 8-fold symmetry, 8 bits per pixel"],
[LIST[$Square, $Bpp4], "Start/stop with 8-fold symmetry, 4 bits per pixel"],
[LIST[$Square, $Bpp2], "Start/stop with 8-fold symmetry, 4 bits per pixel"],
[LIST[$Hexagon, $Bpp8], "Start/stop with 12-fold symmetry, 8 bits per pixel"],
[LIST[$Hexagon, $Bpp4], "Start/stop with 12-fold symmetry, 4 bits per pixel"],
[LIST[$Hexagon, $Bpp2], "Start/stop with 12-fold symmetry, 4 bits per pixel"],
[$MakeIP, "Write []<>ColorKal.ip"],
[$FlipDirection, "Reverse direction"],
[$TogglePause, "Pause or continue"]
],
doc: "Color pixel kaleidoscope control"
]]
.Instantiate[viewerInfo: [name: "cKal", column: static]];
};
ctlButton: Viewer _ NIL;

RandomizeB: PROC = {
OPEN ctl;
DO
xStateB.b _ rs.ChooseInt[halfBMin, halfBMax]*2 + 1;
yStateB.b _ rs.ChooseInt[halfBMin, halfBMax]*2 + 1;
cStateB.b _ rs.ChooseInt[halfBMin, halfBMax]*2 + 1;
IF xStateB.b # yStateB.b AND cStateB.b # yStateB.b AND xStateB.b # cStateB.b THEN EXIT;
ENDLOOP;
};

RandomizeC: PROC = {
OPEN ctl;
xStateB.c _ rs.ChooseInt[halfCMin, halfCMax]*2 + 1;
yStateB.c _ rs.ChooseInt[halfCMin, halfCMax]*2 + 1;
cStateB.c _ rs.ChooseInt[halfCMin, halfCMax]*2 + 1;
};

NoteProfile: PROC [reason: UserProfile.ProfileChangeReason] --UserProfile.ProfileChangedProc-- = {
displayTypeRope: ROPE _ UserProfile.Token["ColorDisplay.Type", "640x480"];
profiledDisplayType _ SELECT TRUE FROM
displayTypeRope.Equal["1024x768", FALSE] => highResolution,
displayTypeRope.Equal["640x480", FALSE] => standard,
ENDCASE => standard;
};

Start: PROC = {
UserProfile.CallWhenProfileChanges[NoteProfile];
font _ ImagerFont.Find["Xerox/PressFonts/TimesRoman-MRR"];
td _ ReadTextData["Kal.texts"];
CreateButton[];
};

Start[];

}.
abcdefghijklmnopqrstuvwxyz1234567890-=\[]_;',./
ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$%~&*()+|{}^:"<>?
abcdefghijklmnopqrstuvwxyz1234567890-=\[]_;',./
ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$%~&*()+|{}^:"<>?
"ColorKal.Mesa
Copyright c 1984 by Xerox Corporation.  All rights reserved.
Mike Spreitzer November 14, 1986 8:42:00 pm PST
INVARIANT
going IFF there is a process running the kaleidoscope.
Code from 5.2:
dd: ImagerDisplay.DisplayData;
context _ Imager.Create[
SELECT bpp FROM
2 => $Std2bpp,
4 => $Std4bpp,
8 => $Std8bpp,
ENDCASE => ERROR];
Imager.ConcatT[context, Imager.Invert[context.state.T]];
dd _ NARROW[context.data];
pm _ dd.pix[0];
entries _ LoadMap[context, bpp, maps[bpp]];
Previously problematic in 6.0:
Works in 6.0, but gets Viewers in the way:
IF vt # Terminal.Current[] THEN ERROR;
ColorDisplay.SetColorDisplayStatus[on: TRUE, bpp: bpp];
LoadMap: PROC [vt: Terminal.Virtual, bpp: NAT] RETURNS [entries: ColorMap] = {
length: NAT _ TwoToThe[bpp];
entries _ MakeEntries[length];
FOR i: INT IN [0 .. length) DO
rgb: ImagerColor.RGB _ MapRound[i, bpp];
Terminal.SetColor[
vt: vt,
aChannelValue: i,
red: Floor[rgb.R*255.99],
green: Floor[rgb.G*255.99],
blue: Floor[rgb.B*255.99]
];
entries[i] _ ImagerColor.ColorFromRGB[rgb, cal];
ENDLOOP;
};
Κ?–

"cedar" style˜
code™
Jšœ
Οm
œ1™<K™/—K˜KšΟk	œ/žœ“
žœŸ
˜ξK˜šΡbnxœžœ
ž˜Kšžœ&žœ“
žœa˜₯™	K™6—K˜
K˜K˜
K˜Kšžœžœžœ
žœ
žœ
žœ
˜Kšžœžœžœ
˜Kšœžœ˜$Kšœ
žœ˜)Kšœžœ˜Kšœžœ˜+Kšœ
žœ˜"Kšœžœ˜,Kšœžœžœ
žœ˜:K˜Kšœžœ˜Kšœžœ˜&K˜Kšœžœžœ˜#Kšœžœžœ'žœ˜LK˜šœ
žœžœ˜K˜Kšœ
žœ
˜Kšœžœ˜—K˜Kšœ
žœžœ
žœ˜šœžœžœ˜Kšœžœ
˜K˜Kšœ	ž˜
K˜—K˜Kšœ	žœžœ˜#šœžœžœ˜Kšœ
žœžœ
˜K˜KšœžΟc
œ˜Kšœžœžœ
˜%Kš
œ˜Kšœ
žœ˜Kšœžœ	˜Kšœžœ	˜Kšœ
žœ˜Kšœ
žœžœ
žœ
˜,Kšœ
žœžœ
žœ
˜,Kšœ
žœ˜Kšœ
žœžœ
žœ˜)Kš
œ'˜'Kš
œ'˜'Kš
œ(˜(Kš
œ(˜(Kšœžœžœ
˜Kšœžœ+˜CKšœžœ˜(Kšœžœ+˜CKšœžœ˜(Kšœžœ+˜CKšœžœ˜(Kš
œ˜Kš
œ5˜5Kšœžœžœ
˜Kš
œ?˜?Kšœ	žœ˜Kšœ
žœ˜K˜—K˜K˜
Kšœ
žœ
˜K˜2K˜Kšœžœžœ
˜Kš
œ˜K˜Kšœžœ˜)K˜K˜#K˜#K˜Kšœžœžœ
˜Kšœ
žœ˜'Kšœžœ˜)K˜šΟn
œžœ+žœ
žœžœ
žœ  œ˜yKšžœ˜	šžœž˜Kšœžœ
˜Kšœžœ
˜"Kšœžœ˜ šžœžœžœ˜%Kšœžœ˜šžœ
žœ
žœ˜šœžœž˜!K˜
Kš
œ˜Kšžœžœ
˜—šœžœž˜*K˜Kš
œ˜Kš
œ˜Kšžœžœ
˜—Kšžœžœ˜(Kš
œ˜—K˜——K˜—K˜Kš‘	œžœ
žœžœ˜(Kš‘œžœ
žœ
žœžœžœžœžœ	žœ˜NK˜š‘œžœ
žœžœ˜"Kšœ
žœžœžœ˜"—K˜š‘œžœ
žœ
žœžœ
žœžœ8žœžœ œ˜™
Kšžœ˜	šœžœž˜Kšžœ˜Kšžœ˜Kšžœžœ
˜—Kšœžœ
žœ#žœžœ
 œ
˜`Kšœ:žœ
˜GKš
œ˜—K˜K˜K˜Kšœžœ
˜Kšœžœ
˜!K˜š‘
œžœžœ+˜HK˜—K˜š‘œžœ˜Kšžœ˜	šžœ˜	Kš
œ%˜%K˜—Kšœ(žœ˜?Kš
œ˜K˜—K˜š‘œžœ˜(Kš
œ˜K˜Kš
œ$˜$Kš
œ$˜$Kšœ7žœ˜=K˜'Kš
œ?˜?Kš
œ˜Kš
œ˜—K˜š‘œžœ
žœžœ˜'Kš
œ=˜=—K˜Kšœžœžœ
˜$Kšœžœžœ
˜K˜š‘œžœ‘œžœ
žœžœ˜BKšžœ˜	š‘	œžœRžœžœ˜qKš
œb˜bK˜—š‘œžœ˜Kšžœžœ#žœ˜SKš
œ˜—š‘œžœ"˜.K˜šžœ,žœžœ
ž˜AK˜cKšžœ
˜—K˜Kš	œ#Οdœ’œ’œ’œF˜Œ
K˜K˜—Kš
œ7˜7Kš
œ1˜1Kšžœžœcžœ˜”
K˜—K˜š‘	œžœžœ
žœ	˜/Kšœžœ˜Kšœžœ˜Kšžœ,žœ
žœ
˜9šžœžœ
žœž˜"šžœžœ
žœž˜"Kšœžœ=žœ˜RKš
œ?˜?Kšžœ
˜—K˜Kšžœ
˜—K˜—K˜Kš
œ&˜&K˜Kšœ
žœ
˜Kšœžœ
˜
K˜š
‘	œžœžœžœžœ˜8šœžœž˜Kšœžœ
˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜Kšžœ	˜——K˜šœ
žœžœ
žœ˜)K˜K˜K˜K˜ —K˜š‘œžœžœ˜*Kšžœ˜	Kšœžœ˜,šžœ'žœ˜/Kšœžœ˜,K˜šžœ)žœ˜1K˜ K˜K˜K˜&K˜K˜—K˜—K˜—K˜š‘œžœžœ˜)Kšžœ˜	šžœžœ˜"šžœžœ˜$K˜K˜K˜ Kšœ 3˜FK˜*K˜—Kš
œ"˜"Kš
œ˜Kšœžœžœ˜6K˜—Kš
œ ˜ Kšœžœžœ˜6K˜—K˜š‘œžœžœžœ,’œ’œ’œ’œžœ‘œžœ
žœžœ/˜Ό
Kšžœ˜	Kšœžœ ˜*Kšœžœ ˜*Kšœžœ
žœ ˜%Kšœžœ
žœ
˜,Kšœžœ ˜ Kšœžœ
žœ˜*š‘œžœ˜$Kšœžœ(˜/K˜
Kš
žœžœžœ
žœ
žœ
˜FK˜Kš
œ0˜0Kš
œ;˜;Kšœ’œ’œ0˜@˜˜
Kšœ
’œ˜Kšœ
’œ˜—˜
Kšœ
’œ˜Kšœ
’œ˜ ——K˜—š‘œžœ,˜:š‘	œžœ˜Kš
œ˜Kš
œ˜K˜K˜K˜K˜—K˜"K˜—K˜Kšœžœžœžœ˜>Kš‘œžœžœžœ
žœžœžœ
˜tš‘œžœžœžœ˜<Kšœžœ˜$Kšœžœ˜$šžœ	žœ˜Kšœžœ˜Kšœžœ˜Kš
œ5˜5Kš
œ5˜5Kš
œ5˜5Kš
œ5˜5Kš
œ5˜5Kš
œ5˜5Kš
œ5˜5Kš
œ5˜5K˜—K˜—š‘œžœžœžœ˜=Kšœžœ
žœ˜&Kšœžœ˜$Kšœžœ˜%Kšœžœ
žœ	˜#Kšœžœ
žœ	˜#Kšœžœ3˜=Kšœžœ4˜>šžœžœžœ
žœ˜)Kšžœ0˜4Kšžœ0˜4Kšžœ0˜4Kšžœ0˜4Kšžœ7˜;Kšžœ7˜;Kšžœ7˜;Kšžœ7˜;Kšžœ.˜2Kšžœ.˜2Kšžœ.˜2Kšžœ.˜2K˜—K˜—š‘	œžœ˜"Kš
œ8˜8K˜fK˜—š‘œžœ,˜:Kš
œ9˜9Kš
œ ’œ’œ’œ’œ’œ’œ˜@Kš
œ˜šžœžœ
žœž˜(K˜K˜K˜Kš
œG˜GKšžœ
˜—K˜—š‘	œžœ,˜;Kš
œ˜šžœžœ
žœžœ
žœž˜6K˜K˜K˜Kš
œ#˜#Kšžœ
˜—K˜—Kšœžœžœ
˜š‘	œžœ,˜;Kšœ
žœžœ˜2Kš
œ˜šžœžœ˜Kš
œF˜FKšœžœžœ˜Bš‘œžœ˜+Kš
œ.˜.K˜—Kšœ	žœ
˜Kš
œ˜K˜K˜—šžœž˜˜šžœž˜šžœžœ˜K˜5Kš
œ#˜#K˜—K˜5Kš
œG˜GKšžœ
˜—K˜—˜
šžœž˜Kš
œ#˜#K˜2šžœžœ˜Kš
œG˜GK˜2K˜—Kšžœ
˜—K˜—Kšžœžœ
˜—šžœžœžœ˜&Kšœžœ%˜/Kšœ5žœ
žœžœ˜UKš
œ˜Kš
œ˜Kš
œ˜—Kšžœžœ
˜"K˜—K˜šžœ
ž˜Kšœžœ’œ’œ’œ’œ˜*Kšœžœ’œ’œ’œ’œ˜FKšžœžœ
˜—K˜Kšœ’œ’œ’œ˜%Kšœ’œ’œ’œ˜%Kšœ	’œ’œ˜Kšœ	’œ’œ˜K˜AKš
œ˜K˜
K˜K˜K˜K˜K˜K˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜"š	žœžœ
žœ
žœž˜'K˜šžœ
žœ˜šœžœž˜!K˜K˜Kšžœžœ
˜—Kšœžœ
˜K˜—Kšžœžœžœ˜CKšžœžœ˜3šžœžœ
žœž˜ Kš
œ&˜&Kšžœ
˜—K˜"šžœ
žœ˜KšΟg
œC˜DKšœ£
œ˜—Kš
œ˜Kšžœ
˜—K˜K˜—K˜š‘	œžœ5žœžœ˜kK˜K˜—K˜š‘œžœžœžœ,˜kKšžœ˜	Kš
œ˜™K™š
œ™šžœž™Kš
œ™Kš
œ™Kš
œ™Kšžœžœ™——Kšœ4ž
œ™8Kšœžœ™K™Kš
œ+™+—™Kšžœ%žœ;˜fKšœOžœM˜‘
—™*Kšžœžœ
žœ
™&Kšœ'žœ™7—Kšœ:žœ˜@Kšžœ.žœ
žœ
˜;Kš
œ˜K˜K˜—K˜Kš
œ7˜7K˜š‘œžœžœ˜@š
œ˜K˜K˜K˜"šœžœ ˜+Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ+˜+K˜K˜—K˜—Kšžœ6žœ
žœ
˜CK˜—K˜š‘œžœžœ-˜ZKšžœ˜	Kšœžœ˜Kš
žœžœžœžœ
žœ
˜9Kšžœžœ
žœ
žœ˜>Kš
œ˜Kšœžœ
˜šžœžœ
žœž˜Kšœžœ˜(šœž˜š
œ
˜
K˜
Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—K˜K˜—Kš
œ,˜,Kšžœ
˜—Kš
œ˜Kš
œ˜K˜Kš
œF˜FKš	œ	žœžœžœ
žœ˜9Kš	œžœžœžœ
žœ˜/—K˜š‘œžœžœžœ™NKšœžœ™Kš
œ™šžœžœ
žœž™Kšœžœ™(™K™Kš
œ™Kš
œ™Kš
œ™Kš
œ™K™—Kš
œ0™0Kšžœ
™—K™—K˜Kš
‘œžœžœžœžœ˜@K˜š
‘œžœ
žœžœžœ˜?Kšœžœ˜šžœž˜
Kš
œ˜Kš
œG˜GKšžœžœ˜——K˜š‘œžœ
žœžœ˜:K˜K˜Kšœžœ
˜—K˜š‘œžœ
žœžœ˜=Kšœžœ˜'—K˜š
‘œžœžœžœžœ˜*Kšœžœ˜K˜—K˜š
‘œžœžœžœžœ˜,Kšœžœ˜K˜—K˜š‘œžœžœžœ˜>Kšžœ˜	Kšœžœ
žœžœ˜*Kšœžœ
˜˜Kšœžœ
˜K˜K˜—š
ž˜Kšœžœ
˜Kšœžœ
˜K˜K˜Kšžœžœ
žœ
˜K˜K˜K˜4Kš
œ˜šœžœ˜K˜Kš
œ=˜=Kš
œ=˜=—Kšžœžœ
žœžœ˜9K˜Kšžœ
˜—K˜
K˜—K˜š
‘œžœžœžœžœ˜1K˜7—K˜š
‘œžœžœžœžœ˜<Kšœžœ
˜Kšœžœ˜K˜	šžœ6ž˜=K˜cKšžœ
˜—K˜—K˜š‘œžœ˜š
œ˜š
œ˜Kš
œ˜šœ	žœ
˜Kšœ
žœG˜LKšœ
žœG˜LKšœ
žœG˜LKšœ
žœI˜NKšœ
žœI˜NKšœ
žœI˜NKš
œ#˜#Kš
œ&˜&Kš
œ#˜#Kš
œ˜—K˜'Kš
œ˜—Kš
œ9˜9—K˜Kšœžœ
˜—K˜š‘
œžœ˜Kšžœ˜	š
ž˜Kš
œ3˜3K˜3K˜3Kš
žœžœžœžœ
žœ
˜WKšžœ
˜—K˜—K˜š‘
œžœ˜Kšžœ˜	Kš
œ3˜3Kš
œ3˜3Kš
œ3˜3K˜—K˜š‘œžœ+ "œ˜bKšœžœ5˜Jšœžœ
žœ
ž˜&Kšœ"žœ˜;Kšœ!žœ˜4Kšžœ
˜—K˜K˜—š‘œžœ˜Kš
œ0˜0Kš
œ:˜:K˜K˜K˜—K˜K˜K˜K˜Kš
£/˜/KšΠgk£˜/Kš
/˜/KšΠkm˜/——…—OvkΧ