<<>> <> <> <> <> <> <> <> <<>> DIRECTORY Args, Commander, EmbeddedButtons, FS, GGActive, GGFileIn, GGInterfaceTypes, GGModelTypes, GGScene, GGState, GGWindow, Imager, IO, MJSContainers, Process, Real, RealFns, Rope, ScreenCoordsTypes, SlackProcess, TEditDocumentPrivate, TiogaActive, TiogaOps, TIPTypes, TIPUser, ViewerClasses, ViewerOps, ViewerTools; DrawShapesImpl: CEDAR PROGRAM IMPORTS Args, Commander, EmbeddedButtons, FS, GGActive, GGFileIn, GGScene, GGState, GGWindow, Imager, IO, MJSContainers, Real, RealFns, Rope, SlackProcess, TEditDocumentPrivate, TiogaActive, TiogaOps, TIPUser, ViewerOps, ViewerTools = BEGIN ROPE: TYPE = Rope.ROPE; Viewer: TYPE = ViewerClasses.Viewer; ViewerRec: TYPE = ViewerClasses.ViewerRec; ViewerClass: TYPE = ViewerClasses.ViewerClass; ViewerClassRec: TYPE = ViewerClasses.ViewerClassRec; Container: TYPE = MJSContainers.MJSContainer; ActiveDoc: TYPE = EmbeddedButtons.ActiveDoc; DSState: TYPE = REF DSStateObj; DSStateObj: TYPE = RECORD [ cursorX: INT, cursorY: INT, oldCursorX: INT, oldCursorY: INT, objectListHead: Object, objectListTail: Object, drawingArea: Viewer, controlPanel: ActiveDoc, controlPanelViewer: Viewer, slackHandle: SlackProcess.SlackHandle ]; Object: TYPE = REF ObjectRec; ObjectRec: TYPE = RECORD [ next: Object, type: ATOM, data: REF]; Rectangle: TYPE = REF RectangleRep; RectangleRep: TYPE = RECORD [ strokeWidth: REAL, x, y, w, h: INT]; Circle: TYPE = REF CircleRep; CircleRep: TYPE = RECORD [ strokeWidth: REAL, x, y, r: INT]; CreateState: PROC [] RETURNS [state: DSState] = { state ¬ NEW[DSStateObj ¬ [ cursorX: 0, cursorY: 0, oldCursorX: 0, oldCursorY: 0, objectListHead: NIL, objectListTail: NIL, drawingArea: NIL, controlPanel: NIL, slackHandle: NIL ]]; }; DrawShapesCommand: Commander.CommandProc = { <> encl: Container; da: Viewer; cp: Container; controlPanelType: ControlPanelType ¬ tioga; state: DSState ¬ CreateState[]; <<>> IF Args.NArgs[cmd] > 0 THEN IF Rope.Equal[Args.GetRope[cmd, 0], "gargoyle", FALSE] THEN controlPanelType ¬ gargoyle; <> encl ¬ MJSContainers.Create[ viewerFlavor: $VanillaMJSContainer, info: [ name: "DrawShapes", caption: TRUE, scrollable: FALSE, iconic: TRUE, data: state ] ]; da ¬ CreateDrawingArea[encl, state]; MJSContainers.ChildXBound[encl, da]; MJSContainers.ChildYBound[encl, da]; state.drawingArea ¬ da; cp ¬ CreateControlPanel[encl, controlPanelType, state]; MJSContainers.ChildXBound[encl, cp]; state.slackHandle ¬ SlackProcess.Create[optimizeProc: NIL]; [] ¬ SlackProcess.EnableAborts[state.slackHandle]; }; Notify: ViewerClasses.NotifyProc = { <> <<>> state: DSState ¬ NARROW[self.data]; <> SlackProcess.QueueAction[state.slackHandle, HandleEvent, input, state, NIL]; }; Paint: ViewerClasses.PaintProc = { <> x, y, cw: INT; state: DSState ¬ NARROW[self.data]; <> IF whatChanged ~= NIL AND state.oldCursorX ~= 0 THEN { x ¬ state.oldCursorX; y ¬ state.oldCursorY; cw ¬ cursorWidth; Imager.SetColor[context, Imager.MakeGray[0.0]]; PaintCursor[context, x, y]; Imager.SetColor[context, Imager.MakeGray[1.0]]; <> FOR object: Object ¬ state.objectListHead, object.next UNTIL object = NIL DO IF IsInside[object, x-cw, x+cw, y-cw, y+cw] THEN Draw[object, context]; ENDLOOP; }; IF whatChanged = NIL THEN whatChanged ¬ state.objectListHead; IF ISTYPE[whatChanged, Object] THEN { FOR object: Object ¬ NARROW[whatChanged], object.next UNTIL object = NIL DO Draw[object, context]; ENDLOOP; }; IF state.cursorX ~= 0 THEN { PaintCursor[context, state.cursorX, state.cursorY]; }; state.oldCursorX ¬ state.cursorX; state.oldCursorY ¬ state.cursorY; }; HandleEvent: SlackProcess.ActionProc = { <> event: LIST OF REF ¬ NARROW[inputAction]; s: ScreenCoordsTypes.TIPScreenCoords; changed: REF ANY ¬ NIL; state: DSState ¬ NARROW[clientData]; <> IF event.first = $Clear THEN { state.objectListHead ¬ NIL; state.objectListTail ¬ NIL; ViewerOps.PaintViewer[state.drawingArea, all, TRUE, NIL]; changed ¬ NIL; } ELSE IF event.first = $Thicker THEN { currentStrokeWidth, newWidth: REF INT; currentStrokeWidth ¬ NARROW[EmbeddedButtons.GetValue[$StrokeWidth, state.controlPanel]]; newWidth ¬ NEW[INT ¬ currentStrokeWidth­ + 1]; EmbeddedButtons.SetValue[$StrokeWidth, newWidth, state.controlPanel]; } ELSE IF event.first = $Thinner THEN { currentStrokeWidth, newWidth: REF INT; currentStrokeWidth ¬ NARROW[EmbeddedButtons.GetValue[$StrokeWidth, state.controlPanel]]; newWidth ¬ NEW[INT ¬ MAX[1, currentStrokeWidth­ - 1]]; EmbeddedButtons.SetValue[$StrokeWidth, newWidth, state.controlPanel]; } ELSE IF Matches[event, LIST[$Circle]] > 0 THEN { EmbeddedButtons.SetValue[$Shape, $Circle, state.controlPanel]; } ELSE IF Matches[event, LIST[$Rectangle]] > 0 THEN { EmbeddedButtons.SetValue[$Shape, $Rectangle, state.controlPanel]; }; <> IF Matches[event, LIST[$Down, $Up, $StillDown]] > 0 THEN { FOR l: LIST OF REF ANY ¬ event, l.rest UNTIL l = NIL DO IF ISTYPE[l.first, ScreenCoordsTypes.TIPScreenCoords] THEN s ¬ NARROW[l.first]; ENDLOOP; }; IF Matches[event, LIST[$Left, $StillDown, $Down]] > 1 THEN { IF s.mouseX ~= state.cursorX OR s.mouseY ~= state.cursorY THEN { state.cursorX ¬ s.mouseX; state.cursorY ¬ s.mouseY; changed ¬ $Cursor; }; } ELSE IF Matches[event, LIST[$Right, $Up]] > 1 THEN { o: Object ¬ NEW[ObjectRec ¬ [ next: NIL, type: NARROW[EmbeddedButtons.GetValue[$Shape, state.controlPanel]], data: NIL]]; IF o.type = $Rectangle THEN { strokeWidth: INT ¬ 2; r: Rectangle; WITH EmbeddedButtons.GetValue[$StrokeWidth, state.controlPanel] SELECT FROM refInt: REF INT => strokeWidth ¬ refInt­; ENDCASE => strokeWidth ¬ 1; r ¬ NEW[RectangleRep ¬ [ strokeWidth: strokeWidth, x: state.cursorX, y: state.cursorY, w: s.mouseX - state.cursorX, h: s.mouseY - state.cursorY]]; IF r.w < 0 THEN { r.x ¬ r.x + r.w; r.w ¬ -r.w; }; IF r.h < 0 THEN { r.y ¬ r.y + r.h; r.h ¬ -r.h; }; o.data ¬ r; } ELSE IF o.type = $Circle THEN { fx: REAL ¬ s.mouseX - state.cursorX; -- floating point conversion fy: REAL ¬ s.mouseY - state.cursorY; -- floating point conversion strokeWidth: INT ¬ 2; c: Circle; WITH EmbeddedButtons.GetValue[$StrokeWidth, state.controlPanel] SELECT FROM refInt: REF INT => strokeWidth ¬ refInt­; ENDCASE => strokeWidth ¬ 1; c ¬ NEW[CircleRep ¬ [ strokeWidth: strokeWidth, x: state.cursorX, y: state.cursorY, r: Real.Round[RealFns.SqRt[RealFns.Power[ABS[fx], 2.0] + RealFns.Power[ABS[fy], 2.0]]]]]; o.data ¬ c; }; <> IF state.objectListHead = NIL THEN { state.objectListHead ¬ o; state.objectListTail ¬ o; } ELSE { state.objectListTail.next ¬ o; state.objectListTail ¬ o; }; state.cursorX ¬ 0; state.cursorY ¬ 0; changed ¬ o; }; IF changed ~= NIL THEN ViewerOps.PaintViewer[state.drawingArea, all, FALSE, changed]; }; CreateDrawingArea: PROC [parent: Viewer, state: DSState] RETURNS [da: Viewer] = { da ¬ ViewerOps.CreateViewer[ flavor: $DrawShapesDrawingArea, info: [ parent: parent, data: state, wy: 110, wx: 0] ]; }; ControlPanelType: TYPE = {gargoyle, tioga}; CreateControlPanel: PROC [parent: Viewer, type: ControlPanelType, state: DSState] RETURNS [cp: Viewer] = { cp ¬ MJSContainers.Create[ viewerFlavor: $VanillaMJSContainer, info: [ name: "DrawShapes Control Panel", scrollable: FALSE, parent: parent, wh: 100, wx: 0, wy: 0] ]; IF type = gargoyle THEN PutGargoyleControlPanelInContainer[cp, state] ELSE PutTiogaControlPanelInContainer[cp, state]; }; PutGargoyleControlPanelInContainer: PROC [cp: Container, state: DSState] = { c: GGModelTypes.Camera ¬ GGScene.CreateDefaultCamera[]; s: IO.STREAM; scene: GGModelTypes.Scene ¬ GGScene.CreateScene[]; success: BOOL; name: ROPE; gv: Viewer; ggData: GGInterfaceTypes.GGData; s ¬ FS.StreamOpen["DrawShapes.gargoyle"]; [success, name] ¬ GGFileIn.FileinSceneOnly[s, scene, FALSE, c]; [gv, ggData] ¬ GGWindow.CreateChildViewer[scene: scene, parent: cp, workingDirectory: NIL]; GGState.SetActive[ggData, TRUE]; MJSContainers.ChildXBound[cp, gv]; MJSContainers.ChildYBound[cp, gv]; state.controlPanel ¬ GGActive.LookupDoc[ggData]; IO.Close[s]; <<>> ViewerOps.PaintViewer[cp, all]; EmbeddedButtons.LinkDocToApplication[doc: state.controlPanel, target: $DrawShapes, targetViewer: state.drawingArea, applicationData: NIL, notifyProc: NIL]; }; PutTiogaControlPanelInContainer: PROC [cp: Container, state: DSState] = { v: Viewer; v ¬ ViewerTools.MakeNewTextViewer[[ parent: cp, data: "Loading control panel...", scrollable: TRUE, border: TRUE]]; MJSContainers.ChildXBound[cp, v]; MJSContainers.ChildYBound[cp, v]; state.controlPanel ¬ TiogaActive.LookupDoc[v]; <<>> ViewerOps.PaintViewer[cp, all]; v ¬ TEditDocumentPrivate.DoLoadFile[v, "DrawShapesControlPanel.tioga"]; state.controlPanelViewer ¬ v; EmbeddedButtons.LinkDocToApplication[doc: state.controlPanel, target: $DrawShapes, targetViewer: state.drawingArea, applicationData: NIL, notifyProc: NIL]; TiogaOps.Interpret[state.controlPanelViewer, LIST[$ActivityOn]]; }; ClearControlPanel: ViewerClasses.DestroyProc = { <> <> }; PaintCursor: PROC [context: Imager.Context, x, y: INT] = { cw: INT ¬ cursorWidth; DrawCursor: Imager.PathProc = { moveTo[[x - cw, y]]; lineTo[[x + cw, y]]; moveTo[[x, y - cw]]; lineTo[[x, y + cw]]; }; Imager.SetStrokeWidth[context, 1]; Imager.MaskStroke[context, DrawCursor, FALSE]; }; IsInside: PROC [object: Object, x, xm, y, ym: INT] RETURNS [b: BOOL ¬ FALSE] = { IF object.type = $Rectangle THEN { r: Rectangle ¬ NARROW[object.data]; s: INT ¬ Real.Round[r.strokeWidth]; IF r.y-s < ym AND r.y+s > y AND r.x-s < xm AND r.x+r.w+s > x THEN b ¬ TRUE; IF r.y+r.h-s < ym AND r.y+r.h+s > y AND r.x-s < xm AND r.x+r.w+s > x THEN b ¬ TRUE; IF r.x-s < xm AND r.x+s > x AND r.y-s < ym AND r.y+r.h+s > y THEN b ¬ TRUE; IF r.x+r.w-s < xm AND r.x+r.w+s > x AND r.y-s < ym AND r.y+r.h+s > y THEN b ¬ TRUE; } ELSE IF object.type = $Circle THEN { c: Circle ¬ NARROW[object.data]; nx, ny, fx, fy: INT; mx: INT ¬ (x + xm) / 2; my: INT ¬ (y + ym) / 2; nd, fd, rx, ry, rx2, ry2, floatr: REAL; <> IF mx < c.x THEN { nx ¬ xm; fx ¬ x; } ELSE { nx ¬ x; fx ¬ xm; }; IF my < c.y THEN { ny ¬ ym; fy ¬ y; } ELSE { ny ¬ y; fy ¬ ym }; rx ¬ nx - c.x; rx2 ¬ fx - c.x; ry ¬ ny - c.y; ry2 ¬ fy - c.y; floatr ¬ c.r; nd ¬ RealFns.SqRt[RealFns.Power[ABS[rx], 2.0] + RealFns.Power[ABS[ry], 2.0]]; fd ¬ RealFns.SqRt[RealFns.Power[ABS[ry], 2.0] + RealFns.Power[ABS[ry2], 2.0]]; IF nd < floatr + c.strokeWidth AND fd > floatr THEN b ¬ TRUE; } ELSE {}; }; Draw: PROC [object: Object, context: Imager.Context] = { IF object.type = $Rectangle THEN { r: Rectangle ¬ NARROW[object.data]; <> RectanglePath: Imager.PathProc = { moveTo[[r.x + r.w / 2, r.y]]; lineTo[[r.x + r.w, r.y]]; lineTo[[r.x + r.w, r.y + r.h]]; lineTo[[r.x, r.y + r.h]]; lineTo[[r.x, r.y]]; lineTo[[r.x + r.w / 2, r.y]]; }; <> Imager.SetStrokeWidth[context, r.strokeWidth]; <> Imager.MaskStroke[context, RectanglePath, TRUE]; } ELSE IF object.type = $Circle THEN { c: Circle ¬ NARROW[object.data]; <> CirclePath: Imager.PathProc = { moveTo[[c.x - c.r, c.y]]; arcTo[[c.x + c.r, c.y], [c.x - c.r, c.y]]; }; <> Imager.SetStrokeWidth[context, c.strokeWidth]; <> Imager.MaskStroke[context, CirclePath, TRUE]; } ELSE {}; }; Matches: PROC[a, b: LIST OF REF ANY] RETURNS[result: INT ¬ 0] = { FOR c: LIST OF REF ANY ¬ a, c.rest UNTIL c = NIL DO FOR d: LIST OF REF ANY ¬ b, d.rest UNTIL d = NIL DO IF c.first = d.first THEN result ¬ result + 1; <> <> ENDLOOP; ENDLOOP; }; cursorWidth: INT ¬ 5; tipTable: TIPTypes.TIPTable ¬ TIPUser.InstantiateNewTIPTable["DrawShapes.tip"]; ViewerOps.RegisterViewerClass[$DrawShapesDrawingArea, NEW[ViewerClassRec ¬ [ flavor: $DrawShapesDrawingArea, notify: Notify, paint: Paint, destroy: ClearControlPanel, tipTable: tipTable]]]; Commander.Register[key: "DrawShapes", proc: DrawShapesCommand, doc: "DrawShapes [gargoyle] -- An extremely simple drawing program. If the 'gargoyle' option is chosen, a Gargoyle illustration is used as the control panel", clientData: NIL, interpreted: TRUE]; END.