

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