Calc

Download an Apple II disk image which includes Calc (.tgz).

Download the same disk image as a ShrinkIt disk archive (.sdk).

Calc: A scientific calculator in Pascal.

Calc is a command-line, scientific calculator written in Kyan Pascal for the Apple II computer. The program is supplied as a ProDOS system file, and the source code, shown below, is included on the disk.

Calc: Features.

The program performs arithmetic on numbers using either decimal (e.g. 123.456) or scientific (e.g. 1.23456e2) notation. Numbers may be in the range ±9.9999999999e±99. The usual arithmetic operation are supported: +, -, *, /, ^, and !. The operations have the expected precedence, but you can use parentheses to change the order. The built-in functions are below. The program responds to several commands, shown below, may be abbreviated to a single letter.

Calc: Design.

The program was originally designed to evaluate integer expressions for a roff-style formatting program. It was later adapted to evaluating floating-point expressions for numerical integration software. This latest version of the program implements the following grammar:

  <expr> ::= <term> + | - <term>
  <term> ::= <factor> * | / <factor>
<factor> ::= <value> ^ <factor> | <value> !
 <value> ::= [ + | - ] ( <expr> ) | <result> | <real>
<result> ::= <name> ( <expr> )
  <name> ::= <letter> { <letter> | <digit> }
  <real> ::= <number> [ . ] [ <number> ] [ e <scale> ]
<number> ::= <digit> { <digit> }
 <scale> ::= [ + | - ] <number>
 <digit> ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9

The result is to make addition and subtraction have equally low precedence, while multiplication and division are higher. Exponentiation and factorial are yet higher, and parenthetic expressions (including function calls) are highest.

Calc: Code.

The program implements the four levels of precedence using four nested functions: Expression, Term, Factor and Value. Evaluation proceeds from left to right for all but exponentiation. Instead, Factor is called recursively, causing an expression like 2^3^4 to be interpreted as 2^(3^4).

{28-Apr-05; J. Matthews; GPL; no warranty}

program Calc;

const
  maxString = 80;
  bang = '!';
  dot = '.';
  minus = '-';
  parOpen = '(';
  parClose = ')';
  plus = '+';
  power = '^';
  slash = '/';
  space = ' ';
  star = '*';

type
  String = array [1..maxString] of char;

var
  s : String;
  i, len, width, dec : integer;
  t, nul, tab : char;
  sn, done : boolean;

procedure LowerCase (var s : String; len : integer);
var i : integer;
begin
  for i := 1 to len do
    if s[i] in ['A'..'Z'] then
      s[i] := chr(ord(s[i]) + 32)
end; {LowerCase}

function IsDigit (c : char) : boolean;
begin
  IsDigit := c in ['0'..'9', dot]
end; {IsDigit}

function ParseInt (var s : String; var i : integer) : integer;
var
  n, sign : integer;
begin
  while (s[i] = space) or (s[i] = tab) do i := i + 1;
  if (s[i] = minus) then sign := -1
  else sign := 1;
  if (s[i] = plus) or (s[i] = minus) then i := i + 1;
  n := 0;
  while s[i] in ['0'..'9'] do begin
    n := 10 * n + ord(s[i]) - ord('0');
    i := i + 1
  end;
  ParseInt := sign * n
end; {ParseInt}

function ParseReal (var s : String; var i : integer) : real;
var
  v : real; j, decimal, exponent : integer;
begin
  while s[i] in [space, tab] do i := i + 1;
  v := 0.0; decimal := 0; exponent := 0;
  while (isdigit(s[i])) do begin {parse decimal number}
    if s[i] = dot then decimal := i
    else v := 10 * v + (ord(s[i]) - ord('0'));
    i := i + 1;
  end;
  if decimal > 0 then
    for j := 1 to (i - decimal - 1) do v := v / 10;
  if s[i] = 'e' then begin {handle scientific notation}
    i := i + 1;
    exponent := ParseInt(s, i);
    if exponent > 0 then
      for j := 1 to exponent do v := v * 10
    else if exponent < 0 then
      for j := 1 to abs(exponent) do v := v / 10
  end;
  ParseReal := v
end; {ParseReal}

function DoDivision (x, y : real) : real;
begin
  if y <> 0 then DoDivision := x / y
  else begin
    Writeln('Please don''t divide by zero!');
    DoDivision := 0
  end
end; {DoDivision}

function DoFactorial (x : real) : real;
var v : real; i, j : integer;
begin
  v := 1; j := abs(trunc(x));
  if (j = 0) or (j = 1) then DoFactorial := 1
  else if j > 69 then Writeln('Arithemtic overflow.')
  else for i := j downto 2 do v := v * i;
  if x < 0 then DoFactorial := -v
  else DoFactorial := v
end; {DoLn}

function DoLn (x : real) : real;
begin
  if x > 0.0 then DoLn := ln(x)
  else begin
    Writeln('Natural log argument must be positive.');
    DoLn := 0.0
  end
end; {DoLn}

function DoPower (b, e : real) : real;
var p : integer; u, v : real;
begin
  v := 1; u := b; p := trunc(e);
  if ((e - p) < 0.00001) and (p > 0) then begin
  {handle positive integral exponents}
    while p > 0 do begin
      while not odd(p) do begin
        p := p div 2; u := sqr(u)
      end;
      p := p - 1; v := u * v
    end;
    DoPower := v
  end
  {else use natural logarithm}
  else DoPower := exp(e * DoLn(b))  
end; {Power}

function DoSqrt (x : real) : real;
begin
  if x > 0.0 then DoSqrt := sqrt(x)
  else begin
    Writeln('Square root argument must be positive.');
    DoSqrt := 0.0
  end
end; {DoSqrt}

procedure SkipToken (var s : String; var i : integer);
begin
  while s[i] in ['a'..'z'] do i := i + 1;
end; {SkipToken}

function SkipSpace (var s : String; var i : integer) : char;
begin
  while (s[i] in [space, tab]) do i := i + 1;
  SkipSpace := s[i]
end;

function Expression (var s : string; var i : integer) : real;
var v : real; t : char; j : integer;

  function Term (var s : String; var i : integer) : real;
  var v : real; t : char;

    function Factor (var s : String; var i : integer) : real;
    var v : real; t : char;

      function Value (var s : String; var i : integer) : real;
      var v : real; t : char;
      begin
        v := 0.0;
        t := SkipSpace(s, i);
        if t = parOpen then begin {nested expression}
          i := i + 1;
          v := Expression(s, i);
          if (SkipSpace(s, i) = parClose) then i := i + 1
          else Writeln('Missing parenthesis in expression.')
        end
        else if t = plus then begin {unary plus}
          i := i + 1; v := Value(s, i)
        end
        else if t = minus then begin {unary minus}
          i := i + 1; v := -Value(s, i)
        end
        else if IsDigit(t) then begin {real number}
          v := ParseReal(s, i)
        end
        else if t in ['a','c','e','l','p','s','t'] then begin {function}
          j := i; SkipToken(s, i);
          if s[j] = 'a' then
            if s[j+1] = 'b' then v := abs(Value(s, i))
            else if s[j+1] = 't' then v := arctan(Value(s, i));
          if s[j] = 'c' then v := cos(Value(s, i));
          if s[j] = 'e' then
            if s[j+1] = 'x' then v := exp(Value(s, i))
            else v := exp(1); {e}
          if s[j] = 'l' then v := DoLn(Value(s, i));
          if s[j] = 'p' then v := 3.14159265358979;
          if s[j] = 's' then
            if s[j+1] = 'i' then v := sin(Value(s, i))
            else if s[j+1] = 'q' then v := DoSqrt(Value(s, i));
          if s[j] = 't' then begin
            v := Value(s, i); v := sin(v)/cos(v)
          end
        end
        else Writeln('Syntax error.');
        Value := v
      end; {Value}

    begin
    v := Value(s, i);
    t := SkipSpace(s, i);
    while t in [bang, power] do begin
      i := i + 1;
      case t of
        bang: v := DoFactorial(v);
        power: v := DoPower(v, Factor(s, i))
      end;
      t := SkipSpace(s, i)
    end;
    Factor := v
    end; {Factor}

  begin
    v := Factor(s, i);
    t := SkipSpace(s, i);
    while t in [star, slash, power] do begin
      i := i + 1;
      case t of
        star: v := v * Factor(s, i);
        slash: v := DoDivision(v, Factor(s, i));
        power: v := DoPower(v, Factor(s, i))
      end;
      t := SkipSpace(s, i)
    end;
    Term := v
  end; {Term}

begin
  v := Term(s, i);
  t := SkipSpace(s, i);
  while t in [plus, minus] do begin
    i := i + 1;
    case t of
      plus: v := v + Term(s, i);
      minus: v := v - Term(s, i)
    end;
    t := SkipSpace(s, i)
  end;
  Expression := v
end; {Expression}

function Length (var s : String) : integer;
var i : integer;
begin
  i := maxString;
  while (s[i] = space) and (i <> 1) do i := i - 1;
  if (s[i] = space) and (i = 1) then i := 0;
  Length := i;
end; {Length}

procedure SetDecimal (var s : String; var i, dec : integer);
begin
  SkipToken(s, i);
  dec := trunc(ParseReal(s, i));
  if dec > 15 then dec := 15;
  if dec < 0 then dec := 0;
  Writeln('Decimal precision set to ', dec);
end; {SetDecimal}

procedure SetWidth (var s : String; var i, width : integer);
begin
  SkipToken(s, i);
  width := trunc(ParseReal(s, i));
  if width > 80 then width := 80;
  if width < 0 then width := 0;
  Writeln('Decimal width set to ', width);
end; {SetWidth}

procedure SetNotation (var sn : boolean);
begin
  sn := not(sn);
  if sn then Writeln('Scientific notation on.')
  else Writeln('Scientific notation off.')
end; {SetNotation}

procedure Format (var s : String; var i : integer);
begin
  if sn then Writeln(Expression(s, i):width)
  else Writeln(Expression(s, i):width:dec)
end; {Format}

function FileCheck : boolean;
begin
FileCheck := false;
#a
 jsr _mli
 db  $C4 ;Get_File_Info
 dw finfo
 bne fexit
 ldy #5 ;result offset
 lda #1 ;true
 sta (_sp),y
fexit equ *
#
end; {FileCheck}
#a
fname str "calc.txt"
finfo db 10
 dw fname
 ds 15
#
procedure Execute;
var s : String; i, len : integer; f : file of char;
begin
  if FileCheck then begin
    reset(f, 'calc.txt');
    while not(eof(f)) do begin
      i := 1;
      repeat
        s[i] := f^; i := i + 1; get(f)
      until f^ = chr(13);
      get(f);
      s[i] := nul;
      for i := 1 to i - 1 do Write(s[i]); Write(' = ');
      i := 1;
      t := SkipSpace(s, i);
      Format(s, i)
    end
  end
  else Writeln('File "calc.txt" not found.')
end; {Execute}

procedure Help;
begin
  Writeln;
  Writeln('+--------------------+');
  Writeln('| Welcome to Calc v1 |');
  Writeln('+--------------------+');
  Writeln;
  Writeln('A scientific calculator by J. Matthews');
  Writeln;
  Writeln('Operators (increasing precedence):');
  Writeln(' +, -, *, /, !, ^, unary +/-, ()');
  Writeln;
  Writeln('Functions & constants:');
  Writeln(' sqrt(), ln(), exp(), atan()');
  Writeln(' cos(), sin(), tan(), e, pi');
  Writeln;
  Writeln('Commands (may be abbreviated):');
  Writeln(' width #: set output field width to #');
  Writeln(' decimal #: set the precision to #');
  Writeln(' notation: toggle scientific notation');
  Writeln(' xecute: execute the file "calc.txt"');
  Writeln(' help: print this help screen');
  Writeln(' quit: exit the program');
  Writeln
end; {Help}

begin
#a ; clear screen
 stx _t
 jsr $FC58
 ldx _t
#
  nul := chr(0); tab := chr(9);
  width := 12; dec:= 6; sn := false; done := false;
  Help;
  repeat
    Write('> '); Readln(s);
    len := Length(s);
    s[len + 1] := nul; {terminate string}
    if len > 0 then begin
      LowerCase(s, len);
      i := 1;
      t := SkipSpace(s, i);
      if t = 'd' then SetDecimal(s, i, dec)
      else if t = 'h' then Help
      else if t = 'n' then SetNotation(sn)
      else if t = 'q' then done := true
      else if t = 'w' then SetWidth(s, i, width)
      else if t = 'x' then Execute
      else Format(s, i)
    end
  until done
end. {Calc}

Copyright 1986,2005 John B. Matthews

Distribution permitted under the terms of the GNU Public License.

Last updated 5-Jan-2019.