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

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

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

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

use this file except in compliance with the License, as described at
}
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
end;

function getYCar (carRad : real; bearing : integer) : integer;
begin
end;

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
Result := basis3DObjX - round(0.5 * round(radius * cos(-(tempDegr + bearing) / 180 * 3.141)));
end
else
begin                //is a y value
if not (yAddition = 0) then
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;
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