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] 𡤋r[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;
[]�leteObject[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.