DrawShapesImpl.mesa
Copyright Ó 1989, 1991, 1992 by Xerox Corporation. All rights reserved.
Contents: A test application with an active document as a control panel. Allows the drawing of simple shapes.
Goodisman, July 21, 1989 2:54:21 pm PDT
Bier, February 10, 1993 6:05 pm PST
Doug Wyatt, April 20, 1992 3:25 pm PDT
Kenneth A. Pier, August 13, 1992 4:19 pm PDT
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 = {
PROC [cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL];
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;
Create enclosing container
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 = {
PROC [self: Viewer, input: LIST OF REF ANY];
state: DSState ¬ NARROW[self.data];
Queue this event for processing.
SlackProcess.QueueAction[state.slackHandle, HandleEvent, input, state, NIL];
};
Paint: ViewerClasses.PaintProc = {
PROC [self: Viewer, context: Imager.Context, whatChanged: REF, clear: BOOL]
RETURNS [quit: BOOL ← FALSE];
x, y, cw: INT;
state: DSState ¬ NARROW[self.data];
Erase the cursor if necessary
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]];
Redraw any necessary objects
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 = {
PROC [clientData: REF ANY, inputAction: REF];
event: LIST OF REF ¬ NARROW[inputAction];
s: ScreenCoordsTypes.TIPScreenCoords;
changed: REF ANY ¬ NIL;
state: DSState ¬ NARROW[clientData];
Application Events
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];
};
User Events
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;
};
Add the object to the list of objects
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 = {
PROC [self: Viewer];
TiogaOps.Interpret[state.controlPanelViewer, LIST[$RedReset]];
};
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;
Find the closest corner and furthest corner
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];
Define the drawing path
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]];
};
Set the stroke width
Imager.SetStrokeWidth[context, r.strokeWidth];
Draw it
Imager.MaskStroke[context, RectanglePath, TRUE];
}
ELSE
IF object.type = $Circle
THEN {
c: Circle ¬ NARROW[object.data];
Define the drawing path
CirclePath: Imager.PathProc = {
moveTo[[c.x - c.r, c.y]];
arcTo[[c.x + c.r, c.y], [c.x - c.r, c.y]];
};
Set the stroke width
Imager.SetStrokeWidth[context, c.strokeWidth];
Draw it
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;
IF c.first = $Up AND d.first = $Down THEN RETURN[0];
IF c.first = $Down AND d.first = $Up THEN RETURN[0];
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.