PolyKal.Mesa
Copyright 1986 by Xerox Corporation. All rights reserved.
Mike Spreitzer November 14, 1986 8:42:01 pm PST
DIRECTORY Basics, BasicTime, Buttons, ColorDisplayFace, FS, IdleBackdoor, Imager, ImagerBox, ImagerColor, ImagerColorMap, ImagerDitherContext, ImagerFont, ImagerInterpress, ImagerPath, ImagerPixelMap, ImagerTerminal, ImagerTransformation, IO, Menus, PopUpButtons, PrincOps, Process, Random, Real, RealFns, Rope, Terminal, ThisMachine, TIPUser, UserProfile, Vector2, ViewerClasses, ViewerOps;
PolyKal: CEDAR MONITOR
IMPORTS BasicTime, ColorDisplayFace, FS, IdleBackdoor, Imager, ImagerBox, ImagerColor, ImagerColorMap, ImagerDitherContext, ImagerFont, ImagerInterpress, ImagerPath, ImagerTerminal, ImagerTransformation, IO, PopUpButtons, Process, Random, Real, RealFns, Rope, Terminal, ThisMachine, UserProfile, Vector2
INVARIANT
going IFF there is a process running the kaleidoscope.
=
{
ROPE: TYPE = Rope.ROPE;
VEC: TYPE = Vector2.VEC;
Viewer: TYPE = ViewerClasses.Viewer;
PixelMap: TYPE = ImagerPixelMap.PixelMap;
Font: TYPE = ImagerFont.Font;
ConstantColor: TYPE = Imager.ConstantColor;
Transformation: TYPE = ImagerTransformation.Transformation;
ColorMapEntryList: TYPE = LIST OF ImagerColorMap.MapEntry;
Sgn: TYPE = INTEGER[-1 .. 1];
TextData: TYPE = RECORD [
texts: TextList,
numTexts: NAT,
totalProbability: REAL];
TextList: TYPE = LIST OF Text;
Text: TYPE = RECORD [
text: ROPE,
bounds: Imager.Box,
cumProb: REAL
];
RealCtl: TYPE = RECORD [
min: REAL ← 0.0,
max: REAL ← 1.0,
exp: REAL ← 0.5];
Control: TYPE = REF ControlPrivate;
ControlPrivate: TYPE = RECORD [
shouldGo: BOOL ← FALSE,
ipRadius: REAL--inches-- ← 3.0,
ipCenter: VEC ← [3.0, 3.0],
ipContext: Imager.Context ← NIL,
wantIP, hold: BOOL ← FALSE,
symmetry: CARDINAL ← 8,
colorSpace: {hsv, hsl, rgb} ← hsv,
p1Ctl: RealCtl ← [exp: 1.0],
p2Ctl, p3Ctl: RealCtl ← [],
background: ImagerColor.RGB ← [0, 0, 0],
upTextMin: Milliseconds ← 10*OneSecond,
upTextMax: Milliseconds ← 60*OneSecond,
downTextMin: Milliseconds ← 1*OneSecond,
downTextMax: Milliseconds ← 6*OneSecond,
vCenter: VEC ← [0, 0],
xSize--x size of 0th slice--, ySize: NAT ← 0,
doText: BOOL ← FALSE,
pausePeriod: Process.Ticks ← 0,
holdPeriod: Process.Ticks ← Process.MsecToTicks[500],
runningPriority: Process.Priority ← Process.priorityBackground,
retraces: NAT ← 1,
change: CONDITION
];
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
$RunStop, $SameSymmetry => {
shouldGo ← NOT going;
IF shouldGo AND OKToGo[] THEN {
IF key = $RunStop THEN symmetry ← rs.ChooseInt[2, 8]*2;
TRUSTED {Process.Detach[FORK Viewit[]]};
};
};
$ToggleIPWriting => wantIP ← NOT wantIP;
$TogglePause => hold ← NOT hold;
ENDCASE => ERROR;
};
StopGoing: ENTRY PROC = {going ← FALSE; BROADCAST ctl.change};
OKToGo: ENTRY PROC RETURNS [go: BOOL] = {
IF go ← NOT going THEN {going ← TRUE; BROADCAST ctl.change}};
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] = {
OPEN ctl;
symmetry ← rs.ChooseInt[2, 8]*2;
[] ← IdleBackdoor.UseAlternateVT[vtProc: DoForVT, logout: NOT control];
};
vtContext: Imager.Context;
GiveVTContext: PROC [to: PROC [context: Imager.Context]] =
{to[vtContext]};
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]};
VTWork: PROC [vt: Terminal.Virtual, Stop: PROC RETURNS [BOOL]] = {
OPEN ctl;
width, height: INTEGER;
mapEntries: ColorMapEntryList ← ImagerColorMap.StandardColorMapEntries[8];
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 ← mapEntries, 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: width, yp1: height, Stop: Stop, vt: vt];
vt ← vt;
};
[vtContext, width, height] ← StartDeviceAndPM[vt];
IF useImagerDitherContext THEN ImagerDitherContext.DoWithDitherMap[context: vtContext, mapEntries: mapEntries, action: WithContext] ELSE WithContext[];
};
useImagerDitherContext: BOOL ← TRUE;
useImagerColorMap: BOOL ← TRUE;
upText, downText, T: Milliseconds ← 0;
curText: Text;
cto: Vector2.VEC;
cts: REAL;
TwoToThe: ARRAY [0 .. 15] OF CARDINAL = [
00001H, 00002H, 00004H, 00008H,
00010H, 00020H, 00040H, 00080H,
00100H, 00200H, 00400H, 00800H,
01000H, 02000H, 04000H, 08000H];
ForkIPWriter: PROC = TRUSTED {Process.Detach[ipWriter ← FORK IPWriter[]]};
ipWriter: PROCESS;
IPWriter: PROC = {
DO
GetRequest: ENTRY PROC = {
ENABLE UNWIND => NULL;
WHILE ctl.wantIP = (ctl.ipContext # NIL) OR NOT going DO WAIT ctl.change ENDLOOP;
};
CollectPage: ENTRY PROC [ipContext: Imager.Context] = {
ENABLE UNWIND => NULL;
ipContext.ScaleT[Imager.metersPerInch];
ipContext.TranslateT[ctl.ipCenter];
ipContext.ScaleT[ctl.ipRadius/ctl.xSize];
ipContext.TranslateT[ctl.vCenter.Neg[]];
ctl.ipContext ← ipContext;
BROADCAST ctl.change;
WHILE going AND ctl.wantIP DO WAIT ctl.change ENDLOOP;
ctl.ipContext ← NIL;
BROADCAST ctl.change;
};
GetRequest[];
ipFile ← ImagerInterpress.Create["[]<>PolyKal.IP"];
ImagerInterpress.DoPage[ipFile, CollectPage];
ImagerInterpress.Close[ipFile];
ENDLOOP;
};
ipFile: ImagerInterpress.Ref;
Dewit: PROC [giveContext: PROC [to: PROC [context: Imager.Context]], xp0, yp0, xp1, yp1: INTEGER, Stop: PROC RETURNS [BOOL], vt: Terminal.Virtual] = {
OPEN ctl;
a: REAL--degrees-- = 360.0/symmetry;
sinA: REAL = RealFns.SinDeg[a];
cosA: REAL = RealFns.CosDeg[a];
vCenter ← [x: (xp0 + xp1)/2, y: (yp0 + yp1)/2];
{toZero: Transformation = ImagerTransformation.Translate[[-vCenter.x, -vCenter.y]];
rotateCCW: Transformation = toZero.PostRotate[2*a].PostTranslate[vCenter];
rotateCW: Transformation = toZero.PostRotate[-2*a].PostTranslate[vCenter];
negateY: Transformation = toZero.PostScale2[[1.0, -1.0]].PostTranslate[vCenter];
d0: REAL = sinA*vCenter.x - cosA*vCenter.y;
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] = {
InnerDoit: PROC = {
context.SetXY[cto];
context.TranslateT[cto];
context.ScaleT[cts];
context.SetFont[font];
context.ShowRope[curText.text];
};
Imager.DoSave[context, InnerDoit];
};
prevUp: BOOL ← FALSE;
outline: ImagerPath.Outline = NEW [ImagerPath.OutlineRep[symmetry]];
DrawInit: PROC [context: Imager.Context] = {
Imager.SetColor[context, ImagerColor.ColorFromRGB[background]];
Imager.MaskBox[context, [xp0, yp0, xp1, yp1]];
};
SettleIPContext: ENTRY PROC = {
ENABLE UNWIND => NULL;
WHILE wantIP # (ipContext # NIL) DO NOTIFY change; WAIT change ENDLOOP;
};
DrawDelta: PROC [context: Imager.Context] = {
shouldUp: BOOL = (T >= upText) AND (T < downText);
urVerts: CARDINAL = rs.ChooseInt[3, 7];
Generate: ImagerPath.PathProc = {
first: BOOL ← TRUE;
firstV, lastV: VEC;
firstD, lastD: REAL;
firstS, lastS: Sgn ← 0;
See: PROC [v: VEC, d: REAL, sgn: Sgn] = {
IF sgn*lastS < 0 THEN {
perLast: REAL = d / REAL[d - lastD];
perCur: REAL = - lastD / REAL[d - lastD];
cross: VEC = [
x: perCur*v.x + perLast*lastV.x,
y: perCur*v.y + perLast*lastV.y];
IF first
THEN {first ← FALSE; moveTo[cross]}
ELSE lineTo[cross];
}
ELSE IF sgn >= 0 THEN {
IF first
THEN {first ← FALSE; moveTo[v]}
ELSE lineTo[v];
};
};
FOR i: INT IN [1 .. urVerts] DO
v: VEC = [
vCenter.x + rs.ChooseInt[0, xSize],
vCenter.y + rs.ChooseInt[0, ySize]];
d: REAL = sinA*v.x - cosA*v.y - d0;
sgn: Sgn = SGN[d];
IF i = 1 THEN {firstV ← v; firstD ← d; firstS ← sgn};
See[v, d, sgn];
lastV ← v;
lastD ← d;
lastS ← sgn;
ENDLOOP;
See[firstV, firstD, firstS];
};
tl: ImagerPath.TrajectoryList ← NIL;
thisColor: ConstantColor = PickColor[];
WHILE tl = NIL DO tl ← ImagerPath.TrajectoryListFromPath[Generate] ENDLOOP;
outline[0] ← tl.first;
IF tl.rest # NIL THEN ERROR;
outline[1] ← TransformTrajectory[outline[0], negateY];
FOR i: INT IN (0 .. symmetry/2) DO
outline[2*i+0] ← TransformTrajectory[outline[2*i-2], rotateCCW];
outline[2*i+1] ← TransformTrajectory[outline[2*i-1], rotateCW];
ENDLOOP;
Imager.SetColor[context, thisColor];
Imager.MaskFillOutline[context, outline, TRUE];
IF ipContext # NIL THEN {
Imager.SetColor[ipContext, thisColor];
Imager.MaskFillOutline[ipContext, outline, TRUE];
};
IF doText AND shouldUp # prevUp THEN {
Imager.SetColor[context, IF shouldUp THEN PickColor[] ELSE black];
DrawText[context];
prevUp ← shouldUp;
};
IF T >= downText THEN PickText[T];
};
oldP: BasicTime.Pulses;
xSize ← MIN[
Real.Fix[(xp1 - xp0) * (SELECT symmetry MOD 4 FROM
0 => 1.0,
2 => cosA,
ENDCASE => ERROR)],
Real.Fix[(yp1 - yp0) / (IF symmetry = 4
THEN 1.0
ELSE MAX[
ImagerTransformation.Rotate[Real.Fix[(90 - a)/(2*a)]*2*a].Transform[[1.0, RealFns.TanDeg[a]]].y,
ImagerTransformation.Rotate[Ceiling[(90 - a)/(2*a)]*2*a].Transform[[1.0, RealFns.TanDeg[a]]].y
])]
]/2;
ySize ← IF symmetry # 4
THEN Real.RoundI[xSize*RealFns.TanDeg[a]]
ELSE xSize;
PickText[T ← 0];
giveContext[DrawInit];
oldP ← BasicTime.GetClockPulses[];
FOR i: INT ← 0, i+1 WHILE NOT Stop[] DO
newP: BasicTime.Pulses;
SettleIPContext[];
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;
oldP ← oldP;
}};
TransformTrajectory: PROC [traj: ImagerPath.Trajectory, m: Transformation] RETURNS [new: ImagerPath.Trajectory] = {
Produce: ImagerPath.PathProc = {
ImagerPath.MapTrajectory[traj, moveTo, lineTo, curveTo, conicTo, arcTo];
};
first: BOOL ← TRUE;
Consume: PROC [t: ImagerPath.Trajectory] = {
IF first THEN {first ← FALSE; new ← t} ELSE ERROR;
};
ImagerPath.TrajectoriesFromPath[Produce, m, Consume];
};
EvalCtl: PROC [rc: RealCtl] RETURNS [r: REAL] = {
r ← rc.min + (rc.max - rc.min)*RealFns.Power[rs.ChooseInt[0, 16384]/16384.0, rc.exp]};
PickColor: PROC RETURNS [color: ConstantColor] = {
OPEN ctl;
p1: REAL = EvalCtl[p1Ctl];
p2: REAL = EvalCtl[p2Ctl];
p3: REAL = EvalCtl[p3Ctl];
color ← ImagerColor.ColorFromRGB[SELECT colorSpace FROM
hsv => ImagerColor.RGBFromHSV[[H: p1, S: p2, V: p3]],
hsl => ImagerColor.RGBFromHSL[[H: p1, S: p2, L: p3]],
rgb => [R: p1, G: p2, B: p3],
ENDCASE => ERROR
];
};
StartDeviceAndPM: PROC [vt: Terminal.Virtual] RETURNS [context: Imager.Context, width, height: INTEGER] = {
OPEN ctl;
bpp: INT = 8;
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[];
width ← fb.width;
height ← fb.height;
};
profiledDisplayType: ColorDisplayFace.ColorDisplayType;
FixC: PROC [r: REAL] RETURNS [c: CARDINAL] = {c ← Real.FixC[r]};
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[
[$RunStop, "Start/stop"],
[$ToggleIPWriting, "Start/stop writing to []<>PolyKal.IP"],
[$TogglePause, "Pause or continue"],
[$SameSymmetry, "Start/stop, but don't choose new symmetry"]
],
doc: "Polygon kaleidoscope control"
]]
.Instantiate[viewerInfo: [name: "pKal", column: static]];
};
ctlButton: Viewer ← NIL;
SGN: PROC [r: REAL] RETURNS [sgn: Sgn] = {
sgn ← SELECT r FROM
<0 => -1,
=0 => 0,
>0 => 1,
ENDCASE => ERROR;
};
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 = {
TRUSTED {
Process.InitializeCondition[@ctl.change, Process.SecondsToTicks[60]];
Process.EnableAborts[@ctl.change]};
ForkIPWriter[];
UserProfile.CallWhenProfileChanges[NoteProfile];
font ← ImagerFont.Find["Xerox/PressFonts/TimesRoman-MRR"];
td ← ReadTextData["Kal.texts"];
CreateButton[];
};
Start[];
}.
abcdefghijklmnopqrstuvwxyz1234567890-=\[]←',./
ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$%~&*()—+|{}^:"<>?
蝩C%gfh). "`z{bP +
![ ]H*({ '`˧de