-- Compiler Controllers/n
-- Stone, May 2, 1981 12:41 PM
-- implementing module for griffin file controllers

DIRECTORY StyleDefs: FROM "StyleDefs" USING [Color, StyleHandle, lStyle, LineEnd, EndType, Style, Orientation],
ControllerDefs: FROM "ControllerDefs",
GriffinFontDefs: FROM "GriffinFontDefs",
GriffinMemoryDefs: FROM "GriffinMemoryDefs",
Real: FROM "Real",
ObjectDefs: FROM "ObjectDefs",
StringDefs: FROM "StringDefs";



-- ---------------------------------------------------------------------------------
-- ---------------------------------------------------------------------------------
Controllers: PROGRAM IMPORTS GriffinMemoryDefs, StringDefs, Real, ObjectDefs EXPORTS ControllerDefs =

BEGIN OPEN ControllerDefs;


-- this section describes the font data
Font: TYPE = RECORD [next: FontHandle, font: GriffinFontDefs.FontDescriptor];
lFont: CARDINAL = SIZE [Font];
FontHandle: TYPE = POINTER TO Font;
firstFont, lastFont: FontHandle ← NIL;
currentFont: GriffinFontDefs.FontDescriptor;

-- this section describes the style data
firstStyle, lastStyle: StyleDefs.StyleHandle ← NIL;
currentStyleRecord: StyleDefs.Style;

--this section describes the hardcopy controller data
hController: HardcopyController;



--this section describes the display controller data
rOne: REAL; -- hack to get fractional constants
dController: DisplayController;
ControlPair: TYPE = RECORD [next: ControlPairHandle, color: StyleDefs.Color, grey: [0 .. 255]];
lControlPair: CARDINAL = SIZE [ControlPair];
ControlPairHandle: TYPE = POINTER TO ControlPair;
firstControlPair, lastControlPair: ControlPairHandle ← NIL;
GreyArray: TYPE = ARRAY [0 .. 3] OF CARDINAL;
grey50: GreyArray = [52525B, 125252B, 52525B, 125252B];
grey100: GreyArray = [177777B, 177777B, 177777B, 177777B];
grey20: GreyArray = [22222B, 34343B, 23232B, 45454B];
grey0: GreyArray = [0, 0, 0, 0];
maxGrey: INTEGER = 16;
defaultGrey: INTEGER = -1;
greyTable: ARRAY [-1 .. maxGrey] OF GreyArray;

PixelsToMicas: REAL;

SetHardcopyController: PUBLIC PROCEDURE [hc: HardcopyController] =
BEGIN hController ←hc END;


SetDisplayController: PUBLIC PROCEDURE [dc: DisplayController] =
BEGIN dController ← dc END;



ReadDisplayController: PUBLIC PROCEDURE RETURNS [DisplayController] =
BEGIN RETURN [dController] END;



ReadHardcopyController: PUBLIC PROCEDURE RETURNS [HardcopyController] =
BEGIN RETURN [hController] END;




SetGreyOfColor: PUBLIC PROCEDURE [color: StyleDefs.Color, grey: [0 .. 255]] = BEGIN
rover: ControlPairHandle ← firstControlPair;
IF rover # NIL THEN BEGIN
UNTIL rover.next = NIL DO IF rover.color = color THEN RETURN; ENDLOOP;
rover ← rover.next ← GriffinMemoryDefs.Allocate [lControlPair];
rover.next ← NIL;
rover.color ← color;
RETURN;
END
ELSE BEGIN
firstControlPair ← GriffinMemoryDefs.Allocate [lControlPair];
firstControlPair.next ← NIL;
firstControlPair.color ← color;
END;
END;




GreyOfColor: PUBLIC PROCEDURE [color: StyleDefs.Color] RETURNS [POINTER TO GreyArray] = BEGIN
rover: ControlPairHandle ← firstControlPair;
-- hack, should be removed and commented code should be uncommented
RETURN [@greyTable [SELECT color FROM
--black-- [0,0,0] => 16,
--dk brown-- [7,255,59] => 14,
--brown-- [7,255,118] => 12,
--tan-- [0,131,217] => 4,
--maroon-- [234,255,79] => 13,
--dk red-- [0,255,160] => 11,
--red-- [0,255,255] => 8,
--orange-- [10,255,255] => 6,
--dk yellow-- [25,255,255] => 7,
--yellow-- [40,255,255] => 3,
--lt yellow-- [40,190,255] => 2,
--dk green-- [71,255,59] => 11,
--green-- [76,255,255] => 7,
--lt green-- [71,193,255] => 5,
--dk blue-- [150,255,170] => 10,
--blue-- [148,255,255] => 7,
--lt blue-- [141,150,255] => 4,
--dk aqua-- [107,255,98] => 9,
--aqua-- [107,224,255] => 5,
--cyan-- [120,255,255] => 5,
--dk purple-- [178,255,178] => 10,
--purple-- [170,224,255] => 8,
--violet-- [170,131,255] => 4,
--magenta-- [200,255,255] => 8,
--pink-- [206,170,255] => 4,
--dk grey-- [0,0,40] => 13,
--grey-- [0,0,120] => 8,
--lt grey-- [0,0,200] => 4,
--pale grey-- [0,0,230] => 1,
--white-- [0,0,255] => 0,
ENDCASE => defaultGrey]];
-- UNTIL rover = NIL DO
-- IF rover.color = color THEN RETURN [greyTable [rover.grey]] ELSE rover ← rover.next;
-- ENDLOOP;
-- RETURN [greyTable [maxGrey]];
END;




ExpungeStyles: PUBLIC PROC = {
appendStyle: ObjectDefs.ObjectProc = {
IF FindStyle[oldStyles,obj.style]#NIL THEN {
oldStyles ← UnlinkStyle[oldStyles,obj.style];
AddStyle[obj.style];
};
};
--old list
oldStyles: StyleDefs.StyleHandle ← firstStyle;
rover,temp: StyleDefs.StyleHandle;
firstStyle ← lastStyle ← NIL;--indicate no styles
ObjectDefs.ForAllObjects[appendStyle];--move each style in use
--delete the old style list
rover ← oldStyles;
UNTIL rover=NIL DO
GriffinMemoryDefs.FreeString[rover.name];
temp ← rover.next;
GriffinMemoryDefs.Free[rover];
rover ← temp;
ENDLOOP;
};

UnlinkStyle: PROC [list,style: StyleDefs.StyleHandle] RETURNS[StyleDefs.StyleHandle] = {
ptr: StyleDefs.StyleHandle;
IF list=style THEN list ← list.next
ELSE {
FOR ptr ← list, ptr.next UNTIL ptr.next=style DO ENDLOOP;
ptr.next ← style.next;
};
RETURN[list];
};

FindStyle: PROC [list,style: StyleDefs.StyleHandle] RETURNS[StyleDefs.StyleHandle]= {
ptr: StyleDefs.StyleHandle;
FOR ptr ← list, ptr.next UNTIL ptr=style OR ptr=NIL DO ENDLOOP;
RETURN[ptr];
};

AddStyle: PROC [style: StyleDefs.StyleHandle] = {
IF firstStyle=NIL THEN firstStyle ← lastStyle ← style
ELSE {lastStyle.next ← style; style.next ← NIL; lastStyle ← style};
};

ForAllControlPairs: PUBLIC PROCEDURE [proc: ControllerDefs.CPProcedure] = BEGIN
rover: ControlPairHandle ← firstControlPair;
UNTIL rover = NIL DO
proc [rover.color, rover.grey];
rover ← rover.next;
ENDLOOP;
END;

AppendStyle: PUBLIC PROCEDURE [src: StyleDefs.StyleHandle]
RETURNS [CARDINAL] =
BEGIN OPEN StyleDefs;
thisstyle, rover: StyleHandle ← NIL;
FOR rover←firstStyle, rover.next UNTIL rover = NIL
DO
IF SameStyle[rover, src]
THEN RETURN[NumberOfStyle[rover]];
ENDLOOP;
thisstyle ← GriffinMemoryDefs.Allocate [lStyle];
thisstyle↑ ← src↑; -- copy body of style
thisstyle.name ← GriffinMemoryDefs.AllocateString[src.name.length];
thisstyle.name.length ← 0;
StringDefs.AppendString[thisstyle.name,src.name];
thisstyle.next ← NIL;
IF firstStyle = NIL THEN firstStyle ← lastStyle ← thisstyle ELSE lastStyle ← lastStyle.next ← thisstyle;
RETURN[NumberOfStyle[thisstyle]];
END;

NumberOfStyle: PUBLIC PROCEDURE [s: StyleDefs.StyleHandle] RETURNS [count: CARDINAL] = BEGIN
rover: StyleDefs.StyleHandle ← firstStyle;
count ← 1;
UNTIL rover = NIL DO
IF s = rover THEN RETURN;
count ← count + 1;
rover ← rover.next;
ENDLOOP;
SIGNAL ControllerError;
END;

StyleWithNumber: PUBLIC PROCEDURE [count: CARDINAL] RETURNS [s: StyleDefs.StyleHandle] = BEGIN
s ← firstStyle;
UNTIL count = 1 DO
IF s = NIL THEN SIGNAL ControllerError;
count ← count - 1;
s ← s.next;
ENDLOOP;
END;


AppendFont: PUBLIC PROCEDURE [fd: GriffinFontDefs.FontDescriptor]
RETURNS [CARDINAL] =
BEGIN
thisfont, rover: FontHandle ← NIL;
FOR rover←firstFont, rover.next UNTIL rover = NIL
DO
IF SameFont[@rover.font,@fd]
THEN RETURN[NumberOfFont[rover]];
ENDLOOP;
thisfont ← GriffinMemoryDefs.Allocate [lFont];
thisfont.font ← fd;
thisfont.next ← NIL;
IF firstFont = NIL
THEN firstFont ← lastFont ← thisfont
ELSE lastFont ← lastFont.next ← thisfont;
RETURN[NumberOfFont[thisfont]];
END;

NumberOfFont: PUBLIC PROCEDURE [font: FontHandle]
RETURNS [count: CARDINAL] =
BEGIN
rover: FontHandle ← firstFont;
count ← 1;
UNTIL rover = NIL DO
IF rover = font THEN RETURN;
count ← count + 1;
rover ← rover.next;
ENDLOOP;
SIGNAL ControllerError;
END;

FontWithNumber: PUBLIC PROCEDURE [count: CARDINAL] RETURNS [fd: GriffinFontDefs.FontDescriptor] = BEGIN
f: FontHandle ← firstFont;
UNTIL count = 1 DO
IF f = NIL THEN SIGNAL ControllerError;
count ← count - 1;
f ← f.next;
ENDLOOP;
fd ← f.font
END;

CurrentFontDescriptor: PUBLIC PROCEDURE RETURNS [GriffinFontDefs.FontDescriptorHandle] = BEGIN
RETURN [@currentFont];
END;


ForAllStyles: PUBLIC PROCEDURE [proc: PROCEDURE [StyleDefs.StyleHandle]] = BEGIN
rover: StyleDefs.StyleHandle ← firstStyle;
UNTIL rover = NIL DO proc [rover]; rover ← rover.next; ENDLOOP;
END;

ForAllFonts: PUBLIC PROCEDURE [proc: PROCEDURE [GriffinFontDefs.FontDescriptor]] = BEGIN
rover: FontHandle ← firstFont;
UNTIL rover = NIL DO proc [rover.font]; rover ← rover.next; ENDLOOP;
END;


styleCount: CARDINAL ← 0;
CurrentStyle: PUBLIC PROCEDURE RETURNS [answer: StyleDefs.StyleHandle] =BEGIN OPEN StyleDefs;
str: STRING;
count: CARDINAL ← 1;
fontid: CARDINAL ← 0;
TryFont: PROCEDURE [fd: GriffinFontDefs.FontDescriptor] = BEGIN
IF StringDefs.EquivalentString [fd.name, currentFont.name] THEN
BEGIN
fd.name ← currentFont.name;
IF fd = currentFont THEN fontid ← count;
END;
count ← count + 1;
END;
ForAllFonts [TryFont];
IF fontid = 0 THEN BEGIN
[]←AppendFont [currentFont];
-- just gave away a string that wasn’t ours, must restore it
str←GriffinMemoryDefs.AllocateString[currentFont.name.length];
StringDefs.AppendString [str, currentFont.name];
currentFont.name ← str;
fontid ← count;
END;
currentStyleRecord.fontid ← fontid;
answer ← firstStyle;
UNTIL answer = NIL DO
currentStyleRecord.next ← answer.next; -- so they’ll be equal
currentStyleRecord.name ← answer.name; -- so they’ll be equal
IF answer↑ = currentStyleRecord THEN RETURN;
answer ← answer.next;
ENDLOOP;
-- note that at this point currentStyleRecord.next must be NIL
styleCount ← styleCount + 1;
answer ← GriffinMemoryDefs.Allocate [lStyle];
answer↑ ← currentStyleRecord;
answer.name ← GriffinMemoryDefs.AllocateString [20];
StringDefs.AppendString [answer.name, "Griffin Style "];
StringDefs.AppendNumber [answer.name, styleCount, 10];
IF firstStyle = NIL THEN
firstStyle ← lastStyle ← answer ELSE lastStyle ← lastStyle.next← answer;
END;

SameStyle: PROCEDURE[s1, s2: StyleDefs.StyleHandle]
RETURNS [same: BOOLEAN] =
BEGIN OPEN StyleDefs;
n1: StyleHandle = s1.next;
n2: StyleHandle = s2.next;
name1: STRING = s1.name;
name2: STRING = s2.name;
s1.next←NIL;
s2.next←NIL;
s1.name←NIL;
s2.name←NIL;
same ← s1↑=s2↑;
s1.next←n1;
s2.next←n2;
s1.name←name1;
s2.name←name2;
END;

SameFont: PROCEDURE[f1, f2: GriffinFontDefs.FontDescriptorHandle]
RETURNS [BOOLEAN] =
BEGIN
IF StringDefs.EquivalentStrings[f1.name, f2.name]
AND f1.rotation = f2.rotation
AND f1.face = f2.face
AND f1.points = f2.points
THEN RETURN[TRUE]
ELSE RETURN[FALSE];
END;

DefaultControllers: PUBLIC PROCEDURE = BEGIN OPEN StyleDefs;
n: FontHandle;
s: StyleHandle;
c: ControlPairHandle;
defaultfontname: STRING;

-- this section resets the font data
UNTIL firstFont = NIL DO
GriffinMemoryDefs.FreeString [firstFont.font.name];
n ← firstFont.next;
GriffinMemoryDefs.Free [firstFont];
firstFont ← n;
ENDLOOP;

lastFont ← NIL;
defaultfontname ← GriffinMemoryDefs.AllocateString [20];
StringDefs.AppendString [defaultfontname, "Helvetica"];
currentFont ← [name: defaultfontname, points: 10, rotation: 0, face: 0];

-- this section resets the style data
UNTIL firstStyle = NIL DO
s ← firstStyle.next;
GriffinMemoryDefs.Free [firstStyle];
firstStyle ← s;
ENDLOOP;

lastStyle ← NIL;

currentStyleRecord.next ← NIL;
currentStyleRecord.color ← [0,0,0];
currentStyleRecord.dashed ← undashed;
currentStyleRecord.firstend ← LineEnd [round, 0, 0, 0, 0, 0];
currentStyleRecord.lastend ← LineEnd [round, 0, 0, 0, 0, 0];
currentStyleRecord.width ← 64;
currentStyleRecord.junctiontype ← round;
currentStyleRecord.fillcolor ← [0,0,0];
currentStyleRecord.filled ← FALSE;
currentStyleRecord.outlined ← TRUE;
currentStyleRecord.fontid ← 0;
currentStyleRecord.backgndcolor ← Color [0,0,0];
currentStyleRecord.fillbackgnd ← FALSE;
currentStyleRecord.anchor ← left;
currentStyleRecord.orientation ← or0;

--set up the conversion from alto pixels to micas (press)

--PixelsToMicas ← 635; PixelsToMicas ← PixelsToMicas/18;
PixelsToMicas ← 32;
--this section resets the hardcopy controller data
hController ← [hxcenter: 304*PixelsToMicas, hycenter: 404*PixelsToMicas, hwidth: 608*PixelsToMicas, hheight: 808*PixelsToMicas,
pressxcenter: Real.RoundC[304*PixelsToMicas], pressycenter: Real.RoundC[404*PixelsToMicas], hscale: 1];


--this section resets the display controller data
rOne ← 1;
dController ← [dxcenter: 304, dycenter: 404, dwidth: 608, dheight: 808, dxscale: rOne/PixelsToMicas,
dyscale: rOne/PixelsToMicas, dxorigin: 0, dyorigin: 0, dgridsize: 8];
UNTIL firstControlPair = NIL DO
c ← firstControlPair.next;
GriffinMemoryDefs.Free [firstControlPair];
firstControlPair ← c;
ENDLOOP;

lastControlPair ← NIL;
END;

CurrentStyleRecord: PUBLIC PROCEDURE RETURNS [StyleDefs.StyleHandle] = BEGIN
RETURN [@currentStyleRecord] END;


ControllerError: PUBLIC SIGNAL = CODE;

-- this code is executed implicitly before anything happens:

greyTable [-1] ← grey50;
greyTable [0] ← [0B, 0B, 0B, 0B];
greyTable [1] ← [0B, 40100B, 0B, 2004B];
greyTable [2] ← [2004B, 40100B, 40100B, 2004B];
greyTable [3] ← [3006B, 40100B, 60140B, 2004B];
greyTable [4] ← [3006B, 60140B, 60140B, 3006B];
greyTable [5] ← [3407B, 60140B, 70160B, 3006B];
greyTable [6] ← [3407B, 160340B, 70160B, 7016B];
greyTable [7] ← [23447B, 160340B, 71162B, 7016B];
greyTable [8] ← [23447B, 162344B, 71162B, 47116B];
greyTable [9] ← [23447B, 172364B, 71162B, 47517B];
greyTable [10] ← [27475B, 172364B, 171362B, 47517B];
greyTable [11] ← [67557B, 172364B, 173366B, 47517B];
greyTable [12] ← [67557B, 173366B, 173366B, 67557B];
greyTable [13] ← [77577B, 173366B, 173767B, 67557B];
greyTable [14] ← [77577B, 177376B, 173767B, 167757B];
greyTable [15] ← [177777B, 177376B, 177777B, 167757B];
greyTable [16] ← [177777B, 177777B, 177777B, 177777B];
DefaultControllers [];


END.