<> <> 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.