Code of Web Version of 3D-Driving

Code for driving round a circuit marked by hexagonal prisms

Introduction

We converted Peter Hearnshaw's program to run in Smart Mobile Studio and you can try it on the previous page. The conversion demonstrates:
  • the initialisation of the XYObjs array with square brackets;
  • input from mouse, touch and keyboard;
  • the display of text with Canvas.FillTextF, lines with Canvas.LineF, rectangles with Canvas.FillRectF and a polygon for the car by creating a path then drawing it with Canvas.Stroke.
Find the set-up code in the ApplicationStarting procedure, keyboard input in KeyDownEvent and the bulk of the code (including three nested functions) in PaintView.

Smart Pascal Code

unit Unit1;

{
    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 by PPS, 2015
}


interface

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

type
  TCanvasProject = class(TW3CustomGameApplication)
  private
    const MAX_OBJECTS: integer = 227;
    const SCALE_FACTOR = 0.5;
    const getMaxX = 953;
    const getMaxy = 700;
    degr, xObj, yObj, basis3DObjX, basis3DObjY, errorInDegr, changeInDegr: integer;
    x1, y1, xCar, yCar, Rdegr, carSpeed, tempDegr, distanceAway, twistingY, getMouseX: real;
    XYObjs: array [1..227, 1..2] of integer = [  //The track
    [1300, 300], [1299, 281], [1293, 259], [1283, 239], [1269, 221], [1249, 207],
    [1229, 201], [1203, 196], [1155, 196], [1177, 196], [1105, 198], [1057, 196],
    [1003, 196], [906, 201], [802, 196], [702, 198], [599, 196], [501, 196], [449, 196],
    [551, 196], [425, 196], [399, 196], [375, 198], [347, 201], [329, 211], [325, 237],
    [325, 259], [329, 281], [347, 291], [377, 293], [399, 301], [431, 303], [451, 301],
    [501, 299], [551, 299], [599, 299], [648, 299], [702, 301], [676, 301], [734, 303],
    [758, 307], [786, 313], [812, 325], [836, 339], [856, 361], [872, 381], [888, 405],
    [896, 435], [900, 465], [904, 501], [902, 549], [902, 525], [900, 602], [902, 650],
    [902, 702], [900, 800], [902, 902], [902, 1003], [902, 1101], [902, 1201], [902, 1253],
    [902, 1301], [904, 1347], [904, 1375], [904, 1402], [908, 1422], [914, 1438], [922, 1456],
    [930, 1466], [944, 1482], [966, 1490], [982, 1500], [1003, 1506], [1031, 1504], [1053, 1504],
    [1077, 1506], [1103, 1504], [1133, 1504], [1153, 1504], [1175, 1506], [1201, 1504],
    [1227, 1500], [1247, 1494], [1263, 1486], [1277, 1472], [1289, 1460], [1295, 1438],
    [1297, 1418], [1299, 1402], [1303, 1375], [1303, 1353], [1303, 1303], [1303, 1249],
    [1305, 1203], [1301, 1105], [1301, 1003], [1303, 902], [1303, 800], [1303, 704],
    [1303, 599], [1303, 503], [1305, 453], [1305, 399], [1303, 351], [1303, 325],
    [1399, 301], [1399, 263], [1393, 233], [1385, 201], [1371, 178], [1355, 158],
    [1335, 134], [1311, 118], [1287, 110], [1261, 106], [1233, 98], [1201, 100],
    [1175, 102], [1155, 100], [1105, 100], [1051, 100], [1001, 98], [904, 100], [802, 100],
    [702, 100], [599, 98], [501, 102], [449, 102], [401, 102], [351, 102], [321, 102],
    [299, 98], [277, 106], [255, 112], [231, 124], [213, 144], [201, 170], [198, 198],
    [201, 219], [201, 247], [201, 275], [198, 299], [203, 327], [207, 351], [217, 371],
    [241, 385], [269, 395], [303, 397], [327, 399], [353, 399], [401, 401], [455, 399],
    [497, 397], [551, 399], [599, 401], [652, 401], [676, 399], [698, 399], [728, 403],
    [748, 411], [770, 421], [784, 443], [794, 461], [798, 481], [802, 503], [802, 529],
    [802, 549], [802, 604], [802, 652], [802, 700], [802, 800], [802, 898], [802, 1001],
    [802, 1103], [800, 1203], [802, 1251], [800, 1299], [802, 1341], [802, 1371],
    [804, 1402], [802, 1438], [810, 1470], [816, 1498], [832, 1520], [848, 1542],
    [866, 1564], [890, 1576], [916, 1586], [942, 1594], [968, 1596], [1001, 1598],
    [1031, 1598], [1055, 1598], [1079, 1596], [1105, 1598], [1133, 1598], [1155, 1598],
    [1173, 1598], [1199, 1598], [1237, 1596], [1271, 1594], [1297, 1586], [1321, 1572],
    [1343, 1556], [1365, 1534], [1381, 1514], [1389, 1486], [1395, 1458], [1399, 1434],
    [1400, 1399], [1400, 1375], [1400, 1349], [1400, 1299], [1400, 1251], [1400, 1203],
    [1399, 1103], [1400, 998], [1400, 902], [1399, 798], [1400, 702], [1400, 604],
    [1400, 503], [1400, 451], [1400, 401], [1400, 351], [1400, 325], [1400, 300]];
  protected
    procedure ApplicationStarting; override;
    procedure ApplicationClosing; override;
    procedure PaintView(Canvas: TW3Canvas); override;
    procedure KeyDownEvent(mCode : integer);
  end;

implementation

procedure TCanvasProject.KeyDownEvent(mCode : integer);
begin
  case mCode of
    27 : Application.Terminate;
    38 : carSpeed := carSpeed + 0.05; // Up arrow key changes how quickly the car accelerates
    40 : carSpeed := carSpeed * 0.9;  // Down arrow key changes how quickly the car decelerates//
  end;
end;

procedure TCanvasProject.ApplicationStarting;
begin
  inherited;
  asm
    window.onkeydown=function(e)
    {
    TCanvasProject.KeyDownEvent(Self,e.keyCode);
    }
    window.focus();
  end;
  KeyDownEvent(0);

  GameView.OnMouseMove := procedure (o: TObject; t: TShiftState; x, y: Integer)
    begin
      if (x > 150) and (x < 350) then
        Getmousex := x / SCALE_FACTOR;
    end;
  GameView.OnMouseDown := lambda carSpeed := carSpeed + 0.05; end;  //how quickly the car accelerates

  GameView.OnTouchMove := procedure (sender : TObject; Info : TW3TouchData)
    begin
      var x := Info.Touches.Touches[0].PageX;
      if (x > 150) and (x < 350) then
        Getmousex := x / SCALE_FACTOR;
    end;
  GameView.OnTouchBegin := lambda carSpeed := carSpeed + 0.05; end;   //how quickly the car accelerates

  xCar := getmaxX div 2;
  yCar := getmaxY div 2;
  getmousex := xCar;
  carSpeed := 0;
  GameView.Delay := 21;
  GameView.StartSession(False);
end;

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

procedure TCanvasProject.PaintView(Canvas: TW3Canvas);

function getXCar (carRad: real; bearing: integer) : integer;
begin
  Result := round(getmaxX / 2) + round(80 * carRad * sin(-(180 + changeInDegr + bearing) / 180 * 3.141));
end;

function getYCar (carRad: real; bearing: integer) : integer;
begin
  Result := (getmaxY - 80) + round(40 * carRad * cos(-(180 + changeInDegr + bearing) / 180 * 3.141));
end;

function gXY(isx: boolean; radius: integer; bearing: integer; yAddition: integer): integer;
  {function to get REAL x or y value (as opposed to the imaginary x,y,z).
   co-ord value based on bearing and distance.}
var
  TotalYAdd: integer;
begin
  if isx then   //is an x value
    begin
     // radius := round(radius * (1 / (distanceAway / 10)));
      radius := round(radius * 10 / distanceAway);
      Result := basis3DObjX - round(0.5 * round(radius * cos(-(tempDegr + bearing) / 180 * 3.141)));
    end
  else
    begin                //is a y value
      TotalYAdd := 0;
      if not (yAddition = 0) then
        TotalYAdd := round(-yAddition * 10 / distanceAway);
      radius := round(radius * 10 / distanceAway);
      Result := TotalYAdd + basis3DObjY - round(0.5 * round(radius * sin(-(tempDegr + bearing) / 180 * 3.141)));
    end;
end;

begin
  // Clear background
  Canvas.FillStyle := 'rgb(0, 0, 0)';
  Canvas.FillRectF(0, 0, GameView.Width, GameView.Height);

  Canvas.Font := '20pt verdana';
  Canvas.FillStyle := 'rgb(255, 255, 255)';
  Canvas.StrokeStyle := 'rgb(255, 255, 255)';
  Canvas.Scale(SCALE_FACTOR, SCALE_FACTOR);
  Canvas.BeginPath;
  Canvas.LineF(50, 300, 850, 300); // horizon line
  Canvas.Stroke;
  Canvas.FillTextF(intToStr(round(carSpeed * 100)) + ' mph', 20, 20, MAX_INT);
  Canvas.FillTextF('Click to start and accelerate and move the mouse', 110, 45, MAX_INT);
  Canvas.FillTextF('from side to side to turn.', 110, 70, MAX_INT);
  Canvas.FillTextF('Up arrow to accelerate, down arrow to brake', 110, 95, MAX_INT);
  Canvas.FillTextF('and Escape to quit.', 110, 120, MAX_INT);
  // the on-screen car
  changeInDegr := round((getmouseX - (getmaxX / 2)) / 10);
  Canvas.BeginPath;
  Canvas.LineF(getXCar(1, 0), getYCar(1, 0), getXCar(1, 150), getYCar(1, 150));
  Canvas.LineF(getXCar(1, 150), getYCar(1, 150), getXCar(0, 330), getYCar(0, 330));
  Canvas.LineF(getXCar(0, 330), getYCar(0, 330), getXCar(1, 210), getYCar(1, 210));
  Canvas.LineF(getXCar(1, 210), getYCar(1, 210), getXCar(1, 0), getYCar(1, 0));
  Canvas.ClosePath;
  Canvas.Stroke;
  // end on-screen car
  if getmouseX < getmaxX / 2 then
    begin
      Rdegr := Rdegr + ((getmouseX - (getmaxX / 2)) / 50);
      if Rdegr < 0 then
        Rdegr := 359.9;
    end;
  if getmouseX > getmaxX / 2 then
    begin
      Rdegr := Rdegr + ((getmouseX - (getmaxX / 2)) / 50);
      if Rdegr > 360 then
        Rdegr := 0.1;
    end;
  // Movement
  // Move car by x value in right angle triangle,  xCar is x pos of viewpoint
  xCar := xCar + (carSpeed * 10 * sin(-(degr + 180) / 180 * 3.141));
  // Move car by y value in right angle triangle.
  yCar := yCar + (carSpeed * 10 * cos(-(degr + 180) / 180 * 3.141));
  if carSpeed > 0 then
    carSpeed := carSpeed * 0.99;
  degr := round(Rdegr);
  // End movement

  x1 := xCar + (-40 * sin(-(degr + 180) / 180 * 3.141)); //x1 is x pos of car (in front of front of line)
  y1 := yCar + (-40 * cos(-(degr + 180) / 180 * 3.141));

  //FOR EACH OBJECT
  for var i := 1 to MAX_OBJECTS do
    begin
      xObj := XYObjs[i][1];  //get the x and y of the object in question
      yObj := XYObjs[i][2];

      //find distanceAway and degrees from CAR to OBJ
      twistingY := 0.28; //This specifies where the objects twist around (i.e. the car).
                         //It is a constant, change it at your peril

      //Pythagoras: sqrt of y length^2 +  x length^2
      distanceAway := twistingY * sqrt((yObj - y1) * (yObj - y1) + (xObj - x1) * (xObj - x1));
      if not ((xObj - round(x1)) = 0) then //Can't divide by zero (in the tempDegr equation below)
        //tempDegr is the bearing from the car to the point
        tempDegr := 90 + ((arctan((yObj - y1) / (xObj - x1))) / 3.141 * 180)
      else
        tempDegr := 90 + ((arctan((yObj - y1) / 0.01)) / 3.141 * 180);  //saved u from a dodgy error
      if x1 - xObj > 0 then
        tempDegr := tempDegr + 180;

      {The direction the car is pointing (degr) needs to be close to the true
       bearing from the car to the point for the object to be in view.}

       {makes a number between 0 and -800 (so we add 850 to shift it all to
        positive and the horizon which starts at 50)}
       basis3DObjX := 850 + round(-10 * (degr - (tempDegr - 40)));

      if distanceAway = 0 then
         distanceAway := 0.01;  //saved you from a nasty divide by zero error

      {This used to be a major problem. When degr goes over 360 it returns to 0.
       However, if degr is low and tempDegr is high, problems occur.}
      if (tempDegr < 150) and (degr > 210) then
         basis3DObjX := 850 + round(-10 * ((degr - 360) - (tempDegr - 40)));
      //Check if one is high and one is low and change the equation accordingly
      if (tempDegr > 210) and (degr < 150) then
         basis3DObjX := 850 + round(-10 * ((degr + 360) - (tempDegr - 40)));
      basis3DObjY    := 300 + round(300 * 10 / distanceAway);
      errorInDegr := 0;
      if (tempDegr < 150) and (degr > 210) then
        errorInDegr := -360;

      //Check if one is high and one is low and change the equation accordingly
      if (tempDegr > 210) and (degr < 150) then
        errorInDegr := +360;

      if ((degr + errorInDegr - 40) < tempDegr) and ((degr+errorInDegr+40)>tempDegr) then //view is 20+20 (40) degrees across
        begin
          //Draw vertical lines between hexagons
          Canvas.StrokeStyle := 'rgb(255, 255, 255)';
          Canvas.BeginPath;
          Canvas.LineF(gXY(True, 70, 0, 0), gXY(False, 35, 0, 0),
                       gXY(True, 70, 0, 0), gXY(False, 35, 0, 100));
          Canvas.LineF(gXY(True, 70, 60, 0), gXY(False, 35, 60, 0),
                       gXY(True, 70, 60, 0), gXY(False, 35, 60, 100));
          Canvas.LineF(gXY(True, 70, 120, 0), gXY(False, 35, 120, 0),
                       gXY(True, 70, 120, 0), gXY(False, 35, 120, 100));
          Canvas.LineF(gXY(True, 70, 180, 0), gXY(False, 35, 180, 0),
                       gXY(True, 70, 180, 0), gXY(False, 35, 180, 100));
          Canvas.LineF(gXY(True, 70, 240, 0), gXY(False, 35, 240, 0),
                       gXY(True, 70, 240, 0), gXY(False, 35, 240, 100));
          Canvas.LineF(gXY(True, 70, 300, 0), gXY(False, 35, 300, 0),
                       gXY(True, 70, 300, 0), gXY(False, 35, 300, 100));
          Canvas.ClosePath;
          Canvas.Stroke;
          //Draw bottom hexagons
          Canvas.BeginPath;
          Canvas.MoveToF(gXY(True, 70, 0, 0), gXY(False, 35, 0, 0));
          Canvas.LineToF(gXY(True, 70, 60, 0), gXY(False, 35, 60, 0));
          Canvas.LineToF(gXY(True, 70, 120, 0), gXY(False, 35, 120, 0));
          Canvas.LineToF(gXY(True, 70, 180, 0), gXY(False, 35, 180, 0));
          Canvas.LineToF(gXY(True, 70, 240, 0), gXY(False, 35, 240, 0));
          Canvas.LineToF(gXY(True, 70, 300, 0), gXY(False, 35, 300, 0));
          Canvas.LineToF(gXY(True, 70, 0, 0), gXY(False, 35, 0, 0));
          Canvas.ClosePath;
          Canvas.Stroke;
          // Draw top hexagons
          Canvas.BeginPath;
          Canvas.MoveToF(gXY(True, 70, 0, 0), gXY(False, 35, 0, 100));
          Canvas.LineToF(gXY(True, 70, 60, 0), gXY(False, 35, 60, 100));
          Canvas.LineToF(gXY(True, 70, 120, 0), gXY(False, 35, 120, 100));
          Canvas.LineToF(gXY(True, 70, 180, 0), gXY(False, 35, 180, 100));
          Canvas.LineToF(gXY(True, 70, 240, 0), gXY(False, 35, 240, 100));
          Canvas.LineToF(gXY(True, 70, 300, 0), gXY(False, 35, 300, 100));
          Canvas.LineToF(gXY(True, 70, 0, 0), gXY(False, 35, 0, 100));
          Canvas.ClosePath;
          Canvas.Stroke;
        end;
  end; //of for
  Canvas.Scale(1 / SCALE_FACTOR, 1 / SCALE_FACTOR);
end;

end.
    
Programming - a skill for life!

Driving round a circuit marked by hexagonal prisms