{ SAGE Utility Menu Unit

  File:	    MNU_UNIT.TEXT
  Date:	    31-Aug-83
  Version:  1A


  COPYRIGHT (c) 1983 SAGE Computer Technology
  All Rights Reserved
  

  Development History:

  1    23-Mar-83  Initial release.
  1A   25-Aug-83  Added MNU_GetIname and MNU_PutIname.
		  Added display info for submenu entry where
		  submenu is not of MNU_2Style.

  Description:

  This Unit provides facilities to interface to a user through
  a standard menu selection process.  Menu items can be an
  integer, a string, a hexadecimal number (2 words long), a
  boolean (On or Off), a nested menu, an event (driving a user
  routine), or a choice of mutually exclusive items.  A more
  complete description is contained in the SAGE manual
  documentation on the MNU_Unit.

}

UNIT MNU_Unit;

INTERFACE
  
TYPE
  
  MNU_Cat = (MNU_Integer,MNU_String,MNU_Hex,MNU_OnorOff,MNU_SubMenu,MNU_Event,
	     MNU_Choice);
  MNU_Status= (MNU_Done,MNU_Get,MNU_Put,MNU_Enter,MNU_ReEnter,MNU_Exit);
  MNU_Style = (MNU_1Style,MNU_2Style);
  
VAR
  
  MNU_Value:INTEGER;
  MNU_HighValue:INTEGER;
  MNU_Boolean:BOOLEAN;
  MNU_StrValue:STRING;
  
  MNU_State:MNU_Status;
  MNU_MenuNumber:INTEGER;
  MNU_ItemNumber:INTEGER;
  MNU_General:INTEGER;
  MNU_Category:MNU_Cat;
  MNU_Fancy:BOOLEAN;
  
  MNU_Aborted:BOOLEAN;
  MNU_Reject:BOOLEAN;
  
  MNU_File:FILE OF CHAR;
  MNU_Fopen:BOOLEAN;
  
{ Procedures to Define a Menu }
PROCEDURE MNU_Menu(MenuName,MenuTitle:STRING; MenuStyle:MNU_Style; MenuNumber,
		   MenuWidth:INTEGER);
PROCEDURE MNU_CopyM(OldName,MenuName,MenuTitle:STRING; MenuNumber:INTEGER);

{ Procedures to Define Items in a Menu }
PROCEDURE MNU_ItemI(ItemName:STRING; General,Number:INTEGER;
		    HighLimit,LowLimit:INTEGER);
PROCEDURE MNU_ItemS(ItemName:STRING; General,Number:INTEGER);
PROCEDURE MNU_ItemO(ItemName:STRING; General,Number:INTEGER);
PROCEDURE MNU_ItemM(ItemName:STRING; General,Number:INTEGER;
		    MenuName:STRING; DispSubItem:BOOLEAN);
PROCEDURE MNU_ItemH(ItemName:STRING; General,Number:INTEGER;
		    Digits:INTEGER);
PROCEDURE MNU_ItemE(ItemName:STRING; General,Number:INTEGER;
		    Redisplay:BOOLEAN);
PROCEDURE MNU_ItemC(ItemName:STRING; General,Number:INTEGER);
PROCEDURE MNU_CopyI(MenuName:STRING; Number:INTEGER);


PROCEDURE MNU_Show(MenuName:STRING);

PROCEDURE MNU_Loop;

{ Procedures for User Screen Output }
PROCEDURE MNU_ClrScreen;
PROCEDURE MNU_Error;
FUNCTION MNU_YesorNo(Prompt:STRING):BOOLEAN;

{ Procedures for Item Name access }
PROCEDURE MNU_GetIname(MenuName:STRING; ItemNumber:INTEGER;
		       VAR ItemName:STRING);
PROCEDURE MNU_PutIname(MenuName:STRING; ItemNumber:INTEGER;
		       ItemName:STRING);
		       

IMPLEMENTATION

USES {$U SCREENOPS.CODE} SCREENOPS,
     {$U SAGETOOLS.CODE} SIO_UNIT;

CONST
  Debug = FALSE;

TYPE
  
  StringPtr = ^STRING;
  MenuPtr   = ^MenuEntry;
  ItemPtr   = ^ItemType;
  RefPtr    = ^INTEGER;
  
  Item_Type = RECORD
		RefCount:INTEGER;
		Name:StringPtr;
		GenValue:INTEGER;
		IDnumber:INTEGER;
		CASE Category:MNU_Cat OF
		  MNU_Integer:(HighLim:INTEGER;
			       LowLim:INTEGER);
		  MNU_Hex:(NumDigits:INTEGER);
		  MNU_SubMenu:(MenuName:StringPtr;
			       DispSubItem:BOOLEAN);
		  MNU_Event:(Redisp:BOOLEAN);
	      END;
  
  Item_Entry = PACKED RECORD
		 Ptr:^Item_Entry;
		 TypePtr:^Item_Type;
		 Xpos:0..255;
		 Ypos:0..255;
		 IDChar:CHAR;
		 Contents:StringPtr;
	       END;
   Menu_Entry = RECORD
		 Ptr:^Menu_Entry;
		 References:RefPtr;
		 Name:StringPtr;
		 Items:^Item_Entry;
		 Title:StringPtr;
		 Style:MNU_Style;
		 Number:INTEGER;
		 Width:INTEGER;
		 Count:INTEGER;
		 MaxHeading:INTEGER;
	       END;

  Menu_Stack = RECORD
		 FPtr:^Menu_Stack;
		 BPtr:^Menu_Stack;
		 Mptr:^Menu_Entry;
	       END;


VAR
  
  
  { System control }
  State: (Idle,Await,StartDefine,Define,Display,Prompt,PopMenu,OldMenu);
  Menu_List:MenuPtr;
  Menu_Tail:MenuPtr;
  SubMenu:^MenuStack;
  EntryError:BOOLEAN;
  
  { Definition section variables }
  Cur_Menu:^Menu_Entry;
  Cur_Entry:^Item_Entry;
  
  { Display section variables }
  Disp_Menu:^Menu_Entry;
  Disp_Item:^Item_Entry;
  PromptLine:INTEGER;
  ErrorLine:INTEGER;
  ReShow:BOOLEAN;
  
  TermHeight,TermWidth:INTEGER;
  ActHeight:INTEGER;
  ActWidth:INTEGER;
  Columns:INTEGER;
  InterColumnSpace:INTEGER;
  ItemCount:INTEGER;
  
  DummyBoolean:BOOLEAN;
  LeadTitle:INTEGER;
  Printout:BOOLEAN;
  PrintError:BOOLEAN;
  PrintFile:STRING[30];


{ General utility procedures }
PROCEDURE Fatal_Error(N:INTEGER);
VAR
  Dummy:BOOLEAN;
BEGIN
  WRITELN;
  WRITE(CHR(7),'Fatal error ');
  IF N <> 0 THEN WRITE(N);
  WRITELN(' in menu system');
  Dummy:=SC_Space_Wait(TRUE);
  EXIT(PROGRAM);
END;

PROCEDURE BlankString(VAR S:STRING; Size:INTEGER);
BEGIN
  FILLCHAR(S[1],Size,' ');
  {$R-}
  S[0]:=CHR(Size);
  {$R+}
END;

FUNCTION Store_String(S:STRING):StringPtr;
VAR
  Ptr:StringPtr;
  Size:INTEGER;
BEGIN
  Size := ((LENGTH(S) + 2) DIV 2)+1; { +1 is for experiment on problem}
  IF VARNEW(Ptr,Size) <> Size THEN Fatal_Error(1);
  { Ptr^:=S; }
  MOVERIGHT(S,Ptr^,LENGTH(S)+1);
  Store_String:=Ptr;
END;

{ Routines to search for things }
{$N+}
PROCEDURE FindMenu(MenuName:STRING; VAR Result:MenuPtr);
VAR
  Cursor:MenuPtr;
  Searching:BOOLEAN;
BEGIN
  Cursor:=Menu_List;
  Searching:=TRUE;
  WHILE Searching AND (Cursor <> NIL) DO
    BEGIN
      IF Cursor^.Name^ = MenuName THEN Searching:=FALSE
      ELSE
	Cursor:=Cursor^.Ptr;
    END;
  Result:=Cursor;
END;

PROCEDURE FindItem(MenuName:STRING; Item:INTEGER; VAR Result:ItemPtr);
VAR
  Cursor:^Item_Entry;
  Searching:BOOLEAN;
  Menu:MenuPtr;
BEGIN
  Result:=NIL;
  IF Disp_Menu <> NIL THEN
    BEGIN
      IF Disp_Menu^.Name^ = MenuName THEN Menu:=Disp_Menu
      ELSE
	FindMenu(MenuName,Menu);
    END
  ELSE
    FindMenu(MenuName,Menu);
  IF Menu <> NIL THEN
    BEGIN
      Cursor:=Menu^.Items;
      Searching:=TRUE;
      WHILE Searching AND (Cursor <> NIL ) DO
	BEGIN
	  IF Cursor^.TypePtr^.IDnumber = Item THEN Searching:=FALSE
	  ELSE
	    Cursor:=Cursor^.Ptr;
	END;
      Result:=Cursor^.TypePtr;
    END;
END;
{$N-}


PROCEDURE MNU_Error;
BEGIN
  IF MNU_Fancy THEN SC_Erase_to_EOL(0,ErrorLine)
  ELSE
    WRITELN;
END;


{ Create a new menu }
PROCEDURE MNU_Menu{ (MenuName,MenuTitle:STRING; MenuStyle:MNU_Style; 
			    MenuNumber,MenuWidth:INTEGER) };
VAR
  OldMenu:MenuPtr;
BEGIN
  FindMenu(MenuName,OldMenu);
  IF OldMenu <> NIL THEN
    BEGIN
      MNU_Error;
      WRITE('Duplicate menu ',MenuName);
      Fatal_Error(0);
    END;
  NEW(Cur_Menu);
  IF Menu_Tail = NIL THEN Menu_List:=Cur_Menu
  ELSE
    Menu_Tail^.Ptr:=Cur_Menu;
  Menu_Tail:=Cur_Menu;
  WITH Cur_Menu^ DO
    BEGIN
      Ptr:=NIL;
      Name:=Store_String(MenuName);
      Title:=Store_String(MenuTitle);
      Number:=MenuNumber;
      Width:=MenuWidth;
      Items:=NIL;
      Style:=MenuStyle;
      Count:=0;
      MaxHeading:=0;
      NEW(References);
      References^:=1;
    END;
  Cur_Entry:=NIL;
END;

{ Create a copy of an old menu with a new title and menu number }
PROCEDURE MNU_CopyM{ (OldName,MenuName,MenuTitle:STRING; MenuNumber:INTEGER) };
VAR
  OldMenu:MenuPtr;
BEGIN
  FindMenu(OldName,OldMenu);
  IF OldMenu = NIL THEN
    BEGIN
      MNU_Error;
      WRITE('Could not find menu ',OldName,' for copy');
      Fatal_Error(0);
    END;
  NEW(Cur_Menu);
  Menu_Tail^.Ptr:=Cur_Menu;
  Menu_Tail:=Cur_Menu;
  WITH Cur_Menu^ DO
    BEGIN
      Ptr:=NIL;
      Name:=Store_String(MenuName);
      Title:=Store_String(MenuTitle);
      Number:=MenuNumber;
      Width:=OldMenu^.Width;
      Items:=OldMenu^.Items;
      Style:=OldMenu^.Style;
      Count:=OldMenu^.Count;
      MaxHeading:=OldMenu^.MaxHeading;
      References:=OldMenu^.References;
      References^:=References^+1;
    END;
  Cur_Entry:=NIL;
END;


PROCEDURE FormEntry(NewType:ItemPtr);
VAR
  Item:^Item_Entry;
  NewString:STRING;
BEGIN
  NEW(Item);
  WITH Item^, Cur_Menu^ DO
    BEGIN
      TypePtr:=NewType;
      IF LENGTH(NewType^.Name^) > MaxHeading THEN
	MaxHeading := LENGTH(NewType^.Name^);
      Count:=Count+1;
      IF (Width > 0) AND
	 (NOT (NewType^.Category IN [MNU_Event])) THEN
	BEGIN
	  if (NewType^.Category = MNU_SubMenu) AND
	     (NOT NewType^.DispSubItem) THEN
	    BEGIN
	      Contents:=NIL;
	    END
	  ELSE
	    BEGIN
	      BlankString(NewString,Width);
	      Contents:=Store_String(NewString);
	    END;
	END
      ELSE
	Item^.Contents:=NIL;
    END;
  IF Cur_Entry = NIL THEN
    Cur_Menu^.Items:=Item
  ELSE
    Cur_Entry^.Ptr:=Item;
  Cur_Entry:=Item;
END;

PROCEDURE ItemCheck(Style:MNU_Style);
BEGIN
  IF Cur_Menu = NIL THEN
    BEGIN
      MNU_Error;
      WRITE('No menu defined before item');
      Fatal_Error(0);
    END;
  IF Cur_Menu^.Style <> Style THEN
    BEGIN
      MNU_Error;
      WRITE('Incorrect item for ',Cur_Menu^.Name^,' menu style');
      Fatal_Error(0);
    END;
END;

PROCEDURE MNU_ItemI{ (ItemName:STRING; General,Number:INTEGER;
		      HighLimit,LowLimit:INTEGER) };
VAR  NewType:ItemPtr;
BEGIN
  ItemCheck(MNU_1Style);
  NEW(NewType,MNU_Integer);
  WITH NewType^ DO
    BEGIN
      Category:=MNU_Integer;
      Name:=Store_String(ItemName);
      GenValue:=General;
      IDnumber:=Number;
      HighLim:=HighLimit;
      LowLim:=LowLimit;
      RefCount:=1;
    END;
  FormEntry(NewType);
END;

PROCEDURE MNU_ItemS{ (Name:STRING; General,Number:INTEGER) };
VAR
  NewType:ItemPtr;
BEGIN
  ItemCheck(MNU_1Style);
  NEW(NewType,MNU_String);
  WITH NewType^ DO
    BEGIN
      Category:=MNU_String;
      Name:=Store_String(ItemName);
      GenValue:=General;
      IDnumber:=Number;
      RefCount:=1;
    END;
  FormEntry(NewType);
END;

PROCEDURE MNU_ItemO{ (Name:STRING; General,Number:INTEGER) };
VAR
  NewType:ItemPtr;
BEGIN
  ItemCheck(MNU_1Style);
  NEW(NewType,MNU_OnorOff);
  WITH NewType^ DO
    BEGIN
      Category:=MNU_OnorOff;
      Name:=Store_String(ItemName);
      GenValue:=General;
      IDnumber:=Number;
      RefCount:=1;
    END;
  FormEntry(NewType);
END;


PROCEDURE MNU_ItemM{ (Name:STRING; General,Number:INTEGER;
		      MenuName:STRING; DispSubItem:BOOLEAN) };
VAR  NewType:ItemPtr;
BEGIN
  ItemCheck(MNU_1Style);
  NEW(NewType,MNU_SubMenu);
  WITH NewType^ DO
    BEGIN
      Category:=MNU_SubMenu;
      Name:=Store_String(ItemName);
      GenValue:=General;
      IDnumber:=Number;
      RefCount:=1;
    END;
  NewType^.MenuName:=Store_String(MenuName);
  NewType^.DispSubItem:=DispSubItem;
  FormEntry(NewType);
END;

PROCEDURE MNU_ItemH{ (Name:STRING; General,Number:INTEGER;
		      Digits:INTEGER) };
VAR  NewType:ItemPtr;
BEGIN
  ItemCheck(MNU_1Style);
  NEW(NewType,MNU_Hex);
  WITH NewType^ DO
    BEGIN
      Category:=MNU_Hex;
      Name:=Store_String(ItemName);
      GenValue:=General;
      IDnumber:=Number;
      RefCount:=1;
      NumDigits:=Digits;
    END;
  FormEntry(NewType);
END;

PROCEDURE MNU_ItemE{ (ItemName:STRING; General,Number:INTEGER;
		      Redisplay:BOOLEAN) };
VAR  NewType:ItemPtr;
BEGIN
  ItemCheck(MNU_1Style);
  NEW(NewType,MNU_Event);
  WITH NewType^ DO
    BEGIN
      Category:=MNU_Event;
      Name:=Store_String(ItemName);
      GenValue:=General;
      IDnumber:=Number;
      RefCount:=1;
      Redisp:=Redisplay;
    END;
  FormEntry(NewType);
END;

PROCEDURE MNU_ItemC{ (ItemName:STRING) };
VAR
  NewType:ItemPtr;
BEGIN
  ItemCheck(MNU_2Style);
  NEW(NewType,MNU_Choice);
  WITH NewType^ DO
    BEGIN
      Category:=MNU_Choice;
      Name:=Store_String(ItemName);
      GenValue:=General;
      IDnumber:=Number;
      RefCount:=1;
    END;
  FormEntry(NewType);
END;

PROCEDURE MNU_CopyI{ (MenuName:STRING; Number:INTEGER) };
VAR
  Item:ItemPtr;
BEGIN
  FindItem(MenuName,Number,Item);
  Item^.RefCount:=Item^.RefCount+1;
  FormEntry(Item);
END;


PROCEDURE MNU_Show{ (MenuName:STRING) };
BEGIN
  FindMenu(MenuName,Disp_Menu);
  IF Disp_Menu = NIL THEN
    BEGIN
      MNU_Error;
      WRITELN('Could not find Menu ',MenuName,' for display');
      Fatal_Error(0);
    END;
  Disp_Item:=Disp_Menu^.Items;
  MNU_MenuNumber:=Disp_Menu^.Number;
  State:=StartDefine;
END;

PROCEDURE MNU_Loop;
VAR
  BacktoUser:BOOLEAN;
  CH:CHAR;

PROCEDURE Store_Input;
VAR
  Width:INTEGER;
  Result:STRING;
  Digits:INTEGER;
  Cursor:^Menu_Entry;
  ICursor:^Item_Entry;
  SearchDone:BOOLEAN;

PROCEDURE Pad;
VAR
  Temporary:STRING;
BEGIN
  IF LENGTH(Result) < Width THEN 
    BEGIN
      {$R-}
      Temporary[0]:=CHR(Width-LENGTH(Result));
      {$R+}
      FILLCHAR(Temporary[1],LENGTH(Temporary),' ');
      INSERT(Temporary,Result,1);
    END;
END;

BEGIN { Store_Input }
  EntryError:=FALSE;
  Result:='';
  Width:=Disp_Menu^.Width;
  CASE Disp_Item^.TypePtr^.Category OF
    MNU_Integer:BEGIN
		  SIO_IntWt(MNU_Value,Result);
		  Pad;
		END;
    MNU_String: BEGIN
		  Result:=MNU_StrValue;
		  Pad;
		END;
    MNU_Hex:	BEGIN
		  Digits:= Disp_Item^.TypePtr^.NumDigits;
		  IF Digits > 4 THEN
		    BEGIN
		      SIO_HexWt(MNU_HighValue,Digits-4,Result);
		      Digits:=4;
		    END;
		  SIO_HexWt(MNU_Value,Digits,Result);
		  Pad;
		END;
    MNU_OnorOff:BEGIN
		  IF MNU_Boolean THEN Result:='On' ELSE Result:='Off';
		  Pad;
		END;
    MNU_SubMenu:BEGIN
		  IF Disp_Item^.TypePtr^.DispSubItem THEN
		    BEGIN
		      FindMenu(Disp_Item^.TypePtr^.MenuName^,Cursor);
		      IF Cursor <> NIL THEN
			BEGIN
			  IF Cursor^.Style = MNU_2Style THEN
			    BEGIN
			      SearchDone:=FALSE;
			      ICursor:=Cursor^.Items;
			      WHILE (ICursor <> NIL) AND (NOT SearchDone) DO
				BEGIN
				  IF ICursor^.TypePtr^.IDnumber = MNU_Value THEN
				    SearchDone:=TRUE
				  ELSE
				    ICursor:=ICursor^.Ptr;
				END;
			      IF SearchDone THEN
				BEGIN
				  Result:=ICursor^.TypePtr^.Name^;
				  Pad;
				END
			      ELSE
				Pad;
			    END
			  ELSE
			    BEGIN
			      Result:=MNU_StrValue;
			      Pad;
			    END;
			END
		      ELSE
			BEGIN
			  MNU_Error;
			  WRITELN('Could not find menu ',
				   Disp_Item^.Typeptr^.MenuName^);
			  Fatal_Error(0);
			END;
		    END
		  ELSE
		    Pad;
		END;
    MNU_Event:	BEGIN
		  Pad;
		END;
    MNU_Choice: BEGIN
		  IF MNU_Value = Disp_Item^.TypePtr^.IDnumber THEN Result:='*';
		  Pad;
		END;
  END;
  IF LENGTH(Result) > Width THEN
    BEGIN
      EntryError:=TRUE;
      {$R-}
      Result[0]:=CHR(Width);
      {$R-}
    END;
  IF Disp_Item^.Contents <> NIL THEN Disp_Item^.Contents^:=Result;
END;

PROCEDURE FetchSetup;
VAR
  Done:BOOLEAN;
  Menu:MenuPtr;
BEGIN
  Done:=FALSE;
  REPEAT
    IF Disp_Item <> NIL THEN
      BEGIN
	IF Disp_Item^.Contents <> NIL THEN
	  BEGIN
	    State:=Define;
	    MNU_State:=MNU_Get;
	    WITH Disp_Item^.TypePtr^ DO
	      BEGIN
		IF Category = MNU_SubMenu THEN
		  BEGIN
		    IF DispSubItem THEN
		      BEGIN
			FindMenu(MenuName^,Menu);
			IF Menu <> NIL THEN
			  BEGIN
			    IF Menu^.Style = MNU_2Style THEN
			      MNU_MenuNumber:=Menu^.Number
			    ELSE
			      BEGIN
				MNU_MenuNumber:=Disp_Menu^.Number;
				MNU_ItemNumber:=IDnumber;
				MNU_General:=GenValue;
			      END;
			  END
			ELSE
			  BEGIN
			    MNU_Error;
			    WRITE('Could not find referenced menu ',
				   MenuName^);
			    Fatal_Error(0);
			  END;
		      END;
		  END
		ELSE
		  BEGIN
		    MNU_MenuNumber:=Disp_Menu^.Number;
		    MNU_ItemNumber:=IDnumber;
		    MNU_General:=GenValue;
		  END;
		MNU_Category:=Category;
	      END;
	    BacktoUser:=TRUE;
	    Done:=TRUE;
	  END
	ELSE
	  BEGIN
	    Disp_Item:=Disp_Item^.Ptr;
	  END;
      END
    ELSE
      BEGIN
	State:=Display;
	Done:=TRUE;
      END;
  UNTIL Done;
END;

PROCEDURE Planner;
VAR
  MaxHeight:INTEGER;
  MinWidth:INTEGER;
  TotalWidth:INTEGER;
BEGIN
  ItemCount:=Disp_Menu^.Count;
  MaxHeight:=TermHeight+1-5;
  MinWidth:=Disp_Menu^.MaxHeading+Disp_Menu^.Width+6;
  Columns:=((ItemCount-1) DIV MaxHeight)+1;
  IF (Columns*MinWidth) > TermWidth THEN
    BEGIN
      WRITELN('Menu ',Disp_Menu^.Name^,' is ',(Columns*MinWidth)-TermWidth,
	      ' characters too wide');
      Fatal_Error(0);
    END;
  ActWidth:=MinWidth;
  InterColumnSpace:=0;
  IF Columns > 1 THEN
    BEGIN
      InterColumnSpace:=(TermWidth-(Columns*MinWidth)) DIV (Columns-1);
      IF InterColumnSpace > 9 THEN InterColumnSpace:=9;
    END;
  ActHeight:=((ItemCount-1) DIV Columns)+1;
  TotalWidth:=(ActWidth*Columns)+(InterColumnSpace*(Columns-1));
  LeadTitle := (TotalWidth - Length(Disp_Menu^.Title^));
  IF LeadTitle < 0 THEN LeadTitle:=0 ELSE LeadTitle:=LeadTitle DIV 2;
  PromptLine:=ActHeight+3;
  ErrorLine:=ActHeight+4;
END;

PROCEDURE ShowMenu;

TYPE 
  ItemPtr=^Item_Entry;

VAR
  Item:ItemPtr;
  Row,Col:INTEGER;
  Ctr:INTEGER;
  CH:CHAR;
  Space:INTEGER;

PROCEDURE CheckIO;
BEGIN
  IF IORESULT <> 0 THEN
    BEGIN
      Printout:=FALSE;
      PrintError:=TRUE;
    END;
END;

{$N+}
PROCEDURE FindItem(Index:INTEGER; VAR Ptr:ItemPtr);
VAR
  Cursor:ItemPtr;
BEGIN
  Cursor:=Disp_Menu^.Items;
  WHILE Index > 0 DO
    BEGIN
      Index:=Index-1;
      Cursor:=Cursor^.Ptr;
    END;
  Ptr:=Cursor;
END;
{$N-}

BEGIN { ShowMenu }
  ReShow:=FALSE;
  PrintError:=FALSE;
  IF MNU_Fancy THEN SC_Clr_Screen
  ELSE
    BEGIN
      WRITELN;
      WRITELN;
    END;
  IF Printout THEN
    BEGIN
      {$I-}
      WRITELN(MNU_File);
      WRITELN(MNU_File);
      {$I+}
      CheckIO;
    END;
  IF LeadTitle > 0 THEN
    BEGIN
      WRITE(' ':LeadTitle);
      IF Printout THEN
	BEGIN
	  {$I-}
	  WRITE(MNU_File,' ':LeadTitle);
	  CheckIO;
	  {$I+}
	END;
    END;
  WRITELN(Disp_Menu^.Title^);
  IF Printout THEN
    BEGIN
      {$I-}
      WRITELN(MNU_File,Disp_Menu^.Title^);
      {$I+}
      CheckIO;
    END;
  WRITELN;
  IF Printout THEN
    BEGIN
      {$I-}
      WRITELN(MNU_File);
      {$I+}
      CheckIO;
    END;
  FOR Row := 0 TO ActHeight-1 DO
    BEGIN
      FOR Col := 0 TO Columns-1 DO
	BEGIN
	  Ctr := (Col*ActHeight) + Row;
	  IF Ctr < ItemCount THEN
	    BEGIN
	      FindItem(Ctr,Item);
	      IF Ctr < 26 THEN CH:=CHR(ORD('A')+Ctr)
	      ELSE
		IF Ctr < 36 THEN CH:=CHR(ORD('0')+Ctr-26)
		ELSE
		  IF Ctr = 36 THEN CH:='*'
		  ELSE
		    IF Ctr = 37 THEN CH:='#'
		    ELSE
		      IF Ctr < (38+26) THEN CH:=CHR(ORD('a')+Ctr-38)
		      ELSE
			BEGIN
			  MNU_Error;
			  WRITELN('Too many items in menu ',Disp_Menu^.Name^);
			  Fatal_Error(0);
			END;
	      Item^.IDChar:=CH;
	      Item^.Xpos:=Col*(ActWidth+InterColumnSpace);
	      Item^.Ypos:=Row+2;
	      WRITE(CH,' - ',Item^.TypePtr^.Name^);
	      IF Printout THEN
		BEGIN
		  {$I-}
		  WRITE(MNU_File,CH,' - ',Item^.TypePtr^.Name^);
		  {$I+}
		  CheckIO;
		END;
	      Space:=Disp_Menu^.MaxHeading-LENGTH(Item^.TypePtr^.Name^);
	      IF Space > 0 THEN
		BEGIN
		  WRITE(' ':Space);
		  IF Printout THEN
		    BEGIN
		      {$I-}
		      WRITE(MNU_File,' ':Space);
		      {$I+}
		      CheckIO;
		    END;
		END;
	      WRITE(' ');
	      IF Printout THEN
		BEGIN
		  {$I-}
		  WRITE(MNU_File,' ');
		  {$I+}
		  CheckIO;
		END;
	      IF Item^.Contents <> NIL THEN
		BEGIN
		  WRITE(Item^.Contents^);
		  IF Printout THEN
		    BEGIN
		      {$I-}
		      WRITE(MNU_File,Item^.Contents^);
		      {$I+}
		      CheckIO;
		    END;
		END
	      ELSE
		IF Disp_Menu^.Width > 0 THEN
		  BEGIN
		    WRITE(' ':Disp_Menu^.Width);
		    IF Printout THEN
		      BEGIN
			{$I-}
			WRITE(MNU_File,' ':Disp_Menu^.Width);
			{$I+}
			CheckIO;
		      END;
		  END;
	      IF Col <> (Columns-1) THEN
		BEGIN
		  IF InterColumnSpace > 2 THEN
		    BEGIN
		      WRITE(' ');
		      IF Printout THEN
			BEGIN
			  {$I-}
			  WRITE(MNU_File,' ');
			  {$I+}
			  CheckIO;
			END;
		    END
		  ELSE
		    BEGIN
		      WRITE('|');
		      IF Printout THEN
			BEGIN
			  {$I-}
			  WRITE(MNU_File,'|');
			  {$I+}
			  CheckIO;
			END;
		    END;
		  IF InterColumnSpace > 0 THEN
		    BEGIN
		      WRITE(' ':InterColumnSpace);
		      IF Printout THEN
			BEGIN
			  {$I-}
			  WRITE(MNU_File,' ':InterColumnSpace);
			  {$I+}
			  CheckIO;
			END;
		    END;
		END;
	    END;
	END;
      WRITELN;
      IF Printout THEN
	BEGIN
	  {$I-}
	  WRITELN(MNU_File);
	  {$I+}
	  CheckIO;
	END;
    END;
  WRITELN;
  IF Printout THEN
    BEGIN
      {$I-}
      WRITELN(MNU_File);
      CheckIO;
      WRITELN(MNU_File,'Select Menu item <CR exits, ! aborts>: ');
      CheckIO;
      WRITELN(MNU_File);
      CheckIO;
      WRITELN(MNU_File);
      {$I+}
      CheckIO;
      Printout:=FALSE;
    END;
  IF PrintError THEN
    BEGIN
      IF MNU_Fancy THEN SC_Erase_to_EOL(0,ActHeight+3) ELSE WRITELN;
      WRITELN('Error writing to file ',PrintFile);
      DummyBoolean:=SC_Space_Wait(TRUE);
    END;
END;

PROCEDURE ErrorCompletion;
VAR
  CH:CHAR;
BEGIN
  WRITE(CHR(7),', Type space to continue');
  REPEAT
    READ(KEYBOARD,CH);
    IF EOLN(KEYBOARD) THEN READLN(KEYBOARD);
  UNTIL CH=' ';
  IF NOT MNU_Fancy THEN
    BEGIN
      WRITELN;
      WRITELN;
    END;
  MNU_Reject:=FALSE;
END;

PROCEDURE MenuPrompt;
VAR
  CH:CHAR;
  Found:BOOLEAN;
  NewSubMenu:^Menu_Stack;
  Cat:MNU_Cat;
  S:STRING;

PROCEDURE ProcessItem;
VAR
  Cursor:INTEGER;
  Dummy:BOOLEAN;
BEGIN
  EntryError:=FALSE;
  Cursor:=1;
  Dummy:=SIO_ByDlim(Cursor,S,' ');
  CASE Disp_Item^.TypePtr^.Category OF
    MNU_Integer:WITH Disp_Item^.TypePtr^ DO
		  BEGIN
		    EntryError:= NOT SIO_IntRd(Cursor,S,MNU_Value);
		    Dummy:=SIO_ByDlim(Cursor,S,' ');
		    IF Cursor < LENGTH(S) THEN EntryError:=TRUE;
		    IF EntryError THEN WRITE('Illegal integer value');
		    IF (MNU_Value > HighLim) OR
		       (MNU_Value < LowLim) THEN
		       BEGIN
			 EntryError:=TRUE;
			 WRITE('Value out of range ',
			 LowLim,' to ',
			 HighLim);
		       END;
		  END;
    MNU_STRING: BEGIN
		  MNU_StrValue:=S;
		END;
    MNU_Hex:	BEGIN
		  EntryError:= NOT SIO_HexRd(Cursor,S,MNU_HighValue,MNU_Value);
		  Dummy:=SIO_ByDlim(Cursor,S,' ');
		  IF Cursor < LENGTH(S) THEN EntryError:=TRUE;
		  IF EntryError THEN WRITE('Illegal hex value');
		END;
    MNU_OnorOff:BEGIN
		  SIO_Upper(S);
		  IF S='ON' THEN MNU_Boolean:=TRUE
		  ELSE
		    IF S='OFF' THEN MNU_Boolean:=FALSE
		    ELSE
		      BEGIN
			EntryError:=TRUE;
			WRITE('Must enter ON or OFF');
		      END;
		END;
  END;
END;

PROCEDURE NestedMenu;
BEGIN
  WRITELN;
  IF SubMenu = NIL THEN
    BEGIN
      NEW(SubMenu);
      SubMenu^.FPtr:=NIL;
      SubMenu^.BPtr:=NIL;
    END
  ELSE
    BEGIN
      IF SubMenu^.FPtr = NIL THEN
	BEGIN
	  NEW(NewSubMenu);
	  SubMenu^.FPtr:=NewSubMenu;
	  NewSubMenu^.BPtr:=SubMenu;
	  NewSubMenu^.FPtr:=NIL;
	  SubMenu:=NewSubMenu;
	END
      ELSE
	SubMenu:=SubMenu^.FPtr;
    END;
  SubMenu^.MPtr:=Disp_Menu;
  WITH Disp_Item^.TypePtr^ DO
    BEGIN
      MNU_ItemNumber:=IDnumber;
      MNU_General:=GenValue;
      MNU_Show(MenuName^);
    END;
  MNU_State:=MNU_Enter;
  BacktoUser:=TRUE;
END;

PROCEDURE HandleInput;
BEGIN
  IF MNU_Fancy THEN SC_Erase_to_EOL(0,ActHeight+3)
  ELSE
    WRITELN;
  WRITE(Disp_Item^.TypePtr^.Name^,': ');
  READLN(S);
  IF LENGTH(S) > 0 THEN
    BEGIN
      ProcessItem;
      IF EntryError THEN
	BEGIN
	  ErrorCompletion;
	  Found:=FALSE;
	END
      ELSE
	BEGIN
	  State:=Await;
	  BacktoUser:=TRUE;
	  MNU_State:=MNU_Put;
	  WITH Disp_Item^.TypePtr^ DO
	    BEGIN
	      MNU_MenuNumber:=Disp_Menu^.Number;
	      MNU_ItemNumber:=IDnumber;
	      MNU_General:=GenValue;
	      MNU_Category:=Category;
	    END;
	END;
    END
  ELSE
    Found:=FALSE;
END;

PROCEDURE HandleChoice;
VAR
  Cursor:^Item_Entry;
BEGIN
  State:=Await;
  BacktoUser:=TRUE;
  MNU_State:=MNU_Put;
  WITH Disp_Item^.TypePtr^ DO
    BEGIN
      MNU_MenuNumber:=Disp_Menu^.Number;
      MNU_ItemNumber:=IDnumber;
      MNU_General:=GenValue;
      MNU_Category:=Category;
      MNU_Value:=IDnumber;
    END;
  Cursor:=Disp_Menu^.Items;
  WHILE Cursor <> NIL DO
    BEGIN
      IF Cursor^.Contents <> NIL THEN
	IF LENGTH(Cursor^.Contents^) > 0 THEN
	  IF Cursor^.Contents^[LENGTH(Cursor^.Contents^)] <> ' ' THEN
	    BEGIN
	      Cursor^.Contents^[LENGTH(Cursor^.Contents^)] := ' ';
	      IF MNU_Fancy THEN
		BEGIN
		  GOTOXY(Cursor^.Xpos+5+Disp_Menu^.MaxHeading,
			 Cursor^.Ypos);
		  WRITE(Cursor^.Contents^);
		END;
	    END;
      Cursor:=Cursor^.Ptr;
    END;
  MNU_Boolean:=TRUE;
END;

PROCEDURE HandleEvent;
BEGIN
  BacktoUser:=TRUE;
  MNU_State:=MNU_Put;
  WITH Disp_Item^.TypePtr^ DO
    BEGIN
      MNU_MenuNumber:=Disp_Menu^.Number;
      MNU_ItemNumber:=IDnumber;
      MNU_General:=GenValue;
      MNU_Category:=Category;
    END;
  IF Disp_Item^.TypePtr^.Redisp THEN State:=Display ELSE State:=Prompt;
END;

BEGIN { MenuPrompt }
  Found:=FALSE;
  REPEAT
    IF MNU_Fancy THEN
      BEGIN
	SC_Erase_to_EOL(0,ActHeight+4);
	SC_Erase_to_EOL(0,ActHeight+3);
      END;
    WRITE('Select menu item <CR exits, ! aborts>: ');
    READ(KEYBOARD,CH);
    IF NOT EOLN(KEYBOARD) THEN
      BEGIN
	IF CH = '!' THEN
	  BEGIN
	    State:=PopMenu;
	    MNU_Aborted:=TRUE;
	    EXIT(MenuPrompt);
	  END;
	IF Disp_Menu^.Count <= 38 THEN
	  IF (CH >= 'a') AND (CH <= 'z') THEN
	    CH:=CHR(ORD(CH)-ORD('a')+ORD('A'));
	Disp_Item:=Disp_Menu^.Items;
	WHILE (NOT Found) AND (Disp_Item <> NIL) DO
	  BEGIN
	    IF Disp_Item^.IDChar = CH THEN Found:=TRUE
	    ELSE
	      Disp_Item:=Disp_Item^.Ptr;
	  END;
	IF Found THEN
	  BEGIN
	    Cat:=Disp_Item^.TypePtr^.Category;
	    IF Cat IN [MNU_SubMenu] THEN NestedMenu
	    ELSE
	      IF Cat IN [MNU_Integer,MNU_String,MNU_Hex,MNU_OnorOff] THEN
		HandleInput
	      ELSE
		IF Cat = MNU_Choice THEN HandleChoice
		ELSE
		  IF Cat = MNU_Event THEN HandleEvent;
	  END
	ELSE
	  BEGIN
	    IF CH = '=' THEN
	      BEGIN
		IF MNU_Fancy THEN SC_Erase_to_EOL(0,ActHeight+3) ELSE WRITELN;
		IF MNU_Fopen THEN
		  BEGIN
		    {$I-}
		    CLOSE(MNU_File,LOCK);
		    {$I+}
		    IF IORESULT<>0 THEN
		      BEGIN
			WRITELN(CHR(7),
				'Error closing previous file ',PrintFile);
			DummyBoolean:=SC_Space_Wait(TRUE);
		      END;
		    MNU_Fopen:=FALSE;
		  END;
		WRITE('File for printout: ');
		READLN(PrintFile);
		IF LENGTH(PrintFile) > 0 THEN
		  BEGIN
		    SIO_Suffix('.TEXT',PrintFile);
		    {$I-}
		    REWRITE(MNU_File,PrintFile);
		    {$I+}
		    IF IORESULT <> 0 THEN
		      BEGIN
			IF MNU_Fancy THEN SC_Erase_to_EOL(0,ActHeight+3)
			ELSE
			  WRITELN;
			WRITELN(CHR(7),'Could not open ',PrintFile);
			DummyBoolean:=SC_Space_Wait(TRUE);
		      END
		    ELSE
		      MNU_Fopen:=TRUE;
		  END;
	      END
	    ELSE
	      IF (CH = '/') AND MNU_Fopen THEN
		BEGIN
		  Printout:=TRUE;
		  ShowMenu;
		END
	      ELSE
		WRITE(CHR(7));
	  END;
      END
    ELSE
      BEGIN
	READLN(KEYBOARD);
	State:=PopMenu;
	Found:=TRUE;
      END;
  UNTIL Found;
END;

BEGIN { MNU_Loop }
  BacktoUser:=FALSE;
  REPEAT
    CASE State OF
      Await:BEGIN
	      IF NOT MNU_Reject THEN
		BEGIN
		  Store_Input;
		  IF MNU_Fancy THEN
		    BEGIN
		      GOTOXY(Disp_Item^.Xpos+5+Disp_Menu^.MaxHeading
			     ,Disp_Item^.Ypos);
		      WRITE(Disp_Item^.Contents^);
		    END
		  ELSE
		    BEGIN
		      WRITELN;
		      ShowMenu;
		    END;
		  IF EntryError THEN 
		    BEGIN
		      IF MNU_Fancy THEN SC_Erase_to_EOL(0,ActHeight+4);
		      WRITE('Warning - item will not fit in display');
		    END;
		END;
	      IF ReShow THEN State:=StartDefine ELSE State:=Prompt;
	      IF MNU_Reject OR EntryError THEN
		BEGIN
		  ErrorCompletion;
		  IF Disp_Menu^.Style = MNU_2Style THEN State:=StartDefine;
		END;
	    END;
      StartDefine:BEGIN
		    IF MNU_Aborted THEN State:=PopMenu
		    ELSE
		      IF MNU_Reject THEN
			BEGIN
			  ErrorCompletion;
			  State:=PopMenu;
			END
		      ELSE
			IF Disp_Menu^.Width > 0 THEN
			  BEGIN
			    Disp_Item:=Disp_Menu^.Items;
			    FetchSetup;
			  END
			ELSE
			  State:=Display;
		  END;
      Define:BEGIN
	       Store_Input;
	       Disp_Item:=Disp_Item^.Ptr;
	       FetchSetup;
	     END;
      Display:BEGIN
		Planner;
		ShowMenu;
		State:=Prompt;
	      END;
      Prompt:BEGIN
	       MenuPrompt;
	     END;
      Idle:  BEGIN
	       MNU_State:=MNU_Done;
	       BacktoUser:=TRUE;
	     END;
      PopMenu:BEGIN
		MNU_MenuNumber:=Disp_Menu^.Number;
		BacktoUser:=TRUE;
		MNU_State:=MNU_Exit;
		State:=OldMenu;
	      END;
      OldMenu:BEGIN
		IF SubMenu <> NIL THEN
		  BEGIN
		    IF SubMenu^.MPtr <> NIL THEN
		      BEGIN
			MNU_Show(SubMenu^.MPtr^.Name^);
			BacktoUser:=TRUE;
			SubMenu^.MPtr:=NIL;
			IF SubMenu^.BPtr <> NIL THEN SubMenu:=SubMenu^.BPtr;
			MNU_State:=MNU_ReEnter;
		      END
		    ELSE
		      BEGIN
			State:=Idle;
		      END;
		  END
		ELSE
		  BEGIN
		    State:=Idle;
		  END;
	      END;
    END;
  UNTIL BacktoUser;
  MNU_Reject:=FALSE;
END;

PROCEDURE MNU_ClrScreen;
BEGIN
  IF MNU_Fancy THEN SC_Clr_Screen
  ELSE
    BEGIN
      WRITELN;
      WRITELN;
    END;
  ReShow:=TRUE;
END;

FUNCTION MNU_YesorNo {(Prompt:STRING):BOOLEAN};
VAR
  Warning:BOOLEAN;
  CH:CHAR;
  Done:BOOLEAN;
BEGIN
  Warning:=FALSE;
  Done:=FALSE;
  MNU_YesorNo:=FALSE;
  WRITE(Prompt,' ');
  REPEAT
    READ(KEYBOARD,CH);
    IF (CH='Y') OR (CH='y') THEN
      BEGIN
	WRITE(CH);
	MNU_YesorNo:=TRUE;
	Done:=TRUE;
      END
    ELSE
      IF (CH='N') OR (CH='n') THEN
	BEGIN
	  Done:=TRUE;
	  WRITE(CH);
	END
      ELSE
	BEGIN
	  IF EOLN(KEYBOARD) THEN READLN(KEYBOARD);
	  WRITE(CHR(7));
	  IF NOT Warning THEN WRITE('Y or N? ');
	  Warning:=TRUE;
	END;
  UNTIL Done;
  WRITELN;
END;

PROCEDURE MNU_GetIname { (MenuName:STRING;ItemNumber:INTEGER;
			 VAR ItemName:STRING) };
VAR
  Item:ItemPtr;
BEGIN
  FindItem(MenuName,ItemNumber,Item);
  IF Item <> NIL THEN ItemName:=Item^.Name^;
END;

PROCEDURE MNU_PutIname { (MenuName:STRING;ItemNumber:INTEGER;
			  ItemName:STRING) };
VAR
  Item:ItemPtr;
  Size:INTEGER;
BEGIN
  FindItem(MenuName,ItemNumber,Item);
  IF Item <> NIL THEN
    BEGIN
      Size:=LENGTH(Item^.Name^);
      IF SIZE <> LENGTH(ItemName) THEN
	IF SIZE > LENGTH(ItemName) THEN
	  BEGIN
	    SIO_Fill(Size-LENGTH(ItemName),ItemName);
	  END
	ELSE
	  BEGIN
	    {$R-}
	    ItemName[0]:=CHR(LENGTH(Item^.Name^));
	    {$R+}
	  END;
      Item^.Name^:=ItemName;
    END;
END;

PROCEDURE InitData;
VAR
  Tinfo:SC_Info_Type;
BEGIN
  SC_Use_Info(SC_Get,T_info);
  WITH T_info.Misc_Info DO
    BEGIN
      Term_Height:=Height;
      Term_Width:=Width;
      MNU_Fancy:=XY_CRT;
    END;
END;

BEGIN { Initialization }
  Menu_List:=NIL;
  Menu_Tail:=NIL;
  Cur_Menu:=NIL;
  Cur_Entry:=NIL;
  Disp_Menu:=NIL;
  Disp_Item:=NIL;
  SubMenu:=NIL;
  State:=Idle;
  ReShow:=FALSE;
  MNU_Reject:=FALSE;
  MNU_Aborted:=FALSE;
  Printout:=FALSE;
  MNU_Fopen:=FALSE;
  InitData;

***;
  
  IF MNU_Fopen THEN
    BEGIN
      {$I-}
      CLOSE(MNU_File,LOCK);
      {$I+}
      IF IORESULT<>0 THEN
	BEGIN
	  WRITELN;
	  WRITELN(CHR(7),'Error closing printout file ',PrintFile);
	  DummyBoolean:=SC_Space_Wait(TRUE);
	END;
      MNU_Fopen:=FALSE;
    END;
END.


                                                                                                                                                                                                                                                                  