Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/BPAS9.ZIP/3_3.PAS

Pascal/Delphi Source File | 1991-09-07 | 9.8 KB | 289 lines

{---------------------------------------------------------------------
 PROGRAM: 3_3

 This program uses the same template feature to build looping procedures
 quickly, filling in the NULL.PROC procedure template as needed, moving the
 new procedure to it alphabetical place in the procedures, and placing
 the procedure name in the MAIN PROGGRAM so that it is called in its
 turn.

 See Tom Swan Chapter 4.  Divide and Conquer.

 Author:                    Mike Benedict
 Date Started:              9/01/91
 Latest Revision:           9/01/91
 Version:                   Turbo Pascal 6.0

 -------------------------------------------------------------------}

 PROGRAM Lesson3_2;

 USES                                      { USES is a reserved word that  }
   Crt;                                    { tells the compiler to use one }
                                           { of the standard libraries or  }
                                           { units listed in the Pascal    }
                                           { Programmer's Guide.           }


 VAR
   Choice     :  Char;                     { Used in CASE Statements     }
   UserQuits  :  Boolean;                  { Used to Quit Menu & Program }
                                           { Note that all variables declared here
                                             are GLOBAL and recognizable to the
                                             program anywhere.           }


 {------------------------------------}    { Anything between brackets  }
 {            PROCEDURES              }    { is ignored at compile time }
 {------------------------------------}    { and allows clear comments  }
                                           { within source code.        }

 {-----------------------------}
 {          INIT.PROC          }
 {-----------------------------}

 PROCEDURE Init;

 BEGIN
   TextBackground(Blue);                   { Procedures and functions that   }
   TextColor(White);                       { are pre-defined by Borland's    }
   ClrScr;                                 { Reference manual.  They are     }
 END;                                      { called the Run-Time Library.    }



 {-----------------------------}
 {         METRIC.PROC         }
 {-----------------------------}

 PROCEDURE METRIC;
                                           { See Tom Swan p.62 }
                                           { Swan makes this a procedure. }

 VAR
   Value       :  Real;
   Selection   :  Integer;

   {---------Inches to Centimeters-----------------------} { Nested Procedures and Functions }

    PROCEDURE InchesToCentimeters;                         { Swan makes this a procedure, and we
                                                             leave it a procedure. }

    CONST
      CentPerInch  =  2.54;                                { Note that all constants and
                                                             variables are LOCAL in this
                                                             procedure.  }

    BEGIN
      WriteLn( Value:1:2, ' inches = ',
               Value * CentPerInch:1:2, ' centimeters'  );
      ReadLn                                               { Swan doesn't use this }
    END;     { InchesToCentimeters }


   {---------Centimeters to Inches-----------------------}

   PROCEDURE CentimetersToInches;

   CONST
     InchPerCent  =  0.397;

   BEGIN
     WriteLn ( Value:1:2, ' centimeters = ',
               Value * InchPerCent:1:2,  ' inches' );
     ReadLn                                               { Swan doesn't use this }
   END;      { CentimetersToInches }


   {---------Feet to Meters------------------------------}

   PROCEDURE FeetToMeters;

   CONST
     MetersPerFt  =  0.9144;

   BEGIN
     WriteLn ( Value:1:2, ' Feet = ',
               Value * MetersPerFt:1:2,  ' Meters' );
     ReadLn                                               { Swan doesn't use this }
   END;      { FeetToMeters }


   {---------Meters to Feet------------------------------}

   PROCEDURE MetersToFeet;

   CONST
     FtPerMeter  =  1.0936;

   BEGIN
     WriteLn ( Value:1:2, ' Meters = ',
               Value * FtPerMeter:1:2,  ' Feet' );
     ReadLn                                               { Swan doesn't use this }
   END;      { MetersToFeet }


   {---------Miles to Kilometers-------------------------}


   PROCEDURE MilesToKilometers;

   CONST
     KmPerMile  =  1.6093;

   BEGIN
     WriteLn ( Value:1:2, ' Miles = ',
               Value * KmPerMile:1:2,  ' Kilometers' );
     ReadLn                                               { Swan doesn't use this }
   END;      { MilesToKilometers }


   {---------Kilometers to Miles-------------------------}

   PROCEDURE KilometersToMiles;

   CONST
     MilesPerKm = 0.62139;

   BEGIN
     WriteLn ( Value:1:2, ' Kilometers = ',
               Value * MilesPerKm:1:2,  ' Miles' );
     ReadLn                                               { Swan doesn't use this }
   END;      { KilometersToMiles }

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

 BEGIN
   ClrScr;
   WriteLn;
   WriteLn;
   Write    ( 'METRICS' );
   WriteLn;
   WriteLn;
   Write    ( 'Value to Convert? ' );
   ReadLn   (Value);
   WriteLn  ( '1 - Inches to centimeters' );
   WriteLn  ( '2 - Centimeters to inches' );
   WriteLn  ( '3 - FeetToMeters         ' );
   WriteLn  ( '4 - MetersToFeet         ' );
   WriteLn  ( '5 - Miles to Kilometers  ' );
   WriteLn  ( '6 - Kilometers to miles  ' );
   WriteLn;
   Write    ( 'Selection? ' ); ReadLn ( Selection );
   WriteLn;
   CASE Selection OF
     1  :  InchesToCentimeters;
     2  :  CentimetersToInches;
     3  :  FeetToMeters;
     4  :  MetersToFeet;
     5  :  MilesToKilometers;
     6  :  KilometersToMiles;

     ELSE WriteLn ( 'Selection Error' )
   END      { CASE }
 END;


 {-----------------------------}
 {       RANGECHK2.PROC        }
 {-----------------------------}

 PROCEDURE RangeChk2;

 VAR
   Age  :  0..100;

 BEGIN
   ClrScr;
   WriteLn;
   WriteLn;
   Write    ( 'How old are you?  ' );
{$R-}                                      { Turn Range Checking Off }
   ReadLn   ( Age );
     IF (Age) > 100 THEN
       WriteLn ('Age is too high.  See value below and then re-enter. ')
     ELSE
     IF (Age) < 0 THEN
       WriteLn ('Age is too low.  See value below and then re-enter.  ')
     ELSE
{$R+}                                      { Turn Range Checking On  }
       WriteLn;
       WriteLn;
       WriteLn  ( 'You are ', Age, ' years old.' );
   ReadLn;

 END;



 {-----------------------------}
 {         .PROC          }
 {-----------------------------}

 PROCEDURE Null;

 BEGIN
 END;


 {------------------------------------}
 {           MAIN PROGRAM             }
 {------------------------------------}

  BEGIN
    Init;                                   { Procedure Call }

    UserQuits := False;                     { Boolean Variable set to false }

    REPEAT                                  { Note that REPEAT UNTIL contains all the
                                              WriteLn statements of the Menu, then the
                                              ReadLn statement to capture the input,
                                              before the CASE END block. }
      ClrScr;
      WriteLn;
      WriteLn  ( '                    Welcome to Beginners Pascal');
      WriteLn;
      WriteLn  ( '                               MENU');
      WriteLn;
      WriteLn  ( '                       A.  Metric Conversion ' );
      WriteLn  ( '                       B.  [Unused Menu Choice]' );
      WriteLn  ( '                       C.  Range Check with Program Error Message ' );
      WriteLn  ( '                       Q.  User Quits Menu'  );
      WriteLn;
      WriteLn;

      Write    ( 'Select a menu choice:  ' );
      ReadLn   ( Choice );
                                           { The CASE ___ OF statement uses the variable,
                                             in this case "Choice" to capture the input,
                                             then executes that procedure/function. }

                                           { Notice that after a choice, the loop returns
                                             back to the Menu. }
      CASE Choice OF
        'a', 'A'    :  Metric;             { Choice A calls Procedure METRIC }
        'b', 'B'    :  Null;               { Choice B calls Procedure RangeChk }
        'c', 'C'    :  RangeChk2;          { Etc. }
        'd', 'D'    :  Null;
        'e', 'E'    :  Null;               { Choice calls Null.Proc until assigned }



        'q', 'Q'    :  UserQuits := True;  { Choice Q changes boolean value to False
                                             and exits Repeat Until Loop and goes to
                                             next line of Main Program code.  That is,
                                             in this program it stops repeating the
                                             menu and drops the user to a cursor.  When
                                             you press <ENTER>, it exits the program.
                                             Change the program to exit immediately.}

      END
    UNTIL UserQuits;

    ReadLn;
  END.                                     { ReadLn stops the program for user  }
                                           { input.           This is a common  }
                                           { way to get the program to stop and }
                                           { show you the screen without pres-  }
                                           { sing ALT-F5.                       }