{ Menu unit }

unit Menus;

interface

uses CRT, Keyb, Strings, Grafix;

const
  { Commands }
  cmSubMenu = 0;
  cmBack    = $FFFF;


type
  TWindow = record
    X1, Y1,
    X2, Y2: integer;
  end;

  PMenu = ^TMenu;

  PMenuItem = ^TMenuItem;
  TMenuItem = record
    Text: PString;              { Name of item }
    Command: word;              { This command is handled by HandleEvent }
    SubMenu: PMenu;             { Is any submenu ? }
    Next: PMenuItem;            { Next item }
  end;

  TMenu = record
    Items,                      { First item of the menu }
    Selected: PMenuItem;        { Selected item by user }
  end;

  { Initialize menu }
  procedure InitMenu(AWindow: TWindow; AMenu: PMenu);
  { Free menu from mem }
  procedure DoneMenu;
  { Return selected command /if it's not a submenu/ }
  function RunMenu: byte;
  { Setup previous menu /submenu/ }
  procedure PrevMenu;

  { Menu construction routines }
  function NewMenu(Items: PMenuItem): PMenu;
  function NewItem(Text: string; Command: Word;
                   Next: PMenuItem): PMenuItem;
  function NewSubMenu(Text: string; SubMenu: PMenu;
                      Next: PMenuItem): PMenuItem;
  procedure DisposeMenu(Menu: PMenu);

implementation

var
  Menu,            { Current menu }
  CurrMenu: PMenu; { Programmer can use this for Draw procedure }
  Win: TWindow;    { Window where the menu is }

procedure InitMenu;
begin
  Menu := AMenu;
  Win := AWindow;
end;

procedure DoneMenu;
begin
  DisposeMenu(Menu);
end;

{ Find next item }
procedure NextItem;
begin
  with CurrMenu^ do
  begin
    Selected := Selected^.Next;
    if Selected = nil then Selected := Items;
  end;
end;

{ Find previous item }
procedure PrevItem;
var
  P: PMenuItem;
begin
  with CurrMenu^ do
  begin
    P := Selected;
    if P = Items then P := nil;
    repeat
      NextItem;
    until Selected^.Next = P;
  end;
end;

{ Find previous menu /submenu/ }
procedure PrevMenu;
var
  SearchDone: boolean;
  Prev: PMenu;
  P: PMenu;

  procedure SearchPrev(AMenu: PMenu);
  var
    Q: PMenu;
  begin
    Q := AMenu;
    Q^.Selected := Q^.Items;  { Set to the first menu item }

    while Q^.Selected <> nil do
    begin
      if Q^.Selected^.SubMenu = CurrMenu then
      begin
        SearchDone := true;
        Prev := Q;
      end else
        { Search submenus }
        If Q^.Selected^.SubMenu <> nil then
          SearchPrev(Q^.Selected^.SubMenu);

      If SearchDone then exit;
      Q^.Selected := Q^.Selected^.Next;
    end;
  end;

begin
  P := Menu; { Starting point }
  SearchDone := false;

  { Do it only if CurrMenu is a some submenu of Menu }
  If CurrMenu <> P then
  begin
    SearchPrev(P);
    If SearchDone then
    begin
      CurrMenu := Prev;
    end else
      CurrMenu := P;
  end;
end;

procedure Draw;
var
  x, y: byte;
  P: PMenuItem;

begin
  With Win do
  begin
    { Draw menu frame }
    Frame(X1, Y1, X2, Y2, 1, 0);

    { Clear the window }
    Window(X1 + 1, Y1 + 1, X2 - 1, Y2 - 1);
    TextBackGround(ColorTable[9]);
    ClrScr;
    Window(1, 1, 80, 50);

    y := Y1 + 2;
    { Draw menu items }
    If CurrMenu <> nil then
    begin
      P := CurrMenu^.Items;
      while P <> nil do
      begin
        If P^.Text <> nil then
        begin
          If P = CurrMenu^.Selected then
          begin
            { Draw background bar }
            For x := X1 + 1 to X2 - 1 do
              Print(x, y, 0, ColorTable[11], ' ');
            TextColor(ColorTable[10]);
            TextBackGround(ColorTable[11]);
          end else
          begin
            TextColor(ColorTable[8]);
            TextBackGround(ColorTable[9]);
          end;
          GotoXY(X1 + 2, y);
          Write(P^.Text^);
        end;
        P := P^.Next;
        Inc(y, 2);
      end;
    end;
  end;
end;

function RunMenu;
var
  i: byte;
  P: PMenu;
  key: word;
  MenuDone: boolean;
  Command: word;

begin
  CurrMenu := Menu;
  MenuDone := false;
  repeat
    Draw;

    repeat
      Key := GetUpCasedKey;
    until Key <> 0;

    { Handle keyboard events }
    case Key of
      kbUpArrow: PrevItem;
      kbDownArrow: NextItem;
      kbBackSpace, kbEsc: PrevMenu;
      kbEnter: if CurrMenu^.Selected^.SubMenu <> nil then
               begin
                 CurrMenu := CurrMenu^.Selected^.SubMenu;
                 CurrMenu^.Selected := CurrMenu^.Items; { Set to first item }
               end else
               begin
                 command := CurrMenu^.Selected^.Command;
                 If Command = cmBack then
                   PrevMenu
                 else
                 begin
                   RunMenu := CurrMenu^.Selected^.Command;
                   MenuDone := true;
                 end;
               end;
    end;
  until MenuDone;
end;

{ Creates new menu }
function NewMenu;
var
  P: PMenu;
begin
  New(P);
  P^.Items := Items;
  P^.Selected := Items;
  NewMenu := P;
end;

{ Creates new menu item }
function NewItem;
var
  P: PMenuItem;
begin
  if (Text <> '') and (Command <> 0) then
  begin
    New(P);
    P^.Text := NewStr(Text);
    P^.Command := Command;
    P^.SubMenu := nil;
    P^.Next := Next;
    NewItem := P;
  end else
    NewItem := Next;
end;

{ Creates new submenu }
function NewSubMenu;
var
  P: PMenuItem;
begin
  if (Text <> '') and (SubMenu <> nil) then
  begin
    New(P);
    P^.Text := NewStr(Text);
    P^.Command := cmSubMenu;
    P^.SubMenu := SubMenu;
    P^.Next := Next;
    NewSubMenu := P;
  end else
    NewSubMenu := Next;
end;

{ Free menu from mem }
procedure DisposeMenu;
var
  P, Q: PMenuItem;
begin
  if Menu <> nil then
  begin
    P := Menu^.Items;
    while P <> nil do
    begin
      if P^.Text <> nil then
      begin
        DisposeStr(P^.Text);
        if P^.SubMenu <> nil then DisposeMenu(P^.SubMenu);
      end;
      Q := P;
      P := P^.Next;
      Dispose(Q);
    end;
    Dispose(Menu);
  end;
end;

end.