-- 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.
e6(635)\187b10B1445b8B75b17B625b4B162b8B60b9B51b14B215b10B214b11B56b16B189b17B141b16B226b10B573b12B181b2B642i18I268i11I352b8B213b13B127b13B196b12B54b11B53b13B55b12B110b14B132b13B215b16B45b14B61b13B282b12B80b17B195b9B159b18B62b12B56b19B97i19I33b11B76b11B144b11B132b11B