PolyKal.Mesa
Copyright 1986 by Xerox Corporation. All rights reserved.
Last Edited by: Spreitzer, May 13, 1986 1:55:59 pm PDT
DIRECTORY Basics, BasicTime, Buttons, ColorDisplayFace, FS, Histograms, IdleBackdoor, Imager, ImagerBox, ImagerColor, ImagerColorMap, ImagerDitherContext, ImagerFont, ImagerInterpress, ImagerPath, ImagerPixelMap, ImagerTerminal, ImagerTransformation, IO, Menus, PrincOps, Process, Random, Real, RealFns, Rope, Terminal, ThisMachine, TIPUser, UserProfile, Vector2, ViewerClasses, ViewerOps;
PolyKal: CEDAR MONITOR
IMPORTS BasicTime, Buttons, ColorDisplayFace, FS, IdleBackdoor, Imager, ImagerBox, ImagerColor, ImagerColorMap, ImagerDitherContext, ImagerFont, ImagerPath, ImagerTerminal, ImagerTransformation, IO, Process, Random, Real, RealFns, Rope, Terminal, ThisMachine, UserProfile =
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
];
Control: TYPE = REF ControlPrivate;
ControlPrivate: TYPE = RECORD [
shouldGo: BOOL ← FALSE,
ipSize: REAL--meters-- ← Imager.metersPerInch*3.0,
wantIP, hold: BOOL ← FALSE,
symmetry: CARDINAL ← 8,
sExp, vExp: REAL ← 0.5,
upTextMin: Milliseconds ← 10*OneSecond,
upTextMax: Milliseconds ← 60*OneSecond,
downTextMin: Milliseconds ← 1*OneSecond,
downTextMax: Milliseconds ← 6*OneSecond,
doText: BOOL ← FALSE,
pausePeriod: Process.Ticks ← 0,
holdPeriod: Process.Ticks ← Process.MsecToTicks[500],
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 [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift, control: BOOL ← FALSE] =
BEGIN OPEN ctl;
SELECT control FROM
FALSE => {
shouldGo ← NOT going;
IF shouldGo AND OKToGo[] THEN {
symmetry ← rs.ChooseInt[2, 8]*2;
TRUSTED {Process.Detach[FORK Viewit[]]};
};
};
TRUE => {
SELECT mouseButton FROM
red => wantIP ← TRUE;
yellow => NULL;
blue => hold ← NOT hold;
ENDCASE => ERROR;
};
ENDCASE => ERROR;
END;
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] = {
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];
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];
xSize: NAT --x size of 0th slice
= 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: NAT = IF symmetry # 4
THEN Real.RoundI[xSize*RealFns.TanDeg[a]]
ELSE xSize;
center: VEC = [x: (xp0 + xp1)/2, y: (yp0 + yp1)/2];
toZero: Transformation = ImagerTransformation.Translate[[-center.x, -center.y]];
rotateCCW: Transformation = toZero.PostRotate[2*a].PostTranslate[center];
rotateCW: Transformation = toZero.PostRotate[-2*a].PostTranslate[center];
negateY: Transformation ← toZero.PostScale2[[1.0, -1.0]].PostTranslate[center];
d0: REAL = sinA*center.x - cosA*center.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, Imager.black];
Imager.MaskBox[context, [xp0, yp0, xp1, yp1]];
};
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 = [
center.x + rs.ChooseInt[0, xSize],
center.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;
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, PickColor[]];
Imager.MaskFillOutline[context, 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;
PickText[T ← 0];
giveContext[DrawInit];
oldP ← BasicTime.GetClockPulses[];
FOR i: INT ← 0, i+1 WHILE NOT Stop[] DO
newP: BasicTime.Pulses;
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];
};
PickColor: PROC RETURNS [color: ConstantColor] = {
OPEN ctl;
color ← ImagerColor.ColorFromRGB[ImagerColor.RGBFromHSV[[
S: RealFns.Power[rs.ChooseInt[0, 16384]/16384.0, sExp],
V: RealFns.Power[rs.ChooseInt[0, 16384]/16384.0, vExp],
H: rs.ChooseInt[0, 1023]/1024.0]]];
};
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 ← Buttons.Create[info: [name: "pKal", column: static], proc: ButtonControl, documentation: "click to run/stop polygon kaleidoscope"];
};
ctlButton: Buttons.Button ← 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 = {
UserProfile.CallWhenProfileChanges[NoteProfile];
font ← ImagerFont.Find["Xerox/PressFonts/TimesRoman-MRR"];
td ← ReadTextData["Kal.texts"];
CreateButton[];
};
Start[];
}.
abcdefghijklmnopqrstuvwxyz1234567890-=\[]←',./
ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$%~&*()—+|{}^:"<>?
蝩C%gfh). "`z{bP +
![ ]H*({ '`˧de