
<<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 18, 1984 11:55:25 am PDT>>
<<Last Edited by: Pier, February 14, 1984 10:38:17 am PST>>

DIRECTORY
GriffinMemoryDefs: FROM "GriffinMemoryDefs",
MenuDefs,
GriffinDefs: FROM "GriffinDefs",
PointDefs: FROM "PointDefs",
DebuggerSwap: FROM "DebuggerSwap",
EncodingDefs: FROM "EncodingDefs",
ControllerDefs: FROM "ControllerDefs",
ScreenDefs USING [EraseBox],
Graphics USING [Context],
Rope USING [ROPE],
ObjectDefs: FROM "ObjectDefs";

ObjectFns: PROGRAM IMPORTS ObjectDefs, PointDefs,  GriffinMemoryDefs, EncodingDefs, DebuggerSwap, ScreenDefs,ControllerDefs
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;

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;
proc [rover];
rover _ next;
ENDLOOP;
END;

ForAllPictureObjects: PUBLIC PROCEDURE [proc: ObjectProc] = BEGIN
ForAllObjectsThroughObject[proc,GetTopPictureObj[]];
END;

ForAllVisibleObjects: PUBLIC PROCEDURE [proc: ObjectProc] = BEGIN
filter: ObjectProc = {
IF Visible[obj] THEN proc [obj] 
};
ForAllObjects[filter];
END;

ForAllVisiblePictureObjects: PUBLIC PROCEDURE [proc: ObjectProc] = BEGIN
filter: ObjectProc = {
IF Visible[obj] THEN 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;
proc [rover] ;
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;

<<hit test>>
GetObjectHandle: PUBLIC PROCEDURE [pt: PointDefs.ScrPt] RETURNS [ObjectHandle] =
BEGIN
new: ObjectHandle _  GetObjectHandleBetweenObjects[pt, NIL,NIL];
IF new#NIL THEN WITH type: new SELECT FROM
token => IF type.tokenType=selected THEN RETURN[type.isSelected];
ENDCASE;
RETURN[new];
END;

GetObjectHandleBetweenObjects: PUBLIC PROCEDURE [pt: PointDefs.ScrPt,
topObject,bottomObject: ObjectHandle] RETURNS [ObjectHandle] =
BEGIN OPEN EncodingDefs;
obj: REF Object;
tol: INTEGER;
IF topObject=NIL THEN topObject _ tailObject;
IF bottomObject=NIL THEN bottomObject _ headObject;
FOR obj _ topObject, obj.backLink
UNTIL obj = bottomObject DO
IF ~Visible[obj] THEN LOOP;
IF pt[X]<obj.tl[X] OR pt[X]>obj.br[X] OR pt[Y]<obj.tl[Y] OR pt[Y]>obj.br[Y]
THEN LOOP;
<<obj may be touched>>
WITH object: obj SELECT FROM
shape => BEGIN
tol _ MAX[1,ObjValToScrVal[object.style.width/2]];
IF TestTraj[pt,object.chainEncoding,tol]
THEN RETURN[obj]
ELSE IF obj.style.filled AND TestArea[pt,object.areaEncoding,tol]
THEN RETURN[obj];
END;
caption,token,menu => RETURN[obj];
ENDCASE;

ENDLOOP;
RETURN[NIL];
END;

ForAllInCluster: PUBLIC PROCEDURE [id: ClusterID,proc: ObjectProc] =
BEGIN
InCluster: ObjectProc = BEGIN
IF obj.cluster=id THEN proc[obj] ;
END;
ForAllPictureObjects[InCluster];
END;

ForAllInBoxDo: PUBLIC PROCEDURE[tl,br: PointDefs.ScrPt,proc: ObjectProc] RETURNS [hit: BOOLEAN] =
BEGIN
ntl: ScrPt _ tl;
nbr: ScrPt _ br;
Inside: ObjectProc = BEGIN
IF BoxInsideBox[obj.tl,obj.br,ntl,nbr] THEN 
BEGIN hit _ TRUE; proc[obj]; END;
END;
ntl[X] _ MIN[br[X],tl[X]];
ntl[Y] _ MIN[br[Y],tl[Y]];
nbr[X] _ MAX[br[X],tl[X]];
nbr[Y] _ MAX[br[Y],tl[Y]];
hit _ FALSE;
ForAllVisibleObjects[Inside];
RETURN;
END;

ForAllPictureObjectsInBoxDo: PUBLIC PROCEDURE[tl,br: PointDefs.ScrPt,proc: ObjectProc] RETURNS [hit: BOOLEAN] =
BEGIN
ntl: ScrPt _ tl;
nbr: ScrPt _ br;
Inside: ObjectProc = BEGIN
IF BoxInsideBox[obj.tl,obj.br,ntl,nbr] THEN 
BEGIN hit _ TRUE; proc[obj]; END;
END;
ntl[X] _ MIN[br[X],tl[X]];
ntl[Y] _ MIN[br[Y],tl[Y]];
nbr[X] _ MAX[br[X],tl[X]];
nbr[Y] _ MAX[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 [tl1[Y]..br1[Y]] AND br0[Y] IN [tl1[Y]..br1[Y]])
THEN RETURN[TRUE]
ELSE RETURN[FALSE];
END;

TestTraj: PROCEDURE[pt: ScrPt, encoding: EncodingDefs.ChainHandle,tol: INTEGER] RETURNS[BOOLEAN]=
BEGIN
flag: BOOLEAN _ FALSE;
SetFlag: PROCEDURE[found: PointDefs.ScrPt] RETURNS[stop: BOOLEAN]  = BEGIN
IF ABS[found[X]-pt[X]] > tol OR ABS[found[Y]-pt[Y]] > tol THEN RETURN[FALSE]
ELSE {flag _ TRUE; RETURN[TRUE]};
END;
UNTIL encoding=NIL DO
IF NOT ((pt[X] <encoding.tl[X]-tol) OR (pt[X] >encoding.br[X]+tol) 
OR (pt[Y] <encoding.tl[Y]-tol)  OR (pt[Y] >encoding.br[Y]+tol)) 
<<is now a possibility>>
THEN EncodingDefs.TestChainChunk[encoding,SetFlag];
IF flag THEN RETURN[TRUE];
encoding _ encoding.link;
ENDLOOP;
RETURN[FALSE];
END;

TestArea: PROCEDURE[pt: ScrPt, encoding: EncodingDefs.AreaHandle,tol: INTEGER] RETURNS[BOOLEAN]=
BEGIN
flag: BOOLEAN _ FALSE;
SetFlag: PROCEDURE[y,lx,dx: INTEGER] RETURNS[stop: BOOLEAN]  = BEGIN
rx: INTEGER _ lx+dx+tol;
lx _ lx-tol;
IF pt[Y]=y AND pt[X] IN [lx..rx] THEN {flag _ TRUE; RETURN[TRUE] }
ELSE RETURN[FALSE];
END;
UNTIL encoding=NIL DO
IF NOT ((pt[X] <encoding.tl[X]-tol) OR (pt[X] >encoding.br[X]+tol) 
OR (pt[Y] <encoding.tl[Y]-tol)  OR (pt[Y] >encoding.br[Y]+tol)) 
<<is now a possibility>>
THEN EncodingDefs.TestAreaChunk[encoding,SetFlag];
IF flag THEN RETURN[TRUE];
encoding _ encoding.link;
ENDLOOP;
RETURN[FALSE];
END;

ReplotAllObjects: PUBLIC PROCEDURE[dc: Graphics.Context] =
BEGIN
ReplotFromObject[headObject.link, dc];
END;

<<if followed by a WriteLink, the chain encoding will get appended>>
AddLink: PUBLIC PROCEDURE[obj: REF shape Object,link: REF Link]=
BEGIN
linkptr: REF Link _ NIL;
IF obj=NIL OR link=NIL THEN RETURN;
obj.validEncoding _ FALSE;
WITH objlinks: obj.trajectory SELECT FROM
linked => BEGIN
IF objlinks.links=NIL THEN BEGIN
objlinks.links _ link;
RETURN;
END
ELSE linkptr _ objlinks.links;
END;
ENDCASE => RETURN;    --could signal bad case
UNTIL linkptr.link=NIL DO linkptr _ linkptr.link ENDLOOP;
linkptr.link _ link;
END;

<<DeleteLink does Erase, which is a hack for the moment>>
DeleteLink: PUBLIC PROCEDURE[obj: REF shape Object,link: REF Link]=
BEGIN
linkptr: REF Link _ NIL;
i: CARDINAL _ 0;
tl,br: ScrPt;
encoding: EncodingDefs.ChainHandle _ obj.chainEncoding;
trailer,delete: EncodingDefs.ChainHandle _ NIL;
WITH objlinks:obj.trajectory SELECT FROM
linked => BEGIN
IF objlinks.links=NIL THEN  RETURN;
IF objlinks.links=link THEN BEGIN
objlinks.links _ FreeLink[objlinks.links];
EraseObject[obj];
delete _ obj.chainEncoding;
obj.chainEncoding _ NIL;
END
ELSE BEGIN
FOR linkptr _ objlinks.links, linkptr.link UNTIL linkptr = NIL  OR linkptr.link=link DO
i _ i+1;
ENDLOOP;
IF linkptr=NIL THEN DebuggerSwap.CallDebugger["link not found"];
i _ i+1;    --linkptr is on the previous link
linkptr.link _ FreeLink[link];
END;
END;
ENDCASE => ERROR;    --better be a linked object
<<encoding chunks are marked with a link number ("i" above).  run thru, find the set belonging to the>>
<<deleted link, erase the box, then delete the encoding.>>
IF i#0 THEN BEGIN
UNTIL encoding=NIL OR i=encoding.linknumber DO 
trailer _ encoding;
encoding _ encoding.link;
ENDLOOP;
IF encoding=NIL THEN DebuggerSwap.CallDebugger["encoding not found"];
delete _ encoding;
UNTIL encoding=NIL OR i#encoding.linknumber DO 
encoding _ encoding.link;
ENDLOOP;
IF trailer=NIL THEN obj.chainEncoding _ encoding ELSE trailer.link _ encoding;
<<GetMbb and DeleteChainEncoding take a chain of chunks ending in NIL;>>
IF encoding#NIL THEN
FOR trailer _ delete,trailer.link UNTIL trailer.link=encoding DO ENDLOOP;
trailer.link _ NIL;
<<erase the link>>
[tl,br] _ GetMbb[delete,obj.style.width];
ScreenDefs.EraseBox[tl,br, NIL];
ReplotBox[tl,br, NIL];
END;
<<delete the encoding and compute new mbb>>
EncodingDefs.DeleteChainEncoding[delete];
[tl,br] _ GetMbb[obj.chainEncoding,obj.style.width];
obj.tl _ tl;
obj.br _ br;
END;

<<duplicate in show objects.  Is here because deletelink is doing the erase as well>>
GetMbb: PROCEDURE[encoding: EncodingDefs.ChainHandle,width: REAL] RETURNS[tl,br: ScrPt]=
BEGIN
halfwidth: INTEGER _ (ObjValToScrVal[width]+1)/2;
ptr: EncodingDefs.ChainHandle _ encoding;
IF ptr=NIL THEN RETURN[[0,0],[0,0]];
tl _ ptr.tl;
br _ ptr.br;
UNTIL ptr=NIL DO
IF ptr.tl[X] < tl[X] THEN tl[X] _ ptr.tl[X];
IF ptr.tl[Y] < tl[Y] THEN tl[Y] _ ptr.tl[Y];
IF ptr.br[X] > br[X] THEN br[X] _ ptr.br[X];
IF ptr.br[Y] > br[Y] THEN br[Y] _ ptr.br[Y];
ptr _ ptr.link;
ENDLOOP;
tl[X] _ tl[X]-halfwidth; tl[Y] _tl[Y]-halfwidth;
br[X] _ br[X]+halfwidth; br[Y] _br[Y]+halfwidth;
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 => -- 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]];
menu =>  obj _ CZone.NEW[Object[menu]];
ENDCASE => ERROR;
obj.view _ CurrentView;
};

AddToken: PUBLIC PROCEDURE[pt: PointDefs.ScrPt,type: TokenType] =
BEGIN
obj: REF Object[token] _ NARROW[StartObject[token]];
obj.tl _ [pt[X]-4,pt[Y]-4];
obj.br _ [pt[X]+4,pt[Y]+4];
obj.validEncoding _ TRUE;
obj.tokenType _ type;
obj.p0 _ ScrToObj[pt];
obj.isSelected _ NIL;
IF type=open THEN obj.cluster _ OpenCluster;    --is always clustered with linkedobj
PlotOneObject[obj,write];
END;

DeleteAllCPs: PUBLIC PROCEDURE =
BEGIN
deleteCP: ObjectProc = {
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] =
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: PROCEDURE[ObjectHandle]]  =
BEGIN
DoSelected: ObjectProc = BEGIN
IF obj.selected = TRUE AND Visible[obj] THEN proc[obj] ;
END;
ForAllPictureObjects[DoSelected];
END;

SelectObject: PUBLIC PROCEDURE[obj: ObjectHandle]  RETURNS [ObjectHandle]=
BEGIN
token: REF Object[token];
IF obj=NIL OR obj.selected = TRUE THEN RETURN[NIL];
IF obj.objectType=token  OR obj.objectType=menu 
THEN RETURN[NIL];
obj.selected _ TRUE;
token _ NARROW[StartObject[token]];
token.tokenType _ selected;
token.p0 _ [0,0];
token.isSelected _ obj;
token.view _ obj.view;
RETURN[token];
END;

DeSelectObject: PUBLIC PROCEDURE[obj: ObjectHandle] =
BEGIN
IF obj=NIL OR obj.selected = FALSE THEN RETURN
ELSE BEGIN
token: ObjectHandle _ ReturnSelected[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[token] _ NIL;
SelectOneObject: PROCEDURE[obj: ObjectHandle] =
BEGIN
IF obj.selected = TRUE THEN RETURN;
IF obj.objectType=token  OR obj.objectType=menu 
THEN RETURN;
obj.selected _ TRUE;
IF token = NIL THEN token _ NARROW[StartObject[token]];
token.tokenType _ selected;
token.p0 _ [0,0];
token.isSelected _ obj;
token.view _ obj.view;
END;
ForAllInCluster[id, SelectOneObject];
RETURN[token];
END;

DeSelectCluster: PUBLIC PROCEDURE[id: ClusterID] =
BEGIN
token: ObjectHandle;
tokenFound: BOOLEAN _ FALSE;
DeSelectOneObject: PROCEDURE [obj: ObjectHandle] =
BEGIN
IF obj.selected _ FALSE THEN RETURN;
obj.selected _ FALSE;
IF tokenFound OR (token _ ReturnSelected[obj]) = NIL
THEN RETURN;
token _ DeleteObject[token];
tokenFound _ TRUE;
END;
ForAllInCluster[id, DeSelectOneObject];
END;

ReturnSelected: PUBLIC PROCEDURE[object: ObjectHandle]  RETURNS[ObjectHandle] =
BEGIN
obj: ObjectHandle _ headObject.link;
UNTIL obj = tailObject DO
WITH token: obj SELECT FROM
token => IF token.tokenType = selected AND token.isSelected = object
THEN RETURN[obj];
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.chainEncoding _ EncodingDefs.CopyChainEncoding[obj.chainEncoding];
newobj.areaEncoding _ EncodingDefs.CopyAreaEncoding[obj.areaEncoding];
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[token] => BEGIN
newobj: REF Object[token] _ NARROW[StartObject[token]];
newobj.tokenType _ obj.tokenType;
newobj.p0 _ obj.p0;
newobj.isSelected _ NIL;
return _ newobj;
END;
ENDCASE;
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.validEncoding _ object.validEncoding;
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];
menuRef: REF Object[menu] => DeleteMenu[menuRef];
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;
ControllerDefs.ExpungeStyles[];
END;

DeleteMenu: PROCEDURE[menu: REF menu Object] = {
rover: MenuDefs.MenuItemHandle _ NARROW[menu.head];
temp: MenuDefs.MenuItemHandle;
UNTIL rover = NIL DO
rover.menu _ NIL;    --delete backpointers
rover.proc _ NIL;    --delete proc references
temp _ rover.link;
rover.link _ NIL;    --break up the list (not necessary but tidy)
rover _ temp;
ENDLOOP;
};

DeleteShape: PROCEDURE[shape: REF shape Object] =
BEGIN
IF shape=NIL THEN RETURN;
EncodingDefs.DeleteAreaEncoding[shape.areaEncoding];
EncodingDefs.DeleteChainEncoding[shape.chainEncoding];
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;

EmergencyDeleteEncodings: PUBLIC PROCEDURE =
BEGIN
DeleteEncodings: ObjectProc =
BEGIN OPEN EncodingDefs;
WITH object: obj SELECT FROM
shape => BEGIN
DeleteAreaEncoding[object.areaEncoding];
DeleteChainEncoding[object.chainEncoding];
object.areaEncoding _ NIL;
object.chainEncoding _ NIL;
END;
ENDCASE;
END;
[]_DeleteObject[tailObject.backLink];    --this one may be trash
ForAllObjects[DeleteEncodings];
END;

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.