Main Code of Web Version of Physics

by Charles Tanner: L6 Age ~17

unit uMain;
{
    Copyright (c) 2011 Charles Tanner

    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 PC web preview by PPS 2015
}

 {I decided that for my program, 'readln's and 'read's wouldn't cut it, for multiple
  reasons. First, if you use one, it stops the code at that point and waits for an
  input from the user, meaning they couldn't see all of the fields after the one they
  are in. One way around that would be repeating the field at the bottom, but that
  wouldn't be intuitive and it would look messy. I could have used the GoTo function
  with 'read's but that would mean you would have to press enter to finish editing a
  field, which doesn't provide a seamless experience.

  My solution was to not use 'read's or 'readln's at all, and instead manually read
  the inputs, including the arrow keys, backspace and enter. This allowed me to make
  the viewing of the fields and editing of them one experience. You press the arrow
  keys to go between the options, and enter the numbers.}
interface

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

type
  TVars = (p, u, v, a, x, t, q);
  TKinetic = (ke, m, velocity);
  TInputState = (isMenu, isUVAXT, isEnergy);

type
  TCanvasProject = class(TW3CustomGameApplication)
  private
    const DELAY = 20;
    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;
    z: TVars;
    input_state: TInputState = isMenu;
    clear, i, choice, ke_choice : integer;
    value : array[u .. t] of string;
    empty : array[u .. t] of Boolean;
    ke_value : array[ke .. velocity] of string;
    ke_empty : array[ke .. velocity] of Boolean;
    Grid: TConsoleGrid;
    protected
    procedure ApplicationStarting; override;
    procedure ApplicationClosing; override;
    procedure PaintView(Canvas: TW3Canvas); override;
    procedure KeyDownEvent(mCode: integer);
    procedure GoToXY(X, Y: integer);
    function Random(LessThan : integer) : integer;
    procedure UVAXT;
    procedure KineticEnergy;
    procedure ClearUVAXT;
    procedure ClearKE;
    procedure clrscr;
    procedure write(txt: string);
    procedure writeln(txt: string);
  end;

implementation

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.ClrScr;
begin
  Grid.ClearGrid;
  GoToXY(1, 1);
end;

procedure TCanvasProject.UVAXT;
begin
  clrscr;
  if z = q then
    z := u;
  if z = p then
    z := t;
  if clear = 1 then
    begin
      writeln('Use the up and down arrows to select an option and');
      writeln('the left arrow to delete the last digit of your value.');
      writeln('Press Esc to return to the main menu.');
      writeln(' ');
      writeln('Please enter 3 values.');
      if z = u then
        write('> ')       //printing out fields
      else
        write('  ');
      write('Initial Velocity (m/s): ');
      writeln(value[u]);
      if z = v then
        write('> ')
      else
        write('  ');
      write('Final Velocity (m/s): ');
      writeln(value[v]);
      if z = a then
        write('> ')
      else
        write('  ');
      write('Acceleration (m/s^2): ');
      writeln(value[a]);
      if z = x then
        write('> ')
      else
        write('  ');
      write('Distance (m): ');
      writeln(value[x]);
      if z = t then
        write('> ')
      else
        write('  ');
      write('Time (s): ');
      writeln(value[t]);
     end;
  clear := 0;
end;

procedure TCanvasProject.KineticEnergy;
begin
  clrscr;
  if ke_choice = 4 then
    ke_choice := 1;            //selecting field
  if ke_choice = 0 then
    ke_choice := 3;
  if clear = 1 then
    begin
      writeln('Use the up and down arrows to select an option and');
      writeln('the left arrow to delete the last digit of your value.');
      writeln('Press Esc to return to the main menu.');
      writeln(' ');
      writeln('Please enter 2 values.');
      if ke_choice = 1 then
        write('> ')
      else
        write('  ');
      write('Kinetic Energy (J): ');
      writeln(ke_value[ke]);
      if ke_choice = 2 then
        write('> ')                    //printing fields
      else
        write('  ');
      write('Mass (kg): ');
      writeln(ke_value[m]);
      if ke_choice = 3 then
        write('> ')
      else
        write('  ');
      write('Velocity (m/s): ');
      writeln(ke_value[velocity]);
    end;
   clear := 0;
 end;

 procedure TCanvasProject.ClearUVAXT;
 begin
   for var i := u to t do
     begin
       value[i] := '';
       empty[i] := true;
     end;
 end;

 procedure TCanvasProject.ClearKE;
 begin
   for var i := ke to velocity do
     begin
       ke_value[i] := '';
       ke_empty[i] := true;
     end;
 end;

function TCanvasProject.Random(LessThan : integer) : integer;
begin
  Result := RandomInt(LessThan);
end;

procedure TCanvasProject.KeyDownEvent(mCode: integer);
begin
  case input_state of
    isMenu: begin
              case mCode of
                38: begin
                      dec(choice);
                      clear := 1;       //selecting line
                    end;
                40: begin
                      inc(choice);
                      clear := 1;
                    end;
                13: begin
                      case choice of
                        1: begin
                             input_state := isUVAXT;
                             z := 1;
                           end;
                        2: begin
                             input_state := isEnergy;
                             ke_choice := 1;
                           end;
                      end;
                    end;
                27: begin
                      ShowMessage('Ending program');
                      GameView.EndSession;
                    end;
              end;
            end;

    isUVAXT: begin
               case mCode of
                 38 : begin
                        dec(z);
                        clear := 1;
                       end;         //going up and down
                 40: begin
                       inc(z);
                       clear := 1;
                     end;
                 37: begin     //  left arrow to delete
                      value[z] := LeftStr(value[z], (Length(value[z]) - 1));
                      clear := 1;
                    end;
                 13: begin         //enter pressed, starting to calculate
                       for var z:= u to t do
                         if value[z] = '' then
                            empty[z] := true
                         else
                           empty[z] := false;

                       //make unique value of i based on which fields are empty
                       // (a.k.a. flagging)
                       i := 0;
                       if empty[u] = false then
                         i := i + 1;
                       if empty[v] = false then
                         i := i + 2;
                       if empty[a] = false then
                         i := i + 4;
                       if empty[x] = false then
                         i := i + 8 ;
                       if empty[t] = false then
                         i := i + 16;
                       for var z:= u to t do
                         if value[z] = '0' then
                           value[z] := '0.0000001';
                       case i of
                         7: begin
                              value[t] := floattostr((strtofloat(value[v]) - strtofloat(value[u])) / strtofloat(value[a])); //uva
                              value[x] := floattostr((strtofloat(value[v]) + strtofloat(value[u])) * strtofloat(value[t]) / 2);
                            end;
                         11: begin
                               value[t] := floattostr(2 * strtofloat(value[x]) / ((strtofloat(value[v]) + strtofloat(value[u]))));  //uvx
                               value[a] := floattostr((strtofloat(value[v]) - strtofloat(value[u])) / strtofloat(value[t]));
                             end;
                         19: begin
                               value[x] := floattostr((strtofloat(value[v]) + strtofloat(value[u])) * strtofloat(value[t])/2); //uvt
                               value[a] := floattostr((strtofloat(value[v]) - strtofloat(value[u])) / strtofloat(value[t]));              //calculating other values
                             end;
                         13: begin
                               value[v] := floattostr(sqrt(strtofloat(value[x]) * strtofloat(value[a]) + sqr(strtofloat(value[u])))); //uax
                               value[t] := floattostr(2 * strtofloat(value[x]) / ((strtofloat(value[v]) + strtofloat(value[u]))));
                             end;
                         21: begin
                               value[v] := floattostr(strtofloat(value[u]) + (strtofloat(value[a]) * strtofloat(value[t]))); //uat
                               value[x] := floattostr((strtofloat(value[v]) + strtofloat(value[u])) * strtofloat(value[t]) / 2);
                              end;
                         25: begin
                               value[v] := floattostr(strtofloat(value[x]) * 2 / strtofloat(value[t]) - strtofloat(value[u])); //uxt
                               value[a] := floattostr((strtofloat(value[v]) - strtofloat(value[u])) / strtofloat(value[t]));
                             end;
                         14: begin
                               value[u] := floattostr(sqrt(sqr(strtofloat(value[v])) - (strtofloat(value[x])) * (strtofloat(value[a])))); //vax
                               value[t] := floattostr(2 * strtofloat(value[x]) / ((strtofloat(value[v]) + strtofloat(value[u]))));
                             end;
                         22: begin
                               value[u] := floattostr(strtofloat(value[v]) - (strtofloat(value[a]) * strtofloat(value[t]))); //vat
                               value[x] := floattostr((strtofloat(value[v]) + strtofloat(value[u])) * strtofloat(value[t]) / 2);
                             end;
                         26: begin
                               value[u] := floattostr(((2 * strtofloat(value[x])) / strtofloat(value[t])) - strtofloat(value[v])); //vxt
                               value[a] := floattostr((strtofloat(value[v]) - strtofloat(value[u])) / strtofloat(value[t]));
                             end;
                         28: begin
                               value[u] := floattostr((strtofloat(value[x]) - (strtofloat(value[a]) * strtofloat(value[t]) * (strtofloat(value[t])) / 2)) / strtofloat(value[t])); //axt
                               value[v] := floattostr(strtofloat(value[u]) + (strtofloat(value[a]) * strtofloat(value[t])));
                             end;
                         15: value[t] := floattostr(2 * strtofloat(value[x]) / ((strtofloat(value[v]) + strtofloat(value[u])))); //uvax
                         23: value[x] := floattostr((strtofloat(value[v]) + strtofloat(value[u])) * strtofloat(value[t]) / 2); //uvat
                         27: value[a] := floattostr((strtofloat(value[v]) - strtofloat(value[u])) / strtofloat(value[t])); //uvxt         For if 4 values are entered
                         29: value[v] := floattostr(strtofloat(value[x]) * 2 / strtofloat(value[t]) - strtofloat(value[u])); //uaxt
                         30: value[u] := floattostr(strtofloat(value[v]) - (strtofloat(value[a]) * strtofloat(value[t]))); //vaxt
                       end;
                   end;
                 27: begin
                       ClearUVAXT;
                       clrscr;
                       input_state := isMenu;
                       clear := 1;
                     end;
               else
                 begin
                   if chr(mCode) in ['0' .. '9'] then
                     value[z] := value[z] + chr(mCode);
                   if (mCode = 110) or (mCode = 190) then
                     value[z] := value[z] + '.';  //keypad '.'
                   clear := 1;
                end;
             end;
      end;

    isEnergy:
      begin
        case mCode of
          38: begin
                dec(ke_choice);
                clear := 1;
              end;               //reading keypresses again
          40: begin
                inc(ke_choice);
                clear := 1;
              end;
          37: begin  // left arrow to delete
                case ke_choice of
                  1: begin
                       ke_value[ke] := LeftStr(ke_value[ke], (Length(ke_value[ke]) - 1));
                       clear := 1;
                     end;
                  2: begin
                       ke_value[m] := LeftStr(ke_value[m], (Length(ke_value[m]) - 1));
                       clear := 1;                                               //backspacing
                     end;
                  3: begin
                       ke_value[velocity] := LeftStr(ke_value[velocity], (Length(ke_value[velocity]) - 1));
                       clear := 1;
                     end;
                end;
             end;
          13: begin
                if ke_value[ke] = '' then
                  ke_empty[ke] := true
                else
                  ke_empty[ke] := false;
                if ke_value[velocity] = '' then
                  ke_empty[velocity] := true
                else
                  ke_empty[velocity] := false;
                if ke_value[m] = '' then
                  ke_empty[m] := true
                else                               //calculating
                  ke_empty[m] := false;
                i := 0;
                if ke_empty[ke] = true then
                  i := i + 1;
                if ke_empty[velocity] = true then
                  i := i + 1;
                if ke_empty[m] = true then
                  i := i + 1;
                if i = 1 then
                  begin
                    if ke_empty[ke] = true then
                      begin
                        ke_value[ke] := floattostr(strtofloat(ke_value[m]) * sqr(strtofloat(ke_value[velocity])) / 2);
                        ke_empty[ke] := false;
                      end;
                    if ke_empty[m] = true then
                      ke_value[m] := floattostr(2 * strtofloat(ke_value[ke]) / sqr(strtofloat(ke_value[velocity])));
                    if ke_empty[velocity] = true then
                      ke_value[velocity] := floattostr(sqrt(2 * strtofloat(ke_value[ke]) / strtofloat(ke_value[m])));
                  end
                else
                  begin
                    clrscr;
                    writeln('You must enter 2 values');
                    clear := 0;
                  end;
              end;
          27: begin
                ClearKE;
                clrscr;
                input_state := isMenu;
                clear := 1;
              end;
        else
          case ke_choice of
            1: begin
                 if chr(mCode) in ['0' .. '9'] then
                   ke_value[ke] := (ke_value[ke] + chr(mCode));
                 if (mCode = 110) or (mCode = 190) then
                   ke_value[ke] := ke_value[ke] + '.';  //keypad '.'
                 clear := 1;
               end;
            2: begin
                 if chr(mCode) in ['0' .. '9'] then
                   ke_value[m] := (ke_value[m] + chr(mCode));
                 if (mCode = 110) or (mCode = 190) then
                   ke_value[m] := ke_value[m] + '.';  //keypad '.'
                 clear := 1;                        //appending input to field
                end;
            3: begin
                 if chr(mCode) in ['0' .. '9'] then
                   ke_value[velocity] := (ke_value[velocity] + chr(mCode));
                 if (mCode = 110) or (mCode = 190) then
                   ke_value[velocity] := ke_value[velocity] + '.';  //keypad '.'
                 clear := 1;
               end;
          end;
        end; //of case mCode of energy
    end; //of isEnergy
  end; //of case input_state
end; //proc

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

procedure TCanvasProject.ApplicationStarting;
begin
  inherited;
  Randomize;
  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);
    }
    window.focus();
  end;
  KeyDownEvent(0);
  GameView.Delay := DELAY;
  Clear := 1;
  Choice := 1;
  z := u;            //set to top line by default
  GameView.StartSession(False);
end;

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

procedure TCanvasProject.PaintView(Canvas: TW3Canvas);

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

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

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

  procedure PaintGrid;
  begin
    Canvas.Font :=  IntToStr(FONT_SIZE) +'px Lucida Console, Monaco, monospace';
    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
  case input_state of
    isMenu: begin
              if choice = 3 then
                choice := 1;
              if choice = 0 then
                choice := 2;
              if clear = 1 then
                begin
                  clrscr;
                  writeln('Use the up and down arrows to select an option and');
                  writeln('Enter to perform the selection.');
                  writeln('Press Esc to end the program.');
                  writeln(' ');
                  writeln('What do you want to do? ');
                  write('UVAXT equation');
                  if choice = 1 then
                    writeln(' <')
                  else
                    writeln(' ');
                  write('Energy');
                  if choice = 2 then
                    writeln(' <');
                end;
              clear := 0;
              PaintGrid;
            end;
     isUVAXT: begin
                Clear := 1;
                UVAXT;
                if clear = 1 then
                  clrscr;
                PaintGrid;
              end;
     isEnergy: begin
                 Clear := 1;
                 KineticEnergy;
                 if clear = 1 then
                   clrscr;
                 PaintGrid;
               end;
  end;
end;

end.
    
Programming - a skill for life!

by Charles Tanner: L6 Age ~17