home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / pibsoft / pibcalc / initcalc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-01-13  |  8.4 KB  |  222 lines
  1. (*--------------------------------------------------------------------------*)
  2. (*                Initialize -- Initialize PibCalc program                  *)
  3. (*--------------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Initialize;
  6.  
  7. (*--------------------------------------------------------------------------*)
  8. (*                                                                          *)
  9. (*     Procedure:  Initialize                                               *)
  10. (*                                                                          *)
  11. (*     Purpose:    Initializes PibCalc execution.                           *)
  12. (*                                                                          *)
  13. (*     Calling Sequence:                                                    *)
  14. (*                                                                          *)
  15. (*        Initialize;                                                       *)
  16. (*                                                                          *)
  17. (*     Calls:                                                               *)
  18. (*                                                                          *)
  19. (*        EnterStandardFunction                                             *)
  20. (*        EnterTokNam                                                       *)
  21. (*        InitAnyStr                                                        *)
  22. (*        Get_Screen_Address                                                *)
  23. (*        Color_Screen_Active                                               *)
  24. (*        Set_Global_Colors                                                 *)
  25. (*                                                                          *)
  26. (*     Called by:                                                           *)
  27. (*                                                                          *)
  28. (*        PibCalc  (Main program)                                           *)
  29. (*                                                                          *)
  30. (*--------------------------------------------------------------------------*)
  31.  
  32. VAR
  33.    i:     INTEGER;
  34.    j:     INTEGER;
  35.    Vname: varnamty;
  36.  
  37. (*--------------------------------------------------------------------------*)
  38. (*         EnterStandardFunction -- Enter standard function definition      *)
  39. (*--------------------------------------------------------------------------*)
  40.  
  41. PROCEDURE EnterStandardFunction( na: alfa; np: INTEGER; fu: stdfuncty );
  42.  
  43. BEGIN (* EnterStandardFunction *);
  44.  
  45.    i := i + 1;
  46.  
  47.    stdfuncs[i].name   := na;
  48.    stdfuncs[i].nparms := np;
  49.    stdfuncs[i].func   := fu;
  50.  
  51. END   (* EnterStandardFunction *);
  52.  
  53. (*--------------------------------------------------------------------------*)
  54. (*       EnterTokNam -- Enter command name/constant name definition         *)
  55. (*--------------------------------------------------------------------------*)
  56.  
  57. PROCEDURE EnterTokNam( na: alfa; tok: tokenty );
  58.  
  59. BEGIN (* EnterTokNam *);
  60.  
  61.    i := i + 1;
  62.  
  63.    toknams[i].name := na;
  64.    toknams[i].tok  := tok;
  65.  
  66. END   (* EnterTokNam *);
  67.  
  68. (*--------------------------------------------------------------------------*)
  69. (*                InitAnyStr -- Initialize a string                         *)
  70. (*--------------------------------------------------------------------------*)
  71.  
  72. PROCEDURE InitAnyStr( VAR s: AnyStr; ch: CHAR );
  73.  
  74. VAR
  75.    i: INTEGER;
  76.  
  77. BEGIN (* InitAnyStr *)
  78.  
  79.    FOR i := 1 TO Maxstrlen DO
  80.       s[i] := ch;
  81.  
  82. END   (* InitAnyStr *);
  83.  
  84. (*--------------------------------------------------------------------------*)
  85.  
  86. BEGIN (* Initialize *)
  87.  
  88.                                    (* Not through executing yet      *)
  89.    done := FALSE;
  90.  
  91.                                    (* Initialize accumulator to zero *)
  92.    curval.def := TRUE;
  93.    curval.typ := INT;
  94.    curval.i   := 0;
  95.    curval.r   := 0.0;
  96.                                    (* Initialize all variables to zero *)
  97.    FOR Vname := 'A' TO 'Z' DO
  98.       WITH VarVals[Vname] DO
  99.          BEGIN
  100.             def := FALSE;
  101.             typ := INT;
  102.             i   := 0;
  103.             r   := 0.0;
  104.          END;
  105.  
  106.    FRAC := 2;                      (* Print 2 dec. places after reals *)
  107.    base := dec;                    (* Default base = decimal          *)
  108.  
  109.  
  110.                                    (* Initialize formal parameters    *)
  111.    dummy.nump := 0;
  112.  
  113.    FOR i := 1 TO Maxformal DO
  114.       WITH dummy.parms[i] DO
  115.          BEGIN
  116.             name    := 'A';
  117.             VAL.def := FALSE;
  118.             VAL.typ := INT;
  119.             VAL.i   := 0;
  120.             VAL.r   := 0.0;
  121.          END;
  122.                                    (* Initialize user functions       *)
  123.  
  124.    FOR i := 1 TO Maxuserfuncs DO
  125.       WITH userfuncs[i] DO
  126.          BEGIN
  127.             name   := '          ';
  128.             nparms := 0;
  129.             FOR j := 1 TO Maxformal DO
  130.                pnames[j] := 'A';
  131.             InitAnyStr(defn,'a');
  132.          END;
  133.  
  134.                                    (* Set standard function names *)
  135.    i := 0;
  136.    EnterStandardFunction('ABS       ',  1, absf);
  137.    EnterStandardFunction('MIN       ', -1, minf);
  138.    EnterStandardFunction('MAX       ', -1, maxf);
  139.    EnterStandardFunction('TRUNC     ',  1, truncf);
  140.    EnterStandardFunction('ROUND     ',  1, roundf);
  141.    EnterStandardFunction('SIN       ',  1, sinf);
  142.    EnterStandardFunction('COS       ',  1, cosf);
  143.    EnterStandardFunction('TAN       ',  1, tanf);
  144.    EnterStandardFunction('COT       ',  1, cotf);
  145.    EnterStandardFunction('SEC       ',  1, secf);
  146.    EnterStandardFunction('CSC       ',  1, cscf);
  147.    EnterStandardFunction('ASIN      ',  1, asinf);
  148.    EnterStandardFunction('ACOS      ',  1, acosf);
  149.    EnterStandardFunction('ATAN      ',  1, atanf);
  150.    EnterStandardFunction('ACOT      ',  1, acotf);
  151.    EnterStandardFunction('ASEC      ',  1, asecf);
  152.    EnterStandardFunction('ACSC      ',  1, acscf);
  153.    EnterStandardFunction('ATAN2     ',  2, atan2f);
  154.    EnterStandardFunction('EXP       ',  1, expf);
  155.    EnterStandardFunction('LN        ',  1, lnf);
  156.    EnterStandardFunction('LOG10     ',  1, log10f);
  157.    EnterStandardFunction('LOG       ',  2, logf);
  158.    EnterStandardFunction('SQRT      ',  1, sqrtf);
  159.    EnterStandardFunction('EE        ',  0, EEf);
  160.    EnterStandardFunction('PI        ',  0, PIf);
  161.  
  162.                                    (* Set command/constant names *)
  163.    i := 0;
  164.    EnterTokNam('END       ',exitsy);
  165.    EnterTokNam('EXIT      ',exitsy);
  166.    EnterTokNam('QUIT      ',exitsy);
  167.    EnterTokNam('HELP      ',helpsy);
  168.    EnterTokNam('DEC       ',decsy);
  169.    EnterTokNam('OCT       ',octsy);
  170.    EnterTokNam('HEX       ',hexsy);
  171.    EnterTokNam('FRAC      ',fracsy);
  172.    EnterTokNam('RAD       ',radsy);
  173.    EnterTokNam('DEG       ',degsy);
  174.    EnterTokNam('DEF       ',defsy);
  175.    EnterTokNam('DEL       ',delsy);
  176.    EnterTokNam('SHOW      ',showsy);
  177.    EnterTokNam('VARS      ',varssy);
  178.    EnterTokNam('FUNCS     ',funcssy);
  179.    EnterTokNam('MOD       ',modsy);
  180.    EnterTokNam('DIV       ',divsy);
  181.    EnterTokNam('EDIT      ',editsy);
  182.  
  183.                                    (* Select color/mono screen *)
  184.  
  185.    Get_Screen_Address( Actual_Screen );
  186.  
  187.                                    (* Establish colors         *)
  188.  
  189.    IF Color_Screen_Active THEN
  190.       BEGIN
  191.  
  192.          ForeGround_Color    := Yellow   (* Color for ordinary text  *);
  193.          BackGround_Color    := Black    (* Usual background color   *);
  194.  
  195.          Prompt_Color        := Red      (* Color for prompts        *);
  196.          Help_Text_Color     := Green    (* Color for help text      *);
  197.          Help_Header_Color   := Blue     (* Color for help headers   *);
  198.          Error_Message_Color := Red      (* Color for errors         *);
  199.  
  200.       END
  201.    ELSE
  202.       BEGIN
  203.  
  204.          ForeGround_Color    := White       (* Color for ordinary text  *);
  205.          BackGround_Color    := Black       (* Usual background color   *);
  206.  
  207.          Prompt_Color        := White       (* Color for prompts        *);
  208.          Help_Text_Color     := White       (* Color for help text      *);
  209.          Help_Header_Color   := White       (* Color for help headers   *);
  210.          Error_Message_Color := White+Blink (* Color for errors         *);
  211.  
  212.       END;
  213.  
  214.    Set_Global_Colors( ForeGround_Color, BackGround_Color );
  215.  
  216.                                    (* No command line read yet *)
  217.    UseEdit  := FALSE;
  218.    Iline    := COL;
  219.    Oline    := COL;
  220.  
  221. END   (* Initialize *);
  222. V( n