PolyHackB.Mesa
Mike Spreitzer July 30, 1986 11:30:42 pm PDT
DIRECTORY BiScrollers, FS, Geom2D, Icons, Imager, ImagerBox, ImagerColor, IO, Misp, PolyHackInsides, Process, Random, Real, RealFns, Rope, StructuredStreams, TIPUser, UnparserBuffer, ViewerClasses, ViewerIO, ViewerOps, ViewerTools, ViewRec;
PolyHackB:
CEDAR
PROGRAM
IMPORTS BiScrollers, Geom2D, FS, Icons, Imager, ImagerBox, ImagerColor, IO, Misp, PolyHackInsides, Process, Random, Rope, SS: StructuredStreams, TIPUser, UB: UnparserBuffer, ViewerIO, ViewerOps, ViewerTools, ViewRec
EXPORTS PolyHackInsides =
BEGIN OPEN Misp, PolyHackInsides;
hackFlavor: ATOM ← $PolyHack;
hackClass: ViewerClasses.ViewerClass ←
NEW [ViewerClasses.ViewerClassRec ← [
flavor: hackFlavor,
paint: PaintHack,
notify: NotifyHack,
tipTable: TIPUser.InstantiateNewTIPTable["PolyHack.TIP"]]];
hackBiScrollerFlavor: ATOM ← $BiScrollerPolyHack;
preferredHackBSStyle: ROPE ← "Buttonless";
hackBSStyle: BiScrollers.BiScrollerStyle;
hackBiScrollerClass: BiScrollers.BiScrollerClass ← NIL;
CreateHack:
PUBLIC
PROC [vi: ViewerClasses.ViewerRec, asBiScroller:
BOOLEAN]
RETURNS [vd: ViewerData] =
BEGIN
is, os: IO.STREAM;
vi.data ← vd ← NEW [ViewerDataRep ← []];
IF asBiScroller
THEN
BEGIN
vd.bs ← hackBSStyle.CreateBiScroller[class: hackBiScrollerClass, info: vi, paint: TRUE];
vd.viewer ← vd.bs.QuaViewer[];
END
ELSE
BEGIN
vd.viewer ← ViewerOps.CreateViewer[flavor: hackFlavor, info: vi, paint: TRUE];
END;
vd.ctlPanel ← NEW [CtlPanelRep ← [Step: StepCmd, Run: RunCmd, Continuous: ContinuousCmd, SetPolys: SetPolys, Clear: ClearHack, PrintPolys: PrintHackPolys, Fit: Fit, ReadEvalPrint: ReadEvalPrint]];
vd.rv ← ViewRec.ViewRef[agg: vd.ctlPanel, specs: ViewRec.BindAllOfATypeFromRefs[rec: vd.ctlPanel, handle: NEW [ViewerData ← vd]], viewerInit: [name: vi.name.Concat[" Control"], iconic: FALSE]];
[in: is, out: os] ← ViewerIO.CreateViewerStreams[name: vi.name.Concat[" Log"]];
vd.log ← os ← SS.Create[onTopOf: UB.NewInittedHandle[[output: [stream[os]]]]];
SS.Begin[os];
vd.env ← Misp.NewEnvironment[vi.name, NIL, is, os];
Misp.DefinePrimitives[vd.env];
DefineHackAStuff[vd.env, vd];
DefineHackBStuff[vd.env, vd];
Load["PolyHack.PreLoad", vd.env, NIL];
END;
PrintHackPolys:
PROC [vd: ViewerData] =
BEGIN
WriteRefAny[vd.log, vd.polys]; vd.log.PutChar['\n];
END;
ReadEvalPrint:
PROC [vd: ViewerData] =
BEGIN
sourceRope: ROPE ← ViewerTools.GetSelectionContents[];
sourceStream: IO.STREAM ← IO.RIS[sourceRope];
raw: REF ANY ← sourceStream.GetRefAny[];
ok: BOOLEAN ← TRUE;
cooked: REF ANY;
cooked ← Misp.Eval[raw, vd.env,
NIL !
Misp.Error => {vd.log.PutF["%g; env: %g, stack: %g\n", IO.rope[msg], IO.refAny[env], IO.refAny[stack]]; ok ← FALSE; CONTINUE};
UNWIND => vd.ctlPanel.stop ← FALSE];
IF ok THEN WriteRefAny[vd.log, cooked];
vd.log.PutChar['\n];
vd.ctlPanel.stop ← FALSE;
END;
ClearHack:
PROC [vd: ViewerData] =
{ViewerOps.PaintViewer[viewer: vd.viewer, hint: all]};
SetPolys:
PUBLIC
PROC [vd: ViewerData] =
BEGIN
sourceRope: ROPE ← ViewerTools.GetSelectionContents[];
sourceStream: IO.STREAM ← IO.RIS[sourceRope];
raw: REF ANY ← sourceStream.GetRefAny[];
cooked: REF ANY;
ok: BOOLEAN ← TRUE;
IF vd.ctlPanel.noisy THEN {WriteRefAny[vd.log, raw]; vd.log.PutChar['\n]};
cooked ← Misp.Eval[raw, vd.env, NIL !Misp.Error => {vd.log.PutF["%g; env: %g, stack: %g\n", IO.rope[msg], IO.refAny[env], IO.refAny[stack]]; ok ← FALSE; CONTINUE}];
IF NOT ok THEN {vd.log.PutChar['\n]; RETURN};
IF vd.ctlPanel.noisy THEN {WriteRefAny[vd.log, cooked]; vd.log.PutChar['\n]};
SetPolyList[vd, cooked];
END;
ToPolyList:
PUBLIC
PROC [asAny:
REF
ANY, vd: ViewerData]
RETURNS [polyList: PolyList, ok:
BOOL] = {
WITH asAny
SELECT
FROM
poly: Poly => {polyList ← LIST[poly]; ok ← TRUE};
pl: PolyList => {polyList ← pl; ok ← TRUE};
lora:
LORA => {
FOR lora ← lora, lora.rest
WHILE lora #
NIL
DO
polyList ← CONS[NARROW[lora.first], polyList];
ENDLOOP;
ok ← TRUE;
};
ENDCASE =>
BEGIN
vd.log.PutRope["Got "];
WriteRefAny[vd.log, asAny];
vd.log.PutRope[" instead of polygon(s)\n"];
polyList ← NIL;
ok ← FALSE;
END;
};
SetPolyList:
PUBLIC
PROC [vd: ViewerData, asAny:
REF
ANY] =
BEGIN
MakeGoodBounds:
PROC [in: Box]
RETURNS [good: Box] = {
Fix:
PROC [minI, maxI:
REAL]
RETURNS [min, max:
REAL] = {
IF minI > maxI THEN min ← -(max ← 10) ELSE {min ← minI; max ← maxI}};
[good.xmin, good.xmax] ← Fix[in.xmin, in.xmax];
[good.ymin, good.ymax] ← Fix[in.ymin, in.ymax]};
BloatBounds:
PROC [unb: Box, halfBloat:
REAL]
RETURNS [bloated: Box] ={
dx: REAL ← halfBloat * (unb.xmax - unb.xmin);
dy: REAL ← halfBloat * (unb.ymax - unb.ymin);
bloated ← [xmin: unb.xmin-dx, ymin: unb.ymin-dy, xmax: unb.xmax+dx, ymax: unb.ymax+dy]};
polyList: PolyList;
ok: BOOL;
[polyList, ok] ← ToPolyList[asAny, vd];
IF
NOT ok
THEN {
RETURN;
};
vd.bloatedBounds ← BloatBounds[vd.bounds ← MakeGoodBounds[PolyListBounds[vd.polys ← polyList]], 0.05];
Fit[vd: vd, paint: TRUE];
END;
PolyListBounds:
PROC [polyList: PolyList]
RETURNS [bounds: Box] =
BEGIN
fr: Geom2D.FRect ← [];
FOR polyList ← polyList, polyList.rest
WHILE polyList #
NIL
DO
fr ← Geom2D.UpdateFRect[PolyBounds[polyList.first], fr];
ENDLOOP;
bounds ← ImagerBox.BoxFromRect[fr.r];
END;
PolyBounds:
PROC [poly: Poly]
RETURNS [bounds: Imager.Rectangle] =
BEGIN
fr: Geom2D.FRect ← [];
FOR vr: VertexRing ← poly.vertices.next, vr.next
WHILE vr # poly.vertices
DO
fr ← Geom2D.UpdateFRect[
ImagerBox.RectFromBox[VertexBounds[vr.vertex]],
fr];
ENDLOOP;
bounds ← fr.r;
END;
RunCmd:
PROC [vd: ViewerData, n:
CARDINAL] =
{RunWork[vd, n, TRUE]};
RunWork:
PROC [vd: ViewerData, n:
CARDINAL, unstop:
BOOL] =
BEGIN
ds: DrawStrokes;
da: DrawAreas;
lda: LORA;
IF
NOT OKToRun[vd]
THEN
RETURN;
BEGIN ENABLE UNWIND => UnRun[vd, unstop];
[lda, da, ds] ← PrepareToRun[vd];
FOR i: CARDINAL IN [1..n] DO StepHack[vd, lda, da, ds] ENDLOOP;
END;
UnRun[vd, unstop];
END;
ContinuousCmd:
PROC [vd: ViewerData] =
BEGIN
IF OKToRun[vd] THEN FinishContinuous[vd];
END;
FinishContinuous:
PROC [vd: ViewerData] =
BEGIN
BEGIN ENABLE UNWIND => UnRun[vd, TRUE];
da: DrawAreas;
ds: DrawStrokes;
lda: LORA;
[lda, da, ds] ← PrepareToRun[vd];
DO StepHack[vd, lda, da, ds] ENDLOOP;
END;
END;
OKToRun:
PUBLIC
PROC [vd: ViewerData]
RETURNS [ok:
BOOLEAN] =
BEGIN
vd.rv.DisplayMessage[ViewRec.clearMessagePlace];
IF NOT (ok ← GetRunLock[vd]) THEN vd.rv.DisplayMessage["Already Running"];
END;
HackExtrema:
PROC [clientData:
REF
ANY, direction: Geom2D.Vec]
RETURNS [min, max: Geom2D.Vec]
--BiScrollers.ExtremaProc-- =
BEGIN
vd: ViewerData ← NARROW[clientData];
[min, max] ← Geom2D.ExtremaOfRect[ImagerBox.RectFromBox[vd.bounds], direction];
END;
NotifyHack: ViewerClasses.NotifyProc
--[self: Viewer, input: LIST OF REF ANY]-- =
TRUSTED {Process.Detach[FORK ReallyNotifyHack[self, input]]};
ReallyNotifyHack:
PROC [self: Viewer, input:
LIST
OF
REF
ANY] =
BEGIN
vd: ViewerData ← ViewerDataOf[self];
TRUSTED {Process.SetPriority[Process.priorityNormal]};
WHILE input #
NIL
DO
SELECT input.first
FROM
$Abort => [] ← AbortRunner[vd];
$RunStop =>
BEGIN
IF GetRunLock[vd] THEN FinishContinuous[vd] ELSE vd.ctlPanel.stop ← TRUE;
input ← input.rest;
END;
$TakePolys =>
BEGIN
IF GetRunLock[vd]
THEN
BEGIN
BEGIN ENABLE UNWIND => UnRun[vd, TRUE];
SetPolys[vd];
END;
UnRun[vd, TRUE];
END
ELSE vd.ctlPanel.stop ← TRUE;
input ← input.rest;
END;
$Clear =>
BEGIN
IF GetRunLock[vd]
THEN
BEGIN
BEGIN ENABLE UNWIND => UnRun[vd, TRUE];
ClearHack[vd];
END;
UnRun[vd, TRUE];
END
ELSE vd.ctlPanel.stop ← TRUE;
input ← input.rest;
END;
$Fit =>
BEGIN
IF GetRunLock[vd]
THEN
BEGIN
BEGIN ENABLE UNWIND => UnRun[vd, TRUE];
Fit[vd: vd, paint: input.rest.first = $paint];
END;
UnRun[vd, TRUE];
END
ELSE vd.ctlPanel.stop ← TRUE;
input ← input.rest.rest;
END;
ENDCASE => ERROR;
ENDLOOP;
END;
ViewerDataOf:
PUBLIC
PROC [v: Viewer]
RETURNS [ViewerData] =
{
RETURN [
WITH v.data
SELECT
FROM
vd: ViewerData => vd,
ENDCASE => NARROW[BiScrollers.QuaBiScroller[v].ClientDataOf[]]]};
Fit:
PUBLIC
PROC [vd: ViewerData, paint:
BOOLEAN ←
TRUE] =
BEGIN
IF vd.bs #
NIL
THEN {
from: Box;
[from.xmin, from.xmax] ← vd.bs.ViewLimitsOfImage[X];
[from.ymin, from.ymax] ← vd.bs.ViewLimitsOfImage[Y];
vd.bs.BoxScale[from: ImagerBox.RectFromBox[from], to: [0, 0, vd.viewer.cw, vd.viewer.ch], paint: paint]
}
ELSE IF paint THEN ViewerOps.PaintViewer[viewer: vd.viewer, hint: client];
END;
Copy:
PUBLIC
PROC [v: Vertex]
RETURNS [u: Vertex] =
BEGIN
u ← NEW [VertexRep ← v^];
u.data ← u.class.Copy[u.data];
END;
Read:
PROC [from:
ROPE]
RETURNS [lora:
LORA] =
{lora ← NARROW[IO.RIS[from].GetRefAny[]]};
WriteRefAny:
PUBLIC
PROC [to:
IO.
STREAM, asAny:
REF
ANY] =
BEGIN
WITH asAny
SELECT
FROM
lora:
LORA =>
BEGIN
SS.Begin[to];
to.PutRope["("];
FOR lora ← lora, lora.rest
WHILE lora #
NIL
DO
WriteRefAny[to, lora.first];
IF lora.rest #
NIL
THEN
BEGIN
to.PutChar[' ];
SS.Bp[ss: to, cond: lookLeft, offset: 4];
END;
ENDLOOP;
to.PutRope[")"];
SS.End[to];
END;
polyList: PolyList => WritePolyList[to, polyList];
poly: Poly => WritePoly[to, poly];
color: Color => WriteColor[to, color];
coloring: Coloring => WriteColoring[to, coloring];
v: Vertex => WriteVertex[to, v];
ENDCASE => to.Put[IO.refAny[asAny]];
END;
WritePolyList:
PROC [to:
IO.
STREAM, pl: PolyList] =
BEGIN
SS.Begin[to];
to.PutRope["{PolyList"];
FOR pl ← pl, pl.rest
WHILE pl #
NIL
DO
to.PutChar[' ];
SS.Bp[ss: to, cond: united, offset: 4];
WritePoly[to, pl.first];
ENDLOOP;
to.PutRope["}"];
SS.End[to];
END;
WritePoly:
PROC [to:
IO.
STREAM, poly: Poly] =
BEGIN
SS.Begin[to];
to.PutRope["{coloring:"]; WriteColoring[to, poly.coloring];
FOR vr: VertexRing ← poly.vertices.next, vr.next
WHILE vr # poly.vertices
DO
to.PutRope[", "];
SS.Bp[ss: to, cond: lookLeft, offset: 4];
WriteVertex[to, vr.vertex];
ENDLOOP;
to.PutRope["}"];
SS.End[to];
END;
WriteColor:
PROC [to:
IO.
STREAM, color: Color] =
BEGIN
to.PutRope[
IF ImagerColor.ColorFromAtom[$Red] = color
THEN "red"
ELSE
IF ImagerColor.ColorFromAtom[$Blue] = color THEN "blue" ELSE
IF ImagerColor.ColorFromAtom[$Yellow] = color THEN "yellow" ELSE
IF ImagerColor.ColorFromAtom[$Green] = color THEN "green" ELSE
IF ImagerColor.ColorFromAtom[$Cyan] = color THEN "cyan" ELSE
IF ImagerColor.ColorFromAtom[$Magenta] = color THEN "magenta" ELSE
IF ImagerColor.ColorFromAtom[$Invert] = color THEN "invert" ELSE
IF ImagerColor.ColorFromAtom[$White] = color THEN "white" ELSE
IF ImagerColor.ColorFromAtom[$Black] = color THEN "black" ELSE
IO.PutFR["%g", IO.refAny[color]] ];
END;
WriteColoring:
PROC [to:
IO.
STREAM, coloring: Coloring] =
BEGIN
IF coloring.constant
THEN WriteColor[to, coloring.color]
ELSE to.PutF["%g", IO.refAny[coloring.form]];
END;
WriteVertex:
PUBLIC
PROC [to:
IO.
STREAM, v: Vertex] =
BEGIN
SS.Begin[to];
to.PutF["%g[x:%g, y:%g", IO.rope[v.class.name], IO.real[v.curLoc.x], IO.real[v.curLoc.y]];
v.class.WriteData[to, v.data];
to.PutF["]"];
SS.End[to];
END;
EvalHalveFirst: EvalProc =
BEGIN
poly: Poly ← NARROW[args.first];
poly.vertices.next.paintHalf ← TRUE;
cooked ← poly;
END;
EvalHalveLast: EvalProc =
BEGIN
poly: Poly ← NARROW[args.first];
poly.vertices.prev.paintHalf ← TRUE;
cooked ← poly;
END;
EvalClosedPoly: EvalProc =
BEGIN
poly: Poly;
coloring: Coloring ← ToColoring[args.first];
poly ← NewPoly[TRUE, coloring];
FOR args ← args.rest, args.rest
WHILE args #
NIL
DO
v: Vertex ← NARROW[args.first];
AddVertexToPoly[v, poly];
ENDLOOP;
Finish[poly];
cooked ← poly;
END;
EvalOpenPoly: EvalProc =
BEGIN
poly: Poly;
coloring: Coloring ← ToColoring[args.first];
poly ← NewPoly[FALSE, coloring];
FOR args ← args.rest, args.rest
WHILE args #
NIL
DO
v: Vertex ← NARROW[args.first];
AddVertexToPoly[v, poly];
ENDLOOP;
Finish[poly];
cooked ← poly;
END;
ToColoring:
PROC [ra:
REF
ANY]
RETURNS [coloring: Coloring] = {
WITH ra
SELECT
FROM
cr: Color => coloring ← NEW [ColoringRep ← [cr]];
c: Coloring => coloring ← c;
ENDCASE => ERROR};
PickInt:
PROC [raw:
LORA, environment: Environment]
RETURNS [i:
INT, rest:
LORA] =
{i ← NARROW[raw.first, Int]^; rest ← raw.rest};
PickReal:
PROC [raw:
LORA, environment: Environment]
RETURNS [r:
REAL, rest:
LORA] =
{
WITH raw.first
SELECT
FROM
real: Real => r ← real^;
int: Int => r ← int^;
ENDCASE => ERROR;
rest ← raw.rest};
Pad:
PROC [given, defaults:
LORA]
RETURNS [padded:
LORA] =
BEGIN
IF (padded ← given) = NIL THEN RETURN [defaults];
WHILE defaults #
NIL
DO
IF given.rest = NIL THEN {given.rest ← defaults.rest; RETURN};
given ← given.rest;
defaults ← defaults.rest;
ENDLOOP;
END;
makeARandomDefaults: LORA ← Read["(7 400 400 10 10)"];
EvalRandomBouncePoly: EvalProc =
BEGIN
nVerts: CARDINAL;
xmax, ymax, dxmax, dymax: INT;
args ← Pad[args, makeARandomDefaults];
[nVerts, args] ← PickInt[args, environment];
[xmax, args] ← PickInt[args, environment];
[ymax, args] ← PickInt[args, environment];
[dxmax, args] ← PickInt[args, environment];
[dymax, args] ← PickInt[args, environment];
cooked ← MakeRandomBouncePoly[nVerts, xmax, ymax, dxmax, dymax];
END;
randomBounceDefaults: LORA ← Read["(400 400 10 10)"];
EvalRandomBounce: EvalProc =
BEGIN
xmax, ymax, dxmax, dymax: INT;
args ← Pad[args, randomBounceDefaults];
[xmax, args] ← PickInt[args, environment];
[ymax, args] ← PickInt[args, environment];
[dxmax, args] ← PickInt[args, environment];
[dymax, args] ← PickInt[args, environment];
cooked ← RandomBounce[xmax, ymax, dxmax, dymax];
END;
bounceDefaults: LORA ← Read["(100 100 10 10 0 0 400 400)"];
EvalBounce: EvalProc =
BEGIN
xmin, ymin, xmax, ymax, dx, dy, x, y: REAL;
args ← Pad[args, bounceDefaults];
[x, args] ← PickReal[args, environment];
[y, args] ← PickReal[args, environment];
[dx, args] ← PickReal[args, environment];
[dy, args] ← PickReal[args, environment];
[xmin, args] ← PickReal[args, environment];
[ymin, args] ← PickReal[args, environment];
[xmax, args] ← PickReal[args, environment];
[ymax, args] ← PickReal[args, environment];
cooked ← NewBounce[
x: x, y: y, dx: dx, dy: dy,
xmin: xmin, xmax: xmax, ymin: ymin, ymax: ymax];
END;
wheelDefaults: LORA ← Read["(100 -1 0 1)"];
EvalWheel: EvalProc =
BEGIN
radius, where, initial, pen: REAL;
args ← Pad[args, wheelDefaults];
[radius, args] ← PickReal[args, environment];
[where, args] ← PickReal[args, environment];
[initial, args] ← PickReal[args, environment];
[pen, args] ← PickReal[args, environment];
cooked ← NEW [WheelRep ← [radius: radius, where: where, initial: initial, pen: pen]];
END;
EvalPoint: EvalProc =
BEGIN
x, y: REAL;
[x, args] ← PickReal[args, environment];
[y, args] ← PickReal[args, environment];
cooked ← NEW [Point ← [x, y]];
END;
endWheel: Wheel ← NEW [WheelRep ← [radius: 0, where: 0, initial: 0, pen: 1]];
Spiro:
PUBLIC
PROC [center: Point, stepSize:
REAL, wheels:
LORA]
RETURNS [v: Vertex] =
BEGIN
oldRate: REAL ← stepSize;
oldRadius: REAL ← 0;
v ← NIL;
FOR wheels ← wheels, wheels.rest
WHILE wheels #
NIL
DO
w: Wheel ← NARROW[wheels.first];
next: Wheel ← IF wheels.rest = NIL THEN endWheel ELSE NARROW[wheels.rest.first];
newRate: REAL ← oldRate*(1 + w.where*oldRadius/w.radius);
newRadius: REAL ← (w.radius + next.where*next.radius) * w.pen;
newV: Vertex;
newV ← NewLisasjous[
x: [base: center.x, amplitude: newRadius, stepSize: newRate, theta: w.initial+90],
y: [base: center.y, amplitude: newRadius, stepSize: newRate, theta: w.initial]];
oldRate ← newRate;
oldRadius ← w.radius;
IF v = NIL THEN v ← newV ELSE v ← NewSum[v, newV, FALSE];
center ← [0, 0];
ENDLOOP;
END;
EvalSum: EvalProc =
BEGIN
ans: Vertex ← NIL;
IF args = NIL THEN ERROR;
FOR args ← args, args.rest
WHILE args #
NIL
DO
this: Vertex ← NARROW[args.first];
ans ← IF ans = NIL THEN this ELSE NewSum[ans, this, FALSE];
ENDLOOP;
cooked ← ans;
END;
EvalOldSum: EvalProc =
BEGIN
ans: Vertex ← NIL;
IF args = NIL THEN ERROR;
FOR args ← args, args.rest
WHILE args #
NIL
DO
this: Vertex ← NARROW[args.first];
ans ← IF ans = NIL THEN this ELSE NewSum[this, ans, TRUE];
ENDLOOP;
cooked ← ans;
END;
epsilon: REAL ← 1E-4;
EvalSeries: EvalProc =
BEGIN
vertices: LORA ← NARROW[args.first];
lastVertex: Vertex ← NIL;
firstCons, lastCons: LORA ← NIL;
dx, dy: REAL ← (IF args.rest # NIL THEN NARROW[args.rest.first, Real]^ ELSE 0);
FOR vertices ← vertices, vertices.rest
WHILE vertices #
NIL
DO
v: Vertex ← NARROW[vertices.first];
this: LORA;
a: Box ← v.class.VertexBounds[v];
newDX: REAL ← ABS[a.xmax - a.xmin];
newDY: REAL ← ABS[a.ymax - a.ymin];
IF newDX <= dx*epsilon AND newDY <= dy*epsilon THEN LOOP;
dx ← MAX[dx, newDX];
dy ← MAX[dy, newDY];
IF lastVertex # NIL THEN v ← NewSum[lastVertex, v, TRUE];
lastVertex ← v;
this ← LIST[v];
IF lastCons = NIL THEN firstCons ← this ELSE lastCons.rest ← this;
lastCons ← this;
ENDLOOP;
cooked ← firstCons;
END;
EvalListPoly: EvalProc =
BEGIN
close: REF ANY ← args.first;
coloring: Coloring ← ToColoring[args.rest.first];
vertices: LORA ← NARROW[args.rest.rest.first];
poly: Poly ← NewPoly[close # NIL, coloring];
FOR vertices ← vertices, vertices.rest
WHILE vertices #
NIL
DO
v: Vertex ← NARROW[vertices.first];
AddVertexToPoly[v, poly];
ENDLOOP;
Finish[poly];
cooked ← poly
END;
EvalSpiro: EvalProc =
BEGIN
center: Point;
wheels: LORA;
stepSize: REAL;
center ← NARROW[args.first, PointRef]^;
[stepSize, args] ← PickReal[args.rest, environment];
wheels ← NARROW[args.first];
cooked ← Spiro[center: center, stepSize: stepSize, wheels: wheels];
END;
EvalLiss: EvalProc =
BEGIN
x, y: Sinusoid;
[x.base, args] ← PickReal[args, environment];
[x.amplitude, args] ← PickReal[args, environment];
[x.stepSize, args] ← PickReal[args, environment];
[x.theta, args] ← PickReal[args, environment];
[y.base, args] ← PickReal[args, environment];
[y.amplitude, args] ← PickReal[args, environment];
[y.stepSize, args] ← PickReal[args, environment];
[y.theta, args] ← PickReal[args, environment];
cooked ← NewLisasjous[x, y];
END;
EvalConstant: EvalProc =
BEGIN
x, y: REAL;
[x, args] ← PickReal[args, environment];
[y, args] ← PickReal[args, environment];
cooked ← NewConstant[x, y];
END;
NewConstant:
PROC [x, y:
REAL]
RETURNS [v: Vertex] =
{RETURN [NEW [VertexRep ← [curLoc: [x: x, y: y], class: constantClass, data: NIL]]]};
EvalChoose: EvalProc =
BEGIN
min, max: INT;
[min, args] ← PickInt[args, environment];
[max, args] ← PickInt[args, environment];
cooked ← NEW [INT ← rs.ChooseInt[min: min, max: max]];
END;
EvalFromRGB: EvalProc = {
r, g, b: REAL;
[r, args] ← PickReal[args, environment];
[g, args] ← PickReal[args, environment];
[b, args] ← PickReal[args, environment];
cooked ← ImagerColor.ColorFromRGB[[R:r, G:g, B:b]];
};
EvalFromHSV: EvalProc = {
h, s, v: REAL;
[h, args] ← PickReal[args, environment];
[s, args] ← PickReal[args, environment];
[v, args] ← PickReal[args, environment];
cooked ← ImagerColor.ColorFromRGB[ImagerColor.RGBFromHSV[[H:h, S:s, V:v]]];
};
EvalColoring: EvalProc = {
c: Coloring ←
NEW [ColoringRep ← [
constant: FALSE,
arg: NEW [REAL ← 0],
env: environment,
stack: stack]];
c.form ← LIST[args.first, c.arg];
UpdateColoring[c];
cooked ← c;
};
EvalStarHack: EvalProc =
BEGIN
cooked ← StarHackWork[args].vl12;
END;
EvalStarHackWithBounds: EvalProc =
BEGIN
vl1, vl2, vl12: REF ANY;
[vl1, vl2, vl12] ← StarHackWork[args];
cooked ← LIST[vl1, vl12, vl2];
END;
StarHackWork:
PROC [args:
LORA]
RETURNS [vl1, vl2, vl12:
LORA] =
BEGIN
nv: Int ← NARROW[args.first];
ns: Int ← NARROW[args.rest.first];
nVerts: CARDINAL ← nv^;
nSteps: CARDINAL ← ns^;
Coords: TYPE = REF CoordsRep;
CoordsRep: TYPE = RECORD [coords: SEQUENCE length: CARDINAL OF Point];
a: Coords ← NEW [CoordsRep[nVerts]];
b: Coords ← NEW [CoordsRep[nVerts]];
vl1 ← vl2 ← vl12 ← NIL;
FOR i:
CARDINAL
IN [0 .. nVerts)
DO
a[i] ← [rs.ChooseInt[0, 100], rs.ChooseInt[0, 100]];
ENDLOOP;
FOR i:
CARDINAL
IN [0 .. nVerts)
DO
j: CARDINAL ← rs.ChooseInt[i, nVerts-1];
b[i] ← a[i]; a[i] ← a[j]; a[j] ← b[i];
ENDLOOP;
FOR i:
CARDINAL
IN [0 .. nVerts)
DO
vl1 ← CONS[NewConstant[a[i].x, a[i].y], vl1];
vl2 ← CONS[NewConstant[b[i].x, b[i].y], vl2];
vl12 ←
CONS[
NewBounce[
x: a[i].x,
y: a[i].y,
dx: (b[i].x - a[i].x)/nSteps,
dy: (b[i].y - a[i].y)/nSteps,
xmin: MIN[a[i].x, b[i].x],
ymin: MIN[a[i].y, b[i].y],
xmax: MAX[a[i].x, b[i].x],
ymax: MAX[a[i].y, b[i].y]],
vl12];
vl1 ← vl1;
ENDLOOP;
vl2 ← vl2;
END;
EvalPrint: Misp.EvalProc =
BEGIN
vd: ViewerData ← NARROW[data];
cooked ← args.first;
WriteRefAny[vd.log, cooked];
vd.log.PutChar['\n];
END;
EvalSetMode: Misp.EvalProc =
BEGIN
vd: ViewerData ← NARROW[data];
mode: REF Mode ← NARROW[args.first];
cooked ← NEW [Mode ← vd.ctlPanel.mode];
vd.ctlPanel.mode ← mode^;
END;
EvalSetSpeed: Misp.EvalProc =
BEGIN
vd: ViewerData ← NARROW[data];
speed: REAL;
[speed, args] ← PickReal[args, environment];
cooked ← NEW [REAL ← vd.ctlPanel.speed];
vd.ctlPanel.speed ← speed;
END;
EvalRun: Misp.EvalProc =
BEGIN
vd: ViewerData ← NARROW[data];
steps: Int ← NARROW[args.first];
cooked ← $T;
RunWork[vd, steps^, FALSE];
END;
EvalStop: Misp.EvalProc =
BEGIN
vd: ViewerData ← NARROW[data];
cooked ← IF vd.ctlPanel.stop THEN $T ELSE NIL;
END;
EvalSetPolys: Misp.EvalProc =
BEGIN
vd: ViewerData ← NARROW[data];
polys: REF ANY ← args.first;
SetPolyList[vd, polys];
cooked ← $T;
END;
EvalDrawPolys: Misp.EvalProc =
BEGIN
vd: ViewerData ← NARROW[data];
oldPolys, polys: PolyList;
oldSpeed: REAL;
ok: BOOL;
[polys, ok] ← ToPolyList[args.first, vd];
IF NOT ok THEN RETURN;
oldPolys ← vd.polys;
oldSpeed ← vd.ctlPanel.speed;
vd.polys ← polys;
vd.ctlPanel.speed ← 0;
StepCmd[vd];
vd.ctlPanel.speed ← oldSpeed;
vd.polys ← oldPolys;
cooked ← polys;
END;
EvalLoad: Misp.EvalProc =
BEGIN
fileName: ROPE ← NARROW[args.first];
Load[fileName, environment, stack];
cooked ← $T;
END;
Load:
PUBLIC
PROC [fileName:
ROPE, env: Misp.Environment, stack: Misp.Stack] =
BEGIN
stream: IO.STREAM ← FS.StreamOpen[fileName: fileName, accessOptions: read];
DO
any: REF ANY;
[] ← stream.SkipWhitespace[];
IF stream.EndOf[] THEN EXIT;
any ← stream.GetRefAny[];
[] ← Misp.Eval[any, env, stack];
ENDLOOP;
stream.Close[];
END;
DefineHackBStuff:
PUBLIC
PROC [environment: Misp.Environment, vd: ViewerData] =
BEGIN
DefColor:
PROC [atom:
ATOM, color: Color] =
{Bind[env: environment, introduce: TRUE, pattern: atom, value: color]};
Defun[environment, $Load, EvalLoad];
Defun[environment, $Run, EvalRun, TRUE, vd];
Defun[environment, $Stop, EvalStop, TRUE, vd];
Defun[environment, $SetPolys, EvalSetPolys, TRUE, vd];
Defun[environment, $DrawPolys, EvalDrawPolys, TRUE, vd];
Defun[environment, $Print, EvalPrint, TRUE, vd];
Defun[environment, $SetMode, EvalSetMode, TRUE, vd];
Defun[environment, $SetSpeed, EvalSetSpeed, TRUE, vd];
Defun[environment, $ClosedPoly, EvalClosedPoly];
Defun[environment, $OpenPoly, EvalOpenPoly];
Defun[environment, $ListPoly, EvalListPoly];
Defun[environment, $StarHack, EvalStarHack];
Defun[environment, $StarHackWithBounds, EvalStarHackWithBounds];
Defun[environment, $RandomBouncePoly, EvalRandomBouncePoly];
Defun[environment, $RandomBounce, EvalRandomBounce];
Defun[environment, $Bounce, EvalBounce];
Defun[environment, $Wheel, EvalWheel];
Defun[environment, $Point, EvalPoint];
Defun[environment, $Spiro, EvalSpiro];
Defun[environment, $Sum, EvalSum];
Defun[environment, $OldSum, EvalOldSum];
Defun[environment, $Series, EvalSeries];
Defun[environment, $Liss, EvalLiss];
Defun[environment, $Constant, EvalConstant];
Defun[environment, $HalveFirst, EvalHalveFirst];
Defun[environment, $HalveLast, EvalHalveLast];
Defun[environment, $Choose, EvalChoose];
Defun[environment, $fromRGB, EvalFromRGB];
Defun[environment, $fromHSV, EvalFromHSV];
Defun[environment, $Coloring, EvalColoring, FALSE];
DefColor[$black, Imager.black];
DefColor[$white, Imager.white];
DefColor[$red, ImagerColor.ColorFromAtom[$Red]];
DefColor[$green, ImagerColor.ColorFromAtom[$Green]];
DefColor[$blue, ImagerColor.ColorFromAtom[$Blue]];
DefColor[$magenta, ImagerColor.ColorFromAtom[$Magenta]];
DefColor[$cyan, ImagerColor.ColorFromAtom[$Cyan]];
DefColor[$yellow, ImagerColor.ColorFromAtom[$Yellow]];
DefColor[$invert, ImagerColor.ColorFromAtom[$Invert]];
END;
Setup:
PROC =
BEGIN
vd: ViewerData;
iconFlavor: Icons.IconFlavor ← Icons.NewIconFromFile[file: "PolyHack.Icons", n: 0];
ViewerOps.RegisterViewerClass[flavor: hackFlavor, class: hackClass];
hackBSStyle ← BiScrollers.GetStyle[preferredHackBSStyle];
IF hackBSStyle = NIL THEN hackBSStyle ← BiScrollers.GetStyle[];
hackBiScrollerClass ← hackBSStyle.NewBiScrollerClass[[
flavor: hackBiScrollerFlavor,
extrema: HackExtrema,
notify: NotifyHack,
paint: PaintHack,
icon: iconFlavor,
menu: BiScrollers.bsMenu,
tipTable: TIPUser.InstantiateNewTIPTable["PolyHack.TIP"],
mayStretch: FALSE]];
vd ← CreateHack[vi: [name: "(BiScrolling) Poly Hack", iconic: FALSE], asBiScroller: TRUE];
END;
Setup[];
END.