3D-Driving

Driving round a circuit marked by hexagonal prisms

Introduction

Peter continues to show imagination and a flair for programming in his most impressive 3D-Driving program. We have adapted the code so that it will run in Smart Mobile Studio and you can now try the web version.

We include two screenshots to show the track (bordered by hexagonal prisms) and the car (a flexible arrowhead). The first shows the car approaching a right bend. The horizontal line is the horizon and the current speed is shown at the top of the graphics window.

Approaching right bend

Approaching right bend

The second screenshot shows the shape of the car while cornering left.

Cornering

Cornering

Peter used the following map of the track in another program so that a click on a point in the image would output the coordinates of that point to a file. He then copied and pasted these coordinates into the source file.

The Track

The Track

In order to run program Driving, you will need to have downloaded Stefan Berinde`s wingraph.zip file as described in our Graphics tutorial. You should copy the unzipped wincrt.pas, wingraph.pas and winmouse.pas (from the src folder) into your program folder. (The compiled units are included in the zip file but you might as well have the source code available for reference). You should find these three files useful for your own motion graphics programs.

If you prefer to drive on a track with lines joining the hexagonal prisms, you can uncomment the appropriate section of code.

The Program

program Driving;
{
    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/
}
uses
  SysUtils,
  wingraph in 'wingraph.pas',
  wincrt in 'wincrt.pas',
  winmouse in 'winmouse.pas';
const
  MAX = 227;
var
  Gd, Gm: smallint;
  degr, xObj, yObj, basis3DObjX, basis3DObjY, TotalYAdd, i, errorInDegr, changeInDegr: integer;
  x1, y1, xCar, yCar, Rdegr, carSpeed, tempDegr, distanceAway, twistingY: real;
  XYObjs: array [1..MAX, 1..2] of integer = (  //91
(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));


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;
begin
    {function to get REAL x or y value (as opposed to the imaginary x,y,z).
     co-ord value based on bearing and distance.}
    if (isx = True) then   //is an x value
    begin
      radius := round(radius * (1 / (distanceAway / 10)));
      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 * (1 / (distanceAway / 10)));
        radius    := round(radius * (1 / (distanceAway / 10)));
        Result    := TotalYAdd + basis3DObjY - round(0.5 * round(radius * sin(-(tempDegr + bearing) / 180 * 3.141)));
    end;
end;

procedure CheckKeyboard;
var
  c: char;
begin
  if not (KeyPressed) then
    Exit;
  c := ReadKey;
  case c of
    #72:  //Up arrow key
    begin
        carSpeed := carSpeed + 0.05;   //how quickly the car accelerates
    end;
    #80:  //Down arrow key
    begin
      carSpeed := carSpeed * 0.9;    //how quickly the car decelerates
    end;
  end;
end;

begin
  SetWindowSize(953,700);
  gd:=9; gm:=13;
  InitGraph(gd,gm,'3D Driving');
  xCar     := round(getmaxX / 2);
  yCar     := round(getmaxY / 2);
  carSpeed := 0;
  UpdateGraph(updateOff);
  repeat
    UpdateGraph(updateNow);
    sleep(21);
    clearDevice;
    CheckKeyboard;
    //set up base lines
    SetColor(white);
    line(50, 300, 850, 300);//horizon line

    outTextXY(20,20,intToStr(round(carSpeed*50))+'mph');
    outTextXY(150,20,'Press the up key to accelerate and move the mouse from side to side to turn.');

    //the on-screen car
    changeInDegr := round((getmouseX - (getmaxX / 2)) / 10);
    line(getXCar(1, 0),getYCar(1, 0),getXCar(1, 150),getYCar(1, 150));
    line(getXCar(1, 150),getYCar(1, 150),getXCar(0, 330),getYCar(0, 330));
    line(getXCar(0, 330),getYCar(0, 330),getXCar(1, 210),getYCar(1, 210));
    line(getXCar(1, 210),getYCar(1, 210),getXCar(1, 0),getYCar(1, 0));
    //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 i := 1 to MAX do
    begin
      xObj := round(XYObjs[i][1]);  //get the x and y of the object in question
      yObj := round(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)

      begin
        //tempDegr is the bearing from the car to the point
        tempDegr := 90 + ((arctan((yObj - y1) / (xObj - x1))) / 3.141 * 180);
      end
      else
      begin
        tempDegr := 90 + ((arctan((yObj - y1) / (0.01))) / 3.141 * 180);  //saved u from a dodgy error
      end;
      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(1 / (distanceAway / 10) * 300);

       {//CODE TO INCLUDE LINES
       if((LastX>-100)and(LastX<1200)and(lastY<1500))then
       begin
         line(gXY(true,70,0,0),gXY(false,35,0,0),LastX,LastY);
       end;
       LastX := gXY(true,70,0,0);
       LastY := gXY(false,35,0,0); }

      errorInDegr := 0;
      {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
        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
      {writeln('Object is in view: Distance Away: ', floattostr(1/(distanceAway/10)),
       ' Ypos across Screen: ', degr-(tempDegr-40));   //need distance, bearing }

      //Draw vertical lines between hexagons
      line(gXY(True, 70, 0, 0), gXY(False, 35, 0, 0), gXY(True, 70, 0, 0), gXY(False, 35, 0, 100));
      line(gXY(True, 70, 60, 0), gXY(False, 35, 60, 0), gXY(True, 70, 60, 0), gXY(
        False, 35, 60, 100));
      line(gXY(True, 70, 120, 0), gXY(False, 35, 120, 0), gXY(True, 70, 120, 0), gXY(
        False, 35, 120, 100));
      line(gXY(True, 70, 180, 0), gXY(False, 35, 180, 0), gXY(True, 70, 180, 0), gXY(
        False, 35, 180, 100));
      line(gXY(True, 70, 240, 0), gXY(False, 35, 240, 0), gXY(True, 70, 240, 0), gXY(
        False, 35, 240, 100));
      line(gXY(True, 70, 300, 0), gXY(False, 35, 300, 0), gXY(True, 70, 300, 0), gXY(
        False, 35, 300, 100));

      //Draw bottom hexagons
      line(gXY(True, 70, 0, 0), gXY(False, 35, 0, 0), gXY(True, 70, 60, 0), gXY(False, 35, 60, 0));
      lineTo(gXY(True, 70, 120, 0), gXY(False, 35, 120, 0));
      lineTo(gXY(True, 70, 180, 0), gXY(False, 35, 180, 0));
      lineTo(gXY(True, 70, 240, 0), gXY(False, 35, 240, 0));
      lineTo(gXY(True, 70, 300, 0), gXY(False, 35, 300, 0));
      lineTo(gXY(True, 70, 0, 0), gXY(False, 35, 0, 0));

      //Draw top hexagons
      line(gXY(True, 70, 0, 0), gXY(False, 35, 0, 100), gXY(True, 70, 60, 0), gXY(
        False, 35, 60, 100));
      lineTo(gXY(True, 70, 120, 0), gXY(False, 35, 120, 100));
      lineTo(gXY(True, 70, 180, 0), gXY(False, 35, 180, 100));
      lineTo(gXY(True, 70, 240, 0), gXY(False, 35, 240, 100));
      lineTo(gXY(True, 70, 300, 0), gXY(False, 35, 300, 100));
      lineTo(gXY(True, 70, 0, 0), gXY(False, 35, 0, 100));
      end;
    end;

  until 1 > 2;
end.

Remarks

Could you write a program using wincrt, wingraph and winmouse?

Programming - a skill for life!

Fourteen programs (with five web versions) including 3D-Driving, GASP and Knowledge by Peter Hearnshaw