Web Version of Calculator

Smart Pascal version of Calculator by Christopher Winward: L6 Age ~16

Introduction

This web version of Calculator is designed as a preview to be run in a browser on a PC. If the program does not work in your current browser, try another such as Chrome. If you see no display at school, the security system might have blocked it. You can try instead this direct link to the program running on its own page. The Smart Pascal code of the main unit follows the program in action. See the web version of MorseCode for the code of the Crt unit. On a Raspberry Pi, install the Lucida Console font.

Program in Action

Calculator.html

Code of Main Unit

unit uMain;
{
    Copyright (c) 2012 Christopher Winward

    Licensed under the Apache License, Version 2.0 (the "License"); you may not
    use this file except in compliance with the License, as described at
    http://www.apache.org/licenses/ and http://www.pp4s.co.uk/licenses/

    Converted to Smart Pascal for web preview by PPS 2014
}

interface

uses 
  System.Types, System.Lists, SmartCL.System, SmartCL.Components, SmartCL.Application,
  SmartCL.Game, SmartCL.GameApp, SmartCL.Graphics, uCrtCanvas;

type
  TReadState = (rsNotReading, rsReading, rsFinishedReading);
  tTokenNames = (TOKEN_NONE, TOKEN_ADD, TOKEN_SUBTRACT, TOKEN_MULTIPLY, TOKEN_DIVIDE,
                 TOKEN_LBRACK, TOKEN_RBRACK, TOKEN_POWER, TOKEN_NUMBER, TOKEN_END, TOKEN_INVALID);
  tToken = class
  public
    eType : tTokenNames; //The eType describes the token type, such as TOKEN_ADD or TOKEN_NUMBER
    eValue : double; //The numerical value of the token, only used if eType is TOKEN_NUMBER
    constructor Create(xType : tTokenNames; xValue : double = 0);
  end;

  tTokenList = class(TObjectList) //We're just expanding upon the tObjectList class to add our own methods.
  public                       //A tObjectList is like an advanced array of pointers
    //Returns a typecasted object -> tToken from the list at a given position
    function at(position : integer): tToken;

    //Returns the last tToken in the list
    function getLast: tToken;

    function getSecondLast: tToken;
    function getFirst: tToken;

    //Removes the last tToken from the list, and returns it
    function popData: tToken;

    //Returns FALSE if a TOKEN_INVALID is found anywhere in it, otherwise TRUE
    function isValid: boolean;

    //Print all the data in the list straight out to the console
    procedure dumpData;
  end;


  TCanvasProject = class(TW3CustomGameApplication)
  private
    const DELAY = 100;
    const SCALE_FACTOR = 2;
    const CELL_WIDTH = 5 * SCALE_FACTOR;
    const CELL_HEIGHT = 8 * SCALE_FACTOR;
    const FONT_SIZE = 9 * SCALE_FACTOR;
    const ROWS = 25;
    const COLS = 80;
    const WIDTH = COLS * CELL_WIDTH;
    const HEIGHT = ROWS * CELL_HEIGHT;
    reading_state: TReadState = rsNotReading;
    TempReadString: string = '';
    Grid: TConsoleGrid;
    Inputting := true;
    tokensToEvaluate, postfixTokens: tTokenList;
  protected
    procedure ApplicationStarting; override;
    procedure ApplicationClosing; override;
    procedure PaintView(Canvas: TW3Canvas); override;
    procedure KeyDownEvent(mCode: integer);
    procedure GoToXY(X, Y: integer);
    procedure clrscr;
    procedure ClrEOL;
    procedure textColor(colour: TConsoleColour);
    procedure textBackground(colour: TConsoleColour);
    procedure write(txt: string);
    procedure writeln(txt: string); overload;
    procedure writeln; overload;
    procedure readln(var InputString : string);

    procedure InputExpression;
    function stringToTokens(inputString : string) : tTokenList;
    function evaluateRPN(inputList : tTokenList) : double;
    function convertInfixToPostfix(inputList : tTokenList) : tTokenList;
  end;

implementation

var
  inputString : string;

constructor tToken.Create(xType: tTokenNames; xValue: double = 0);
begin
  eType := xType;
  eValue := xValue;
end;

function tTokenList.at(position: integer): tToken;
begin
  //Typecast a pointer to a tToken pointer and return it
  exit tToken(Items[position]);
end;

function tTokenList.getLast: tToken;
begin
  exit at(Count - 1);
end;

function tTokenList.getSecondLast: tToken;
begin
  exit at(Count - 2);
end;

function tTokenList.getFirst: tToken;
begin
  exit at(0);
end;

function tTokenList.isValid: boolean;
begin
  for var tCount := 0 to Count - 1 do
  //Simply check all the tokens and return false if any are TOKEN_INVALID
  if at(tCount).eType = TOKEN_INVALID then
    exit false;
  exit true;
end;

//Dump out the data in a tokenList, mostly for debugging purposes
procedure tTokenList.dumpData;
begin
  for var i:= 0 to self.count - 1 do
    writeln(inttostr(i)+ ': ' + at(i).eType.ToString+' '+ at(i).eValue.ToString);
  writeln(' ');
end;

function tTokenList.popData: tToken;
begin
  result := getLast;
  Remove(Count - 1);
end;

//Look at a string, and convert it into a tTokenList of tTokens
function TCanvasProject.stringToTokens(inputString : string) : tTokenList;

  //We nest a few functions in here as they aren't needed elsewhere
  function checkStringNumber(inputString : string) : boolean;
  var
    charCount, decCount : integer;
  begin
    //Just check that we have a valid number with only one decimal place
    decCount := 0;
    for charCount := 1 to length(inputString) do
      begin
        if inputString[charCount] = '.' then
          begin
            inc(decCount);
            if decCount = 2 then //We've found a second decimal place, so it's not valid
              exit false;
      end;
    end;
    exit true;
  end;

  procedure exitFail;
  begin
    result.Add(tToken.Create(TOKEN_INVALID));
    result.Add(tToken.Create(TOKEN_END));
  end;

var
  charCount, tokenCount : integer;
  tempChar : string;
  strTempNumber : string = '';
  dblTempNumber : double;
  lBrackCount, rBrackCount : integer; //For counting left and right brackets
begin
  lBrackCount := 0;
  rBrackCount := 0;
  result := tTokenList.Create; //Create a new tTokenList and set the result to it.
  if length(inputString) = 0 then
    exitFail; //If no input is entered, fail
  for charCount := 1 to length(inputString) do //Loop through all the characters in the string.
    begin
      tempChar := inputString[charCount];
      //Add the character to a temporary number string if it's a digit or decimal point.
      if tempChar in ['0' .. '9', '.'] then
        strTempNumber += tempChar
      else
        begin //If not a digit or .
          if length(strTempNumber) <> 0 then //If there is a number string to evaluate
            begin
              if checkStringNumber(strTempNumber) then //Check it's a valid number
                dblTempNumber := StrToFloat(strTempNumber)
              else
                begin
                  dblTempNumber := 0; //If not, exit fail
                  writeln('Could not convert number properly.');
                  exitFail;
                end;
              //Add the number to the token list
              result.Add(tToken.Create(TOKEN_NUMBER, dblTempNumber));
              strTempNumber := ''; //Clear the temporary number
            end;

          case tempChar of //If it's an operator, add it to the token list
            '+' : result.Add(tToken.Create(TOKEN_ADD));
            '-' : result.Add(tToken.Create(TOKEN_SUBTRACT));
            '*' : result.Add(tToken.Create(TOKEN_MULTIPLY));
            '/' : result.Add(tToken.Create(TOKEN_DIVIDE));
            '(' : begin
                    result.Add(tToken.Create(TOKEN_LBRACK));
                    inc(lBrackCount);
                  end;
            ')' : begin
                    result.Add(tToken.Create(TOKEN_RBRACK));
                    inc(rBrackCount);
                  end;
            '^' : result.Add(tToken.Create(TOKEN_POWER));
          else
            begin
              writeln('Invalid characters used in statement.');
              exitFail;
            end;
          end;
        end;
    end;
  if rBrackCount <> lBrackCount then //Unequal numbers of left and right brackets
    begin
      writeln('Mismatched brackets');
      exitFail;
    end;
  //Check the current temporary number string one last time.
  if length(strTempNumber) <> 0 then
    begin
      if checkStringNumber(strTempNumber) then
        begin
          dblTempNumber := StrToFloat(strTempNumber);
          result.Add(tToken.Create(TOKEN_NUMBER,dblTempNumber));
        end
      else
        begin
          dblTempNumber := 0;
          writeln('Could not convert number properly.');
          exitFail;
        end;
    end;

  //Now run a syntax analysis to check that it's safe to run.
  if (result.getLast.eType <> TOKEN_NUMBER) and (result.getLast.eType <> TOKEN_RBRACK) then
    //The expression must end in a number or right bracket.
     exitFail;
  if (result.getFirst.eType <> TOKEN_NUMBER) and (result.getFirst.eType <> TOKEN_LBRACK) then
    begin //Check it starts with a number or left bracket.
      if (result.getFirst.eType = TOKEN_SUBTRACT) or (result.getFirst.eType = TOKEN_ADD) then
        //Add a 0 before any leading plus or minus signs.
        result.Insert(0, tToken.create(TOKEN_NUMBER, 0))
      else
        begin
          writeln('Syntax error - calculation doesn''t start with a number.');
          exitFail;
        end;
    end;

  for tokenCount := 1 to result.Count - 1 do
    begin
      case result.at(tokenCount).eType of
        TOKEN_ADD, TOKEN_SUBTRACT, TOKEN_MULTIPLY, TOKEN_DIVIDE,
        TOKEN_POWER :  begin
                         if not(result.Count = tokenCount) then
                           begin
                             if ((result.at(tokenCount - 1).eType <> TOKEN_NUMBER) and
                                (result.at(tokenCount - 1).eType <> TOKEN_RBRACK))
                                or
                                ((result.at(tokenCount + 1).eType <> TOKEN_NUMBER) and
                                (result.at(tokenCount + 1).eType <> TOKEN_LBRACK)) then
                                //Check that operators have numbers or appropriate brackets around them
                               begin
                                 if result.at(tokenCount-1).eType <> TOKEN_NUMBER then
                                   //Add a leading zero before + and -
                                   result.insert(tokenCount,tToken.create(TOKEN_NUMBER, 0))
                                 else
                                   begin
                                     writeln('Bad tokens around ADD, SUBTRACT, MULTIPLY, DIVIDE or POWER sign');
                                     exitFail;
                                   end;
                               end;
                           end
                         else
                           begin
                             writeln('Ends with a binary operator.');
                             exitFail;
                           end;
                       end;
        TOKEN_LBRACK : begin
                       {Check that after a left bracket there is a number,
                       another left bracket, or a right bracket}
                         if (result.at(tokenCount+1).eType <> TOKEN_NUMBER) and
                            (result.at(tokenCount+1).eType <> TOKEN_LBRACK) and
                            (result.at(tokenCount+1).eType <> TOKEN_RBRACK) then
                           exitFail;
                       end;
      end;
    end;
  result.Add(tToken.Create(TOKEN_END));
end;

function TCanvasProject.convertInfixToPostfix(inputList: tTokenList): tTokenList;
{This is an implementation of the Shunting-yard algorithm that makes use of stacks to convert
infix equations into postfix. As Pascal does not have a built in stack, I just used a modified
tObjectList to act in a similar manner.
http://en.wikipedia.org/wiki/Shunting-yard_algorithm gives a good overview of the algorithm.
I haven't commented this function as it doesn't deviate away from the algorithm much if at all,
and I will assume you have read the Wikipedia article explaining it.}
var
  tempToken : tToken;
  outputTokenList : tTokenList;
  temporaryStack : tTokenList;
  tokenCount : integer;
begin
  outputTokenList := tTokenList.create;
  temporaryStack := tTokenList.create;
  temporaryStack.add(tToken.create(TOKEN_END));   //OK so far
  for tokenCount := 0 to inputList.count - 1 do
    begin
      tempToken := inputList.at(tokenCount);
      case tempToken.eType of
        //These don't need any special cases, they go straight to the output.
        TOKEN_NUMBER :   outputTokenList.Add(tempToken);

        TOKEN_ADD,
        TOKEN_SUBTRACT : begin
                           if outputTokenList.Count = 0 then
                             outputTokenList.Add(tToken.create(TOKEN_NUMBER, 0));
                           while true do
                             begin
                               case temporaryStack.getLast.eType of
                                 TOKEN_ADD, TOKEN_SUBTRACT, TOKEN_MULTIPLY, TOKEN_DIVIDE,
                                 TOKEN_POWER : outputTokenList.Add(temporaryStack.popData);
                               else
                                 break;
                               end;
                             end;
                           temporaryStack.add(tempToken);
                         end;
        TOKEN_MULTIPLY,
        TOKEN_DIVIDE :   begin
                           case temporaryStack.getLast.eType of
                             TOKEN_MULTIPLY, TOKEN_DIVIDE,
                             TOKEN_POWER : outputTokenList.Add(temporaryStack.popData);
                           end;
                           temporaryStack.add(tempToken);
                         end;
        TOKEN_POWER :    begin
                           if outputTokenList.Count = 0 then
                             outputTokenList.Add(tToken.create(TOKEN_NUMBER,0));
                           while true do
                             begin
                               case temporaryStack.getLast.eType of
                                 TOKEN_POWER : outputTokenList.Add(temporaryStack.popData);
                               else
                                 break;
                               end;
                             end;
                           temporaryStack.add(tempToken);
                         end;
        TOKEN_LBRACK :   temporaryStack.Add(tempToken);
        TOKEN_RBRACK :   begin
                           while temporaryStack.getLast.eType <> TOKEN_LBRACK do
                             outputTokenList.add(temporaryStack.popData);
                           temporaryStack.popData;
                         end;
        TOKEN_END :      while temporaryStack.Count <> 0 do
                           outputTokenList.add(temporaryStack.popData);
      end;
    end;
  exit outputTokenList;
end;

//Just push the tokens onto a stack, evaluating the operands when they appear.
function TCanvasProject.evaluateRPN(inputList : tTokenList): double;
var
  tempToken: tToken;
  stack: tTokenList; //A temporary stack for holding values to use operators on later
  tokenCount: integer;
  tempDouble: double;
begin
  stack := tTokenList.Create;
  for tokenCount := 0 to inputList.Count - 1 do
    begin
      tempToken := inputList.at(tokenCount);
      case tempToken.eType of
        TOKEN_NUMBER :   stack.Add(tempToken);
                         //Add the top two values on the stack together.
        TOKEN_ADD :      stack.getSecondLast.eValue += stack.popData.eValue;
        TOKEN_SUBTRACT : stack.getSecondLast.eValue -= stack.popData.eValue;
        TOKEN_MULTIPLY : stack.getSecondLast.eValue *= stack.popData.eValue;
        TOKEN_DIVIDE :   stack.getSecondLast.eValue /= stack.popData.eValue;
        TOKEN_POWER :    //Raise the second last value to the power of the last value on the stack.
                         begin
                           tempDouble := power( stack.getSecondLast.eValue , stack.getLast.eValue);
                           stack.popData; //Use a temporary variable so we can pop the data.
                           stack.getLast.eValue := tempDouble;
                         end;
      end;
    end;
  if stack.Count <> 1 then
    writeln('Could not properly evaluate statement. The following result is unreliable.');
  exit stack.at(0).eValue;
end;

procedure TCanvasProject.ApplicationStarting;
begin
  inherited;
  Grid := new TConsoleGrid;
  Grid.Rows := ROWS;
  Grid.Cols := COLS;
  GameView.Width:= WIDTH;
  GameView.Height := HEIGHT;
  asm
    window.onkeydown = function(e)
    {
    TCanvasProject.KeyDownEvent(Self, e.keyCode);
    }
  end;
  KeyDownEvent(0);
  tokensToEvaluate := tTokenList.create;
  GameView.Delay := DELAY;
  GameView.StartSession(False);
end;

procedure TCanvasProject.KeyDownEvent(mCode: integer);
begin
  if mCode = 27 then
    ApplicationClosing;
  if mCode = 65 then
    Inputting := true;
  if reading_state = rsReading then
    if mCode = 13 then
      reading_state := rsFinishedReading
    else
      begin
        case mCode of
          39:           TempReadString += ' ';
          32, 48 .. 57: TempReadString += chr(mCode);
          189, 109:     TempReadString += '-';
          190, 110:     TempReadString += '.';
          191, 111:     TempReadString += '/';
          106:          TempReadString += '*';
          107:          TempReadString += '+';
          38:           TempReadString += '^';
          187:          TempReadString += '=';
          188:          TempReadString += ',';
          219:          TempReadString += '(';
          221:          TempReadString += ')';
          37:           TempReadString := LeftStr(TempReadString, (length(TempReadString) - 1));
        end;
      end;
end;

procedure TCanvasProject.GoToXY(X, Y: integer);
begin
  Grid.CursorX := X;
  Grid.CursorY := Y;
end;

procedure TCanvasProject.ClrScr;
begin
  Grid.ClearGrid;
  GoToXY(1, 1);
end;

procedure TCanvasProject.ClrEOL;
begin
  grid.ClearEol(Grid.CursorX, Grid.CursorY);
end;

procedure TCanvasProject.textColor(colour: TConsoleColour);
begin
  Grid.TextColour := colour;
end;

procedure TCanvasProject.textBackground(colour: TConsoleColour);
begin
  Grid.BackgroundColour := colour;
end;

procedure TCanvasProject.write(txt: string);
begin
  Grid.write(txt);
end;

procedure TCanvasProject.writeln(txt : string);
begin
  Grid.write(txt);
  Grid.CursorX := 1;
  Grid.CursorY := Grid.CursorY + 1;
end;

procedure TCanvasProject.writeln;
begin
  Grid.CursorX := 1;
  Grid.CursorY := Grid.CursorY + 1;
end;

procedure TCanvasProject.readln(var InputString : string);
begin
  case reading_state of
    rsReading:  write(TempReadString);
    rsNotReading: begin
                    reading_state := rsReading;
                    TempReadString := '';
                  end;
    rsFinishedReading: begin
                         InputString := TempReadString;
                         reading_state := rsNotReading;
                         writeln(TempReadString);
                       end;
  end;
end;

procedure TCanvasProject.ApplicationClosing;
begin
  GameView.EndSession;
  Grid.Destroy;
  inherited;
end;

procedure TCanvasProject.InputExpression;
begin
  if Inputting then
    begin
      writeln('Please enter a standard calculation.');
      writeln('Type square brackets for round ones and the up arrow for "^".');
      writeln('You may use the left arrow to delete.');
      writeln;
      readln(InputString);
      if not ((reading_state = rsNotReading) and (length(InputString) > 0)) then
        exit;
      write('>>> ');
      if inputString = 'exit' then
        exit;
      tokensToEvaluate := stringToTokens(inputString);
      if tokensToEvaluate.isValid then
        begin
          postfixTokens := convertInfixToPostfix(tokensToEvaluate);
          if postfixTokens.isValid then //Check that after conversion, it is still valid.
            writeln(floatToStr(evaluateRPN(postfixTokens)))
          else
            writeln('Syntax error.');
        end
      else
        writeln('Syntax error.');
    end;
  writeln;
  writeln;
  writeln('Type Esc to quit or A for another expression.');
  Inputting := false;
end;

procedure TCanvasProject.PaintView(Canvas: TW3Canvas);

  procedure PaintGrid;
  begin
    Canvas.Font :=  IntToStr(FONT_SIZE) +'px Lucida Console';
    var currentChar: TCharacter;
    for var x := 1 to COLS do
      for var y := 1 to ROWS do
        begin
          currentChar := Grid.getCharacters[x, y];
          SetTextColor(currentChar.TextBackGroundColour, Canvas);
          Canvas.FillRect((x - 1) * CELL_WIDTH, ((y - 1) * CELL_HEIGHT) + 2, CELL_WIDTH, CELL_HEIGHT);
          SetTextColor(currentChar.TextColour, Canvas);
          Canvas.FillText(currentChar.Letter, (x - 1) * CELL_WIDTH, y * CELL_HEIGHT);
        end;
  end;

begin
  if Inputting then
    InputExpression;
  PaintGrid;
  if inputting then
    clrscr;
end;

end.

Programming - a skill for life!

by Christopher Winward: U6 Age ~17