-- 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.