Compiler ObjectFns/n
mstone April 30, 1981 1:24 PM
geoff December 6, 1979 10:45 AM
everyone December 11, 1979 12:15 AM
Last Edited by: Stone, June 14, 1983 10:43 am
Last Edited by: Pier, February 14, 1984 10:38:17 am PST
DIRECTORY
GriffinMemoryDefs: FROM "GriffinMemoryDefs",
PointDefs,
Rope USING [ROPE],
GriffinEncoding,
ObjectDefs: FROM "ObjectDefs";
ObjectFns: CEDAR PROGRAM IMPORTS ObjectDefs, PointDefs, GriffinMemoryDefs, GriffinEncoding
EXPORTS ObjectDefs =
BEGIN OPEN ObjectDefs,PointDefs,GriffinMemoryDefs;
headObject: REF Object ← NIL; --bottom object
tailObject: REF Object ← NIL; --top object
CurrentView: View ← main;
ROPE: TYPE = Rope.ROPE;
selectTokenSize: INT = 5;
tokenSize: INT = 4;
GetCurrentView: PUBLIC PROCEDURE RETURNS [View]=
BEGIN RETURN[CurrentView];
END;
SetCurrentView: PUBLIC PROCEDURE[view: View]=
BEGIN
CurrentView ← view;
END;
Visible: PUBLIC PROCEDURE[object: ObjectHandle] RETURNS[BOOLEAN]=
BEGIN
IF object.deleted OR object.view#CurrentView OR ~object.visible OR object.cull=outside
THEN RETURN[FALSE] ELSE RETURN[TRUE];
END;
GetNextClusterID: PUBLIC PROCEDURE RETURNS[id: ClusterID] =
BEGIN
GetID: ObjectProc = BEGIN
IF obj.cluster > id THEN id ← obj.cluster;
END;
id ← OpenCluster; --[0..OpenCluster] are reserved
ForAllObjects[GetID];
RETURN[id+1];
END;
ForAllObjects: PUBLIC PROCEDURE [proc: ObjectProc] = BEGIN
rover,next: ObjectHandle;
rover ← headObject.link;
UNTIL rover = tailObject DO
next ← rover.link;
IF proc [rover] THEN EXIT;
rover ← next;
ENDLOOP;
END;
ForAllObjectsReversed: PUBLIC PROCEDURE [proc: ObjectProc] = BEGIN
rover,next: ObjectHandle;
rover ← tailObject;
UNTIL rover = headObject DO
next ← rover.backLink;
IF proc [rover] THEN EXIT;
rover ← next;
ENDLOOP;
END;
ForAllPictureObjects: PUBLIC PROCEDURE [proc: ObjectProc] = BEGIN
filter: ObjectProc = {
IF obj.objectType=shape OR obj.objectType=caption THEN RETURN[proc [obj]]
};
ForAllObjects[filter];
END;
ForAllVisibleObjects: PUBLIC PROCEDURE [proc: ObjectProc] = BEGIN
filter: ObjectProc = {
IF Visible[obj] THEN RETURN[proc [obj]]
};
ForAllObjects[filter];
END;
ForAllVisiblePictureObjects: PUBLIC PROCEDURE [proc: ObjectProc] = BEGIN
filter: ObjectProc = {
IF Visible[obj] THEN RETURN[proc [obj]]
};
ForAllPictureObjects[filter];
END;
ForAllObjectsThroughObject: PUBLIC PROCEDURE [proc: ObjectProc,
lastObj: ObjectHandle] = BEGIN
rover,next: ObjectHandle;
rover ← headObject.link;
UNTIL rover = tailObject DO
next ← rover.link;
IF rover = lastObj THEN next ← tailObject;
IF proc [rover] THEN EXIT;
rover ← next;
ENDLOOP;
END;
GetTopPictureObj: PUBLIC PROCEDURE RETURNS [top: ObjectHandle] =
BEGIN
top ← tailObject.backLink;
UNTIL top.objectType = caption OR
top.objectType = shape DO
top ← top.backLink; ENDLOOP;
RETURN;
END;
GetNextObject: PUBLIC PROCEDURE [obj: ObjectHandle] RETURNS [ObjectHandle] =
BEGIN
IF obj=NIL THEN RETURN[NIL];
obj ←obj.link;
UNTIL obj=NIL OR Visible[obj] DO obj ← obj.link ENDLOOP;
RETURN[obj];
END;
ForAllInCluster: PUBLIC PROCEDURE [id: ClusterID,proc: ObjectProc] =
BEGIN
InCluster: ObjectProc = BEGIN
IF obj.cluster=id THEN RETURN[proc[obj]];
END;
ForAllPictureObjects[InCluster];
END;
ForAllInBoxDo: PUBLIC PROCEDURE[tl,br: PointDefs.ScrPt,proc: ObjectProc] RETURNS [hit: BOOLEAN] =
BEGIN
ntl, nbr: ScrPt ← tl;
Inside: ObjectProc = BEGIN
IF BoxInsideBox[obj.tl,obj.br,ntl,nbr] THEN
BEGIN hit ← TRUE; RETURN[proc[obj]]; END;
END;
ntl[X] ← MIN[br[X],tl[X]];
ntl[Y] ← MAX[br[Y],tl[Y]];
nbr[X] ← MAX[br[X],tl[X]];
nbr[Y] ← MIN[br[Y],tl[Y]];
hit ← FALSE;
ForAllVisibleObjects[Inside];
RETURN;
END;
ForAllPictureObjectsInBoxDo: PUBLIC PROCEDURE[tl,br: PointDefs.ScrPt,proc: ObjectProc] RETURNS [hit: BOOLEAN] =
BEGIN
ntl, nbr: ScrPt ← tl;
Inside: ObjectProc = BEGIN
IF BoxInsideBox[obj.tl,obj.br,ntl,nbr] THEN
BEGIN hit ← TRUE; RETURN[proc[obj]]; END;
END;
ntl[X] ← MIN[br[X],tl[X]];
ntl[Y] ← MAX[br[Y],tl[Y]];
nbr[X] ← MAX[br[X],tl[X]];
nbr[Y] ← MIN[br[Y],tl[Y]];
hit ← FALSE;
ForAllVisiblePictureObjects[Inside];
RETURN;
END;
first set in second set
BoxInsideBox: PROCEDURE[tl0,br0,tl1,br1: ScrPt] RETURNS [BOOLEAN]=
BEGIN
IF (tl0[X] IN [tl1[X]..br1[X]] AND br0[X] IN [tl1[X]..br1[X]]
AND tl0[Y] IN [br1[Y]..tl1[Y]] AND br0[Y] IN [br1[Y]..tl1[Y]])
THEN RETURN[TRUE]
ELSE RETURN[FALSE];
END;
Add a link and make its encoding
AppendLink: PUBLIC PROCEDURE[obj: REF shape Object, link: REF Link] RETURNS [GriffinEncoding.Link] =
TRUSTED BEGIN
encoding: GriffinEncoding.Link;
IF obj=NIL OR link=NIL THEN ERROR;
WITH objlinks: obj.trajectory SELECT FROM
linked => BEGIN
IF objlinks.links=NIL THEN BEGIN
objlinks.links ← link;
END
ELSE BEGIN
linkptr: REF Link ← objlinks.links;
UNTIL linkptr.link=NIL DO linkptr ← linkptr.link ENDLOOP;
linkptr.link ← link;
END;
END;
ENDCASE => ERROR; --could signal bad case
encoding ←
IF link.degree=D1 THEN GriffinEncoding.EncodeLinearLink[link.knots]
ELSE GriffinEncoding.EncodeCubicLink[link.knots, obj.trajectory.splineType];
obj.edgeEncoding ←
IF obj.edgeEncoding=NIL THEN GriffinEncoding.EncodeEdge[LIST[encoding]]
ELSE GriffinEncoding.AppendLink[obj.edgeEncoding, encoding];
obj.validEncoding ← TRUE;
RETURN[encoding];
END;
RemoveLastLink: PUBLIC PROCEDURE[obj: REF shape Object] RETURNS [GriffinEncoding.Link] =
TRUSTED BEGIN
index: NAT ← 0;
WITH objlinks:obj.trajectory SELECT FROM
linked => BEGIN
encoding: GriffinEncoding.Link;
IF objlinks.links=NIL THEN ERROR;
IF objlinks.links.link=NIL THEN objlinks.links ← NIL --only one link
ELSE {
prev, lptr: REF Link;
FOR lptr ← objlinks.links, lptr.link UNTIL lptr.link = NIL DO prev ← lptr; ENDLOOP;
prev.link ← FreeLink[lptr];
};
encoding ← GriffinEncoding.RemoveLastLink[obj.edgeEncoding];
obj.tl ← PointDefs.ScrRealToScr[obj.edgeEncoding.tl];
obj.br ← PointDefs.ScrRealToScr[obj.edgeEncoding.br];
RETURN[encoding];
END;
ENDCASE => ERROR; --better be a linked object
END;
does allocate and links the object in on top
StartObject: PUBLIC PROCEDURE[type: ObjectType] RETURNS [ObjectHandle] =
BEGIN
object: ObjectHandle ← AllocateObject[type];
LinkObject[object];
RETURN[object];
END;
LinkObject: PROC [new: ObjectHandle] = {
rover: ObjectHandle;
IF new=NIL THEN RETURN;
rover ← tailObject;
SELECT new.objectType FROM
menu => NULL;
token, selectToken => -- under menus
UNTIL rover.backLink.objectType=token
OR rover.backLink.objectType=shape
OR rover.backLink.objectType=caption
DO rover ← rover.backLink;
ENDLOOP;
shape,caption => -- under runtime objects
UNTIL rover.backLink.objectType=caption OR rover.backLink.objectType=shape
DO rover ← rover.backLink;
ENDLOOP;
ENDCASE => ERROR;
InsertAfter[new, rover.backLink];
};
AllocateObject: PROC [type: ObjectType] RETURNS [obj: ObjectHandle] = {
ENABLE UNWIND => {obj ← NIL}; 
SELECT type FROM
shape => obj ← CZone.NEW[Object[shape]];
caption => obj ← CZone.NEW[Object[caption]];
token => obj ← CZone.NEW[Object[token]];
selectToken => obj ← CZone.NEW[Object[selectToken]];
menu => obj ← CZone.NEW[Object[menu]];
ENDCASE => ERROR;
obj.view ← CurrentView;
};
GetTokenBoundingBox: PUBLIC PROC[token: REF Object[token]] RETURNS [tl,br: ScrPt] = {
pt: ScrPt ← ObjToScr[token.p0];
tl ← [pt[X]-tokenSize, pt[Y]+tokenSize];
br ← [pt[X]+tokenSize+1, pt[Y]-tokenSize-1];
};
GetSelectTokenBoundingBox: PUBLIC PROC[token: REF selectToken Object] RETURNS [tl,br: ScrPt] = {
pt: ScrPt ← ObjToScr[token.p0];
tl ← [pt[X]-selectTokenSize, pt[Y]+selectTokenSize];
br ← [pt[X]+selectTokenSize, pt[Y]-selectTokenSize];
};
AddToken: PUBLIC PROCEDURE[pt: PointDefs.ScrPt,type: TokenType] =
BEGIN
obj: REF Object[token] ← NARROW[StartObject[token]];
obj.p0 ← ScrToObj[pt];
[obj.tl, obj.br] ← GetTokenBoundingBox[obj];
obj.validEncoding ← TRUE;
obj.tokenType ← type;
IF type=open THEN obj.cluster ← OpenCluster; --is always clustered with linkedobj
PlotOneObject[obj];
END;
DeleteAllCPs: PUBLIC PROCEDURE =
BEGIN
deleteCP: ObjectProc = TRUSTED {
WITH token: obj SELECT FROM
token =>
IF token.tokenType = open OR token.tokenType = CP
THEN obj ← DeleteObject[obj];
ENDCASE;
};
ForAllObjects[deleteCP];
END;
ReadCPs: PUBLIC PROCEDURE RETURNS[array: PointDefs.ObjPtSequence] =
TRUSTED BEGIN ENABLE UNWIND => {array ← NIL}; 
obj: REF Object ← headObject.link;
ntokens: INTEGER ← 0;
UNTIL obj = tailObject DO
WITH token: obj SELECT FROM
token => IF token.tokenType = CP OR token.tokenType = open
THEN ntokens ← ntokens+1;
ENDCASE;
obj ← obj.link;
ENDLOOP;
IF ntokens=0 THEN BEGIN
array ← NIL;
RETURN;
END;
array ← CZone.NEW[ObjPtSequenceRec[ntokens]];
obj ← headObject.link;
ntokens ← 0;
UNTIL obj = tailObject DO
WITH token: obj SELECT FROM
token => IF token.tokenType = CP OR token.tokenType = open THEN BEGIN
array[ntokens] ← token.p0;
ntokens ← ntokens+1;
END;
ENDCASE;
obj ← obj.link;
ENDLOOP;
END;
ForAllSelectedDo: PUBLIC PROCEDURE[proc: ObjectProc] =
BEGIN
DoSelected: ObjectProc = BEGIN
IF obj.selected = TRUE AND Visible[obj] THEN RETURN[proc[obj]];
END;
ForAllPictureObjects[DoSelected];
END;
SelectObject: PUBLIC PROCEDURE[obj: ObjectHandle] RETURNS [ObjectHandle]=
BEGIN
token: REF Object[selectToken];
IF obj=NIL OR obj.selected = TRUE THEN RETURN[NIL];
IF obj.objectType=token OR obj.objectType=menu OR obj.objectType=selectToken
THEN RETURN[NIL];
obj.selected ← TRUE;
token ← CreateSelectToken[obj];
RETURN[token];
END;
LocateSelectToken: PROCEDURE [token: REF selectToken Object, object: ObjectHandle] = TRUSTED BEGIN
screenLoc: PointDefs.ScrPt;
WITH typedObj: object SELECT FROM
caption => screenLoc ← ObjToScr[typedObj.p0];
shape => BEGIN
screenLoc ← GriffinEncoding.PointForSelectToken[typedObj.edgeEncoding];
END;
ENDCASE => ERROR;
token.p0 ← PointDefs.ScrToObj[screenLoc];
END;
CreateSelectToken: PROC [forObject: ObjectHandle] RETURNS [REF Object[selectToken]] ~ {
token: REF Object[selectToken] ← NARROW[StartObject[selectToken]];
pt: ScrPt ← ObjToScr[[0,0]];
LocateSelectToken[token, forObject];
[token.tl,token.br] ← GetSelectTokenBoundingBox[token];
[token.tl, token.br] ← GetSelectTokenBoundingBox[token];
token.validEncoding ← TRUE;
token.located ← TRUE;
token.selectedObj ← forObject;
token.view ← forObject.view;
RETURN[token];
};
DeSelectObject: PUBLIC PROCEDURE[obj: ObjectHandle] =
BEGIN
IF obj=NIL OR obj.selected = FALSE THEN RETURN
ELSE BEGIN
token: ObjectHandle ← ReturnSelectToken[obj];
obj.selected ← FALSE;
IF token=NIL THEN RETURN;
token ← DeleteObject[token];
END;
END;
SelectCluster: PUBLIC PROCEDURE[id: ClusterID] RETURNS [ObjectHandle]=
BEGIN
token: REF Object[selectToken] ← NIL;
SelectOneObject: ObjectProc =
BEGIN
IF obj.selected = TRUE OR obj.objectType=token OR obj.objectType=menu
THEN RETURN[FALSE];
obj.selected ← TRUE;
IF token = NIL THEN token ← CreateSelectToken[obj];
END;
ForAllInCluster[id, SelectOneObject];
RETURN[token];
END;
DeSelectCluster: PUBLIC PROCEDURE[id: ClusterID] =
BEGIN
token: ObjectHandle;
tokenFound: BOOLEAN ← FALSE;
DeSelectOneObject: ObjectProc =
BEGIN
IF obj.selected ← FALSE THEN RETURN[FALSE];
obj.selected ← FALSE;
IF tokenFound OR (token ← ReturnSelectToken[obj]) = NIL
THEN RETURN[FALSE];
token ← DeleteObject[token];
tokenFound ← TRUE;
END;
ForAllInCluster[id, DeSelectOneObject];
END;
ReturnSelectToken: PUBLIC PROCEDURE[object: ObjectHandle] RETURNS[REF Object[selectToken]] =
BEGIN
obj: ObjectHandle ← headObject.link;
UNTIL obj = tailObject DO
WITH obj SELECT FROM
token: REF Object[selectToken] => IF token.selectedObj = object THEN RETURN[token];
ENDCASE;
obj ← obj.link;
ENDLOOP;
RETURN[NIL];
END;
does a Start object, fills in all the info from the indicated object
doesn't copy selected field or cluster info
CopyObject: PUBLIC PROCEDURE [object: ObjectHandle] RETURNS [ObjectHandle] =
BEGIN
return: ObjectHandle ← NIL;
IF object=NIL THEN RETURN[NIL];
WITH object SELECT FROM
obj: REF Object[shape] => BEGIN
newobj: REF Object[shape] ← NARROW[StartObject[shape]];
newobj.closed ← obj.closed;
newobj.trajectory ← CopyTrajectory[obj.trajectory];
newobj.edgeEncoding ← NIL;
newobj.areaEncoding ← NIL;
EncodeObject[newobj]; --rather than copying the encoding
return ← newobj;
END;
obj: REF Object[caption] => BEGIN
newobj: REF Object[caption] ← NARROW[StartObject[caption]];
newobj.p0 ← obj.p0;
newobj.text ← obj.text;
return ← newobj;
END;
obj: REF Object[selectToken] => ERROR;
obj: REF Object[token] => ERROR;
ENDCASE;
return.validEncoding ← TRUE;
return.style ← object.style;
return.cluster ← 0;
return.view ← object.view;
return.deleted ← object.deleted;
return.visible ← object.visible;
return.selected ← FALSE;
return.cull ← object.cull;
return.tl ← object.tl;
return.br ← object.br;
RETURN[return];
END;
CopyTrajectory: PROCEDURE[traj: REF Trajectory] RETURNS[REF Trajectory]=
BEGIN 
WITH traj SELECT FROM
type: REF Trajectory[linked] => BEGIN
ptr: REF Link ← type.links;
firstlink: REF Link ← NIL;
thislink,newlink: REF Link;
newtraj: REF Trajectory[linked] ← NEW [Trajectory[linked]];
UNTIL ptr=NIL DO
ENABLE UNWIND => newtraj ←NIL;
newlink ← CZone.NEW[Link];
newlink^ ← [NIL,ptr.degree,CopyKnots[ptr.knots]];
IF firstlink=NIL THEN thislink ← firstlink ← newlink
ELSE BEGIN
thislink.link ← newlink;
thislink ← newlink;
END;
ptr ← ptr.link;
ENDLOOP;
newtraj.splineType ← type.splineType;
newtraj.links ← firstlink;
RETURN[newtraj];
END;
type: REF Trajectory[cyclic] => {
newtraj: REF Trajectory[cyclic] ← NEW [Trajectory[cyclic]];
newtraj.splineType ← traj.splineType;
newtraj.knots ← CopyKnots[type.knots];
RETURN[newtraj];
};
ENDCASE;
RETURN [NIL];
END;
CopyKnots: PROCEDURE[array: PointDefs.ObjPtSequence] RETURNS[newarray: PointDefs.ObjPtSequence]=
BEGIN ENABLE UNWIND => {newarray ← NIL}; 
newarray ← CZone.NEW[ObjPtSequenceRec[array.length]];
FOR i: NAT IN [0..array.length) DO newarray[i] ← array[i]; ENDLOOP;
END;
SinkObject: PUBLIC PROCEDURE[object: ObjectHandle]=
BEGIN
IF object.backLink=headObject THEN RETURN; --already on bottom
UnlinkObject[object];
InsertAfter[object,headObject];
END;
FloatObject: PUBLIC PROCEDURE[object: ObjectHandle]=
BEGIN
IF TopPicture[object] THEN RETURN;
remove object
UnlinkObject[object];
LinkObject[object];
END;
FlipUpObject: PUBLIC PROCEDURE[object: ObjectHandle]=
BEGIN
nextobj: ObjectHandle;
IF TopPicture[object] THEN RETURN;
nextobj ← object.link;
UNTIL Visible[nextobj] OR TopPicture[nextobj] DO nextobj ← nextobj.link; ENDLOOP;
IF ~Visible[nextobj] THEN RETURN; --already top visible
UnlinkObject[object];
insert after next object
InsertAfter[object,nextobj];
END;
TopPicture: PROCEDURE[object: ObjectHandle] RETURNS[BOOLEAN] = INLINE
BEGIN
IF object.link.objectType=token OR object.link.objectType=menu
THEN RETURN[TRUE] ELSE RETURN[FALSE];
END;
UnlinkObject: PROCEDURE[object: ObjectHandle]=
BEGIN
object.backLink.link ← object.link;
object.link.backLink ← object.backLink;
object.link ← NIL;
object.backLink ← NIL;
END;
InsertAfter: PROCEDURE[object,prevobj: ObjectHandle]=
BEGIN
object.link ← prevobj.link; 
object.backLink ← prevobj;
prevobj.link ← object;
object.link.backLink ← object; 
END;
FlipDownObject: PUBLIC PROCEDURE[object: ObjectHandle]=
BEGIN
prevobj: ObjectHandle;
IF object.backLink=headObject THEN RETURN; --already on bottom
prevobj ← object.backLink;
UNTIL Visible[prevobj] OR prevobj.backLink=headObject DO
prevobj ← prevobj.backLink;
ENDLOOP;
IF ~Visible[prevobj] THEN RETURN; --already bottom visible object
UnlinkObject[object];
link it in after prevobj.backLink
InsertAfter[object, prevobj.backLink];
END;
unlinks object. Set up for undo
DeleteObject: PUBLIC PROCEDURE[object: ObjectHandle] RETURNS[next:ObjectHandle]=
BEGIN
IF object=NIL THEN RETURN[NIL];
next ← object.link;
UnlinkObject[object];
WITH object SELECT FROM
shapeRef: REF Object[shape] => DeleteShape[shapeRef];
ENDCASE;
END;
ExpungeObjects: PUBLIC PROCEDURE=
BEGIN
obj: ObjectHandle ← headObject;
UNTIL obj=NIL DO
IF obj.deleted THEN obj ← DeleteObject[obj]
ELSE obj ← obj.link;
ENDLOOP;
END;
DeleteShape: PROCEDURE[shape: REF shape Object] =
TRUSTED BEGIN
IF shape=NIL THEN RETURN;
shape.edgeEncoding ← NIL;
shape.areaEncoding ← NIL;
WITH type: shape.trajectory SELECT FROM
linked => BEGIN
link: REF Link ← type.links;
UNTIL link=NIL DO
link ← FreeLink[link];
ENDLOOP;
END;
cyclic => type.knots ← NIL;
ENDCASE;
shape.trajectory ← NIL;
END;
FreeLink: PROCEDURE[link: REF Link] RETURNS[next: REF Link]=
BEGIN
next ← link.link;
link.knots ← NIL;
END;
InitObjectFns: PUBLIC PROC = {
headObject ← AllocateObject[caption];
tailObject ← AllocateObject[menu];
headObject.visible ← tailObject.visible ← FALSE;
headObject.validEncoding ← tailObject.validEncoding ← TRUE;
headObject.cull ← tailObject.cull ← outside;
headObject.link ← tailObject;
tailObject.backLink ← headObject;
headObject.backLink ← NIL;
tailObject.link ← NIL;
};
END.