CP/M/CPM_CDROM.iso/mbug/mbug133.arc/MENU.PAS

Pascal/Delphi Source File | 1979-12-31 | 9KB | 336 lines

{--------------------------------------------------------------------------
                       F i l e    I n f o r m a t i o n

* DESCRIPTION
This program is an expanded version of CHOICES: A generalized menu technique.
Requires: Turbo Pascal 3.0. Author: Bill Tooker. Version T1.0.

* CHECKED BY
DM - 9/7/86

==========================================================================
}
Program menudemo;
{Version: 01/07/1986 12:29:50}
{Converted to Microbee CP/M 20/11/89 by A J Laughton}
{
This program is an expanded version of "Choices: A Generalized Menu Technique"
which was published in the October/November version of TUG Lines.

                           The original model was written by
                           Barry Abrahamsen of Seattle, Washington
}

{ These values are for the Microbee}

const
  up_arrow_chr        = '^';
  down_arrow_chr      = 'v';
  escape              = #27;
  up_arrow            = #05;       { Ctrl E or Up arrow key }
  down_arrow          = #24;       { Ctrl X or Down arrow key }

  max_choices         = 7;  {one less than the actual number of choices}
  cr                  = #13;
  bell                = #07;

type
  choice_type = record            { more information could be included here}
    row           : integer;      { and that information returned by GET_CHOICE,}
    column        : integer;      { instead of just the position of the choice in}
    description   : string[60];{ the array }

  end;

var
  choice             :array[0..max_choices] of choice_type;
  desc_text          :array[0..20] of string[60];
  result             :integer;
  keyin, control_key :char;
  row_variable       : integer;
  Execute_file       : file;
  Execute_name       : string[64];
  Menu_title         : string[50];


Procedure Set_Menu_Heading;
var
    title_position         :  integer;
begin

     title_position := 40 - (length(menu_title) div 2);
     gotoxy(title_position,2);
     Write(menu_title);
     gotoxy(10,23);
     writeln('Position your choice with ',up_arrow_chr,' or ',down_arrow_chr,' and press <ENTER>');
     gotoxy(10,24);
     writeln('[or Key in the number for your selection]');
END;

procedure set_menu_values;
begin
     Menu_title   := 'The Title of the Menu .......';
     desc_text[0] := '1: The first menu item...........';
     desc_text[1] := '2: The second menu item..........';
     desc_text[2] := '3: The Third Menu Item...........';
     desc_text[3] := '4: The Fourth Menu Item...........';
     desc_text[4] := '5: The Fifth Menu Item............';;
     desc_text[5] := '6: The Sixth Menu Item............';
     desc_text[6] := '7: The Seventh Menu Item.........:';
     desc_text[7] := '8: Sign Off - return to CP/M';
end;


procedure get_a_character(var keyin, control_key: char);
begin
       control_key := #0;
       read(kbd,keyin);
       if(keyPressed and (keyin = #27)) then
       begin
          delay(0);
          read(kbd,control_key);
       end
         else
            if (keyin in [#1..#31,#127]) then
               control_key := keyin;
 end; {get_a_character}



procedure turn_on(choice : choice_type);  {highlights a menu choice}
begin
  gotoxy(choice.column, choice.row);
  lowvideo;
  write(choice.description);
end;

procedure turn_off(choice : choice_type); {cancels the highlighting}
begin
  gotoxy(choice.column, choice.row);
  normvideo;
  write(choice.description);
end;

procedure initialize_choices; { puts the descriptions of the menu choices}
                              { and their location on the screen in an  }
var                           { array }
  i :integer;


begin
  row_variable := 5;
  for i := 0 to max_choices do
    with choice[i] do
      begin
           row := row_variable;
           row_variable := row_variable + 2;
           column := 15;
           description := desc_text[i];
      end;

end;

procedure display_choices;

var
  i : integer;

begin
  clrscr;
  set_menu_heading;
  for i := 0 to max_choices do
    with choice[i] do
      begin
          gotoxy(column, row);
          write(description);
      end;
   turn_on(choice[0]);

end; {display_choices}


function get_choice : integer;
var
  c : char;
  current, last : integer;
  c_integer     : integer;
  result_code   : integer;
begin
  current := 0;
  last := 0;
  repeat {loop until they hit the RETURN key}
    get_a_character(keyin,control_key);
    if control_key > #0 then
         c := control_key
    else
         c := keyin;

{************************************************************************}
{**  If ESCape is pressed set the Exit to CP/M option                  **}
{************************************************************************}

   if c = escape
   then
       c := '8';

{************************************************************************}
{**  If a Number was pressed set the appropriate option...........     **}
{************************************************************************}

    if c in ['1'..'8'] then
        begin
             val(c,c_integer,result);
             last := current;
             current := c_integer - 1;
             turn_off(choice[last]);
             turn_on(choice[current]);
             c := cr;
        end;


{************************************************************************}
{**  If either up or down arrow was pressed set corresponding option   **}
{**  If RETurn was pressed execute the current option                  **}
{************************************************************************}

    case c of
       down_arrow   : begin
                          last := current;
                          current := last + 1;
                      end;

       up_arrow     : begin
                          last := current;
                          if last <> 0 then
                             current := last - 1
                          else
                              current := max_choices;
                      end;

                      else if c <> cr then write(#7);
    end; {case}


    if c in [up_arrow, down_arrow] then
      begin
          current := current mod (max_choices + 1);
          turn_off(choice[last]);
          turn_on(choice[current]);
      end;
  until c = cr; {end repeat}
  get_choice := current;
end; {get_choice}



{*********************** execute actual program required ***************}



Procedure Do_actual_Execute;
var
   Response        :char;

 begin
{Change this if you are chaining or executing a program}

{ This is for testing only!!!!!!!!!}

        gotoxy(10,22);
        write('You would be doing: ',Execute_Name);
        Read(Response);
        gotoxy(10,22);
        clreol;


{ The following code should be opened up if the menu will be calling .COM
File programs.  If this is the case the individual items should assign the name
of the program to be executed into the variable Execute_name in the form
Pgmname.com  }

 {
    assign(Execute_File,Execute_name);
    Execute(Execute_File);
}
 end;


{These should be changed to correspond to the action associated with
 the menu option requested
}


PROCEDURE Item0;
    BEGIN
        Execute_name := 'Menu#:01';
        do_actual_Execute;
    end;

PROCEDURE Item1;
    BEGIN
        Execute_name := 'Menu#:02';
        do_actual_Execute;
    end;

PROCEDURE Item2;
    BEGIN
        Execute_name := 'Menu#:03';
        do_actual_Execute;
    end;

PROCEDURE Item3;
    BEGIN
         Execute_name := 'Menu#:04';
         do_actual_Execute;
    end;

PROCEDURE item4;
    BEGIN
         Execute_name := 'Menu#:05';
         do_actual_Execute;
    end;

PROCEDURE item5;
    BEGIN
         Execute_name := 'Menu#:06';
         do_actual_Execute;
    end;

PROCEDURE item6;
    BEGIN
         Execute_name := 'Menu#:07';
         do_actual_Execute;
    end;

PROCEDURE item7;
    BEGIN
         Execute_name := 'Menu#:08';
         do_actual_Execute;
    end;


{----------- Main Program -----------------}

begin
  set_menu_values;
  initialize_choices;
  display_choices;
  result := get_choice;

  gotoxy(20,20);

  case result of
       0: item0;
       1: item1;
       2: item2;
       3: item3;
       4: item4;
       5: item5;
       6: item6;
  else
          write('Returning to CP/M');
  end; {case}

  clrscr;
end.