-- File CIFDisjoint.mesa
-- Output module for Disjoint
-- Written by Martin Newell, March 1981
-- Last June 17, 1981  12:13 PM

DIRECTORY

AuxIntDefs: FROM "AuxIntDefs" USING [IExpand, IGetRootID, IGetFirstSymbol,
	IGetNextSymbol, IStop, ISymBB],
AuxOutputDefs: FROM "AuxOutputDefs",
CIFDevicesDefs: FROM "CIFDevicesDefs" USING [DeviceDescriptor,
	DeviceDescriptorRecord, RegisterDevice],
CIFUtilitiesDefs: FROM "CIFUtilitiesDefs" USING [Rectangle,
	SetClipRectangle, DrawClipRectangle,
	GetDisplayContext],
Graphics: FROM "Graphics" USING [DisplayContext, PopContext, PushContext,
	Scale],
InlineDefs: FROM "InlineDefs" USING [LowHalf],
IntDefs: FROM "IntDefs" USING [IBoundBox],
IntStorageDefs: FROM "IntStorageDefs" USING [ObjectName, NilObjectName],
IntTransDefs: FROM "IntTransDefs" USING [Transform, TransformRecord],
IODefs: FROM "IODefs" USING [CR, SP, WriteLine, WriteString,
	WriteChar, GetOutputStream, SetOutputStream, WriteDecimal],
JaMFnsDefs: FROM "JaMFnsDefs" USING [PopString, GetJaMBreak, SetJaMBreak,
	PopBoolean],
ParserTypeDefs: FROM "ParserTypeDefs" USING [Point, Path],
Real: FROM "Real" USING [Fix, WriteReal],
StreamDefs: FROM "StreamDefs" USING [StreamHandle, NewByteStream, Write,
	Append],
StringDefs: FROM "StringDefs" USING[AppendString,
	AppendLongDecimal],
SystemDefs: FROM "SystemDefs" USING [AllocateHeapNode, FreeHeapNode];

CIFCIF: PROGRAM
IMPORTS AuxIntDefs, CIFDevicesDefs, CIFUtilitiesDefs, Graphics, InlineDefs, IntDefs, IODefs, JaMFnsDefs, Real, StreamDefs, StringDefs, SystemDefs
EXPORTS AuxOutputDefs =

BEGIN OPEN AuxIntDefs, AuxOutputDefs, CIFDevicesDefs, CIFUtilitiesDefs, Graphics, InlineDefs, IntDefs, IntStorageDefs, IntTransDefs, IODefs, JaMFnsDefs, ParserTypeDefs, Real, StreamDefs, StringDefs, SystemDefs;


-- DJ procedures

DJDeviceRecord: DeviceDescriptorRecord _ [
	next:					NIL,
	name:					"disjoint",
	deviceSelect: 		DJSelect,
	deviceDrawFrame: 	DJDrawFrame,
	deviceSetScale: 		DJSetScale,
	deviceSetClipRegion: DJSetClipRegion,
	deviceOutput: 		DJOutput,
	deviceLayer: 		DJLayer,
	deviceLoadLayer: 	DJLoadLayer,
	deviceRectangle: 	DJRectangle,
	deviceStartPoly: 	DJStartPoly,
	devicePolyVertex: 	DJPolyVertex,
	deviceEndPoly: 		DJEndPoly,
	deviceText: 			DJText
];

--the following types are copied from CIFOutput
UserObjectType: TYPE = {User9, User94, other};
UserObject: TYPE = POINTER TO UserObjectRecord;
UserObjectRecord: TYPE = RECORD[
	SELECT type: UserObjectType FROM
		User9 => [	--Symbol name
			name: PACKED ARRAY [0..0) OF CHARACTER],
		User94 => [	--Named point
			x: REAL,
			y: REAL,
			name: PACKED ARRAY [0..0) OF CHARACTER],
		ENDCASE];

DJSelect: PROCEDURE RETURNS[BOOLEAN] =
	BEGIN
	RETURN[TRUE];
	END;

DJDrawFrame: PROCEDURE =
	BEGIN
	DrawClipRectangle[];
	END;

DJSetScale: PROCEDURE [factor: REAL] =
	BEGIN
	dc: DisplayContext _ GetDisplayContext[];
	PopContext[dc];
	PushContext[dc];
	Scale[dc, [factor,factor]];
	END;

DJSetClipRegion: PROCEDURE [rt: Rectangle] =
	BEGIN
	SetClipRectangle[rt];
	END;

DJOutput: PROCEDURE =
--expects <boolean filename> (boolean is true for ALL symbols, false for REFERENCED only)
	BEGIN
	symbol: ObjectName;
	cifNum: CARDINAL;
	fileName: STRING _ [100];
	allSymbols: BOOLEAN;
	PopString[fileName];
	allSymbols _ PopBoolean[];
	IF ~DotinName[fileName] THEN AppendString[fileName,".dis"];
	Aborted _ FALSE;
	InitDict[256];
	IF allSymbols THEN --get handle on all symbols, even if not referenced
	{	FOR s:ObjectName _ IGetFirstSymbol[],IGetNextSymbol[]
				UNTIL s=NilObjectName DO
		{	u: STRING _ [100];
			[] _ Lookup[s];
		};
		ENDLOOP;
	};
--provoke initial entries in dictionary
	ScanningTopLevel _ TRUE;
	IExpand[IGetRootID[]];
	IF Aborted THEN
	{	Abort[];
		RETURN;
	};
	ScanningTopLevel _ FALSE;
--output symbols
	DoHeader[fileName];
	[symbol,cifNum] _ GetNonProcessedEntry[];
	UNTIL cifNum=0 DO
		DoSymbolHeader[symbol];
		IExpand[symbol];
		IF Aborted THEN
		{	Abort[];
			RETURN;
		};
		DoSymbolTrailer[symbol];
		[symbol,cifNum] _ GetNonProcessedEntry[];
	ENDLOOP;
--output mainline
	DJStream.put[DJStream,CR];
	IExpand[IGetRootID[]];
	IF Aborted THEN
	{	Abort[];
		RETURN;
	};
	DoTrailer[];
	FreeDict[];
	END;

Abort: PROCEDURE[] =
	BEGIN
	save: StreamHandle _ GetOutputStream[];
	SetOutputStream[DJStream];
	WriteLine["***Aborted***"];
	SetOutputStream[save];
	WriteLine["***Aborted***"];
	DoTrailer[];
	FreeDict[];
	END;

DoHeader: PROCEDURE[fileName: STRING] =
	BEGIN
	l,b,r,t: LONG INTEGER;
	save: StreamHandle _ GetOutputStream[];
	DJStream _ NewByteStream[fileName, Write+Append];
	SetOutputStream[DJStream];
	WriteString["(File: "]; WriteString[fileName];
	WriteLine[".  Created by CIFDJ)/print"];
	[l,r,b,t] _ IBoundBox[];
	WriteChar[CR]; WriteLongDecimal[l]; 
	WriteChar[SP]; WriteLongDecimal[b];
	WriteChar[SP]; WriteLongDecimal[r];
	WriteChar[SP]; WriteLongDecimal[t];
	WriteLine[" 1 windows"];
	SetOutputStream[save];
	CurrentLayer _ 32000; --i.e. not set
	END;

DoTrailer: PROCEDURE =
	BEGIN
	DJStream.destroy[DJStream];
	DJStream _ NIL;
	END;

DoSymbolHeader: PROCEDURE [symbol: ObjectName] =
	BEGIN
	save: StreamHandle _ GetOutputStream[];
	n: INTEGER;
	l,b,r,t: LONG INTEGER;
	SetOutputStream[DJStream];
	WriteChar[CR];
	n _ Lookup[symbol];
	WriteChar['(]; WriteDecimal[n]; WriteChar[')];
	[l,r,b,t] _ ISymBB[symbol];
	WriteChar[SP]; WriteLongDecimal[l];
	WriteChar[SP]; WriteLongDecimal[b];
	WriteChar[SP]; WriteLongDecimal[r];
	WriteChar[SP]; WriteLongDecimal[t];
	WriteString[" ms ("]; WriteDecimal[n]; WriteLine[") open"];
	SaveLayer _ CurrentLayer;
	CurrentLayer _ 32000;
	SetOutputStream[save];
	END;

DoSymbolTrailer: PROCEDURE[symbol: ObjectName] =
	BEGIN
	save: StreamHandle _ GetOutputStream[];
	SetOutputStream[DJStream];
	WriteLine["close"];
	SetOutputStream[save];
	CurrentLayer _ SaveLayer;
	END;

DJLayer: PROCEDURE [layer: CARDINAL] =
	BEGIN
	END;

DJLoadLayer: PROCEDURE[layer:CARDINAL, v0,v1,v2,v3: CARDINAL] =
	BEGIN
	END;

DJRectangle: PROCEDURE [r: Rectangle] =
	BEGIN
	END;

DJStartPoly: PROCEDURE [x,y: REAL] =
	BEGIN
	END;

DJPolyVertex: PROCEDURE [x,y: REAL] =
	BEGIN
	END;

DJEndPoly: PROCEDURE =
	BEGIN
	END;

DJText: PROCEDURE[text: STRING, x,y: REAL] =
	BEGIN
	END;

--Procedures that export AuxOutputDefs--

AuxWire: PUBLIC PROCEDURE [layerName: CARDINAL, width: LONG CARDINAL, a: ParserTypeDefs.Path] =
	BEGIN
	WriteLine["Wire not implemented in CIFDJ"];
	END;

AuxFlash: PUBLIC PROCEDURE [layerName: CARDINAL, diameter: LONG CARDINAL, center: ParserTypeDefs.Point] =
	BEGIN
	WriteLine["Flash not implemented in CIFDJ"];
	END;

AuxPolygon: PUBLIC PROCEDURE [layerName: CARDINAL, a: ParserTypeDefs.Path] =
	BEGIN
	WriteLine["Polygon not implemented in CIFDJ"];
	END;

AuxBox: PUBLIC PROCEDURE [layerName: CARDINAL, length, width: LONG CARDINAL,
			center: ParserTypeDefs.Point, xRotation, yRotation: LONG INTEGER] =
	BEGIN
	save: StreamHandle _ GetOutputStream[];
	len,wid,length2,width2: LONG CARDINAL;
	IF GetJaMBreak[] THEN
	{	IStop[];
		SetJaMBreak[FALSE];
		Aborted _ TRUE;
		RETURN;
	};
	IF ScanningTopLevel THEN RETURN;
	IF yRotation#0 AND xRotation#0 THEN
	{	WriteLine["CIFDisjoint - oblique rectangles not implemented"];
		RETURN;
	};
	IF yRotation=0 THEN {len _ length; wid _ width;}
	ELSE {len _ width; wid _ length;};
	SetOutputStream[DJStream];
	SetLayer[layerName];
	length2 _ len/2;
	IF length2+length2<length THEN length2 _ length2 + 1;
	width2 _ wid/2;
	IF width2+width2<width THEN width2 _ width2 + 1;
	WriteChar[SP]; WriteLongDecimal[center.x - length2];
	WriteChar[SP]; WriteLongDecimal[center.y - width2];
	WriteChar[SP]; WriteLongDecimal[center.x + length2];
	WriteChar[SP]; WriteLongDecimal[center.y + width2];
	WriteLine[" mg"];
	SetOutputStream[save];
	END;

AuxUserObject: PUBLIC PROCEDURE [layerName: CARDINAL,
		size: CARDINAL, data: POINTER TO UNSPECIFIED] =
	BEGIN
	WriteLine["Names not implemented in CIFDJ"];
	END;

AuxCall: PUBLIC PROCEDURE [symbol: ObjectName, cifNumber: LONG CARDINAL, transform: Transform] =
	BEGIN
	save: StreamHandle _ GetOutputStream[];
	t: TransformRecord;
	c,s: REAL;
	Rx,Ry: LONG INTEGER;
	cifNum: INTEGER _ Lookup[symbol]; --need to do this always
	IF ScanningTopLevel THEN RETURN;
	SetOutputStream[DJStream];
	WriteString[" ("]; WriteLongDecimal[cifNum]; WriteChar[')];
	t _ transform^;
--Check Mirror
	IF (t.a11*t.a22-t.a21*t.a12)<0 THEN --determinant negative - need mirror
	{	t.a11 _ -t.a11;
		t.a12 _ -t.a12;
		SetOutputStream[save];
		WriteLine["Mirrored symbols calls not implemented in CIFDJ"];
		SetOutputStream[DJStream];
	};
--check Rotate
	c _ t.a11/t.a33;
	s _ t.a12/t.a33;
	IF s#0 OR c<0 THEN
	{	SELECT TRUE FROM
		c=s	=> Rx _ Ry _ 1;
		c=0	=> {Rx _ 0; Ry _ IF s<0 THEN -1 ELSE 1; };
		s=0	=> {Ry _ 0; Rx _ IF c<0 THEN -1 ELSE 1; };
		ENDCASE =>
		{	f: REAL _ ABS[BigCIFInteger/c];
			f _ MIN[f,ABS[BigCIFInteger/s]];
			Rx _ Fix[c*f];
			Ry _ Fix[s*f];
		};
		SetOutputStream[save];
		WriteLine["Rotated symbols calls not implemented in CIFDJ"];
		SetOutputStream[DJStream];
	};
--Check translation
	WriteChar[SP]; WriteLongDecimal[Fix[t.a31/t.a33]];
	WriteChar[SP]; WriteLongDecimal[Fix[t.a32/t.a33]];
	WriteLine[" mi"];
	SetOutputStream[save];
	END;

BigCIFInteger: LONG INTEGER _ 20000000B; --2^22

SetLayer: PUBLIC PROCEDURE [layerName: CARDINAL] =
	BEGIN
	CurrentLayer _ layerName;
	WriteChar[SP]; WriteDecimal[CurrentLayer];
	END;

--Dictionary

DictEntry: TYPE = POINTER TO DictEntryRecord;
DictEntryRecord: TYPE = RECORD [
	next: DictEntry,		--global list in order in which entries are made
	ovflow: DictEntry,	--overflow list from entry in hash table
	key: ObjectName,		--internal ID of symbol
	value: CARDINAL		--generated CIF symbol # for output
];

DictHead: DictEntry;
DictTail: DictEntry;
HTable: DESCRIPTOR FOR ARRAY OF DictEntry;
LastProcessedEntry: DictEntry; --points to last processed entry
Value: CARDINAL;

InitDict: PROCEDURE[hashlength: CARDINAL] =
	BEGIN
	i: CARDINAL;
	DictHead _ NIL;
	DictTail _ NIL;
	HTable _
		DESCRIPTOR[AllocateHeapNode[hashlength*SIZE[DictEntry]],hashlength];
	FOR i IN [0..hashlength) DO HTable[i] _ NIL; ENDLOOP;
	LastProcessedEntry _ NIL;
	Value _ 0;
	END;

Lookup: PROCEDURE[key: ObjectName] RETURNS[CARDINAL] =
--Return value associated with key.  If key not found then
--allocate a new entry with generated value, and return the value.
	BEGIN
	de: DictEntry;
	h: CARDINAL;
	[de,h] _ Where[key];
	IF de=NIL THEN
	{	de _ AllocateHeapNode[SIZE[DictEntryRecord]];
		de^ _ [
			next: NIL,
			ovflow: HTable[h],
			key: key,
			value: (Value_Value+1)];
		HTable[h] _ de;
		IF DictTail=NIL THEN DictHead _ DictTail _ de
		ELSE
		{	DictTail.next _ de;
			DictTail _ de;
		};
	};
	RETURN[de.value];
	END;

GetNonProcessedEntry: PROCEDURE
		RETURNS[key: ObjectName, value: CARDINAL] =
--Step LastProcessedEntry and return its key and value, if any
	BEGIN
	IF LastProcessedEntry=NIL THEN LastProcessedEntry _ DictHead
	ELSE LastProcessedEntry _ LastProcessedEntry.next;
	IF LastProcessedEntry=NIL THEN RETURN[NilObjectName,0]
	ELSE RETURN[LastProcessedEntry.key, LastProcessedEntry.value];
	END;

FreeDict: PROCEDURE =
	BEGIN
	de,nextde: DictEntry;
	FOR de _ DictHead, nextde UNTIL de=NIL DO
		nextde _ de.next;
		FreeHeapNode[de];
	ENDLOOP;
	FreeHeapNode[BASE[HTable]];
	END;

Where: PROCEDURE[key: ObjectName] RETURNS[de: DictEntry, h: CARDINAL] =
--h is result of hashing name
	BEGIN
	h _ Hash[key, LENGTH[HTable]];
	FOR de  _ HTable[h], de.ovflow UNTIL de=NIL OR key=de.key
		DO --nothing-- ENDLOOP;
	END;

Hash: PROCEDURE[key: ObjectName, range: CARDINAL] RETURNS[h: CARDINAL] =
--h is result of hashing name into [0..range)
	BEGIN
	i: CARDINAL _ LowHalf[key];
	RETURN[i MOD range];
	END;

--Utilities

WriteLongDecimal: PROCEDURE[n: LONG INTEGER] =
	BEGIN
	s: STRING _ [50];
	AppendLongDecimal[s,n];
	WriteString[s];
	END;

WriteFloat: PROCEDURE[r: REAL] =
	BEGIN
	WriteReal[WriteChar,r];
	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;

--DJ parameters
ScanningTopLevel: BOOLEAN;
DJStream: StreamHandle _ NIL;
SaveLayer: CARDINAL;
CurrentLayer: CARDINAL;
Aborted: BOOLEAN;



--set up context

RegisterDevice[@DJDeviceRecord];

END.
(635)\128b9B1223b6B909b14B33b10B38b16B231b8B60b11B50b10B150b15B67b8B1145b5B208b8B543b9B74b14B552b15B189b7B46b11B67b11B43b11B40b12B40b9B28b6B95b7B148b8B158b10B129b6B1010b13B151b7B1322b8B618b8B273b6B536b20B369b8B173b5B228b4B193b16B106b10B62b9B