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