-- File: DisjointControl.mesa
-- Test program for generating disjoint cells
-- Written by Martin Newell/Dan Fitzpatrick February 1981
-- Last edited (Alto/Pilot): 11-Aug-81 14:56:59

DIRECTORY

CIFUtilitiesDefs: FROM "CIFUtilitiesDefs" USING [ClearClipRectangle],
DisjointAllocDefs: FROM "DisjointAllocDefs" USING [AllocateSymbol, LookupSymbol, PrintAlloc, AllocateRectangle, FreeRectangle, EnumerateSymbols, AllocateGeometry, MakeSymbol, MakeInstance, MakeGeometry, AllocateInstance],
DisjointCollapseDefs: FROM "DisjointCollapseDefs" USING [GarbageCollect, Collapse, SetCollapseSize],
DisjointGatherDefs: FROM "DisjointGatherDefs" USING [InitGather, FinishGather],
DisjointGraphicsDefs: FROM "DisjointGraphicsDefs" USING [DrawInstance, DrawSymbol, BoundBox, ScreenToPress],
DisjointIODefs: FROM "DisjointIODefs" USING [CIFInput, CIFOutput, PrintSymbols],
DisjointJoinDefs: FROM "DisjointJoinDefs" USING [Join],
DisjointPropDefs: FROM "DisjointPropDefs" USING [AllocPropID, PutProp, GetProp, RemoveProp],
DisjointSplitDefs: FROM "DisjointSplitDefs" USING [Split],
DisjointTypes: FROM "DisjointTypes" USING [PropList, Instance, Symbol, Rectangle, Geometry],
DJExtDefs: FROM "DJExtDefs" USING [Extract, Flatten, ExtOutput, ExtDebug, ToggleDebug, PrintExtAlloc, ExtCount],
Inline: FROM "Inline" USING [BITXOR],
IODefs: FROM "IODefs" USING [WriteDecimal, WriteString, WriteLine],
JaMFnsDefs: FROM "JaMFnsDefs" USING [Register, PopString, GetReal, PopInteger, PushReal, PopBoolean],
SegmentDefs: FROM "SegmentDefs" USING [InsufficientVM],
String: FROM "String" USING [AppendString, AppendChar],
SystemDefs: FROM "SystemDefs" USING [AllocateHeapString],
Time: FROM "Time" USING [AppendCurrent];

DisjointControl: PROGRAM
IMPORTS CIFUtilitiesDefs, DisjointCollapseDefs, DisjointIODefs, DisjointJoinDefs, DisjointPropDefs, DisjointSplitDefs, DisjointAllocDefs, DisjointGatherDefs, DisjointGraphicsDefs, DJExtDefs, Inline, IODefs, JaMFnsDefs, SegmentDefs, String, SystemDefs, Time =
BEGIN
OPEN CIFUtilitiesDefs, DisjointCollapseDefs, DisjointIODefs, DisjointJoinDefs, DisjointPropDefs, DisjointSplitDefs, DisjointTypes, DisjointAllocDefs, DisjointGatherDefs, DisjointGraphicsDefs, DJExtDefs, Inline, IODefs, JaMFnsDefs, SegmentDefs, String, SystemDefs, Time;

TopSymbol: Symbol ← NIL;
CurrentSymbol: Symbol ← NIL;

--Initialization

Init: PROCEDURE =
BEGIN
TopSymbol ← MakeSymbol["Top",0,0,600,600]; --deallocate?
CurrentSymbol ← TopSymbol;
END;

--*** JaM Interface ***

CallInit: PROCEDURE =
BEGIN
Init[];
ClearClipRectangle[];
END;

CallErase: PROCEDURE =
BEGIN
ClearClipRectangle[];
END;

CallMakeSymbol: PROCEDURE =
BEGIN --expects <name, l,b,r,t>
t: REAL ← GetReal[];
r: REAL ← GetReal[];
b: REAL ← GetReal[];
l: REAL ← GetReal[];
name: STRING ← [50];
PopString[name];
[] ← MakeSymbol[name, l,b,r,t];
END;

OpenSymbol: PROCEDURE =
BEGIN --expects <name>
name: STRING ← [50];
s: Symbol;
PopString[name];
s ← LookupSymbol[name];
IF s=NIL THEN {WriteString["Unknown symbol: "]; WriteLine[name];}
ELSE CurrentSymbol ← s;
END;

CloseSymbol: PROCEDURE =
BEGIN
CurrentSymbol ← TopSymbol;
END;

CallMakeInstance: PROCEDURE =
BEGIN --expects <name, x,y>
y: REAL ← GetReal[];
x: REAL ← GetReal[];
name: STRING ← [50];
PopString[name];
DrawInstance[MakeInstance[CurrentSymbol, name, x,y]];
END;

CallDrawInstances: PROCEDURE =
BEGIN
ClearClipRectangle[];
FOR i:Instance ← CurrentSymbol.insts, i.next UNTIL i=NIL DO
DrawInstance[i];
ENDLOOP;
END;

CallMakeGeometry: PROCEDURE =
BEGIN --expects <layer, l,b,r,t>
t: REAL ← GetReal[];
r: REAL ← GetReal[];
b: REAL ← GetReal[];
l: REAL ← GetReal[];
layer: INTEGER ← PopInteger[];
[] ← MakeGeometry[CurrentSymbol, layer, l,b,r,t];
END;

SetWindows: PROCEDURE = --of current symbol
BEGIN --expects <l1,b1,r1,t1, l2,b2,r2,t2, ..., ln,bn,rn,tn, n>
nrecs: INTEGER ← PopInteger[];
rec,next: Rectangle;
windows: Rectangle ← NIL;
THROUGH [1..nrecs] DO
t: REAL ← GetReal[];
r: REAL ← GetReal[];
b: REAL ← GetReal[];
l: REAL ← GetReal[];
rec ← AllocateRectangle[];
rec↑ ← [
next: NIL,
l:l, b:b, r:r, t:t
];
rec.next ← windows;
windows ← rec;
ENDLOOP;
FOR rec ← CurrentSymbol.windows, next UNTIL rec=NIL DO
next ← rec.next;
FreeRectangle[rec];
ENDLOOP;
CurrentSymbol.windows ← windows;
END;

CallBoundBox: PROCEDURE =
BEGIN
--put <l b r t> of current symbol on stack
l,b,r,t: REAL;
[l,b,r,t] ← BoundBox[CurrentSymbol];
PushReal[l];
PushReal[b];
PushReal[r];
PushReal[t];
END;

CallSplit: PROCEDURE =
BEGIN
ENABLE {
InsufficientVM => {
CallPrintAlloc[];
WriteLine["Out of VM!"];
CONTINUE;
};
};
--make copy of CurrentSymbol
copySymbol: Symbol ← AllocateSymbol[];
copySymbol.name ← AllocateHeapString[CurrentSymbol.name.length + 1];
AppendString[copySymbol.name,CurrentSymbol.name];
AppendChar[copySymbol.name,’$];
copySymbol.geom ← NIL;
FOR gptr: Geometry ← CurrentSymbol.geom,gptr.next UNTIL gptr = NIL DO
g: Geometry ← AllocateGeometry[];
g↑ ← [
next: copySymbol.geom,
layer: gptr.layer,
l: gptr.l,
b: gptr.b,
r: gptr.r,
t: gptr.t
];
copySymbol.geom ← g;
ENDLOOP;
-- copy instance list
FOR iptr: Instance ← CurrentSymbol.insts,iptr.next UNTIL iptr = NIL DO
in: Instance ← AllocateInstance[];
in↑ ← [
next: copySymbol.insts,
symbol: iptr.symbol,
xOffset: iptr.xOffset,
yOffset: iptr.yOffset
];
copySymbol.insts ← in;
ENDLOOP;
-- copy window
FOR wptr: Rectangle ← CurrentSymbol.windows,wptr.next UNTIL wptr = NIL DO
wind: Rectangle ← AllocateRectangle[];
wind↑ ← [
next: copySymbol.windows,
l: wptr.l,
b: wptr.b,
r: wptr.r,
t: wptr.t
];
copySymbol.windows ← wind;
ENDLOOP;
InitGather[];
Split[copySymbol];
FinishGather[];
CurrentSymbol ← copySymbol;
Collapse[CurrentSymbol];
END;

CallJoin: PROCEDURE =
BEGIN
ENABLE {
InsufficientVM => {
CallPrintAlloc[];
WriteLine["Out of VM"];
CONTINUE;
};
};

Join[CurrentSymbol];
Collapse[CurrentSymbol];
GarbageCollect[CurrentSymbol];
END;

CallExtractor: PROCEDURE =
BEGIN
ENABLE {
InsufficientVM => {
CallPrintAlloc[];
WriteLine["Out of VM"];
CONTINUE;
};
};

FillInStipple: PROC[s: Symbol] RETURNS[BOOLEAN] =
BEGIN
Stipple ← BITXOR[Stipple+S2,S2];
s.data ← Stipple;
RETURN[FALSE];
END;

[] ← EnumerateSymbols[FillInStipple];
Extract[CurrentSymbol];
END;

CallExtCount: PROCEDURE =
BEGIN
ExtCount[CurrentSymbol];
END;

CallFlatten: PROCEDURE =
BEGIN
Flatten[CurrentSymbol];
END;

CallExtOutput: PROCEDURE =
BEGIN
ExtOutput[CurrentSymbol];
END;

CallExtDebug: PROCEDURE =
BEGIN
ExtDebug[];
END;

Stipple: CARDINAL ← 52525B;
S2: CARDINAL ← 42673B;

CallDrawSymbol: PROCEDURE =
BEGIN --expects <callOnce level> boolean integer
level: INTEGER ← PopInteger[];
callOnce: BOOLEAN ← PopBoolean[];
FillInStipple: PROC[s: Symbol] RETURNS[BOOLEAN] =
BEGIN
Stipple ← BITXOR[Stipple+S2,S2];
s.data ← Stipple;
RETURN[FALSE];
END;
[] ← EnumerateSymbols[FillInStipple];
DrawSymbol[CurrentSymbol, callOnce, level];
END;

CallPrintSymbols: PROCEDURE =
BEGIN
PrintSymbols[];
END;

CallPrintAlloc: PROCEDURE =
BEGIN
PrintAlloc[];
PrintExtAlloc[];
END;

CallCIFOutput: PROCEDURE =
BEGIN -- expects <callOnce fileName> callOnce is boolean
fileName: STRING ← [50];
callOnce: BOOLEAN;
PopString[fileName];
callOnce ← PopBoolean[];
IF ~DotInName[fileName] THEN AppendString[fileName, ".cif"];
CIFOutput[CurrentSymbol, callOnce, fileName];
END;

CallCIFInput: PROCEDURE =
BEGIN -- expects nothing
CIFInput[FALSE, CurrentSymbol];
END;

CallScreenToPress: PROCEDURE =
BEGIN -- expects <fileName>
fileName: STRING ← [40];
PopString[fileName];
IF ~DotInName[fileName] THEN AppendString[fileName, ".press"];
ScreenToPress[fileName];
END;

--***

DotInName: PROCEDURE[name: STRING] RETURNS[BOOLEAN] =
BEGIN
FOR i:CARDINAL IN [0..name.length) DO
IF name[i]=’. THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END;

CallGarbageCollect: PROCEDURE[] =
BEGIN
GarbageCollect[CurrentSymbol];
END;

CallCollapse: PROCEDURE[] =
BEGIN
Collapse[CurrentSymbol];
END;

CallSetCollapseSize: PROCEDURE[] =
BEGIN-- expects <n>
n: INTEGER ← PopInteger[];
SetCollapseSize[n];
END;

-- test property lists

TestPropList: PropList ← NIL;

CallAllocID: PROCEDURE[] =
BEGIN
WriteDecimal[AllocPropID[]];
WriteLine[""];
END;

CallPutProp: PROCEDURE[] =
BEGIN-- expects <id data>
data: INTEGER ← PopInteger[];
id: INTEGER ← PopInteger[];
PutProp[@TestPropList,id,data];
END;

CallGetProp: PROCEDURE[] =
BEGIN-- expects <id>
id: INTEGER ← PopInteger[];
WriteDecimal[GetProp[TestPropList,id]];
WriteLine[""];
END;

CallRemProp: PROCEDURE[] =
BEGIN-- expects <id>
id: INTEGER ← PopInteger[];
RemoveProp[TestPropList,id];
END;

GetTime: PROCEDURE =
BEGIN
str:STRING ← [64];
AppendCurrent[str];
WriteLine[str];
END;

--*** START Code ***

Init[];

Register["time",GetTime];
Register["init",CallInit];
Register["erase",CallErase];
Register["makesymbol",CallMakeSymbol];
Register["open",OpenSymbol];
Register["close",CloseSymbol];
Register["makeinstance",CallMakeInstance];
Register["drawinstances",CallDrawInstances];
Register["makegeometry",CallMakeGeometry];
Register["windows",SetWindows];
Register["boundbox",CallBoundBox];
Register["split",CallSplit];
Register["join",CallJoin];
Register["drawsymbol",CallDrawSymbol];
Register["printsymbols",CallPrintSymbols];
Register["alloc",CallPrintAlloc];
Register["cifout",CallCIFOutput];
Register["cifin",CallCIFInput];
Register["press",CallScreenToPress];
Register["allocid",CallAllocID];
Register["put",CallPutProp];
Register["get",CallGetProp];
Register["remove",CallRemProp];
Register["garbagecollect",CallGarbageCollect];
Register["collapse",CallCollapse];
Register["setcollapsesize",CallSetCollapseSize];
Register["extract",CallExtractor];
Register["flatten",CallFlatten];
Register["extout",CallExtOutput];
Register["count",CallExtCount];
Register["extdebug",CallExtDebug];
Register["debug",ToggleDebug];

END.