-- 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",
	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];
	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;

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.
ĘČ˜JšĪĪcō
œ
Īk	œžœ$žœžœžœ žœ"žœžœžœžœžœžœžœ
žœcžœžœ
žœ6žœ
žœœžœ
žœ
œžœžœžœĪnœžœ
ž	œ
žœ	žœ
žœžœŸœžœ
ž	œžœžœŸœžœ
ž	œžœ
žœžœ
žœžœžœžœžœ
žœ
žœžœ
žœ
žœžœŸœžœ
ž	œ
žœžœžœžœžœžœ œžœžœŸ
œžœ
ž	œžœ4žœžœ4žœžœŸœžœ
ž	œžœ6žœŸœžœ
ž	œžœžœžœ(žœŸœžœ
ž	œžœžœžœ0žœŸœžœ
ž	œ.žœ4žœžœžœžœ4žœžœŸœžœ
ž	œ
žœžœžœžœžœžœžœžœŸ
œžœ
ž	œžœžœ
žœžœ
žœ
žœ
žœžœžœ
žœžœžœžœžœŸœžœ
ž	œžœžœ8žœ
žœžœžœ
žœ
žœžœ
žœžœžœ
žœžœžœžœŸœžœ
ž	œ?žœžœ
žœžœžœžœžœ
žœžœžœ
žœžœ!žœžœ
žœžœ
žœžœž
œ	ž
œžœž
œ	ž
œžœž
œ	ž
œžœž
œ	ž
œžœ
žœžœ
žœ
žœžœ	žœ,žœ*žœ
žœžœ
žœžœ)žœ
žœ	žœžœžœžœžœ
žœžœŸœžœ
ž	œ$žœžœžœžœžœ#žœŸ
œžœ
ž	œ*žœžœžœ8žœžœ%žœžœžœ
žœžœž
œžœž
œž
œž
œžœž
œž
œž
œžœž
œž
œž
œžœž
œž
œ
žœ žœžœŸœžœ
ž	œ*žœžœžœ8žœžœ%žœžœžœ
žœžœž
œžœž
œž
œž
œžœž
œž
œž
œžœž
œž
œž
œžœž
œž
œ
žœ'žœžœŸœž	œžœžœžœ
žœž
œžœž
œž
œžœž
œžœž
œž
œžœž
œžœž
œž
œžœž
œžœž
œž
œžœ
žœ
žœžœ
žœ
žœžœŸœž	œ4žœžœ
žœžœžœžœŸœž	œžœžœžœžœ
žœž
œž
œ	žœ
žœž
œž
œ	žœ
ž
œžœ	žœžœžœžœ
žœ
žœžœ
žœž
œž
œžœž
œž
œžœž
œž
œžœž
œž
œ	œžœ1žœžœ
žœ
žœžœžœ
žœžœŸœž	œ3žœžœ
žœžœžœžœŸœž	œ
žœ
žœžœžœžœžœž
œžœž
œžœ
žœ	žœžœ
žœžœ
žœ
žœžœžœ
žœ
žœžœ
žœž
œž
œžœž
œž
œžœž
œž
œžœž
œž
œ	œžœ0žœžœ
žœ
žœžœžœ
žœžœŸœžœ
ž	œžœ(žœCŸœžœ
ž	œžœžœžœ
žœžœžœžœ
žœžœ
žœ
žœžœžœžœ
žœžœžœžœ
žœ
žœžœžœžœžœžœžœžœžœ
žœžœžœ8Ÿ
œžœ
ž	œžœžœžœ
žœžœžœwžœžœžœ
žœžœžœžœ
žœžœžœžœ
žœvžœžœžœ
žœžœ(žœžœžœžœžœžœ	žœ
žœ9"œ#žœžœžœžœģ
žœžœ
žœžœ
žœ
žœžœ6žœžœ
žœ
žœGžœ
žœ
žœžœ žœžœ	žœ
žœžœGœ
žœ
žœ
žœžœžœžœ
žœžœœGžœžœžœ*œyžœTŸœž	œ+žœžœžœžœJžœžœ
žœ
žœ)žœžœ
žœžœž
œž
œžœž
œž
œžœž
œž
œžœž
œž
œžœž
œž
œžœž
œž
œžœž
œž
œžœž
œž
œžœž
œž
œž
œž
œž
œž
œž
œž
œ
žœ/Ÿœžœ
ž	œžœžœBžœ
žœŸ
œžœ.žœžœ
žœ
žœžœžœ	žœœ
žœ%žœ&žœ%žœžœœ
žœ#žœ#žœžœžœžœ(Ÿœžœžœžœ
žœžœžœžœžœ*žœ*žœ'žœžœŸœžœ
ž	œ(žœžœžœ#ž
œž
œž
œž
œžœ@žœžœžœ%œžœŸœžœ
ž	œžœžœžœ
žœžœžœžœžœžœžœŸœžœ
ž	œ
žœ#žœ
žœ
žœ
žœ	žœ$žœžœžœžœžœ
žœžœžœ
žœžœžœžœžœžœ
žœ
žœžœžœžœAžœžœžœžœ
žœžœžœ
žœžœ
žœ:žœžœžœžœŸœžœ
ž	œž	œžœžœžœžœ
žœžœžœ$žœŸœžœ
ž	œžœžœžœžœžœ
žœžœ
žœ
žœ
žœžœžœžœ
žœ
žœžœ
žœsžœ	žœŸœžœ
ž	œžœ
žœžœ
žœžœ
žœ
žœ
žœ
žœ=žœžœžœ
žœ
žœ!žœžœŸ
œžœ
ž	œžœžœžœžœŸœž	œžœžœžœ
žœ
žœžœžœžœ
žœžœžœ	žœ
žœ	žœxžœ(žœ	žœŸœžœ
ž	œžœ"žœžœŸœž	œžœžœžœ
žœ
žœžœžœžœ!žœžœ
žœ.žœžœ*žœŸœžœ
ž	œžœžœ&žœžœžœžœ
žœžœžœžœ
žœ	žœžœžœ
žœžœuŸ
œžœ
ž	œžœžœžœžœžœ
žœ
žœ
žœžœžœ
žœžœžœžœĪsœ”žœžœžœžœ œ]žœžœžœžœ œfžœžœžœŸžœ
žœŸœž	œžœ
žœ
žœžœžœžœ
žœžœžœžœ!žœžœžœžœžœžœžœ
žœžœ
žœ
žœžœžœ&žœžœ
žœ#žœ
žœ:žœžœIžœ
žœ	žœ$žœžœjžœžœžœžœžœŸ	œž	œ!žœ%žœ
žœ
žœžœžœ"žœžœ
žœžœžœžœŸ
œžœ
ž	œžœ
žœžœ
žœœ6žœŸœžœ
ž	œžœ
žœžœ
žœœ*žœŸœžœ
ž	œžœžœžœ
žœžœžœžœžœžœžœ
žœœœžœŸ
œž	œžœ
žœžœ
žœ
žœžœžœ
žœ
žœžœ
žœ
žœžœŸœž	œžœ[žœžœžœŸœž	œ žœpžœŸœžœ
ž	œžœžœžœ
žœœžœžœžœžœžœžœ
žœ œ$œ'žœ#Ÿœžœ
ž	œžœžœ
žœžœ
žœ
žœ
žœ.žœžœ
žœžœ*žœžœŸœžœ
ž	œžœ!žœžœ
žœžœ
žœžœžœ"žœŸœž	œžœžœ
žœžœ
žœ
žœnžœžœ
žœžœ	žœžœžœ
žœžœžœžœžœžœžœŸœž	œžœžœžœžœ žœžœŸœžœ
ž	œžœ žœ
žœžœ
žœ
žœžœqžœžœžœžœžœ(œ žœvžœ8žœ…
žœžœžœ
˜īž
—…—Or`@