-- Compiler Controllers/n
-- Stone, May 2, 1981 12:41 PM
-- implementing module for griffin file controllers
-- Last Edited by: Stone, July 13, 1983 6:29 pm

DIRECTORY StyleDefs: FROM "StyleDefs" USING [Color, StyleHandle, LineEnd, EndType, Style, Orientation],
 ControllerDefs: FROM "ControllerDefs",
 GriffinFontDefs: FROM "GriffinFontDefs",
 Real: FROM "Real",
 ObjectDefs: FROM "ObjectDefs",
 GriffinMemoryDefs USING [CZone],
 Graphics USING [Color],
 GraphicsColor USING [HSVToColor],
 GriffinDefs USING [AppendNumber],
 Rope;



-- ---------------------------------------------------------------------------------
-- ---------------------------------------------------------------------------------
Controllers: PROGRAM
 IMPORTS Rope, Real, ObjectDefs, GraphicsColor, GriffinMemoryDefs, GriffinDefs
 EXPORTS ControllerDefs =

BEGIN OPEN GriffinMemoryDefs, ControllerDefs;

ROPE: TYPE = Rope.ROPE;

-- this section describes the font data
Font: TYPE = RECORD [next: FontHandle, font: GriffinFontDefs.FontDescriptorHandle];
FontHandle: TYPE = REF Font;
firstFont, lastFont: FontHandle ← NIL;
currentFont: GriffinFontDefs.FontDescriptorHandle ← CZone.NEW[GriffinFontDefs.FontDescriptor];

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

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



--this section describes the display controller data
dController: DisplayController;
ControlPair: TYPE = RECORD [next: ControlPairHandle, color: StyleDefs.Color, grey: [0 .. 255]];
lControlPair: CARDINAL = SIZE [ControlPair];
ControlPairHandle: TYPE = REF ControlPair;
firstControlPair, lastControlPair: ControlPairHandle ← NIL;

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;


GreyOfColor: PUBLIC PROCEDURE [color: StyleDefs.Color] RETURNS [Graphics.Color] = BEGIN
RETURN[GraphicsColor.HSVToColor[
 h: color.hue/255.0, s: color.saturation/255.0, v: color.brightness/255.0]];
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
  temp ← rover.next;
  rover.next ← NIL; --drop it on the floor
  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𡤏irstStyle, rover.next UNTIL rover = NIL
  DO
  IF SameStyle[rover, src]
   THEN RETURN[NumberOfStyle[rover]];
  ENDLOOP;
 thisstyle ← CZone.NEW [Style];
 thisstyle^ ← src^; -- copy body of style
 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.FontDescriptorHandle]
  RETURNS [CARDINAL] =
 BEGIN
 thisfont, rover: FontHandle ← NIL;
 FOR rover𡤏irstFont, rover.next UNTIL rover = NIL DO
  IF SameFont[rover.font,fd]
   THEN RETURN[NumberOfFont[rover]];
  ENDLOOP;
 thisfont ← CZone.NEW[Font ← [NIL,CZone.NEW[GriffinFontDefs.FontDescriptor ← fd^]]];
 currentFont^ ← fd^;
 IF firstFont = NIL
  THEN firstFont ← lastFont ← thisfont
  ELSE{lastFont.next ← thisfont; lastFont ← lastFont.next};
 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.FontDescriptorHandle] = 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.FontDescriptorHandle]] = 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;
 count: CARDINAL ← 1;
 fontid: CARDINAL ← 0;
 TryFont: PROCEDURE [fd: GriffinFontDefs.FontDescriptorHandle] = BEGIN
  IF Rope.Equal [fd.name, currentFont.name, FALSE] AND
   fd.points=currentFont.points AND
   fd.rotation=currentFont.rotation AND fd.face=currentFont.face
   THEN fontid ← count;
  count ← count + 1;
  END;
 --first see if the font in the current style record really exists
 ForAllFonts [TryFont];
 IF fontid = 0 THEN fontid𡤊ppendFont [currentFont];
 currentStyleRecord.fontid ← fontid;
 answer ← firstStyle;
 UNTIL answer = NIL DO
  IF answer^ = currentStyleRecord^ THEN RETURN[answer];
  answer ← answer.next;
  ENDLOOP;
 styleCount ← styleCount + 1;
 answer ← CZone.NEW [Style];
 answer^ ← currentStyleRecord^;
 answer.name ← GriffinDefs.AppendNumber ["Griffin Style ", styleCount];
 IF firstStyle = NIL THEN
  firstStyle ← lastStyle ← answer ELSE lastStyle ← lastStyle.next← answer;
 RETURN[answer];
 END;

SameStyle: PROCEDURE[s1, s2: StyleDefs.StyleHandle]
  RETURNS [same: BOOLEAN] =
BEGIN OPEN StyleDefs;
n1: StyleHandle = s1.next;
n2: StyleHandle = s2.next;
name1: ROPE = s1.name;
name2: ROPE = 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 Rope.Equal[f1.name, f2.name, FALSE]
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: ROPE ← "Cream";

-- this section resets the font data
UNTIL firstFont = NIL DO
 n ← firstFont.next;
 firstFont.next ← NIL;
 firstFont ← n;
 ENDLOOP;

lastFont ← NIL;
currentFont^ ← [name: defaultfontname, points: 10, rotation: 0, face: 0];

-- this section resets the style data
UNTIL firstStyle = NIL DO
 s ← firstStyle.next;
 firstStyle.next ← NIL;
 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
dController ← [dxcenter: 304, dycenter: 404, dwidth: 608, dheight: 808, dxscale: 1.0/PixelsToMicas,
 dyscale: 1.0/PixelsToMicas, dxorigin: 0, dyorigin: 0, dgridsize: 8];
UNTIL firstControlPair = NIL DO
 c ← firstControlPair.next;
 firstControlPair.next ← NIL;
 firstControlPair ← c;
 ENDLOOP;

lastControlPair ← NIL;
END;

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


ControllerError: PUBLIC SIGNAL = CODE;

-- Called from GriffinViewerImpl:
--DefaultControllers [];


END.