-- color menu
-- MStone December 11, 1980  7:15 PM
-- Tiberi January 25, 1980  1:37 PM

DIRECTORY
	MenuDefs: FROM "MenuDefs",
	ControllerDefs: FROM "ControllerDefs",
	StringDefs: FROM "StringDefs",
	ScreenDefs: FROM "ScreenDefs",
	StyleDefs: FROM "StyleDefs",
	RefreshDefs: FROM "RefreshDefs",
	GriffinFontDefs: FROM "GriffinFontDefs",
	PointDefs: FROM "PointDefs",
	ObjectDefs: FROM "ObjectDefs"
		USING [MenuOrientation, StartObject, ObjectProc,
		ForAllObjects, ReplotBoxFromObject],
	GriffinMemoryDefs: FROM "GriffinMemoryDefs";

Menu: PROGRAM
	IMPORTS StringDefs, ObjectDefs, GriffinFontDefs,
		GriffinMemoryDefs, ScreenDefs, ControllerDefs,
		RefreshDefs, PointDefs
	EXPORTS MenuDefs SHARES MenuDefs = 
BEGIN OPEN MenuDefs, ObjectDefs;

X: INTEGER = PointDefs.X;
Y: INTEGER = PointDefs.Y;

menuLineWidth: INTEGER = 3;
menuMargin: INTEGER = 4;
menuTopMargin: INTEGER = 1;
menuStyle: StyleDefs.StyleHandle _ NIL;
menuFont: GriffinFontDefs.FontDescriptor;
menuHeight: INTEGER _ 0;
menuBaseLine: INTEGER _ 0;
menuGrey: POINTER TO ARRAY [0..3] OF CARDINAL _ NIL;
black: POINTER TO ARRAY [0..3] OF CARDINAL _ NIL;


twoLineWidth: INTEGER = 2*menuLineWidth;

MenuStyle: PUBLIC PROCEDURE RETURNS [StyleDefs.StyleHandle] =
BEGIN
RETURN [menuStyle]
END;

CreateMenu: PUBLIC PROCEDURE [orientation: MenuOrientation, tl: PointDefs.ScrPt, title: STRING] RETURNS [menu: MenuHandle] = 
BEGIN
menu _ LOOPHOLE [StartObject [menu], MenuHandle];
-- a MenuHandle is a POINTER TO menu Object
menu.head _ NIL;
menu.validEncoding _ TRUE;
menu.style _ menuStyle;
menu.orientation _ orientation;
menu.visible _ FALSE;
menu.tl _ tl; -- leave space for enclosing box
SELECT orientation FROM
vertical =>
	BEGIN
	menu.br [X] _ tl [X] + twoLineWidth-1;
	menu.br [Y] _ tl [Y] + menuLineWidth-1;
	END;
horizontal =>
	BEGIN
	menu.br [X] _ tl [X] + menuLineWidth-1;
	menu.br [Y] _ tl [Y] + twoLineWidth + menuHeight;
	END;
ENDCASE;
IF title # NIL AND title.length > 0
   THEN AddMenuItem [menu, title, NullMenuProc].inverted _ TRUE;
END;

NullMenuProc: MenuProc = BEGIN END;

ItemWidth: PROCEDURE [string:STRING] RETURNS [INTEGER] = INLINE
BEGIN
RETURN [PointDefs.ObjValToScrVal[GriffinFontDefs.StringWidth [string,
	@menuFont, menuStyle.orientation]] + menuMargin - 1];
END;

AddMenuItem: PUBLIC PROCEDURE [menu: MenuHandle, string: STRING, proc: MenuProc] RETURNS [MenuItemHandle] = 
BEGIN
newitem: MenuItemHandle;
rover: MenuItemHandle;
first: BOOLEAN _ FALSE;

newitem _ GriffinMemoryDefs.Allocate [SIZE [MenuItem]];
newitem^ _ [link: NIL, menu: menu, selected: FALSE, inverted: FALSE,
	tl: , br: , string: NIL, proc: proc];
IF menu.head=NIL
THEN BEGIN first _ TRUE; menu.head _ newitem END
ELSE	BEGIN
	FOR rover _ menu.head, rover.link UNTIL rover.link = NIL
		DO ENDLOOP;  --find end
	rover.link _ newitem
	END;
SELECT menu.orientation FROM
vertical =>
	BEGIN
	newitem.tl [X] _ menu.tl [X] + menuLineWidth;
	newitem.tl [Y] _ menu.br [Y] + 1;
	END;
horizontal =>
	BEGIN
	newitem.tl [X] _ menu.br [X] + 1;
	newitem.tl [Y] _ menu.tl [Y] + menuLineWidth;
	END;
ENDCASE;
newitem.string _ GriffinMemoryDefs.AllocateString [string.length];
StringDefs.AppendString [newitem.string, string];
SELECT menu.orientation FROM
vertical =>
	BEGIN
	width: INTEGER _ ItemWidth[string];
	IF first OR menu.tl[X] + width + twoLineWidth > menu.br [X]
		THEN ChangeMenuWidth[menu, ItemWidth[string]]
		ELSE newitem.br [X] _ menu.br [X] - menuLineWidth;
	newitem.br [Y] _ newitem.tl [Y] + menuHeight;
	menu.br [Y] _ newitem.br [Y] + menuLineWidth;
	END;
horizontal =>
	BEGIN
	newitem.br [X] _ newitem.tl [X] + ItemWidth[string];
	newitem.br [Y] _ menu.br [Y] - menuLineWidth;
	menu.br [X] _ newitem.br [X] + menuLineWidth
	END;
ENDCASE;
IF menu.visible THEN RefreshDefs.EraseAndSave[menu];
RETURN [newitem];
END;

ChangeMenuWidth: PROCEDURE [menu: MenuHandle, width: INTEGER] =
BEGIN OPEN ObjectDefs;
WidenMenu: MenuProc =
	BEGIN
	item.br [X] _ item.tl [X] + width;
	END;
IF menu.orientation # vertical THEN ERROR;
ForAllMenuItems [menu, WidenMenu];
menu.br [X] _ menu.tl [X] + width + twoLineWidth;
IF menu.visible THEN RefreshDefs.EraseAndSave[menu];
END;

ForAllMenus: PUBLIC PROCEDURE [proc: PROCEDURE [menu: MenuHandle]] =
BEGIN OPEN ObjectDefs;
IsMenu: ObjectProc =
	BEGIN
	WITH object: obj SELECT FROM
		menu => proc[@object];
	ENDCASE; 
	END;
ForAllObjects[IsMenu];
END;

ForAllMenuItems: PUBLIC PROCEDURE [menu: MenuHandle, proc: MenuProc] = 
BEGIN
rover: MenuItemHandle;
FOR rover _ menu.head, rover.link UNTIL rover = NIL
		DO proc [rover] ENDLOOP;
END;

PlotMenu:  PUBLIC PROCEDURE [menu: MenuHandle] = 
BEGIN
tl, br: PointDefs.ScrPt;
ScreenDefs.EraseBoxBW[menu.tl, menu.br];
ScreenDefs.SetFunction[replace];
ScreenDefs.SetFillParms[menuGrey,0];
menu.visible _ TRUE;

--top edge:
tl _ menu.tl;
br [X] _ menu.br[X];
br [Y] _ tl [Y] + menuLineWidth - 1;
ScreenDefs.BoxFill [tl, br];

--left edge:
br [X] _ tl [X] + menuLineWidth - 1;
br [Y] _ menu.br [Y];
tl _ menu.tl;
ScreenDefs.BoxFill [tl, br];

-- the right edge:
tl [X] _ menu.br [X] - menuLineWidth + 1;
tl [Y] _ menu.tl [Y];
br _ menu.br;
ScreenDefs.BoxFill [tl, br];

-- the bottom edge:
tl [X] _ menu.tl [X];
tl [Y] _ menu.br [Y] - menuLineWidth + 1;
br _ menu.br;
ScreenDefs.BoxFill [tl, br];

ForAllMenuItems [menu, ShowItem];
END;

ShowMenu: PUBLIC PROCEDURE [menu: MenuHandle] = 
BEGIN
menu.visible _ TRUE;
RefreshDefs.PlotAndMark[menu];
END;

HideMenu:  PUBLIC PROCEDURE [menu: MenuHandle] = 
BEGIN
menu.visible _ FALSE;
RefreshDefs.EraseAndSave[menu];
END;

ShowItem: PUBLIC MenuProc = 
BEGIN
tl, br: PointDefs.ScrPt;
screen: ScreenDefs.ScreenPtr _ ScreenDefs.GetCurrentScreen[];
tl _ item.tl;
br _ IF item.menu.orientation = vertical
	THEN [item.br[X], item.br[Y] + menuLineWidth]
	ELSE [item.br[X] + menuLineWidth, item.br[Y]];
IF tl[X] >screen.rx OR tl[Y] >screen.by
   OR br[X] < screen.lx OR br[Y] < screen.ty
	THEN RETURN;

IF item.menu.orientation = vertical
	THEN tl [Y] _ item.br [Y]+1 -- bottom edges
	ELSE tl [X] _ item.br [X]+1; -- right edges
ScreenDefs.SetFunction[replace];
ScreenDefs.SetFillParms[menuGrey,0];
ScreenDefs.BoxFill [tl, br];

GriffinFontDefs.DisplayString [item.string,
	MenuAnchorPoint[item],
	StyleDefs.Anchor [center],
	StyleDefs.Orientation [or0], @menuFont];
IF item.inverted THEN
	BEGIN
	ScreenDefs.InvertBox[item.tl, item.br];
	END;
END;

OverWhichItem: PUBLIC PROCEDURE [pt: PointDefs.ScrPt] RETURNS [lastitem: MenuItemHandle] = 
BEGIN
lastover: MenuHandle _ NIL;
IsOverMenu: PROCEDURE[m: MenuHandle] = 
	BEGIN
	IF m.visible
	  AND pt [X] IN [m.tl[X]..m.br[X]]
	  AND pt [Y] IN [m.tl[Y]..m.br[Y]]
		THEN lastover _ m;
	END;
LastItemOver: MenuProc =
	BEGIN
	IF pt [X] IN [item.tl [X] .. item.br [X]] AND
		pt [Y] IN [item.tl [Y] .. item.br [Y]] THEN lastitem _ item
	END;
lastitem _ NIL;
ForAllMenus[IsOverMenu];
IF lastover = NIL THEN RETURN [NIL];
-- which menu item?
ForAllMenuItems[lastover, LastItemOver];
END;

IsOverItem: PUBLIC PROCEDURE [pt: PointDefs.ScrPt,
		item: MenuItemHandle] RETURNS [BOOLEAN] = 
BEGIN
IF pt [X] IN [item.tl [X]..item.br [X]]
   AND pt [Y] IN [item.tl [Y]..item.br [Y]]
	THEN RETURN [TRUE]
	ELSE RETURN [FALSE];
END;

BugItem: PUBLIC PROCEDURE [item: MenuItemHandle] = 
BEGIN item.proc [item] END;

--questions about menus:

WhichMenu:  PUBLIC PROCEDURE [item: MenuItemHandle]
	RETURNS [menu: MenuHandle] =
BEGIN RETURN [item.menu] END;

IsSelected:  PUBLIC PROCEDURE [item: MenuItemHandle] RETURNS [BOOLEAN] =
BEGIN RETURN [item.selected] END;

MenuString:  PUBLIC PROCEDURE [item: MenuItemHandle] RETURNS [STRING] =
BEGIN RETURN [item.string] END;
-- the string returned might go away sometime!

MenuAnchorPoint: PUBLIC PROCEDURE [item: MenuItemHandle]
		RETURNS [pt: PointDefs.ScrPt] =
BEGIN
pt[X] _ (item.br[X]+item.tl[X])/2 + 1;
pt[Y] _ item.tl[Y] + menuTopMargin;
END;

--changing things:

SetMenuString: PUBLIC PROCEDURE [item: MenuItemHandle, string: STRING] =
BEGIN
menu: MenuHandle = item.menu;
width: INTEGER _ 0;
FindWidest: MenuProc =
	BEGIN
	w: INTEGER _ ItemWidth[item.string];
	IF w>width THEN width _ w;
	END;
GriffinMemoryDefs.FreeString[item.string];
item.string _ GriffinMemoryDefs.AllocateString [string.length];
StringDefs.AppendString [item.string, string];
IF menu.visible THEN RefreshDefs.EraseAndSave[menu];
ForAllMenuItems [menu, FindWidest];
ChangeMenuWidth[menu, width];
IF menu.visible THEN RefreshDefs.EraseAndSave[menu];
END;

SelectOnly: PUBLIC MenuProc =
BEGIN
ForAllMenuItems[item.menu, Deselect];
Select[item];
END;

Select: PUBLIC MenuProc =
BEGIN
item.selected _ TRUE;
ClearMenuItem[item]
END;

Deselect: PUBLIC MenuProc =
BEGIN
IF item.selected THEN
	BEGIN
	item.selected _ FALSE;
	ClearMenuItem[item];
	END;
END;

HighlightMenuItem: PUBLIC MenuProc =
BEGIN
wasInverted: BOOLEAN = item.inverted;
item.inverted _ ~ item.selected;
IF item.menu.visible AND wasInverted # item.inverted
   THEN ObjectDefs.ReplotBoxFromObject[item.tl, item.br, item.menu];
END;

ClearMenuItem: PUBLIC MenuProc =
BEGIN
wasInverted: BOOLEAN = item.inverted;
item.inverted _ item.selected;
IF item.menu.visible AND wasInverted # item.inverted
   THEN ObjectDefs.ReplotBoxFromObject[item.tl, item.br, item.menu];
END;

InitMenuStyle: PROCEDURE =
BEGIN OPEN GriffinFontDefs, StringDefs;
currentFont: FontDescriptorHandle;
best: FontDescriptorHandle _ NIL;
nameInSet: PROC[s: STRING] RETURNS[BOOLEAN] = {
	RETURN[ 
	EquivalentString[s, "Cream"] OR
	EquivalentString[s, "Helvetica"] OR
	EquivalentString[s, "TimesRoman"] OR
	EquivalentString[s, "Gacha"] OR
	EquivalentString[s, "SmallTalk"]];
	};

findCream10: PROC[font: FontDescriptorHandle] = {
	IF font.rotation=Rot0Degrees AND
		EquivalentString[font.name, "Cream"] AND font.points=10 
		THEN best _ font;
	};
findAny10InSet: PROC[font: FontDescriptorHandle] = {
	IF font.rotation=Rot0Degrees AND
		font.points=10 AND nameInSet[font.name] THEN best _ font;
	};

findAnyInSet: PROC[font: FontDescriptorHandle] = {
	IF font.rotation=Rot0Degrees AND nameInSet[font.name]
		THEN best _ font;
	};

findAny: PROC[font: FontDescriptorHandle] = {
	IF font.rotation=Rot0Degrees AND best#NIL THEN best _ font;
	};

menuStyle _ ControllerDefs.CurrentStyleRecord[];
--pick a menu font.  Try for Cream 10, then one of the nameset above
--Then, find the first font that meets one of those names
--default to the first font found
ForAllFonts[findCream10];
IF best=NIL THEN ForAllFonts[findAny10InSet];
IF best=NIL THEN ForAllFonts[findAnyInSet];
IF best=NIL THEN ForAllFonts[findAny];
IF best=NIL THEN StartupFontError[nofonts];
currentFont _ ControllerDefs.CurrentFontDescriptor[];
currentFont^ _ best^;
	BEGIN OPEN menuStyle;
	color _ [0,0,128]; -- 50% grey
	fillcolor _ [0,0,128];
	backgndcolor _ [0,0,128];
	anchor _ center;
	orientation _ or0;
	END;
menuStyle _ ControllerDefs.CurrentStyle[];
menuFont _ ControllerDefs.FontWithNumber[menuStyle.fontid];
menuHeight _ PointDefs.ObjValToScrVal[GriffinFontDefs.MaxHeight
		[@menuFont]] + menuTopMargin-1;
menuBaseLine _ GriffinFontDefs.BaseLine [@menuFont];
menuGrey _ ControllerDefs.GreyOfColor[menuStyle.color];
black _ ControllerDefs.GreyOfColor[[0,0,0]];
END;

InitMenuStyle;

END.