Main unit of web version of ascii3D

Main unit of Smart Pascal version of retro racing game

unit uMain;
{
    Copyright (c) 2011 Peter Hearnshaw

    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, SmartCL.System, SmartCL.Components, SmartCL.Application,
  SmartCL.Game, SmartCL.GameApp, SmartCL.Graphics, uCrtCanvas;

type
  TCanvasProject = class(TW3CustomGameApplication)
  private
    const DELAY = 150;
    const CELL_WIDTH = 10;
    const CELL_HEIGHT = 16;
    const FONT_SIZE = 18;
    const START_FRAME = 5000 DIV DELAY;
    const TRACK_LENGTH = 300;
    const Y_SPEED = 3;
    const WIDTH = 80 * CELL_WIDTH;
    const HEIGHT = 25 * CELL_HEIGHT;
    const trackWidth = 25;
    Grid: TConsoleGrid;
    Sleeping: Boolean = false;
    FrameNumber, ElapsedSeconds, SleepFrameNumber: integer;
    StartTime : TDateTime;
    xpos, sidewaysMovement, middleX, displayMessageTimer, finishX, finishX2,
      curve, carShift, boostCircleY, boostCircleX, otherCarY, otherCarX,
      roadX1, roadX2, treeY, treeX, speed, throughTrack, finishY : integer;
    otherCarYReal : real;
    treeLeft, otherCarLeft : boolean;
    displayMessage: string;
    curveArrPoints : array[1 .. 28] of integer = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 12, 12,
                                                   12, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0];
    totalRoadArr : array[1 .. 20, 1 .. 2] of integer;

  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;
  end;

implementation

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

procedure TCanvasProject.KeyDownEvent(mCode: integer);
begin
  if SleepFrameNumber = 0 then
    case mCode of
      37: xPos += Y_SPEED;  //move left
      39: xPos -= Y_SPEED;  //move right
      27: GameView.EndSession;
    end;
end;

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 := 25;
  Grid.Cols := 80;
  GameView.Width:= WIDTH;
  GameView.Height := HEIGHT;
  asm
    window.onkeydown = function(e)
    {
    TCanvasProject.KeyDownEvent(Self,e.keyCode);
    }
  end;
  KeyDownEvent(0);
  xpos := 32;
  GameView.Delay := DELAY;
  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 write(txt: string);
  begin
    Grid.write(txt);
  end;

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

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

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

  procedure PaintGrid;
  begin
    Canvas.Font :=  IntToStr(FONT_SIZE) +'px Lucida Console';
    var currentChar: TCharacter;
    for var x := 1 to 80 do
      for var y := 1 to 25 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;

  procedure startScreen;
  begin
    textbackground(white);
    clrscr;
    textcolor(LightRed);
    gotoXY(22, 1);
    writeln('000     00000  000000 000       000  ');
    gotoXY(22, 2);
    writeln('00 00   00000   0000  00 00    00 00 ');
    gotoXY(22, 3);
    writeln('00  00  00       00   00  00  00   00');
    gotoXY(22, 4);
    writeln('00  00  00       00   00  00  00   00');
    gotoXY(22, 5);
    writeln('00 00   0000     00   00 00   00   00');
    gotoXY(22, 6);
    writeln('000     0000     00   000     00   00');
    gotoXY(22, 7);
    writeln('000     00       00   000     00   00');
    gotoXY(22, 8);
    writeln('00 00   00       00   00 00   00   00');
    gotoXY(22, 9);
    writeln('00  00  00000    00   00  00   00 00 ');
    gotoXY(22, 10);
    writeln('00  00  00000    00   00  00    000  ');
    gotoXY(33, 12);
    textcolor(red);
    writeln('RACING PROGRAM');

    gotoXY(28, 15);
    write('GET THE BOOSTS: ');
    gotoXY(44, 15);
    textColor(lightmagenta);
    write('O');
    gotoXY(28, 18);
    textcolor(red);
    write('AVOID THE CARS: ');
    textbackground(cyan);
    textColor(white);
    gotoXY(45, 17);
    write('/  \');
    gotoXY(45, 18);
    write('[  ]');
    gotoXY(45, 19);
    write('----');
    textColor(red);
    textbackground(lightgray);
    gotoXY(19, 21);
    write('JUST USE LEFT AND RIGHT ARROW KEYS TO MOVE');
    gotoXY(18, 22);
    write('CAR SPEED IS AUTOMATIC, NO NEED TO USE UP KEY');
    gotoXY(22, 23);
    write('CROSS THE FINISH AS SOON AS POSSIBLE');
  end;

procedure doOtherCar;
begin
  if (random(15) = 3) and (otherCarY = 0) then
    begin
      otherCarY := 11;
      otherCarYReal := 11;
      otherCarLeft := false;
      if random(2) = 1 then
        otherCarLeft := true;
    end;
  if otherCarY > 0 then
    begin
      otherCarYReal := otherCarYReal + (speed / 3900) + (otherCarY / 40);
      otherCarY := round(otherCarYReal);
      if otherCarY >= 25 then
        begin
          otherCarY := 0;
          otherCarYReal := 0;
        end;
    end;
  if otherCarY > 0 then
    begin
      if otherCarLeft = true then
        otherCarX := -1 + round(2 * (otherCarY - 5) / 5) + xpos -
                                ((otherCarY - 11) - 7) - sidewaysMovement +
                                 round(sidewaysMovement * sin((otherCarY - 11) * 7 * 0.0174))
      else
        otherCarX := round(-2 * (otherCarY - 5) / 5) + xpos +
                           trackWidth + ((otherCarY - 11) - 7) -
                           sidewaysMovement + round(sidewaysMovement * sin((otherCarY - 11) * 7 * 0.0174));
    end;
end;

procedure doGold;
begin
  if (random(15) = 3) and (boostCircleY = 0) then
    boostCircleY := 10;
  if boostCircleY > 0 then
    begin
      boostCircleY := boostCircleY + 1;
      if boostCircleY = 25 then
        boostCircleY := 0;
    end;
  // calculation for display of gold
  if boostCircleY > 0 then
    begin
      boostCircleX := round((xpos - ((boostCircleY - 10) - 7) - sidewaysMovement +
                            round(sidewaysMovement * sin((boostCircleY - 10) * 7 * 0.0174)) +
                            xpos + 18 + ((boostCircleY - 10) -7) - sidewaysMovement +
                            round(sidewaysMovement * sin((boostCircleY - 10) * 7 * 0.0174))) / 2);
    end;
end;

procedure doTree;
var
  spacingFromRoad : integer;
begin
  if (random(8) = 3) and (treeY = 0) then
    begin
      treeY := 11;
      treeLeft := false;
      if random(2) = 1 then
        treeLeft := true;
    end;
  if treeY > 0 then
    begin
     treeY := treeY + round((treeY - 10) / 5) + 1;
     if treeY = 25 then
       treeY := 0;
    end;
  if treeY > 0 then
    begin
      spacingFromRoad := 4 + round(treeY - 10); //move tree 4 points from roadside coord.
                                                //Also move further away from road as tree moves closer (perspective)
      if treeLeft = true then
        treeX := xpos - spacingFromRoad - ((treeY - 10) - 7) - sidewaysMovement +
                 round(sidewaysMovement * sin((treeY - 10) * 7 * 0.0174));
      if treeLeft = false then
        treeX := xpos + spacingFromRoad + trackWidth + ((treeY - 10) - 7) - sidewaysMovement +
        round(sidewaysMovement * sin((treeY - 10) * 7 * 0.0174));
        textcolor(lightgray);
    end;
end;

procedure finishScreen;
begin
  textbackground(white);
  clrscr;
  textcolor(black);
  writeln('ACROSS THE FINISH LINE...');
  writeln('IN ' + inttostr(ElapsedSeconds) + ' SECONDS');
  writeln(' ');
  write('Refresh for another race.');
  PaintGrid;
  GameView.EndSession;

end;

procedure doFinishLine;
begin
  inc(finishY);
  if finishY = 24 then
    finishScreen;
  finishX := xpos -((finishY - 11) - 7) - sidewaysMovement +
             round(sidewaysMovement * sin((finishY - 11) * 7 * 0.0174));
  finishX2 := xpos + trackWidth + ((finishY - 11) - 7) - sidewaysMovement +
              round(sidewaysMovement * sin((finishY - 11) * 7 * 0.0174));
end;

begin
  ////////////////////////////// Main Paint ////////////////////////////////////
  inc(FrameNumber);
  if FrameNumber = 1 then
    begin
      TextBackground(white);
      ClrScr;
      startScreen;
      PaintGrid;
    end;
  if FrameNumber = START_FRAME then
    StartTime := now;
  if FrameNumber >= START_FRAME then
    begin
      ElapsedSeconds := Round((Now - StartTime) * 24 * 60 * 60);
      if SleepFrameNumber > 0 then
        dec(SleepFrameNumber);
      PaintGrid;
      if SleepFrameNumber > 0 then
        exit;
      if Sleeping then
        Sleeping := false;
      displayMessage := '                     ';
      ClrScr;
      doGold;
      doTree;
      doOtherCar;
      inc(throughTrack);
      if throughTrack > TRACK_LENGTH then
        begin
          if finishY = 0 then
            finishY := 10;
          doFinishLine;
        end;
       //work out the road
      for var i := 11 to 25 do  //for each line from horizon to bottom of screen
        begin               //roughly sine shape from 0 to 90 degrs
          roadX1 := xpos -((i - 11) - 7) - sidewaysMovement +
                    round(sidewaysMovement * sin((i - 11) * 7 * 0.0174));
          roadX2 := xpos + trackWidth + ((i - 11) - 7) - sidewaysMovement +
                    round(sidewaysMovement * sin((i - 11) * 7 * 0.0174));
          totalRoadArr[i - 10][1] := roadX1;
          totalRoadArr[i - 10][2] := roadX2;
        end;
      if sidewaysMovement = 0 then
        begin
          case random(35) of
            1 : sidewaysMovement := 1;
            2 : sidewaysMovement := -1;
          end;
          curve := 0;
        end;
      if sidewaysMovement > 0 then
        begin
          inc(curve);
          sidewaysMovement := curveArrPoints[curve];
        end;
      if sidewaysMovement < 0 then
        begin
          dec(curve);
          sidewaysMovement := -curveArrPoints[-curve];
        end;
      if sidewaysMovement > 0 then
        xpos := xpos - 1;
      if sidewaysMovement < 0 then
        xpos := xpos + 1;

      if speed > 70 then
        if (roadX2 < 40) or (roadX1 > 40) then
          speed := speed - 3;
      if speed < 100 then
        speed := speed + 2;
      if speed > 100 then
        speed := round(speed * 0.99);

      if sidewaysMovement > 4 then
        carShift := 1;
      if sidewaysMovement < -4 then
        carShift := -1;
      if sidewaysMovement = 0 then
        carShift := 0;

      if (boostCircleY > 22) and ((boostCircleX + 5) > 40) and ((boostCircleX - 5) < 40) then
        begin
          boostCircleY := 0;
          displayMessage := 'BOOST';
          displayMessageTimer := 15;
        end;
      if (otherCarY > 21) and ((otherCarX + 3) > 40) and ((otherCarX - 3) < 40) then
        begin  //crashed
          speed := 0;
          // sleep(800);
          SleepFrameNumber := 800 div DELAY;
          otherCarY := 0;
          displayMessage := 'CRASH';
          Sleeping := true;
        end;
      if displayMessage = 'BOOST' then
        begin
          dec(displayMessageTimer);
          if displayMessageTimer = 0 then
            begin
              displayMessage := '                    ';
              displayMessageTimer := 0;
            end;
          speed := speed + round((200 - speed) / 25);
        end;

      //VISUAL STUFF
      TextBackground(Green);
      clrscr;  //makes whole screen green
      for var a := 1 to 9 do //blue sky
        begin
          gotoXY(1, a);
          TextBackground(blue);
          ClrEol;
        end;
      textcolor(white);
      gotoXY(1, 1);
      writeln('TIME ELAPSED: ' + inttostr(ElapsedSeconds) + ' SECONDS');
      gotoXY(40, 1);
      writeln('SPEED: ' + inttostr(speed));
      write('ESC TO STOP MOVEMENT');
      gotoXY(47, 1);
      middleX := round((totalRoadArr[15][1] + totalRoadArr[15][2]) / 2);
      if (middleX > 60) or (middleX < 20) then
        begin
          speed := 0;
          // sleep(800);
           Sleeping := true;
           SleepFrameNumber := 800 div DELAY;
           xpos := 32;
           sidewaysMovement := 0;
           displayMessage := 'CRASHED OFF ROAD';
           otherCarY := 0;
        end;

      //Horizon line
      TextBackground(White);
      gotoXY(1, 10);
      ClrEol;

      //TRACK
      for var i := 11 to 25 do  //for each line from horizon to bottom of screen
        begin
          TextBackground(LightGray);
          if (totalRoadArr[i - 10][1] < 81) and (totalRoadArr[i - 10][1] > 0) then
            begin
              gotoXY(totalRoadArr[i - 10][1], i);
              Write(' ');
              Grid.CursorX := Grid.CursorX + 1;
              TextBackground(brown);
              clrEol;
            end
          else
            gotoXY(1, i);
          TextBackground(brown);
          clrEol;
          if (totalRoadArr[i - 10][2] < 81) and (totalRoadArr[i - 10][2] > 0) then
            begin
              TextBackground(LightGray);
              gotoXY(totalRoadArr[i - 10][2], i);
              Write(' ');
              Grid.CursorX := Grid.CursorX + 1;
              TextBackground(green);
              clrEol;
            end;
        end;
      //Draw Car
      TextBackground(lightred);
      textcolor(white);
      gotoXY(40 - carShift, 23);
      write('/  \');
      gotoXY(40, 24);
      write('[  ]');
      gotoXY(40 + carShift, 25);
      write('----');

      //Finish Line
      if finishX > 0 then
        begin
          gotoXY(finishX, finishY);
          textbackground(Cyan);
          textcolor(yellow);
          for var i := finishX + 1 to finishX2 - 1 do
            begin
              gotoXY(i, finishY);
              writeln('|');
            end;
        end;

      //Draw Tree
      if (treeY > 0) and (treeX < 74) and (treeX > 6) then
        begin
          textbackground(green);
          textcolor(lightgreen);
          if (treeY > 18) then
            begin
              gotoXY(treeX - 3, treeY);
              write('  /\  ');
              gotoXY(treeX - 3, treeY + 1);
              write(' /  \ ');
              gotoXY(treeX - 3, treeY + 2);
              write('/____\');
              textcolor(black);
              if (treeY + 3 < 25) then
                begin
                  gotoXY(treeX - 3, treeY + 3);
                  write('  II  ');
                end;
             end
          else if (treeY < 15) then
            begin
               gotoXY(treeX - 1, treeY);
               write('/\');
            end
          else
            begin
              gotoXY(treeX - 2, treeY);
              write(' /\ ');
              gotoXY(treeX - 2, treeY + 1);
              write('/  \');
              textcolor(black);
              gotoXY(treeX - 2, treeY + 2);
              write(' II ');
            end;
        end;

      //Do BOOSTS
      if boostCircleY > 0 then
        begin
          gotoXY(boostCircleX, boostCircleY);
          TextBackground(brown);
          textcolor(LightMagenta);
          if boostCircleY > 18 then  //if very close make gold large
            write('O')
          else if boostCircleY < 14 then  //if far away make gold small
            write('.')
          else         //if in between make gold medium
            write('o');
         end;
      //Do Other car
      if otherCarY > 0 then
        begin
          TextBackground(Cyan);
          textcolor(BLUE);
          if otherCarY > 23 then
            begin
             gotoXY(otherCarX, otherCarY);
             write('/  \');
             gotoXY(otherCarX, otherCarY + 1);
             write('[  ]');
            end
          else if otherCarY > 18 then
             begin
              gotoXY(otherCarX, otherCarY);
              write('/  \');
              gotoXY(otherCarX, otherCarY + 1);
              write('[  ]');
              gotoXY(otherCarX, otherCarY + 2);
              write('----');
             end
          else if otherCarY > 14 then
            begin
              gotoXY(otherCarX, otherCarY);
              write('/\');
              gotoXY(otherCarX, otherCarY + 1);
              write('--');
            end
          else if otherCarY < 0 then
            begin
              gotoXY(otherCarX, otherCarY);
              write('/\');
            end;
        end;
      //Messages
      textbackground(Blue);
      textcolor(white);
      gotoXY(37, 8);
      write(displayMessage);
      gotoXY(1, 1);
      // Sleep if not already sleeping
      if not Sleeping then
        begin
          SleepFrameNumber := (200 - Speed) div DELAY;
          Sleeping := true;
        end;
    end;
end;

end.

Programming - a skill for life!

Retro racing game