-- File: DisjointJoin.mesa
-- Mates sub-cells in a cell
-- Written by Martin Newell/Dan Fitzpatrick August 1981
-- Last edited (Alto): August 7, 1981  11:55 AM

DIRECTORY

DisjointAllocDefs: FROM "DisjointAllocDefs" USING [AllocateInstance, FreeInstance, AllocateSymbol, AllocateRectangle, Alloc, Free],
DisjointJoinDefs: FROM "DisjointJoinDefs",
DisjointPropDefs: FROM "DisjointPropDefs" USING [GetProp, PutProp, AllocPropID],
DisjointTypes: FROM "DisjointTypes" USING [Instance, Rectangle, Symbol, PropID, InstanceRecord],
Inline: FROM "Inline" USING [LowHalf],
Real: FROM "Real" USING [Fix];
 
DisjointJoin: PROGRAM
IMPORTS DisjointAllocDefs, DisjointPropDefs, Inline, Real
EXPORTS DisjointJoinDefs =
BEGIN
OPEN DisjointTypes, DisjointAllocDefs, DisjointPropDefs, Inline, Real;

Join: PUBLIC PROCEDURE[symbol: Symbol] =
BEGIN
	next:SymbCell;

	HashTbl _ ALL[NIL];
	Mate[symbol];
	FOR i:INTEGER IN [0..TblSize) DO
		FOR p:SymbCell _ HashTbl[i],next UNTIL p = NIL DO
			next _ p.next;
			FreeSymbCell[p];
			ENDLOOP;
		ENDLOOP;
	END;

Mate: PUBLIC PROCEDURE[symbol: Symbol] =
BEGIN
	-- mate all the calls in symbol with their neighbors
	nomoreH:BOOLEAN _ FALSE;
	nomoreV:BOOLEAN _ FALSE;
	PutProp[@symbol.prop,checkID,1];
	FOR instance:Instance _ symbol.insts,instance.next UNTIL instance = NIL DO
		-- see that all sub-symbols have been joined
		IF GetProp[instance.symbol.prop,checkID] # 1 THEN Mate[instance.symbol];
		ENDLOOP;
	UNTIL nomoreH OR nomoreV DO
		nomoreV _ MateV[symbol];
		nomoreH _ MateH[symbol];
		ENDLOOP;
	UNTIL nomoreH DO
		nomoreH _ MateH[symbol];
		ENDLOOP;
	UNTIL nomoreV DO
		nomoreV _ MateV[symbol];
		ENDLOOP;
	END;

MateH: PROCEDURE[symbol: Symbol] RETURNS[nomore:BOOLEAN] =
-- mates sub-cells of symbols up with their right neighbor
-- replace instance list of symbol with new mated instance list
-- Returns true when it cannot mate any one
BEGIN
	i1,i2:Instance;
	iList:Instance _ Sort[symbol.insts,HCompare];
	nomore _ TRUE;
	List _ NIL;		-- empty global instance list
	FOR i1 _ iList,iList UNTIL i1 = NIL DO
		iList _ iList.next;
		i2 _ iList;
		IF i2 = NIL THEN {
			Add[i1];
			EXIT;
			};
		IF TouchingH[i1,i2] THEN {		-- mate i1 & i2
			symb:Symbol _ FindSymbol[i1,i2];
			in:Instance _ MakeInstance[symb,i1,i2];
			Add[in];
			iList _ iList.next;
			FreeInstance[i1];	FreeInstance[i2];
			nomore _ FALSE;
			LOOP;
			};
		Add[i1];			-- can't use i1 so put back on List
		ENDLOOP;
	symbol.insts _ List;
	END;

MateV: PROCEDURE[symbol: Symbol] RETURNS[nomore:BOOLEAN] =
-- mates sub-cells of symbols up with their above neighbor
-- Returns true when it cannot mate any one
BEGIN
	i1,i2:Instance;
	iList:Instance _ Sort[symbol.insts,VCompare];
	nomore _ TRUE;
	List _ NIL;		-- empty global instance list
	FOR i1 _ iList,iList UNTIL i1 = NIL DO
		iList _ iList.next;
		i2 _ iList;
		IF i2 = NIL THEN {
			Add[i1];
			EXIT;
			};
		IF TouchingV[i1,i2] THEN {		-- mate i1 & i2
			symb:Symbol _ FindSymbol[i1,i2];
			in:Instance _ MakeInstance[symb,i1,i2];
			Add[in];
			iList _ iList.next;
			FreeInstance[i1];	FreeInstance[i2];
			nomore _ FALSE;
			LOOP;
			};
		Add[i1];			-- can't use i1 so put back on List
		ENDLOOP;
	symbol.insts _ List;
	END;

FindSymbol: PROCEDURE[i1,i2:Instance] RETURNS[Symbol] =
-- tries to find symbol that represents i1 & i2, creates one if necessary
BEGIN
	cell:SymbCell;
	x:REAL _ i2.xOffset - i1.xOffset;
	y:REAL _ i2.yOffset - i1.yOffset;
	n:CARDINAL _ hash[i1,i2];
	FOR cell _ HashTbl[n],cell.next UNTIL cell = NIL DO
		IF i1.symbol = cell.symbol1 AND i2.symbol = cell.symbol2 AND
			x = cell.xOffset AND y = cell.yOffset THEN RETURN[cell.ActualSymbol];
		ENDLOOP;
	-- if we get here the symbol wasn't in hash table (create a symbol)
	cell _ AllocateSymbCell[];
	cell^ _ [
		next: HashTbl[n],
		symbol1: i1.symbol,
		symbol2: i2.symbol,
		xOffset: x,
		yOffset: y,
		ActualSymbol: MakeSymbol[i1,i2]
		];
	HashTbl[n] _ cell;
	RETURN[cell.ActualSymbol];
	END;

hash: PROCEDURE[i1,i2:Instance] RETURNS[m:INTEGER] = INLINE
BEGIN
	n:LONG INTEGER _ (LOOPHOLE[i1.symbol,LONG CARDINAL]/3 +
							 LOOPHOLE[i2.symbol,LONG CARDINAL]/13);
	n _ n + Fix[i2.xOffset - i1.xOffset] + 7*Fix[i2.yOffset - i1.yOffset];
	m _ LowHalf[n];
	m _ m MOD TblSize;
	IF m < 0 THEN RETURN[-m];
	END;

MakeSymbol: PROCEDURE[i1,i2:Instance] RETURNS[symb:Symbol] =
-- creates a new symbol with copies of i1 & i2 in it
BEGIN
	wList:Rectangle;
	newi1:Instance _ AllocateInstance[];
	newi2:Instance _ AllocateInstance[];
	newi1^ _ [
		next: newi2,
		symbol: i1.symbol,
		xOffset: 0,
		yOffset: 0
		];
	newi2^ _ [
		next: NIL,
		symbol: i2.symbol,
		xOffset: i2.xOffset - i1.xOffset,
		yOffset: i2.yOffset - i1.yOffset
		];
	wList _ CreateWindowList[i1.symbol.windows,i2.symbol.windows,newi2.xOffset,newi2.yOffset];
	symb _ AllocateSymbol[];
	symb^ _ [
		next: symb.next,
		geom: NIL,
		insts: newi1,
		windows: wList
		];
	END;

CreateWindowList: PROCEDURE[w1,w2:Rectangle,x,y:REAL] RETURNS[win:Rectangle] =
-- try to merge window lists if possible
BEGIN
	p,q,new:Rectangle;
	win _ NIL;
	FOR q _ w1,q.next UNTIL q = NIL DO
		new _ AllocateRectangle[];
		new^ _ [
			next: win,
			l: q.l,
			b: q.b,
			r: q.r,
			t: q.t
			];
		win _ new;
		ENDLOOP;
	FOR p _ w2,p.next UNTIL p = NIL DO
		FOR q _ win,q.next UNTIL q = NIL DO
			IF q.b = p.b+y AND q.t = p.t+y THEN {
				IF q.r = p.l+x THEN {		-- p is to the right of q
					q.r _ p.r+x;
					GOTO found;
					};
				IF q.l = p.r+x THEN {		-- p is to the left of q
					q.l _ p.l+x;
					GOTO found;
					};
				};
			IF q.l = p.l+x AND q.r = p.r+x THEN {
				IF q.t = p.b+y THEN {		-- p is above q
					q.t _ p.t+y;
					GOTO found;
					};
				IF q.b = p.t+y THEN {		-- p is below q
					q.b _ p.b+y;
					GOTO found;
					};
				};
			REPEAT
				found => NULL;
				FINISHED => {
					-- if we get here we must create a new window
					new _ AllocateRectangle[];
					new^ _ [
						next: win,
						l: p.l+x,
						b: p.b+y,
						r: p.r+x,
						t: p.t+y
						];
					win _ new;
					};
			ENDLOOP;
		ENDLOOP;
	END;

Add: PROCEDURE[in:Instance] =
-- add in to List
BEGIN
	in.next _ List;
	List _ in;
	END;

Sort: PROCEDURE[iList:Instance,comp:PROCEDURE[i1,i2:Instance] RETURNS[BOOLEAN]] RETURNS[Instance] =
-- sort iList using comp
BEGIN
	list:InstanceRecord;
	p,next:Instance;
	list.next _ NIL;
	FOR in:Instance _ iList,next UNTIL in = NIL DO
		next _ in.next;
		-- insert in into new list
		FOR p _ @list,p.next UNTIL p.next = NIL DO
			IF comp[p.next,in] THEN EXIT;
			ENDLOOP;
		in.next _ p.next;
		p.next _ in;
		ENDLOOP;
	RETURN[list.next];
	END;

TouchingH: PROCEDURE[i1,i2:Instance] RETURNS[BOOLEAN] = INLINE
-- return true if i1 is touching i2 to the left or right
BEGIN
	w1:Rectangle _ i1.symbol.windows;
	w2:Rectangle _ i2.symbol.windows;
	x:REAL _ i2.xOffset - i1.xOffset;
	y:REAL _ i2.yOffset - i1.yOffset;
	IF AtY[i1] # AtY[i2] THEN RETURN[FALSE];
	w1 _ i1.symbol.windows;	w2 _ i2.symbol.windows;
	IF w1.b # w2.b+y OR w1.t # w2.t+y THEN RETURN[FALSE];
	IF w1.r = w2.l+x THEN RETURN[TRUE];
	IF w1.l = w2.r+x THEN RETURN[TRUE];
	RETURN[FALSE];
	END;

TouchingV: PROCEDURE[i1,i2:Instance] RETURNS[BOOLEAN] = INLINE
-- return true if i1 is touching i2 above or below
BEGIN
	w1:Rectangle _ i1.symbol.windows;
	w2:Rectangle _ i2.symbol.windows;
	x:REAL _ i2.xOffset - i1.xOffset;
	y:REAL _ i2.yOffset - i1.yOffset;
	IF AtX[i1] # AtX[i2] THEN RETURN[FALSE];
	w1 _ i1.symbol.windows;	w2 _ i2.symbol.windows;
	IF w1.r # w2.r+y OR w1.l # w2.l+y THEN RETURN[FALSE];
	IF w1.b = w2.t+x THEN RETURN[TRUE];
	IF w1.t = w2.b+x THEN RETURN[TRUE];
	RETURN[FALSE];
	END;

HCompare: PROCEDURE[i1,i2:Instance] RETURNS[BOOLEAN] =
-- return true if i1 is below i2 or at same height but to the left of i2
BEGIN
	RETURN[AtY[i1] < AtY[i2] OR (AtY[i1]=AtY[i2] AND AtX[i1] < AtX[i2])];
	END;

VCompare: PROCEDURE[i1,i2:Instance] RETURNS[BOOLEAN] =
-- return true if i1 is below i2 or at same height but to the left of i2
BEGIN
	RETURN[AtX[i1] < AtX[i2] OR (AtX[i1]=AtX[i2] AND AtY[i1] < AtY[i2])];
	END;

AtY: PROCEDURE[in:Instance] RETURNS[y:REAL] =
-- return the location of bottom of in
BEGIN
	RETURN[in.yOffset+in.symbol.windows.b];
	END;

AtX: PROCEDURE[in:Instance] RETURNS[x:REAL] =
-- return the location of left of in
BEGIN
	RETURN[in.xOffset+in.symbol.windows.l];
	END;

MakeInstance: PROCEDURE[symb:Symbol, i1,i2:Instance] RETURNS[in:Instance] =
BEGIN
	in _ AllocateInstance[];
	in^ _ [
		next: NIL,
		symbol:symb,
		xOffset:i1.xOffset,
		yOffset:i1.yOffset
		];
	END;

AllocateSymbCell: PROCEDURE RETURNS[cell:SymbCell] = INLINE
BEGIN
	cell _ Alloc[SIZE[SymbCellRecord]];
	END;

FreeSymbCell: PROCEDURE[cell:SymbCell] = INLINE
BEGIN
	Free[cell,SIZE[SymbCellRecord]];
	END;

List:Instance;

SymbCell:TYPE = LONG POINTER TO SymbCellRecord;
SymbCellRecord:TYPE = RECORD [
		next: SymbCell,				-- next in hash bucket chain
		symbol1: Symbol,				-- first symbol
		symbol2: Symbol,				-- second symbol
		xOffset,yOffset: REAL,		-- displacement of symbol2 from symbol1
		ActualSymbol: Symbol		-- symbol which represents two symbs & offset
		];
HashTbl:ARRAY [0..TblSize) OF SymbCell;
TblSize:CARDINAL = 512;
checkID:PropID _ AllocPropID[];


END.
e6(635)\161b9B427b12B173b4B250b4B47i22I6i21I168i41I300b5B57i55I4i60I4i40I104i26I158i12I204i32I41b5B57i55I4i40I104i26I158i12I204i32I41b10B49i70I324i64I226b4B309b10B54i49I509b16B66i37I347i22I74i21I122i12I74i12I106i42I190b3B30i14I43b4B99i21I136i23I164b9B57i53I390b9B57i47I390b8B50i69I85b8B50i69I85b3B46i35I55b3B46i33I55b12B188b16B94b12B202i25I26i12I26i13I30i16I7i5I36i42I