Program MenuTest;

Uses DOS,CRT,Mouse,Graph,Menu;

Var I,J,K,X,Y,Code,Fore,
    Back,Sh,ShD,Driver,Mode : Integer;
    Ch                      : Char;
    M                       : MouseType;
    Screen                  : Polygon;
    MainMenu,ModeMenu,
    ColorMenu,ShadowMenu,
    ShadDirMenu,TestMenu,
    InterMenu               : MenuType;

{------------------------------------------------------------------------}

Procedure InitSystem;

  Var GraphDriver,GraphMode,ErrorCode : Integer;
      Ends                            : Char;

    Begin
      GraphDriver := Detect;
      InitGraph(GraphDriver,GraphMode,'');
      ErrorCode := Graphresult;
      If ErrorCode <> grOK then
        Begin
          Writeln('Graphics error: ',GraphErrorMsg(ErrorCode));
          Writeln('Program aborted...');
          Ends := ReadKey;
          Halt(1);
        End;
    End;

{------------------------------------------------------------------------}

Function ReadKbd : Char;

  Var Ch      : Char;
      FuncKey : Boolean;

    Begin
      Ch := ReadKey;
      If Ch <> #0 then FuncKey := False else
        Begin
          FuncKey := True;
          Ch      := ReadKey;
        End;
      ReadKbd := Ch;
    End;

{-------------------------------------------------------------------------}

Procedure SetMainMenu(Var MainMenu : MenuType);

  Var OneOpt : OneList;
      I      : Byte;

    Begin
      OneOpt[1] := 'Show Menu';
      OneOpt[2] := 'Mode';
      OneOpt[3] := 'Colors';
      OneOpt[4] := 'Shadow';
      OneOpt[5] := 'Quit';
      SetUpMenu(MainMenu,5,0,GraphMenu,OneOpt);
      SetMenuColors(MainMenu,Black,LightBlue);
      For I := 1 to 5 do
        SetMenuOptionCode(MainMenu,I,0,100 * I);
    End;

{------------------------------------------------------------------------}

Procedure SetModeMenu(Var ModeMenu : MenuType);

  Var OneOpt : OneList;
      I      : Byte;

    Begin
      OneOpt[1] := 'Text';
      OneOpt[2] := 'CGA';
      OneOpt[3] := 'Hercules';
      OneOpt[4] := 'EGA';
      OneOpt[5] := 'VGA';
      SetUpMenu(ModeMenu,0,5,GraphMenu,OneOpt);
      SetMenuColors(ModeMenu,Black,LightBlue);
      For I := 1 to 5 do
        SetMenuOptionCode(ModeMenu,0,I,200 + I);
    End;

{------------------------------------------------------------------------}

Procedure SetColorMenu(Var ColorMenu : MenuType; NumCol : Byte; Free : Boolean);

  Var OneOpt : OneList;
      I      : Byte;

    Begin
      If Free then FreeList(ColorMenu);
      If NumCol = 16 then
        Begin
          OneOpt[ 1] := 'Black';
          OneOpt[ 2] := 'Blue';
          OneOpt[ 3] := 'Green';
          OneOpt[ 4] := 'Cyan';
          OneOpt[ 5] := 'Red';
          OneOpt[ 6] := 'Magenta';
          OneOpt[ 7] := 'Brown';
          OneOpt[ 8] := 'Light Gray';
          OneOpt[ 9] := 'Dark Gray';
          OneOpt[10] := 'Light Blue';
          OneOpt[11] := 'Light Green';
          OneOpt[12] := 'Light Cyan';
          OneOpt[13] := 'Light Red';
          OneOpt[14] := 'Light Magenta';
          OneOpt[15] := 'Yellow';
          OneOpt[16] := 'White';
          SetUpMenu(ColorMenu,0,16,GraphMenu,OneOpt);
          For I := 1 to 16 do
            SetMenuOptionCode(ColorMenu,0,I,300 + I);
        End else
          Begin
            OneOpt[1] := 'Black';
            OneOpt[2] := 'Light Green';
            OneOpt[3] := 'Light Red';
            OneOpt[4] := 'Yellow';
            SetUpMenu(ColorMenu,0,4,GraphMenu,OneOpt);
            For I := 1 to 4 do
              SetMenuOptionCode(ColorMenu,0,I,300 + I);
          End;
      SetMenuColors(ColorMenu,Black,LightBlue);
    End;

{------------------------------------------------------------------------}

Procedure SetShadowMenu(Var ShadowMenu : MenuType);

  Var OneOpt : OneList;
      I      : Byte;

    Begin
      OneOpt[1] := 'Direction';
      OneOpt[2] := 'Colors';
      SetUpMenu(ShadowMenu,0,2,GraphMenu,OneOpt);
      SetMenuColors(ShadowMenu,Black,LightBlue);
      For I := 1 to 2 do
        SetMenuOptionCode(ShadowMenu,0,I,400 + I);
    End;

{------------------------------------------------------------------------}

Procedure SetShadDirMenu(Var ShadDirMenu : MenuType);

  Var OneOpt : OneList;
      I      : Byte;

    Begin
      OneOpt[1] := 'No Shadow';
      OneOpt[2] := 'Upper Left';
      OneOpt[3] := 'Upper Right';
      OneOpt[4] := 'Lower Left';
      OneOpt[5] := 'Lower Right';
      SetUpMenu(ShadDirMenu,0,5,GraphMenu,OneOpt);
      SetMenuColors(ShadDirMenu,Black,LightBlue);
      For I := 1 to 5 do
        SetMenuOptionCode(ShadDirMenu,0,I,500 + I);
    End;

{------------------------------------------------------------------------}

Procedure SetInterMenu(Var InterMenu : MenuType);

  Var OneOpt : OneList;
      I      : Byte;

    Begin
      OneOpt[1] := 'Foreground';
      OneOpt[2] := 'Background';
      SetUpMenu(InterMenu,0,2,GraphMenu,OneOpt);
      SetMenuColors(InterMenu,Black,LightBlue);
      For I := 1 to 2 do
        SetMenuOptionCode(InterMenu,0,I,600 + I);
    End;


{------------------------------------------------------------------------}

Procedure SetTestMenu(Var TestMenu : MenuType);

  Var TwoOpt : TwoList;
      I,J,K  : Integer;

    Begin
      TwoOpt[1,1] := 'Pascal';
      TwoOpt[2,1] := 'C';
      TwoOpt[3,1] := 'BASIC';
      TwoOpt[4,1] := 'Prolog';
      TwoOpt[1,2] := 'Fortran';
      TwoOpt[2,2] := 'Cobal';
      TwoOpt[3,2] := 'Modula';
      TwoOpt[4,2] := 'Forth';
      TwoOpt[1,3] := 'IBM';
      TwoOpt[2,3] := 'Compaq';
      TwoOpt[3,3] := 'Tandy';
      TwoOpt[4,3] := 'AST Research';
      SetUpMenu(TestMenu,4,3,GraphMenu,TwoOpt);
      K := 700;
      For J := 1 to 3 do
        For I := 1 to 4 do
          Begin
            Inc(K);
            SetMenuOptionCode(TestMenu,I,J,K);
          End;
    End;

{------------------------------------------------------------------------}

Procedure ChangeVideoModes(Var Name : MenuType; Mode : Boolean);

  Begin
    Name.Mode := Mode;
    If Name.Direction then
      Begin
        If Mode then
          SetMenuSpaces(Name,5,3) else
            SetMenuSpaces(Name,3,0);
        SetMenuSpacing(Name);
      End else
        Begin
          If Mode then
            Begin
              If Driver <> CGA then
                SetMenuSpaces(Name,65,5) else
                  SetMenuSpaces(Name,10,5);
            End else
              SetMenuSpaces(Name,8,0);
          SetMenuSpacing(Name);
          If Mode then
            SetMenuRect(Name,MenuMinX(Name),MenuMinY(Name),
                             GetMaxX - 2,MenuMaxY(Name)) else
             SetMenuRect(Name,MenuMinX(Name),MenuMinY(Name),79,MenuMaxY(Name));
        End;
    If Not Mode then
      Begin
        If Driver = HercMono then
          SetMenuColors(Name,White,Black);
      End else
        SetMenuColors(Name,Black,LightBlue);
  End;

{------------------------------------------------------------------------}

Procedure MenuProcessor(Code : Integer);

  Var I : Integer;

  Begin
    Case Code of
      100 : Begin
              SetMenuColors(TestMenu,Fore,Back);
              SetMenuShadow(TestMenu,Sh,ShD);
              If MenuMode(TestMenu) then
                SetMenuSpaces(TestMenu,5,5) else
                  SetMenuSpaces(TestMenu,3,0);
              SetMenuSpacing(TestMenu);
              If MenuOpen(List[1]^) then
                MenuToggle;
              If MenuMode(TestMenu) then
                OpenMenu(TestMenu,10,100) else
                  OpenMenu(TestMenu,5,10);
            End;

      200 : Begin
              If MenuOpen(List[1]^) then
                MenuToggle;
              OpenMenu(ModeMenu,OptMinX(MainMenu),MenuMaxY(MainMenu));
            End;
      201 : Begin
              If (MenuOpen(List[MenuNum]^)) and (MenuNum > 0) then
                MenuToggle;
              If MenuOpen(List[0]^) then CloseMenu(List[0]^);
              DetectGraph(Driver,Mode);
              If Driver = HercMono then
                TextMode(Mono) else
                  TextMode(Co80);
              SetColorMenu(ColorMenu,16,True);
              ChangeVideoModes(MainMenu,TextMenu);
              ChangeVideoModes(ModeMenu,TextMenu);
              ChangeVideoModes(ColorMenu,TextMenu);
              ChangeVideoModes(ShadowMenu,TextMenu);
              ChangeVideoModes(ShadDirMenu,TextMenu);
              ChangeVideoModes(InterMenu,TextMenu);
              ChangeVideoModes(TestMenu,TextMenu);
              If MouseExists then ResetMouse;
              TextBackGround(Green);
              ClrScr;
              CursorOff;
              OpenMenu(MainMenu,1,1);
              If MouseExists then ShowMouse;
            End;
      202 : Begin
              If (MenuOpen(List[MenuNum]^)) and (MenuNum > 0) then
                MenuToggle;
              If MenuOpen(List[0]^) then CloseMenu(List[0]^);
              If ScreenMode then CloseGraph;
              Driver := CGA;
              Mode   := CGAC0;
              InitGraph(Driver,Mode,'');
              Screen[1].X :=       0; Screen[1].Y :=       0;
              Screen[2].X :=       0; Screen[2].Y := GetMaxY;
              Screen[3].X := GetMaxX; Screen[3].Y := GetMaxY;
              Screen[4].X := GetMaxX; Screen[4].Y :=       0;
              Screen[5] := Screen[1];
              SetColorMenu(ColorMenu,4,True);
              ChangeVideoModes(MainMenu,GraphMenu);
              ChangeVideoModes(ModeMenu,GraphMenu);
              ChangeVideoModes(ColorMenu,GraphMenu);
              ChangeVideoModes(ShadowMenu,GraphMenu);
              ChangeVideoModes(ShadDirMenu,GraphMenu);
              ChangeVideoModes(InterMenu,GraphMenu);
              ChangeVideoModes(TestMenu,GraphMenu);
              SetFillStyle(InterLeaveFill,Green);
              FillPoly(5,Screen);
              DrawPoly(5,Screen);
              OpenMenu(MainMenu,1,1);
              If MouseExists then ShowMouse;
            End;
      203 : Begin
              If (MenuOpen(List[MenuNum]^)) and (MenuNum > 0) then
                MenuToggle;
              If MenuOpen(List[0]^) then CloseMenu(List[0]^);
              If ScreenMode then CloseGraph;
              Driver := HercMono;
              Mode   := HercMonoHi;
              InitGraph(Driver,Mode,'');
              Screen[1].X :=       0; Screen[1].Y :=       0;
              Screen[2].X :=       0; Screen[2].Y := GetMaxY;
              Screen[3].X := GetMaxX; Screen[3].Y := GetMaxY;
              Screen[4].X := GetMaxX; Screen[4].Y :=       0;
              Screen[5] := Screen[1];
              ChangeVideoModes(MainMenu,GraphMenu);
              ChangeVideoModes(ModeMenu,GraphMenu);
              ChangeVideoModes(ColorMenu,GraphMenu);
              ChangeVideoModes(ShadowMenu,GraphMenu);
              ChangeVideoModes(ShadDirMenu,GraphMenu);
              ChangeVideoModes(InterMenu,GraphMenu);
              ChangeVideoModes(TestMenu,GraphMenu);
              SetFillStyle(InterLeaveFill,Green);
              FillPoly(5,Screen);
              DrawPoly(5,Screen);
              OpenMenu(MainMenu,1,1);
              If MouseExists then ShowMouse;
            End;
      204 : Begin
              If (MenuOpen(List[MenuNum]^)) and (MenuNum > 0) then
                MenuToggle;
              If MenuOpen(List[0]^) then CloseMenu(List[0]^);
              If ScreenMode then CloseGraph;
              Driver := EGA;
              Mode   := EGAHi;
              InitGraph(Driver,Mode,'');
              Screen[1].X :=       0; Screen[1].Y :=       0;
              Screen[2].X :=       0; Screen[2].Y := GetMaxY;
              Screen[3].X := GetMaxX; Screen[3].Y := GetMaxY;
              Screen[4].X := GetMaxX; Screen[4].Y :=       0;
              Screen[5] := Screen[1];
              SetColorMenu(ColorMenu,16,True);
              ChangeVideoModes(MainMenu,GraphMenu);
              ChangeVideoModes(ModeMenu,GraphMenu);
              ChangeVideoModes(ColorMenu,GraphMenu);
              ChangeVideoModes(ShadowMenu,GraphMenu);
              ChangeVideoModes(ShadDirMenu,GraphMenu);
              ChangeVideoModes(InterMenu,GraphMenu);
              ChangeVideoModes(TestMenu,GraphMenu);
              SetFillStyle(InterLeaveFill,Green);
              FillPoly(5,Screen);
              DrawPoly(5,Screen);
              OpenMenu(MainMenu,1,1);
              If MouseExists then ShowMouse;
            End;
      205 : Begin
              If (MenuOpen(List[MenuNum]^)) and (MenuNum > 0) then
                MenuToggle;
              If MenuOpen(List[0]^) then CloseMenu(List[0]^);
              If ScreenMode then CloseGraph;
              Driver := VGA;
              Mode   := VGAHi;
              InitGraph(Driver,Mode,'');
              Screen[1].X :=       0; Screen[1].Y :=       0;
              Screen[2].X :=       0; Screen[2].Y := GetMaxY;
              Screen[3].X := GetMaxX; Screen[3].Y := GetMaxY;
              Screen[4].X := GetMaxX; Screen[4].Y :=       0;
              Screen[5] := Screen[1];
              SetColorMenu(ColorMenu,16,True);
              ChangeVideoModes(MainMenu,GraphMenu);
              ChangeVideoModes(ModeMenu,GraphMenu);
              ChangeVideoModes(ColorMenu,GraphMenu);
              ChangeVideoModes(ShadowMenu,GraphMenu);
              ChangeVideoModes(ShadDirMenu,GraphMenu);
              ChangeVideoModes(InterMenu,GraphMenu);
              ChangeVideoModes(TestMenu,GraphMenu);
              SetFillStyle(InterLeaveFill,Green);
              FillPoly(5,Screen);
              DrawPoly(5,Screen);
              OpenMenu(MainMenu,1,1);
              If MouseExists then ShowMouse;
            End;

      300 : Begin
              If MenuOpen(List[1]^) then
                MenuToggle;
              OpenMenu(InterMenu,OptMinX(MainMenu),MenuMaxY(MainMenu));
            End;

      400 : Begin
              If MenuOpen(List[1]^) then
                MenuToggle;
              OpenMenu(ShadowMenu,OptMinX(MainMenu),MenuMaxY(MainMenu));
            End;
      401 : OpenMenu(ShadDirMenu,OptMinX(ShadowMenu),OptMaxY(ShadowMenu));
      402 : Begin
              OpenMenu(ColorMenu,OptMinX(ShadowMenu),OptMaxY(ShadowMenu));
              For I := 1 to 16 do
                SetMenuOptionCode(ColorMenu,0,I,3000 + I);
            End;

      500 : Begin
              CloseGraph;
              TextBackground(Black);
              ClrScr;
              CursorOn;
              Halt;
            End;
      501 : Begin
               Sh := 0;
               MenuBackOut(List);
             End;
      502 : Begin
               Sh := 1;
               MenuBackOut(List);
             End;
      503 : Begin
               Sh := 2;
               MenuBackOut(List);
             End;
      504 : Begin
               Sh := 3;
               MenuBackOut(List);
             End;
      505 : Begin
               Sh := 4;
               MenuBackOut(List);
             End;

      601 : Begin
              OpenMenu(ColorMenu,OptMinX(InterMenu),OptMaxY(InterMenu));
              For I := 1 to 16 do
                SetMenuOptionCode(ColorMenu,0,I,1000 + I);
            End;
      602 : Begin
              OpenMenu(ColorMenu,OptMinX(InterMenu),OptMaxY(InterMenu));
              For I := 1 to 16 do
                SetMenuOptionCode(ColorMenu,0,I,2000 + I);
            End;

      1001 : Begin
               Fore := 0;
               MenuBackOut(List);
             End;
      1002 : Begin
               Fore := 1;
               MenuBackOut(List);
             End;
      1003 : Begin
               Fore := 2;
               MenuBackOut(List);
             End;
      1004 : Begin
               Fore := 3;
               MenuBackOut(List);
             End;
      1005 : Begin
               Fore := 4;
               MenuBackOut(List);
             End;
      1006 : Begin
               Fore := 5;
               MenuBackOut(List);
             End;
      1007 : Begin
               Fore := 6;
               MenuBackOut(List);
             End;
      1008 : Begin
               Fore := 7;
               MenuBackOut(List);
             End;
      1009 : Begin
               Fore := 8;
               MenuBackOut(List);
             End;
      1010 : Begin
               Fore := 9;
               MenuBackOut(List);
             End;
      1011 : Begin
               Fore := 10;
               MenuBackOut(List);
             End;
      1012 : Begin
               Fore := 11;
               MenuBackOut(List);
             End;
      1013 : Begin
               Fore := 12;
               MenuBackOut(List);
             End;
      1014 : Begin
               Fore := 13;
               MenuBackOut(List);
             End;
      1015 : Begin
               Fore := 14;
               MenuBackOut(List);
             End;
      1016 : Begin
               Fore := 15;
               MenuBackOut(List);
             End;
      2001 : Begin
               Back := 0;
               MenuBackOut(List);
             End;
      2002 : Begin
               Back := 1;
               MenuBackOut(List);
             End;
      2003 : Begin
               Back := 2;
               MenuBackOut(List);
             End;
      2004 : Begin
               Back := 3;
               MenuBackOut(List);
             End;
      2005 : Begin
               Back := 4;
               MenuBackOut(List);
             End;
      2006 : Begin
               Back := 5;
               MenuBackOut(List);
             End;
      2007 : Begin
               Back := 6;
               MenuBackOut(List);
             End;
      2008 : Begin
               Back := 7;
               MenuBackOut(List);
             End;
      2009 : Begin
               Back := 8;
               MenuBackOut(List);
             End;
      2010 : Begin
               Back := 9;
               MenuBackOut(List);
             End;
      2011 : Begin
               Back := 10;
               MenuBackOut(List);
             End;
      2012 : Begin
               Back := 11;
               MenuBackOut(List);
             End;
      2013 : Begin
               Back := 12;
               MenuBackOut(List);
             End;
      2014 : Begin
               Back := 13;
               MenuBackOut(List);
             End;
      2015 : Begin
               Back := 14;
               MenuBackOut(List);
             End;
      2016 : Begin
               Back := 15;
               MenuBackOut(List);
             End;
      3001 : Begin
               ShD := 0;
               MenuBackOut(List);
             End;
      3002 : Begin
               ShD := 1;
               MenuBackOut(List);
             End;
      3003 : Begin
               ShD := 2;
               MenuBackOut(List);
             End;
      3004 : Begin
               ShD := 3;
               MenuBackOut(List);
             End;
      3005 : Begin
               ShD := 4;
               MenuBackOut(List);
             End;
      3006 : Begin
               ShD := 5;
               MenuBackOut(List);
             End;
      3007 : Begin
               ShD := 6;
               MenuBackOut(List);
             End;
      3008 : Begin
               ShD := 7;
               MenuBackOut(List);
             End;
      3009 : Begin
               ShD := 8;
               MenuBackOut(List);
             End;
      3010 : Begin
               ShD := 9;
               MenuBackOut(List);
             End;
      3011 : Begin
               ShD := 10;
               MenuBackOut(List);
             End;
      3012 : Begin
               ShD := 11;
               MenuBackOut(List);
             End;
      3013 : Begin
               ShD := 12;
               MenuBackOut(List);
             End;
      3014 : Begin
               ShD := 13;
               MenuBackOut(List);
             End;
      3015 : Begin
               ShD := 14;
               MenuBackOut(List);
             End;
      3016 : Begin
               ShD := 15;
               MenuBackOut(List);
             End;
    End;
  End;

{------------------------------------------------------------------------}

Begin
  InitSystem;
  Screen[1].X :=       0; Screen[1].Y :=       0;
  Screen[2].X :=       0; Screen[2].Y := GetMaxY;
  Screen[3].X := GetMaxX; Screen[3].Y := GetMaxY;
  Screen[4].X := GetMaxX; Screen[4].Y :=       0;
  Screen[5] := Screen[1];
  SetMainMenu(MainMenu);
  SetModeMenu(ModeMenu);
  SetColorMenu(ColorMenu,16,False);
  SetShadowMenu(ShadowMenu);
  SetShadDirMenu(ShadDirMenu);
  SetInterMenu(InterMenu);
  SetTestMenu(TestMenu);
  SetFillStyle(InterleaveFill,Green);
  FillPoly(5,Screen);
  DrawPoly(5,Screen);
  ChangeVideoModes(MainMenu,GraphMenu);
  ChangeVideoModes(ModeMenu,GraphMenu);
  ChangeVideoModes(ColorMenu,GraphMenu);
  ChangeVideoModes(ShadowMenu,GraphMenu);
  ChangeVideoModes(ShadDirMenu,GraphMenu);
  ChangeVideoModes(InterMenu,GraphMenu);
  OpenMenu(MainMenu,1,1);
  ResetMouse;
  If MouseExists then ShowMouse;

  M.Count := 0;
  Ch      := #0;
  Repeat
    Case Ch of
      #27 : MenuBackOut(List);
      #13 : MenuProcessor(ReturnCode(List[MenuNum]^));
      #61 : If (Not MenuOpen(MainMenu)) and (ScreenMode = MenuMode(MainMenu))
              then OpenMenu(MainMenu,1,1);
      #67 : CloseMenu(List[MenuNum]^);
      #68 : MenuToggle;
      #71 : JumpCursor(List[MenuNum]^,First);
      #79 : JumpCursor(List[MenuNum]^,Last);
      #75 : MoveCursor(List[MenuNum]^,Left);
      #77 : MoveCursor(List[MenuNum]^,Right);
      #72 : MoveCursor(List[MenuNum]^,Up);
      #80 : MoveCursor(List[MenuNum]^,Down);
    End;
    Ch := #0;
    If KeyPressed then Ch := ReadKBD
      else If MouseExists then Released(0,M);
    If M.Count > 0 then
      Begin
        If Driver <> CGA then
          Code := MenuMouse(List,M.Column,M.Row) else
            Code := MenuMouse(List,M.Column div 2,M.Row);
        MenuProcessor(Code);
        Code := 0;
        M.Count := 0;
      End;
  Until Ch = #45;

  CloseGraph;
  TextBackground(Black);
  ClrScr;
  CursorOn;
End.