-- 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_firstStyle, 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_firstFont, 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_AppendFont [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.

�Êá˜JšÜÏcnœ1Ïk	œžœ
žœNžœ%žœžœžœ"žœžœžœžœ�ª
œžœžœHžœžœ
žœ&žœžœžœ�(œžœžœMžœžœ)žœb�)œ/žœ4žœ�6œ$�5œ-žœžœTžœžœ#žœžœEžœžœÏnœžœ
ž	œžœžœŸœžœ
ž	œžœžœŸœžœ
ž	œ
žœžœ
žœžœŸœžœ
ž	œ
žœžœ
žœžœŸœžœ
ž	œžœžœ
žœhžœŸ
œžœ
žœ/žœ žœ
žœW�œnžœ�œ(�5œžœžœ
žœTžœŸœžœ%žœ:žœžœžœžœžœžœ
žœ!žœ
Ÿ	œžœ%žœ9žœžœžœžœ
žœ
žœžœŸœžœ%žœžœ
žœ"žœ'žœŸœžœ
ž	œ&žœ0žœ	žœ
žœ;žœžœŸœžœ
ž	œ žœžœžœ
žœ-žœžœžœ	žœžœžœžœ
žœžœžœ�œžœžœžœ
žœ$žœ*žœžœŸ
œžœ
ž	œžœ	žœžœ:žœ	žœ
žœžœžœ
žœ/žœžœžœŸœžœ
ž	œ	žœžœžœžœžœžœžœ
žœ
žœ7žœžœŸ
œžœ
ž	œ.žœžœžœ žœžœžœ	žœ
žœžœžœ
žœžœžœ	Ïsœžœ@žœ
žœžœ#žœ7žœžœŸœžœ
ž	œžœ	žœžœ.žœ	žœ
žœžœžœ
žœ/žœžœžœŸœžœ
ž	œ	žœžœ.žœžœžœžœžœ
žœ
žœ7žœžœŸœžœ
ž	œ
žœ*žœ
žœžœŸœžœ
ž	œž	œžœ.žœ	žœ
žœ#žœžœŸœžœ
ž	œž	œ+žœ"žœ	žœ
žœ(žœžœžœŸœžœ
ž	œ
žœ"žœ
žœžœžœŸœž	œ.žœžœ(žœžœ!žœ%žœžœ(žœÏiBœžœžœ^žœ
žœ
žœžœžœ
žœ$žœ0žœsžœžœ
žœ#žœ&žœžœŸ	œž	œ"žœžœžœ
žœIžœžœžœ
žœ
žœ
žœHžœŸœž	œ1žœžœžœ
žœžœžœžœžœžœ
žœ
žœžœ
žœ
žœžœŸœžœ
ž	œžœ
žœRžœ
�%žœ
žœ
žœ>žœžœM�&žœžœ
žœAžœžœžœÔžœ žœsžœK�:œ
�9œ�3œë
�2œª
žœžœ
žœSžœžœžœŸœžœ
ž	œ
žœžœ
žœžœžœ
žœžœ�
œ!�œžœ˜´P—…—(6.