ColorKal.Mesa
Copyright 1984 by Xerox Corporation. All rights reserved.
Mike Spreitzer November 14, 1986 8:42:00 pm PST
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
INVARIANT
going IFF there is a process running the kaleidoscope.
=
{
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;
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:
IF ColorDisplayFace.displayType = none THEN [] ← ColorDisplayFace.SetDisplayType[profiledDisplayType];
[] ← Terminal.SetColorBitmapState[vt: vt, newState: displayed, newMode: [full: FALSE, bitsPerPixelChannelA: bpp, bitsPerPixelChannelB: 0], newVisibility: aOnly];
Works in 6.0, but gets Viewers in the way:
IF vt # Terminal.Current[] THEN ERROR;
ColorDisplay.SetColorDisplayStatus[on: TRUE, bpp: bpp];
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];
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;
};
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!@#$%~&*()—+|{}^:"<>?
蝩C%gfh). "`z{bP +
![ ]H*({ '`˧de