home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CHOICE.ZIP / CHOICE.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-11-25  |  10.9 KB  |  226 lines
  1. PROGRAM Choice;
  2.  
  3. { PROGRAM NAME: CHOICE Ver. 1.0  Copyright (c) 1984  Bruce N. Wheelock
  4.  
  5.   NOTICE:      A limited license is granted to all users of this program to
  6.                make copies of this program and distribute them to other users,
  7.                on the following conditions:
  8.  
  9.                      1.  The program is not to be distributed to others in
  10.                          modified form.
  11.                      2.  No fee (or other consideration) is to be charged for
  12.                          copying or distributing the program without an
  13.                          express written agreement with the author.
  14.                      3.  The copyright and description information in this
  15.                          program is not to be altered or removed.
  16.  
  17.   AUTHOR:       Bruce N. Wheelock
  18.                 6333 College Grove Way, Apt. G-4
  19.                 San Diego, CA  92115
  20.  
  21.                 The author may be contacted on the following public access
  22.                 computer systems:
  23.  
  24.                 P.dBMS #1   (619) 444-7099   (address to Bruce N. Wheelock)
  25.                 FidoNet/FTL (619) 286-7838   (address to Bruce Wheelock)
  26.  
  27.   DESCRIPTION:  This program is designed to be used within a batch file under
  28.                 PC-DOS/MS-DOS ver. 2.0 or later, to permit menu selection
  29.                 control; it will mainly be of interest to hard drive users.
  30.                 The program is called with an integer argument which
  31.                 specifies the largest choice number which may be selected.
  32.                 CHOICE will prompt the user for his choice number and check to
  33.                 see whether the number entered is an integer between 0 and the
  34.                 value in the argument. If it is not, an error message is dis-
  35.                 played and the user is again prompted for a choice.  If the
  36.                  number is within the range, ERRORLEVEL (a batch-testable
  37.                 value) is set to the number entered, and the program ends.
  38.                 ERRORLEVEL may then be tested by the batch file and action
  39.                 taken based on the result.
  40.  
  41.   USE:          Here is a sample batch file:
  42.  
  43.                           ECHO OFF
  44.                           :START
  45.                           CLS
  46.                           ECHO 1. Run LOTUS 1-2-3
  47.                           ECHO 2. Run Microsoft WORD
  48.                           ECHO 3. Run Microsoft SPELL
  49.                           ECHO 4. Run SMARTCOM II
  50.                           ECHO 0. Exit to DOS
  51.                           ECHO
  52.                           REM The previous line has two (2) blanks after ECHO
  53.                           IF NOT ERRORLEVEL 4 GOTO THREE
  54.                           SCOM
  55.                           GOTO START
  56.                           :THREE
  57.                           IF NOT ERRORLEVEL 3 GOTO TWO
  58.                           SPELL
  59.                           GOTO START
  60.                           :TWO
  61.                           IF NOT ERRORLEVEL 2 GOTO ONE
  62.                           WORD
  63.                           GOTO START
  64.                           :ONE
  65.                           IF NOT ERRORLEVEL 1 GOTO ZERO
  66.                           LOTUS
  67.                           GOTO START
  68.                           :ZERO
  69.                           IF NOT ERRORLEVEL 0 GOTO START
  70.                           REM End of batch file
  71.  
  72.   NOTES:        When ERRORLEVEL is checked in a batch file, the IF is satis-
  73.                 fied if the value is equal to or greater than the value
  74.                 tested.  Because of this, testing must begin at the highest
  75.                 possible value and decrease to the lowest.  Detailed infor-
  76.                 mation on batch files may be found in your DOS manual.
  77.  
  78.                 Turbo PASCAL .COM programs have an instruction to clear the
  79.                 screen when the program begins.  This is not desirable in this
  80.                 program.  It is necessary, therefore, to disable the screen
  81.                 clearing instruction.  This instruction is located at memory
  82.                 address 02FC.  The instruction is CD10 (Interrupt 10).  It may
  83.                 be disabled by changing the instruction to 9090.  To do this
  84.                 using DEBUG.COM, follow these procedures:
  85.  
  86.                            A>DEBUG CHOICE.COM
  87.                            -E02FC
  88.                            NNNN:02FC CD.90  [Type the 90 and press return]
  89.                            -E02FD
  90.                            NNNN:02FD 10.90  [Type the 90 and press return]
  91.                            -W
  92.                            Writing nnnn blocks
  93.                            -Q
  94.                            A>
  95.  
  96.                 For instructions on using DEBUG, consult your DOS manual.
  97.  
  98.                 Program results will be unpredictable if the argument to the
  99.                 program is not an integer.  If no argument is specified, the
  100.                 value defaults to 1 (one).
  101.  
  102.   ACKNOWLEDGMENTS: The procedure GetMax is adapted from CMDLINE.PAS, posted
  103.                    on FidoNet/FTL by Bruce Webster (SYSOP).  The procedure
  104.                    SetErrlevel is adapted from a program by Bruce Webster
  105.                    and myself.  Help in eliminating the screen clear
  106.                    instruction was provided by Bill Parker of Ashton-Tate.   }
  107.  
  108.  
  109. CONST
  110.      Col = 15;              { The column in which the prompt response occurs }
  111.  
  112. TYPE
  113.     Result = RECORD              { Record of DOS registers for DOS interface }
  114.            AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : INTEGER;
  115.     END;   { RECORD Result }
  116.  
  117.     CommandString  = string[127];  { Type for buffer to receive the argument }
  118.  
  119. VAR
  120.    Row : INTEGER;                { Variable for the screen row of the cursor }
  121.    Regs : Result;                                   { DOS registers variable }
  122.    ErrorLevel : INTEGER;        { Variable to hold the error level to be set }
  123.    Ok : BOOLEAN;                                    { Valid entry check flag }
  124.    CL : CommandString absolute cseg:$80;                   { Argument buffer }
  125.    Max : INTEGER;                   { Numeric representation of the argument }
  126.  
  127.  
  128. PROCEDURE GetMax(VAR Max : INTEGER);
  129.  
  130. { GetMax retrieves the argument to the program, converts it to an integer, &
  131.   places the integer in the variable MAX.  This is the value of the highest
  132.   legal user response.  If no argument is given, the default is 1 (one).     }
  133.  
  134. VAR
  135.    I, Temp : INTEGER;                       { Local index and work variables }
  136.  
  137. BEGIN
  138.      Temp := LENGTH(CL);                                { Length of argument }
  139.      FOR I := 1 TO Temp DO                     { Set loop to argument length }
  140.          IF CL[I] <> ' ' THEN               { Ignore imbedded/leading blanks }
  141.              Max := (Max*10) + (ORD(CL[I]) - 48);   { Convert char to number }
  142.      IF Temp = 0                  { If length is zero, no argument was given }
  143.      THEN                                                          { so. . . }
  144.         Max := 1;                                       { default Max to one }
  145. END;    { PROCEDURE GetMax }
  146.  
  147.  
  148. FUNCTION Valid(ErrorLevel:INTEGER; Max : INTEGER) : BOOLEAN;
  149.  
  150. { Valid checks to see if the number entered by the user is between 0 and Max }
  151.  
  152. BEGIN
  153.      IF (ErrorLevel >= 0) AND (ErrorLevel <= Max)              { Range check }
  154.      THEN
  155.         Valid := TRUE                      { If in range, set result to TRUE }
  156.      ELSE
  157.         Valid := FALSE;               { If out of range, set result to FALSE }
  158. END;    { FUNCTION Valid }
  159.  
  160.  
  161. PROCEDURE SetErrlevel(ErrorLevel : INTEGER);
  162.  
  163. { SetErrlevel sets places 4C hex in AH and ErrorLevel in AL, then performs an
  164.   MSDOS call with the record of registers.  The MSDOS call forces an immediate
  165.   program termination, so there is no return from this procedure. }
  166.  
  167. BEGIN
  168.      WITH Regs DO AX := $4C00 OR ErrorLevel;   { Set contents of AX register }
  169.      MSDOS(Regs);                                      { MSDOS call function }
  170. END;    { PROCEDURE SetErrlevel }
  171.  
  172.  
  173. PROCEDURE ErrorMsg;
  174.  
  175. { ErrorMsg is called if PROCEDURE Valid returned a FALSE.  It displays an
  176.   error message, sounds a tone, and prompts for a new value. }
  177.  
  178. BEGIN
  179.      SOUND(400);                                          { Activate speaker }
  180.      LowVideo;                              { Set character display to 'dim' }
  181.      WRITE('Not a valid choice.  Must be ');
  182.      NormVideo;                            { Set character display to normal }
  183.      WRITE('1 ');
  184.      LowVideo;                              { Set character display to 'dim' }
  185.      WRITE('through ');
  186.      NormVideo;                            { Set character display to normal }
  187.      WRITE(Max);
  188.      LowVideo;                              { Set character display to 'dim' }
  189.      WRITE(' or ');
  190.      NormVideo;                            { Set character display to normal }
  191.      WRITE('0.');
  192.      DELAY(400);                   { Approx. 400 millisecond delay for sound }
  193.      NOSOUND;                                             { Shut-off speaker }
  194. END;    { PROCEDURE ErrorMsg }
  195.  
  196.  
  197. BEGIN    { Main }
  198.  
  199.      {$I-}                   { Disable automatic run-time I/O error checking }
  200.      Max := 0;                                                    { Init Max }
  201.      GetMax(Max);                              { Get the highest legal value }
  202.      Ok := FALSE;                                                  { Init Ok }
  203.      WRITE('Enter choice: ');                                  { Prompt user }
  204.      REPEAT                 { UNTIL Ok }
  205.           READLN(ErrorLevel);           { Keep taking values. . .            }
  206.           IF IOResult <> 0              { handle non-integer entries. . .    }
  207.           THEN                          { by changing the response. . .      }
  208.              ErrorLevel := Max + 1;     { to more than Max. . .              }
  209.           Ok := Valid(ErrorLevel, Max); { checking the response. . .         }
  210.           Row := WhereY - 1;            { keeping track of cursor line. . .  }
  211.           IF Ok                         { and when value is valid. . .       }
  212.           THEN
  213.              BEGIN
  214.                  GOTOXY(1,Row + 1);     { going to error line to. . .        }
  215.                  ClrEol;                { erase possible error message. . .  }
  216.                  WRITELN;               { feed a blank line and. . .         }
  217.                  SetErrlevel(ErrorLevel) { SetErrorlevel forcing program end }
  218.              END    { THEN of IF Ok }
  219.           ELSE                          { but if its is not valid. . .       }
  220.              BEGIN
  221.                  ErrorMsg;              { display an error message. . .      }
  222.                  GOTOXY(Col,Row);       { go up a line. . .                  }
  223.                  ClrEol                 { erase the illegal entry. . .       }
  224.              END;    { ELSE of IF Ok }  { and try again.                     }
  225.      UNTIL Ok;     { end of REPEAT loop }
  226. END.    { Main }