home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS - Coast to Coast
/
simteldosarchivecoasttocoast2.iso
/
calculat
/
pibcal11.zip
/
INITCALC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-03-09
|
9KB
|
222 lines
(*--------------------------------------------------------------------------*)
(* Initialize -- Initialize PibCalc program *)
(*--------------------------------------------------------------------------*)
PROCEDURE Initialize;
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: Initialize *)
(* *)
(* Purpose: Initializes PibCalc execution. *)
(* *)
(* Calling Sequence: *)
(* *)
(* Initialize; *)
(* *)
(* Calls: *)
(* *)
(* EnterStandardFunction *)
(* EnterTokNam *)
(* InitAnyStr *)
(* Get_Screen_Address *)
(* Color_Screen_Active *)
(* Set_Global_Colors *)
(* *)
(* Called by: *)
(* *)
(* PibCalc (Main program) *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
i: INTEGER;
j: INTEGER;
Vname: varnamty;
(*--------------------------------------------------------------------------*)
(* EnterStandardFunction -- Enter standard function definition *)
(*--------------------------------------------------------------------------*)
PROCEDURE EnterStandardFunction( na: alfa; np: INTEGER; fu: stdfuncty );
BEGIN (* EnterStandardFunction *);
i := i + 1;
stdfuncs[i].name := na;
stdfuncs[i].nparms := np;
stdfuncs[i].func := fu;
END (* EnterStandardFunction *);
(*--------------------------------------------------------------------------*)
(* EnterTokNam -- Enter command name/constant name definition *)
(*--------------------------------------------------------------------------*)
PROCEDURE EnterTokNam( na: alfa; tok: tokenty );
BEGIN (* EnterTokNam *);
i := i + 1;
toknams[i].name := na;
toknams[i].tok := tok;
END (* EnterTokNam *);
(*--------------------------------------------------------------------------*)
(* InitAnyStr -- Initialize a string *)
(*--------------------------------------------------------------------------*)
PROCEDURE InitAnyStr( VAR s: AnyStr; ch: CHAR );
VAR
i: INTEGER;
BEGIN (* InitAnyStr *)
FOR i := 1 TO Maxstrlen DO
s[i] := ch;
END (* InitAnyStr *);
(*--------------------------------------------------------------------------*)
BEGIN (* Initialize *)
(* Not through executing yet *)
done := FALSE;
(* Initialize accumulator to zero *)
curval.def := TRUE;
curval.typ := INT;
curval.i := 0;
curval.r := 0.0;
(* Initialize all variables to zero *)
FOR Vname := 'A' TO 'Z' DO
WITH VarVals[Vname] DO
BEGIN
def := FALSE;
typ := INT;
i := 0;
r := 0.0;
END;
FRAC := 2; (* Print 2 dec. places after reals *)
base := dec; (* Default base = decimal *)
(* Initialize formal parameters *)
dummy.nump := 0;
FOR i := 1 TO Maxformal DO
WITH dummy.parms[i] DO
BEGIN
name := 'A';
VAL.def := FALSE;
VAL.typ := INT;
VAL.i := 0;
VAL.r := 0.0;
END;
(* Initialize user functions *)
FOR i := 1 TO Maxuserfuncs DO
WITH userfuncs[i] DO
BEGIN
name := ' ';
nparms := 0;
FOR j := 1 TO Maxformal DO
pnames[j] := 'A';
InitAnyStr(defn,'a');
END;
(* Set standard function names *)
i := 0;
EnterStandardFunction('ABS ', 1, absf);
EnterStandardFunction('MIN ', -1, minf);
EnterStandardFunction('MAX ', -1, maxf);
EnterStandardFunction('TRUNC ', 1, truncf);
EnterStandardFunction('ROUND ', 1, roundf);
EnterStandardFunction('SIN ', 1, sinf);
EnterStandardFunction('COS ', 1, cosf);
EnterStandardFunction('TAN ', 1, tanf);
EnterStandardFunction('COT ', 1, cotf);
EnterStandardFunction('SEC ', 1, secf);
EnterStandardFunction('CSC ', 1, cscf);
EnterStandardFunction('ASIN ', 1, asinf);
EnterStandardFunction('ACOS ', 1, acosf);
EnterStandardFunction('ATAN ', 1, atanf);
EnterStandardFunction('ACOT ', 1, acotf);
EnterStandardFunction('ASEC ', 1, asecf);
EnterStandardFunction('ACSC ', 1, acscf);
EnterStandardFunction('ATAN2 ', 2, atan2f);
EnterStandardFunction('EXP ', 1, expf);
EnterStandardFunction('LN ', 1, lnf);
EnterStandardFunction('LOG10 ', 1, log10f);
EnterStandardFunction('LOG ', 2, logf);
EnterStandardFunction('SQRT ', 1, sqrtf);
EnterStandardFunction('EE ', 0, EEf);
EnterStandardFunction('PI ', 0, PIf);
(* Set command/constant names *)
i := 0;
EnterTokNam('END ',exitsy);
EnterTokNam('EXIT ',exitsy);
EnterTokNam('QUIT ',exitsy);
EnterTokNam('HELP ',helpsy);
EnterTokNam('DEC ',decsy);
EnterTokNam('OCT ',octsy);
EnterTokNam('HEX ',hexsy);
EnterTokNam('FRAC ',fracsy);
EnterTokNam('RAD ',radsy);
EnterTokNam('DEG ',degsy);
EnterTokNam('DEF ',defsy);
EnterTokNam('DEL ',delsy);
EnterTokNam('SHOW ',showsy);
EnterTokNam('VARS ',varssy);
EnterTokNam('FUNCS ',funcssy);
EnterTokNam('MOD ',modsy);
EnterTokNam('DIV ',divsy);
EnterTokNam('EDIT ',editsy);
(* Select color/mono screen *)
Get_Screen_Address( Actual_Screen );
(* Establish colors *)
IF Color_Screen_Active THEN
BEGIN
ForeGround_Color := Yellow (* Color for ordinary text *);
BackGround_Color := Black (* Usual background color *);
Prompt_Color := Red (* Color for prompts *);
Help_Text_Color := Green (* Color for help text *);
Help_Header_Color := Blue (* Color for help headers *);
Error_Message_Color := Red (* Color for errors *);
END
ELSE
BEGIN
ForeGround_Color := White (* Color for ordinary text *);
BackGround_Color := Black (* Usual background color *);
Prompt_Color := White (* Color for prompts *);
Help_Text_Color := White (* Color for help text *);
Help_Header_Color := White (* Color for help headers *);
Error_Message_Color := White+Blink (* Color for errors *);
END;
Set_Global_Colors( ForeGround_Color, BackGround_Color );
(* No command line read yet *)
UseEdit := FALSE;
Iline := COL;
Oline := COL;
END (* Initialize *);