home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / calculat / pibcal11.zip / PIBCALC.PAS < prev    next >
Pascal/Delphi Source File  |  1985-03-11  |  25KB  |  429 lines
  1. (*$V-,B-,C-,U-,R-,X-*)
  2. (* PIBCALC - Interactive Programmable Calculator *)
  3.  
  4. (*--------------------------------------------------------------------------*)
  5. (*                    PibCalc --- Programmable Calculator                   *)
  6. (*--------------------------------------------------------------------------*)
  7. (*                                                                          *)
  8. (*   Author:   Philip R. Burns                                              *)
  9. (*   Date:     March, 1985                                                  *)
  10. (*   Version:  1.1                                                          *)
  11. (*   Systems:  For MS-DOS on IBM PCs and close compatibles only.            *)
  12. (*                                                                          *)
  13. (*   Overview: PibCalc is an interactive desk calculator designed for use   *)
  14. (*             especially by programmers.  PibCalc tries to combine the     *)
  15. (*             features from better pocket calculators with the expression  *)
  16. (*             syntax of the common algorithmic programming languages.      *)
  17. (*                                                                          *)
  18. (*             PibCalc offers the following features:                       *)
  19. (*                                                                          *)
  20. (*                Integer and Real Floating Point Arithmentic               *)
  21. (*                Octal, Decimal, and Hexadecimal Bases.                    *)
  22. (*                The usual arithmetic operators.                           *)
  23. (*                Common mathematical functions.                            *)
  24. (*                User-defined variables.                                   *)
  25. (*                User-defined functions.                                   *)
  26. (*                                                                          *)
  27. (*    NEEDED PROGRAM FILES                                                  *)
  28. (*    --------------------                                                  *)
  29. (*                                                                          *)
  30. (*       The library file PIBCALC.LBR contains all of the needed files:     *)
  31. (*                                                                          *)
  32. (*         (1)  Program source files                                        *)
  33. (*                                                                          *)
  34. (*              PIBCALC.PAS     (main program)                              *)
  35. (*              SCREENROU.PAS                                               *)
  36. (*              DUPL.PAS                                                    *)
  37. (*              EDITHELP.PAS                                                *)
  38. (*              EDITSTRI.PAS                                                *)
  39. (*              INITCALC.PAS                                                *)
  40. (*              ERRORS.PAS                                                  *)
  41. (*              MATHROUT.PAS                                                *)
  42. (*              READLINE.PAS                                                *)
  43. (*              DISPLAY.PAS                                                 *)
  44. (*              GETTOK.PAS                                                  *)
  45. (*              ARITH.PAS                                                   *)
  46. (*              EXPRESSI.PAS                                                *)
  47. (*              SETGUYS.PAS                                                 *)
  48. (*              DOGUYS.PAS                                                  *)
  49. (*                                                                          *)
  50. (*         (2)  Program documentation file (on-line help)                   *)
  51. (*                                                                          *)
  52. (*              PIBCALC.HLP --- the text for the online HELP file.          *)
  53. (*                                                                          *)
  54. (*    Documentation                                                         *)
  55. (*    -------------                                                         *)
  56. (*                                                                          *)
  57. (*       The file PIBCALC.HLP contains more complete documentation on the   *)
  58. (*       use of the PibCalc features.  You should read this file through    *)
  59. (*       before using PibCalc for the first time.   PIBCALC.HLP can also be *)
  60. (*       read during a PibCalc session by entering the HELP command.        *)
  61. (*                                                                          *)
  62. (*    Compiling PibCalc                                                     *)
  63. (*    -----------------                                                     *)
  64. (*                                                                          *)
  65. (*       File PIBCALC.PAS is the main program source file, and contains     *)
  66. (*       include statements for the remaining source files.  Hence, to      *)
  67. (*       compile PibCalc, enter Turbo (preferably Turbo-87), declare        *)
  68. (*       PIBCALC.PAS to be the M)ain file, request compilation to a .COM    *)
  69. (*       file using O)ptions, and enter C)ompile.                           *)
  70. (*                                                                          *)
  71. (*       PibCalc uses REAL arithmetic extensively, so that it benefits      *)
  72. (*       considerably from the performance enhancement available from the   *)
  73. (*       8087 math co-processor.  If you have an 8087/80287 chip, you       *)
  74. (*       should compile PibCalc with TURBO-87.  Doing so will result in a   *)
  75. (*       CONSIDERABLE improvement in performance and accuracy.              *)
  76. (*                                                                          *)
  77. (*    Using PibCalc                                                         *)
  78. (*    -------------                                                         *)
  79. (*                                                                          *)
  80. (*       Once you have a compiled version of PibCalc, running it is         *)
  81. (*       quite straightforward:  just type                                  *)
  82. (*                                                                          *)
  83. (*               PIBCALC                                                    *)
  84. (*                                                                          *)
  85. (*       in response to the DOS prompt.                                     *)
  86. (*                                                                          *)
  87. (*       To leave PibCalc, type                                             *)
  88. (*                                                                          *)
  89. (*               EXIT                                                       *)
  90. (*                                                                          *)
  91. (*       when you get the PibCalc prompt.                                   *)
  92. (*                                                                          *)
  93. (*    Online Help                                                           *)
  94. (*    -----------                                                           *)
  95. (*                                                                          *)
  96. (*    If the file PIBCALC.HLP is located in the same directory as PIBCALC,  *)
  97. (*    and you execute PibCalc in that directory, then you can request the   *)
  98. (*    online help during execution of PibCalc by entering the HELP command. *)
  99. (*    If the file PIBCALC.HLP is not found, then no help will be displayed. *)
  100. (*                                                                          *)
  101. (*    The file PIBCALC.HLP also contains more details on the use of various *)
  102. (*    PibCalc features.   You should read it at least once before using     *)
  103. (*    PibCalc.                                                              *)
  104. (*                                                                          *)
  105. (*--------------------------------------------------------------------------*)
  106. (*                                                                          *)
  107. (*    Possible Improvements                                                 *)
  108. (*    ---------------------                                                 *)
  109. (*                                                                          *)
  110. (*       (1)  PibCalc would benefit from the addition of complex            *)
  111. (*            arithmetic.                                                   *)
  112. (*       (2)  Additional functions to evaluate special mathematical and     *)
  113. (*            statistical distributions would be useful.                    *)
  114. (*       (3)  A more comprehensive programming facility allowing for        *)
  115. (*            saving up statements, flow of control, and conditional        *)
  116. (*            branching would be nice.                                      *)
  117. (*       (4)  > 16 bit integer arithmetic.                                  *)
  118. (*       (5)  Better trigonometric functions.                               *)
  119. (*                                                                          *)
  120. (*       Any Volunteers?????                                                *)
  121. (*                                                                          *)
  122. (*--------------------------------------------------------------------------*)
  123. (*                                                                          *)
  124. (*    Glitches                                                              *)
  125. (*    --------                                                              *)
  126. (*                                                                          *)
  127. (*       (1)  Turbo version 2.0 only allows 16-bit integers.  Hence, any    *)
  128. (*            integer expression outside this range will result in bad      *)
  129. (*            results.  Hopefully a later version will implement 32-bit     *)
  130. (*            integers as provided by the 8087.  To allow for this,         *)
  131. (*            the type LONG_INTEGER is used to refer to integer values.     *)
  132. (*            With version 2.0 of Turbo, this is just the ordinary 16-bit   *)
  133. (*            integers.  If longer integers become available, change        *)
  134. (*            the definition of LONG_INTEGER to refer to these longer       *)
  135. (*            integers.                                                     *)
  136. (*                                                                          *)
  137. (*       (2)  A large part of PibCalc was previously implemented in a       *)
  138. (*            mainframe dialect of Pascal.  This Pascal, like the standard, *)
  139. (*            allowed out-of-block GOTOs.  Out-of-block GOTOs are VERY      *)
  140. (*            useful for getting out layers of recursive descent when       *)
  141. (*            parsing or executing a stack of operations.  Regrettably,     *)
  142. (*            Turbo Pascal does NOT allow out-of-block GOTOs, resulting in  *)
  143. (*            a considerable amount of less-than-elegant code to check and  *)
  144. (*            re-check if global error flags have been set.                 *)
  145. (*                                                                          *)
  146. (*--------------------------------------------------------------------------*)
  147. (*                                                                          *)
  148. (*    Credits:                                                              *)
  149. (*    --------                                                              *)
  150. (*                                                                          *)
  151. (*       PibCalc is based in part on John Norstad's DCALC, in part on a     *)
  152. (*       previous mainframe calculator program I wrote, and in part on a    *)
  153. (*       number of other similar calculator programs.                       *)
  154. (*                                                                          *)
  155. (*       The WordStar-like string editing routine (for editing the last     *)
  156. (*       command line or a function definition) is modified from a routine  *)
  157. (*       I found on a BBS.  My thanks to the anonymous author of the        *)
  158. (*       original.                                                          *)
  159. (*                                                                          *)
  160. (*--------------------------------------------------------------------------*)
  161. (*                                                                          *)
  162. (*    Where to send fan mail and letter bombs:                              *)
  163. (*    ----------------------------------------                              *)
  164. (*                                                                          *)
  165. (*       Suggestions for improvements or corrections are welcome.           *)
  166. (*       Please leave messages on Gene Plantz's BBS (312) 882 4227          *)
  167. (*       or Ron Fox's BBS (312) 940 6496.                                   *)
  168. (*                                                                          *)
  169. (*       I hope that you find this program useful -- and, if you expand     *)
  170. (*       please upload your extensions so that all of us can enjoy them!    *)
  171. (*                                                                          *)
  172. (*--------------------------------------------------------------------------*)
  173.  
  174. (*--------------------------------------------------------------------------*)
  175. (*                           Global Constants                               *)
  176. (*--------------------------------------------------------------------------*)
  177.  
  178. CONST
  179.  
  180.    MaxLint      = 32767            (* Maximum value of long integer       *);
  181.    Maxstrlen    = 255              (* Maximum string length               *);
  182.    Maxstdfuncs  = 25               (* Number of built-in functions        *);
  183.    Maxuserfuncs = 20               (* Maximum number of user functions    *);
  184.    Maxformal    = 10               (* Maximum number of formal parameters *);
  185.    Maxtoknams   = 18               (* Maximum number of syntactic tokens  *);
  186.  
  187.                                    (* Base of the Naperian Logarithms     *)
  188.    EE           = 2.718281828459045;
  189.                                    (* Guess what?                         *)
  190.    PI           = 3.141592653589793;
  191.  
  192.    col          = 'a'              (* End of string marker                *) ;
  193.  
  194.    cr           = #13              (* Carriage return character           *);
  195.    bs           = #08              (* Backspace character                 *);
  196.    del          = #127             (* Delete character                    *);
  197.    Ctrlx        = ^x               (* Line delete character               *);
  198.    Ctrld        = ^d               (* Move right character                *);
  199.    Ctrls        = ^s               (* Move left character                 *);
  200.    Ctrlh        = ^h               (* Alternate move left character       *);
  201.    Ctrlf        = ^f               (* Move to end of line character       *);
  202.    Ctrla        = ^a               (* Move to front of line character     *);
  203.    Ctrlv        = ^v               (* Toggle insert/delete mode           *);
  204.  
  205. (*--------------------------------------------------------------------------*)
  206. (*                              Global Types                                *)
  207. (*--------------------------------------------------------------------------*)
  208.  
  209. TYPE
  210.                                    (* Command names/user funcs/constants *)
  211.  
  212.    Alfa      = PACKED ARRAY[1..10] OF CHAR;
  213.  
  214.                                    (* General string *)
  215.    AnyStr    = STRING[Maxstrlen];
  216.                                    (* Change to long integer type if poss. *)
  217.    Long_Integer = INTEGER;
  218.                                    (* Command type *)
  219.  
  220.    tokenty = ( exitsy,     helpsy,     decsy,      octsy,      hexsy,
  221.                fracsy,     radsy,      degsy,      defsy,      delsy,
  222.                showsy,     varssy,     funcssy,    modsy,      divsy,
  223.                varsy,      constsy,    eolsy,      stdfuncsy,  userfuncsy,
  224.                plussy,     minussy,    starsy,     slashsy,    exponsy,
  225.                oparsy,     cparsy,     equalssy,   commasy,    dollarsy,
  226.                periodsy,   editsy );
  227.  
  228.                                    (* Variable names are 'A' through 'Z' *)
  229.    varnamty = 'A'..'Z';
  230.                                    (* Types of values are integer and real *)
  231.    varty = ( int, rea );
  232.  
  233.                                    (* Defined value type *)
  234.    valuety = RECORD
  235.                 def:  BOOLEAN      (* If value assigned yet *);
  236.                 typ:  varty        (* Which value applies -- integer or real *);
  237.                 i:    Long_Integer (* Integer value *);
  238.                 r:    REAL         (* Real value *);
  239.              END;
  240.                                    (* Bases for arithmetic *)
  241.    basety = ( dec, oct, hex );
  242.  
  243.    charsetty = SET OF CHAR;
  244.  
  245.                                    (* Built-in functions/constants *)
  246.  
  247.    stdfuncty = ( absf,    minf,    maxf,    truncf,    roundf,
  248.                  sinf,    cosf,    tanf,    cotf,      secf,
  249.                  cscf,    asinf,   acosf,   atanf,     acotf,
  250.                  asecf,   acscf,   atan2f,  expf,      lnf,
  251.                  log10f,  logf,    sqrtf,   EEf,       PIf      );
  252.  
  253.                                     (* Formal parameters for user function *)
  254.    formalty = RECORD
  255.                  nump:  INTEGER     (* Number of formal parameters *);
  256.                  parms: ARRAY [1..maxformal] OF
  257.                            RECORD
  258.                               name: varnamty   (* Name of formal parameter *);
  259.                               VAL:  valuety    (* Value type of formal par. *);
  260.                            END
  261.               END;
  262.                                    (* Angle calcs -- degrees or radians *)
  263.    anglety = ( rad, deg );
  264.  
  265. (*--------------------------------------------------------------------------*)
  266. (*                          Global Variables                                *)
  267. (*--------------------------------------------------------------------------*)
  268.  
  269. VAR
  270.  
  271.    UseEdit:   BOOLEAN              (* TRUE to use edited line            *);
  272.    ErrorFlag: BOOLEAN              (* Execution time error flag          *);
  273.    HelpFile:  TEXT                 (* File containing help text          *);
  274.    Iline:     AnyStr               (* Command input line                 *);
  275.    Oline:     AnyStr               (* Saved command input line           *);
  276.    Ipos:      INTEGER              (* Current position in command line   *);
  277.    token:     tokenty              (* Current token from command line    *);
  278.    varnam:    varnamty             (* Variable name if token = varsy     *);
  279.    constval:  valuety              (* Constant value if token = constsy  *);
  280.    istdfunc:  INTEGER              (* Index into Stdfuncs table if token *)
  281.                                    (* = Stdfuncsy                        *);
  282.    iuserfunc: INTEGER              (* Index in userfuncs table if token  *)
  283.                                    (* = Userfuncsy                       *);
  284.    curval:    valuety              (* Current accumulator value          *);
  285.  
  286.                                    (* Current variable values            *)
  287.    VarVals:   ARRAY[varnamty] OF valuety;
  288.  
  289.    done:      BOOLEAN              (* TRUE when time to quit PibCalc     *);
  290.    base:      basety               (* Current default base               *);
  291.    Frac:      INTEGER              (* No. of digits to display after     *)
  292.                                    (* decimal point.                     *);
  293.  
  294.    angle:     anglety              (* Current angle units -- rad or deg  *);
  295.    dummy:     formalty             (* Dummy (Empty) formal param. list   *);
  296.  
  297.                                    (* Standard Functions                 *)
  298.    stdfuncs:  ARRAY[ 1 .. Maxstdfuncs ] OF
  299.                  RECORD
  300.                     name:   alfa        (* Function name             *);
  301.                     nparms: INTEGER     (* No. of formal parameters  *);
  302.                     func:   stdfuncty   (* Type of built-in function *);
  303.                  END;
  304.  
  305.                                    (* User-defined functions *)
  306.    userfuncs: ARRAY[ 1 .. Maxuserfuncs ] OF
  307.                  RECORD
  308.                     name:   alfa        (* Function name             *);
  309.                     nparms: INTEGER     (* No. of formal parameters  *);
  310.                                         (* Parameter names           *)
  311.                     pnames: PACKED ARRAY [1..maxformal] OF varnamty;
  312.                     defn:   AnyStr      (* Function definition text  *);
  313.                  END;
  314.  
  315.                                    (* Commands/constants/func names  *)
  316.  
  317.    toknams:   ARRAY[ 1 .. Maxtoknams ] OF
  318.                  RECORD
  319.                     name: alfa     (* Token name *);
  320.                     tok:  tokenty  (* Token type *);
  321.                  END;
  322.  
  323. (*-----------------------------------------------------------------------*)
  324. (*                   Global Color Variables                              *)
  325. (*-----------------------------------------------------------------------*)
  326.  
  327. VAR
  328.  
  329.    ForeGround_Color    : INTEGER   (* Color for ordinary text           *);
  330.    BackGround_Color    : INTEGER   (* Usual background color            *);
  331.    Help_Text_Color     : INTEGER   (* Help text color                   *);
  332.    Help_Header_Color   : INTEGER   (* Help header color                 *);
  333.    Prompt_Color        : INTEGER   (* Color for prompts                 *);
  334.    Error_Message_Color : INTEGER   (* Color for error messages          *);
  335.  
  336. (*-----------------------------------------------------------------------*)
  337. (*                           Screen Types                                *)
  338. (*-----------------------------------------------------------------------*)
  339.  
  340. CONST
  341.  
  342.      Color_Screen_Address   = $B800;   (* Address of color screen          *)
  343.      Mono_Screen_Address    = $B000;   (* Address of mono screen           *)
  344.      Screen_Length          = 4000;    (* 80 x 25 x 2 = screen area length *)
  345.  
  346. TYPE
  347.                                               (* A screen image            *)
  348.    Screen_Type       = Array[ 1 .. Screen_Length ] Of BYTE;
  349.  
  350.    Screen_Ptr        = ^Screen_Image_Type;
  351.    Screen_Image_Type = RECORD
  352.                           Screen_Image: Screen_Type;
  353.                        END;
  354.  
  355. (*--------------------------------------------------------------------------*)
  356. (*                         Screen Variables                                 *)
  357. (*--------------------------------------------------------------------------*)
  358.  
  359. VAR
  360.                                    (* Memory-mapped screen area *)
  361.    Actual_Screen        : Screen_Ptr;
  362.  
  363. (*--------------------------------------------------------------------------*)
  364. (*                       Included Routines                                  *)
  365. (*--------------------------------------------------------------------------*)
  366.  
  367. PROCEDURE NextTok;
  368.    FORWARD;
  369.  
  370. (*$I SCREENRO.PAS  *)
  371. (*$I DUPL.PAS      *)
  372. (*$I EDITHELP.PAS  *)
  373. (*$I EDITSTRI.PAS  *)
  374. (*$I INITCALC.PAS  *)
  375. (*$I ERRORS.PAS    *)
  376. (*$I MATHROUT.PAS  *)
  377. (*$I READLINE.PAS  *)
  378. (*$I DISPLAY.PAS   *)
  379. (*$I GETTOK.PAS    *)
  380. (*$I ARITH.PAS     *)
  381. (*$I EXPRESSI.PAS  *)
  382. (*$I SETGUYS.PAS   *)
  383. (*$I DOGUYS.PAS    *)
  384.  
  385. (* ----------------------------------------------------------------- *)
  386.  
  387. BEGIN (* PibCalc -- Main Program *)
  388.  
  389.                                    (* Initialize PibCalc execution *)
  390.    Initialize;
  391.                                    (* Display welcome              *)
  392.  
  393.    WRITELN('PibCalc version 1.1 ready.  Type HELP for instructions.');
  394.  
  395.                                    (* Loop over command lines      *)
  396.    REPEAT
  397.                                    (* No errors found this line    *)
  398.       Errorflag := FALSE;
  399.                                    (* Read command line            *)
  400.       ReadLine;
  401.                                    (* Pick up first token on line  *)
  402.       NextTok;
  403.                                    (* And execute appropriate task *)
  404.       IF ( NOT ErrorFlag ) THEN
  405.          CASE token OF
  406.  
  407.             exitsy:    DoExit;
  408.             helpsy:    DoHelp;
  409.             decsy:     SetBase ( dec );
  410.             octsy:     SetBase ( oct );
  411.             hexsy:     SetBase ( hex );
  412.             radsy:     SetAngle( rad );
  413.             degsy:     SetAngle( deg );
  414.             fracsy:    SetFrac;
  415.             showsy:    DoShow;
  416.             defsy:     DoDef;
  417.             delsy:     DoDel;
  418.             dollarsy:  DoEsp;
  419.             eolsy:     Display(' ',Curval);
  420.             editsy:    DoEdit;
  421.  
  422.          ELSE
  423.             DoExp;
  424.          END  (* Case *);
  425.  
  426.    UNTIL done;
  427.  
  428. END (* PibCalc *).
  429.