UNIT MENUBOX;

INTERFACE
USES IOSTUFF,KEY2,CRT,DOS;
  PROCEDURE ResetBox;
  PROCEDURE SetMenuBox(X,Y: Integer; Header: AnyStr; MenuStr: LongStr);
  FUNCTION PickMenuBox : Char;

IMPLEMENTATION

CONST
  ColorF1   = Yellow;      { Menu Phrase colors }
  ColorB1   = Blue;
  ColorF2   = LightCyan;   { Foreground Color - First Letter }
  ColorB2   = Blue;
  ColorF3   = Black;       { Reverse Video colors for bar cursor }
  ColorB3   = LightGray;
  ColorF4   = LightGray;     { Border Colors }
  ColorB4   = Black;
  MaxMenuItems = 12;

VAR
  XPos,YPos : Integer;
  MenuMsg   : Array[1..MaxMenuItems] of ShortStr; { Make this longer if needed }
  MenuLtr   : Array[1..MaxMenuItems] of Char;
  NumPicks  : Integer;
  Pick      : Integer;
  LastPick  : Integer;
  Longest   : Integer;
  HeaderText : AnyStr;
  SaveAttr  : Byte;
{============================================================================}
PROCEDURE ResetBox;

{ Writes the box menu on the screen }

VAR
    P : Integer;
BEGIN
    SaveAttr := TextAttr;
    SetColor(ColorF4,ColorB4);
    SBorder(XPos,YPos,XPos+Longest+3,YPos+NumPicks+1,HeaderText);
    For P := 1 to NumPicks do Begin
      FillChar(MenuMsg[P,Length(MenuMsg[P])+1],Longest-Length(MenuMsg[P]),' ');
      MenuMsg[P,0] := Chr(Longest);
      SetColor(ColorF1,ColorB1);
      WriteSt(' '+MenuMsg[P]+' ',XPos+1,YPos+P);
      SetColor(ColorF2,ColorB2);
      WriteCh(MenuLtr[P],XPos+2,YPos+P);
    End;
    TextAttr := SaveAttr;
END;
{============================================================================}
  PROCEDURE SetMenuBox(X,Y: Integer; Header: AnyStr; MenuStr: LongStr);

  VAR
    CPos   : Integer;
    Len    : Integer;

  BEGIN
    XPos := X; YPos := Y;
    Pick := 1;
    LastPick := 1;
    CPos := 1;
    NumPicks := 0;
    Longest := 1;

    Repeat
      If NumPicks < MaxMenuItems then NumPicks := NumPicks + 1;
      Len := Pos('@',Copy(MenuStr,CPos,Length(MenuStr)+1-CPos))-1;
      MenuMsg[NumPicks] := Copy(MenuStr,CPos,Len);
      MenuLtr[NumPicks] := UpCase(MenuMsg[NumPicks,1]);


      If Length(MenuMsg[NumPicks]) > Longest
        then Longest := Length(MenuMsg[NumPicks]);
      CPos := CPos+Len+1;
    Until CPos >= Length(MenuStr);
    HeaderText := Header;
    If Length(HeaderText) > Longest then HeaderText[0] := chr(Longest);
    ResetBox;
  END;

{============================================================================}
  FUNCTION PickMenuBox : Char;

CONST
     UpArrow   = #72;
     Downarrow = #80;
     EnterKey  = #13;
     EscKey    = #27;
     Abort     = #0;
VAR
  Err,II    : Integer;
  Ch        : Char;
  PickExit  : Boolean;
  BeepOn    : Boolean;
{  FunctKey  : Boolean;     }

BEGIN
 SaveAttr := TextAttr;       { Save the current colors }
 HideCursor;                 { Hide the cursor }
 PickExit := False;
 SetColor(ColorF3,ColorB3);

                             { Write the first pick in reverse }
  WriteSt(' '+MenuMsg[Pick]+' ',XPos+1,YPos+Pick);

  Repeat     { Main keystroke reading loop -- continue until enter or escape }

     Ch := Nextkey;     { Read a key }


  If not FunctKey then Case Ch of     { Handle non function keys here }
    #32..#125: Begin                  { Check characters against 1st letters }
                BeepOn := True;
                 For II := 1 to NumPicks do Begin
                   If UpCase(Ch) = MenuLtr[II] then Begin   { got a match }
                      Pick := II;
                      PickExit := True;
                      BeepOn := False;
                   End;
                 End;
                If BeepOn then Beep;
               End;
    EnterKey,EscKey : PickExit := True;  { Get ready to exit }

   End; {case not functkey}

  If FunctKey then  Case Ch of     { Handle function keys here }
       UpArrow   : Pick := Pred(Pick);  { Move up one }
       DownArrow : Pick := Succ(Pick);  { Move down one }
       Else Beep;

     End; {case functkey}


   If Pick > NumPicks then Pick := 1;    { Make sure Pick in bounds }
   If Pick < 1 then Pick := NumPicks;

   If Pick <> LastPick then Begin
     SetColor(ColorF1,ColorB1);            { Restore last pick }
     WriteSt(' '+MenuMsg[LastPick]+' ',XPos+1,YPos+LastPick);
     SetColor(ColorF2,ColorB2);            { Restore 1st letter last pick }
     WriteCh(MenuLtr[LastPick],XPos+2,YPos+LastPick);

     SetColor(ColorF3,ColorB3);            { Highlight new pick in reverse }
     WriteSt(' '+MenuMsg[Pick]+' ',XPos+1,YPos+Pick);

     LastPick := Pick;
   End;

 Until PickExit;

 If Ch = EscKey then PickMenuBox := Abort    { set function to #0 }
                else PickMenuBox := MenuLtr[Pick];  {set function to letter }
 TextAttr := SaveAttr;   { Restore colors }
End;

END. {of unit}