-- Compiler ObjectFns/n
-- mstone April 30, 1981  1:24 PM
-- geoff December 6, 1979  10:45 AM
-- everyone December 11, 1979  12:15 AM

DIRECTORY
	GriffinStartDefs: FROM "GriffinStartDefs",
	GriffinMemoryDefs: FROM "GriffinMemoryDefs",
	GriffinDefs: FROM "GriffinDefs",
	PointDefs: FROM "PointDefs",
	MiscDefs: FROM "MiscDefs",
	InlineDefs: FROM "InlineDefs",
	EncodingDefs: FROM "EncodingDefs",
	ControllerDefs: FROM "ControllerDefs",
	ScreenDefs: FROM "ScreenDefs",
	StringDefs: FROM "StringDefs",
	ObjectDefs: FROM "ObjectDefs";

ObjectFns: PROGRAM IMPORTS ObjectDefs, PointDefs,  GriffinMemoryDefs, EncodingDefs, MiscDefs, InlineDefs,ScreenDefs,StringDefs, ControllerDefs
	EXPORTS ObjectDefs, GriffinStartDefs = 
BEGIN OPEN ObjectDefs,PointDefs,GriffinMemoryDefs;

headObject: POINTER TO Object _ NIL;	--bottom object
tailObject: POINTER TO Object _ NIL;	--top object
CurrentView: View _ main;

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.selected];
	ENDCASE;
RETURN[new];
END;

GetObjectHandleBetweenObjects: PUBLIC PROCEDURE [pt: PointDefs.ScrPt,
		topObject,bottomObject: ObjectHandle] RETURNS [ObjectHandle] =
BEGIN OPEN EncodingDefs;
obj: POINTER TO 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: POINTER TO EncodingDefs.ChainEncoding,tol: INTEGER] RETURNS[BOOLEAN]=
BEGIN
flag: BOOLEAN _ FALSE;
SetFlag: PROCEDURE[found: PointDefs.ScrPt]  = BEGIN
	IF flag THEN RETURN;	--true hit look no more
	IF ABS[found[X]-pt[X]] > tol OR ABS[found[Y]-pt[Y]] > tol THEN RETURN;
--indicate found
	flag _ 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.PlotChainChunk[encoding,SetFlag];
	IF flag THEN RETURN[TRUE];
	encoding _ encoding.link;
	ENDLOOP;
RETURN[FALSE];
END;

TestArea: PROCEDURE[pt: ScrPt, encoding: POINTER TO EncodingDefs.AreaEncoding,tol: INTEGER] RETURNS[BOOLEAN]=
BEGIN
flag: BOOLEAN _ FALSE;
SetFlag: PROCEDURE[y,lx,dx: INTEGER]  = BEGIN
	rx: INTEGER _ lx+dx+tol;
	IF flag THEN RETURN;	--true hit look no more
	lx _ lx-tol;
	IF pt[Y]=y AND pt[X] IN [lx..rx] THEN flag _ 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.PlotAreaChunk[encoding,SetFlag];
	IF flag THEN RETURN[TRUE];
	encoding _ encoding.link;
	ENDLOOP;
RETURN[FALSE];
END;

ReplotAllObjects: PUBLIC PROCEDURE =
BEGIN
ReplotFromObject[headObject.link];
END;

--if followed by a WriteLink, the chain encoding will get appended
AddLink: PUBLIC PROCEDURE[obj: POINTER TO shape Object,link: POINTER TO Link]=
BEGIN
linkptr: POINTER TO 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: POINTER TO shape Object,link: POINTER TO Link]=
BEGIN
linkptr: POINTER TO Link _ NIL;
i: CARDINAL _ 0;
tl,br: ScrPt;
encoding: POINTER TO EncodingDefs.ChainEncoding _ obj.chainEncoding;
trailer,delete: POINTER TO EncodingDefs.ChainEncoding _ 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 MiscDefs.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 MiscDefs.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];
	ReplotBox[tl,br];
	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: POINTER TO EncodingDefs.ChainEncoding,width: REAL] RETURNS[tl,br: ScrPt]=
BEGIN
halfwidth: INTEGER _ (ObjValToScrVal[width]+1)/2;
ptr: POINTER TO EncodingDefs.ChainEncoding _ 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 => {Free[obj]; obj _ NIL};	
SELECT type FROM
	shape => BEGIN
		obj _ Allocate[SIZE[shape Object]];
		obj.body _ shape[FALSE,,NIL,NIL];	--set the tag, elid trajectory
		END;
	caption => BEGIN
		obj _ Allocate[SIZE[caption Object]];
		obj.body _ caption[[-1,-1],NIL];	--set the tag
		END;
	token => BEGIN
		obj _ Allocate[SIZE[token Object]];
		obj.body _ token[,,];	--set the tag;
		END;
	menu => BEGIN
		obj _ Allocate [SIZE [menu Object]];
		obj.body _ menu [vertical,NIL];	-- set the tag;
		END;
	ENDCASE;
obj^_[NIL,NIL,NIL,0,CurrentView,FALSE,TRUE,FALSE,partial,FALSE,[0,0],[0,0],];
};

AddToken: PUBLIC PROCEDURE[pt: PointDefs.ScrPt,type: TokenType] =
BEGIN
obj: ObjectHandle _ StartObject[token];
obj.tl _ [pt[X]-4,pt[Y]-4];
obj.br _ [pt[X]+4,pt[Y]+4];
obj.validEncoding _ TRUE;
obj.body _ token[type,ScrToObj[pt],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: DESCRIPTOR FOR ARRAY OF PointDefs.ObjPt] =
BEGIN ENABLE UNWIND => {array _ DESCRIPTOR[NIL,0]};	
obj: POINTER TO 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 _ DESCRIPTOR[NIL,0];
	RETURN;
	END;
array _ DESCRIPTOR[Allocate[ntokens*SIZE[PointDefs.ObjPt]],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: ObjectHandle;
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 _ StartObject[token];
token.body _ token[selected,[0,0],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: ObjectHandle _ 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 BEGIN
		token _ StartObject[token];
		token.body _ token[selected,[0,0],obj];
		token.view _ obj.view;
		END
	    ELSE token.body _ token[selected,[0,0],obj];
	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.selected = 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 newobj: ObjectHandle _ NIL;
IF object=NIL THEN RETURN[NIL];
BEGIN ENABLE UNWIND => {Free[newobj]; newobj _ NIL};	
WITH obj: object SELECT FROM
	shape => BEGIN
		newobj _ StartObject[shape];
		newobj.body _ shape[obj.closed,CopyTrajectory[obj.trajectory],
			CopyChainEncoding[obj.chainEncoding],
			CopyAreaEncoding[obj.areaEncoding]];
		END;
	caption => BEGIN
		string: STRING _ AllocateString[obj.text.length];
		StringDefs.AppendString[from: obj.text, to: string];
		newobj _ StartObject[caption];
		newobj.body _ caption[obj.p0,string];
		END;
	token => BEGIN
		newobj _ StartObject[token];
		newobj.body _ token[obj.tokenType,obj.p0,NIL];
		END;
	ENDCASE;
{OPEN object; newobj^ _
	[,,style,0,view,deleted,visible,FALSE,cull,validEncoding,tl,br,]};
RETURN[newobj];
END;
END;

CopyTrajectory: PROCEDURE[traj: Trajectory] RETURNS[newtraj: Trajectory]=
BEGIN	
WITH type: traj SELECT FROM
	linked => BEGIN
		ptr: POINTER TO Link _ type.links;
		firstlink: POINTER TO Link _ NIL;
		thislink,newlink: POINTER TO Link ;
		UNTIL ptr=NIL DO
				ENABLE UNWIND => newtraj _ [traj.splineType,linked[NIL]];
			newlink _ Allocate[SIZE[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 _ [traj.splineType,linked[firstlink]];
		END;
	cyclic => newtraj _ [traj.splineType,cyclic[CopyKnots[type.knots]]];
	ENDCASE;
END;

CopyChainEncoding: PROCEDURE[chain: POINTER TO EncodingDefs.ChainEncoding] RETURNS[newchain: POINTER TO EncodingDefs.ChainEncoding]=
--should really carefully clean up and deallocate, I suppose
BEGIN OPEN EncodingDefs; ENABLE UNWIND => {newchain _ NIL};
length: INTEGER;
firstChunk: POINTER TO ChainEncoding _ NIL;
thisChunk,ptr: POINTER TO ChainEncoding;
FOR ptr _ chain, ptr.link UNTIL ptr=NIL DO
	IF firstChunk=NIL THEN firstChunk _ thisChunk _Allocate[SIZE[ChainEncoding]]
	ELSE BEGIN 
		thisChunk.link _ Allocate[SIZE[ChainEncoding]];
		thisChunk _ thisChunk.link;
		END;
	thisChunk^ _ ptr^;
	length _ LENGTH[ptr.octants];
	thisChunk.octants _ DESCRIPTOR[Allocate[(length+1)/2],length];
	InlineDefs.COPY[BASE[ptr.octants],(length+1)/2,BASE[thisChunk.octants]];
	ENDLOOP;
newchain _ firstChunk;
END;

CopyAreaEncoding: PROCEDURE[oldarea: POINTER TO EncodingDefs.AreaEncoding] RETURNS[newarea: POINTER TO EncodingDefs.AreaEncoding]=
BEGIN OPEN EncodingDefs; ENABLE UNWIND => {newarea _ NIL};
length: INTEGER;
firstArea: POINTER TO AreaEncoding _ NIL;
thisArea,areaptr: POINTER TO AreaEncoding;
ptr: POINTER;
FOR areaptr _ oldarea, areaptr.link UNTIL areaptr=NIL DO
	IF firstArea=NIL THEN firstArea _ thisArea _Allocate[SIZE[AreaEncoding]]
	ELSE BEGIN 
		thisArea.link _ Allocate[SIZE[AreaEncoding]];
		thisArea _ thisArea.link;
		END;
	thisArea^ _ areaptr^;
	WITH area: areaptr SELECT FROM
		shortrun => BEGIN
			ptr _ BASE[area.runs];
			length _ LENGTH[area.runs];
			END;
		longrun => BEGIN
			ptr _ BASE[area.runs];
			length _ LENGTH[area.runs];
			END;
		ENDCASE;
	WITH area: thisArea SELECT FROM
		shortrun => BEGIN
			area.runs _ DESCRIPTOR[Allocate[length*SIZE[ShortRun]],length];
			InlineDefs.COPY[ptr,length*SIZE[ShortRun],BASE[area.runs]];
			END;
		longrun => BEGIN
			area.runs _ DESCRIPTOR[Allocate[length*SIZE[LongRun]],length];
			InlineDefs.COPY[ptr,length*SIZE[LongRun],BASE[area.runs]];
			END;
		ENDCASE;
	ENDLOOP;
newarea _ firstArea;
END;

CopyKnots: PROCEDURE[array: DESCRIPTOR FOR ARRAY OF ObjPt] RETURNS[newarray: DESCRIPTOR FOR ARRAY OF ObjPt]=
BEGIN ENABLE UNWIND => {newarray _ DESCRIPTOR[NIL,0]};	
newarray _ DESCRIPTOR[Allocate[SIZE[ObjPt]*LENGTH[array]],LENGTH[array]];
InlineDefs.COPY[BASE[array],SIZE[ObjPt]*LENGTH[array],BASE[newarray]];
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 body: object SELECT FROM
	shape => BEGIN
		EncodingDefs.DeleteAreaEncoding[body.areaEncoding];
		EncodingDefs.DeleteChainEncoding
			[body.chainEncoding];
		DeleteTrajectory[@body.trajectory];
		END;
	token => NULL;
	caption => NULL;
	ENDCASE;
Free[object];
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;

DeleteTrajectory: PROCEDURE[traj: POINTER TO Trajectory] =
BEGIN
IF traj=NIL THEN RETURN;
WITH type: traj SELECT FROM
	linked => BEGIN
		link: POINTER TO Link _ type.links;
		tmp: POINTER TO Link _ NIL;
		UNTIL link=NIL DO
			link _ FreeLink[link];
			ENDLOOP;
		END;
	cyclic =>  Free[BASE[type.knots]];
	ENDCASE;
END;

FreeLink: PROCEDURE[link: POINTER TO Link] RETURNS[next: POINTER TO Link]=
BEGIN
next _ link.link;
Free[BASE[link.knots]];
Free[link];
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.(896)