SuperHappyFunLand

by James Hall: L6 Age ~17

Introduction

In this program (now available as a web version) James experiments with his own 3D graphics procedures. He constructs objects from polygons, calculates how they should be drawn in two dimensions, then draws the polygons in an order of distance from the origin so that the closer faces obscure the ones at the far side of objects. (The origin is the position of the "player", given the prefix letter "p" in variable names).

Press any key to start. You can then use the wasd and i and k keys to move relative to the objects and see the objects from different perspectives. The effect of the n and m keys to move the objects laterally without making them appear to rotate as they do so. Try the eight keys and expect to want to spend some time navigating! The code behind the keys (in procedure getinput) works by applying both translations (px, py and pz) and rotations (protate). You may find it helpful to see how to rotate points using polar coordinates.

The following screenshots show views of the collection of objects from the left and from the right.

View from right

View from left

The source code of SuperHappyFunLand is in superhappyfunland.txt. No graphics files are required, but in order to run it 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, and wingraph.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 files useful for your own graphics programs.

We have added many comments to this program as we tried to follow the code. We have added lines of code in comments at the end of procedure getinput. If you uncomment these, you will see the images being constructed from polygons.

The Program

```program SuperHappyFunLand;
{

use this file except in compliance with the License, as described at
}
{\$APPTYPE CONSOLE}

uses
Classes, SysUtils, wingraph, wincrt, math;

var
currline, numofobsinmap, numofpoly, i, j, k, l, n, px, py, pz, tempx1, tempy1, tempz1 : integer;
pointsofobjects : array[1 .. 150, 1 .. 20] of integer;  //num, polys points per poly for all
objects : array[1 .. 100, 1 .. 100, 1 .. 3] of integer;  //obtype, num of point within obtype, x/y/z
obsinmap : array[1 .. 1000, 1 .. 5] of integer; // obnum, obtype/obx/oby/obz/colour
temppoint : PointType; //PointType defined in WinGraph is for x and y coords
temppolyarray : array[1 .. 10000] of PointType;
allpolys : array[1 .. 5000, 1 .. 10000] of integer; //Range of second index huge
allpolyscol : array[1 .. 5000] of integer;  //Colour of each polygon
allpolydist : array[1 .. 5000] of real; //Distance of each polygon
allpolyorder : array[1 .. 5000] of integer;  //Order of each polygon by distance
Gd, Gm : smallint;
key : char;
protate, theta, magnitude : real;
nope : boolean;

procedure drawobject(typeob, x, y, z, col  : integer);
begin
currline := 0;
for l := 1 to pointsofobjects[typeob, 1] do  //l represents point
begin
inc(numofpoly);  //numofpoly is initialised to 0 on each key press
allpolydist[numofpoly] := 0;
for k := 1 to pointsofobjects[typeob, l + 1] do
begin
inc(currline);
tempz1 := z - pz + objects[typeob, currline, 3]; //Adjust z for z-displacement and z-value within object.
if (tempz1 <> 0) then
begin
//Pythagoras
magnitude := sqrt((x - px + objects[typeob, currline, 1]) * (x - px + objects[typeob, currline, 1]) + tempz1 * tempz1);
if(tempz1 >= 0) then
theta := arctan((x - px + objects[typeob, currline, 1]) / tempz1); //theta is angle of hypotenuse from z axis
//Adjust theta if not in 0-360 degree range.
if(tempz1 < 0) then
theta := arctan(( x - px + objects[typeob, currline, 1]) / tempz1) + pi;
theta := theta + protate;
if theta > 2 * pi then
theta := theta - 2 * pi;
if theta < 0 then
theta := theta + 2 * pi;
if round(magnitude * cos(theta)) > 0 then
begin
//Calculate x and y coordinates (2D) for drawing.
// tempx1 := round(400 + 800 * (round(magnitude * sin(theta))) / (round(magnitude * cos(theta))));
tempx1 := round(400 + 800 * tan(theta));
tempy1 := round(400 + 800 * (y - py + objects[typeob, currline, 2]) / (round(magnitude * cos(theta))));
//Save the the x and y coord to be drawn in allpolys array
allpolys[numofpoly, 2 * k] := tempx1;   //Stored in 2,4,6,8 ...
allpolys[numofpoly, 2 * k + 1] := tempy1; //stored in 3,5,7,9
end;
end;
//Add the contribution of the point to the distance of the poly.  Distances averaged.
allpolydist[numofpoly] :=  allpolydist[numofpoly] + magnitude / pointsofobjects[typeob, l + 1];
end;
allpolys[numofpoly, 1] := pointsofobjects[typeob, l + 1];
//Now have array allpolys, first index is num of points in poly, next points for all polys
//Save colour code of poly (1-10) in array allpolyscol.
allpolyscol[numofpoly] := col;
end;
end;

procedure setobs;
begin
//7 obtypes
pointsofobjects[1, 1] := 6;  //6 polys in obtype 1
for i := 1 to 6 do
pointsofobjects[1, i + 1] := 4; //each poly has 4 points
pointsofobjects[2, 1] := 6;  //6 polys in obtype 2
for i := 1 to 6 do
pointsofobjects[2, i + 1] := 4; //each poly has 4 points
pointsofobjects[3, 1] := 5; //5 polys in obtype 3
pointsofobjects[3, 2] := 4;  //First poly has 4 points
for i := 1 to 4 do
pointsofobjects[3, i + 2] := 3; //Other 4 polys have 3 points: will be square based pyramid
pointsofobjects[4, 1] := 1;  //1 poly in obtype 4
pointsofobjects[4, 2] := 4;  //poly has 4 points
pointsofobjects[5, 1] := 1;   //1 point in obtype 5
pointsofobjects[5, 2] := 4;  //poly has 4 points
pointsofobjects[6, 1] := 1;  //1 poly in obtype 6
pointsofobjects[6, 2] := 4;  //poly has 4 points
pointsofobjects[7, 1] := 6;  //6 polys in obtype 6
for i := 1 to 6 do
pointsofobjects[7, i + 1] := 4; //Each poly has 4 points
//Coords of faces. Cube has 6 faces each with 4 coords.
//obtype 1
objects[1, 1, 1] := -20;
objects[1, 1, 2] := -20;
objects[1, 1, 3] := -20;
objects[1, 2, 1] := +20;
objects[1, 2, 2] := -20;
objects[1, 2, 3] := -20;
objects[1, 3, 1] := +20;
objects[1, 3, 2] := +20;
objects[1, 3, 3] := -20;
objects[1, 4, 1] := -20;
objects[1, 4, 2] := +20;
objects[1, 4, 3] := -20;

objects[1, 5, 1] := -20;
objects[1, 5, 2] := -20;
objects[1, 5, 3] := +20;
objects[1, 6, 1] := +20;
objects[1, 6, 2] := -20;
objects[1, 6, 3] := +20;
objects[1, 7, 1] := +20;
objects[1, 7, 2] := +20;
objects[1, 7, 3] := +20;
objects[1, 8, 1] := -20;
objects[1, 8, 2] := +20;
objects[1, 8, 3] := +20;

objects[1, 9, 1] := -20;
objects[1, 9, 2] := -20;
objects[1, 9, 3] := +20;
objects[1, 10, 1] := -20;
objects[1, 10, 2] := -20;
objects[1, 10, 3] := -20;
objects[1, 11, 1] := -20;
objects[1, 11, 2] := +20;
objects[1, 11, 3] := -20;
objects[1, 12, 1] := -20;
objects[1, 12, 2] := +20;
objects[1, 12, 3] := +20;

objects[1, 13, 1] := +20;
objects[1, 13, 2] := -20;
objects[1, 13, 3] := +20;
objects[1, 14, 1] := +20;
objects[1, 14, 2] := -20;
objects[1, 14, 3] := -20;
objects[1, 15, 1] := +20;
objects[1, 15, 2] := +20;
objects[1, 15, 3] := -20;
objects[1, 16, 1] := +20;
objects[1, 16, 2] := +20;
objects[1, 16, 3] := +20;

objects[1, 17, 1] := +20;
objects[1, 17, 2] := -20;
objects[1, 17, 3] := +20;
objects[1, 18, 1] := +20;
objects[1, 18, 2] := -20;
objects[1, 18, 3] := -20;
objects[1, 19, 1] := -20;
objects[1, 19, 2] := -20;
objects[1, 19, 3] := -20;
objects[1, 20, 1] := -20;
objects[1, 20, 2] := -20;
objects[1, 20, 3] := +20;

objects[1, 21, 1] := +20;
objects[1, 21, 2] := +20;
objects[1, 21, 3] := +20;
objects[1, 22, 1] := +20;
objects[1, 22, 2] := +20;
objects[1, 22, 3] := -20;
objects[1, 23, 1] := -20;
objects[1, 23, 2] := +20;
objects[1, 23, 3] := -20;
objects[1, 24, 1] := -20;
objects[1, 24, 2] := +20;
objects[1, 24, 3] := +20;
//obtype 2
objects[2, 1, 1] := -30;
objects[2, 1, 2] := -30;
objects[2, 1, 3] := -30;
objects[2, 2, 1] := +30;
objects[2, 2, 2] := -30;
objects[2, 2, 3] := -30;
objects[2, 3, 1] := +30;
objects[2, 3, 2] := +30;
objects[2, 3, 3] := -30;
objects[2, 4, 1] := -30;
objects[2, 4, 2] := +30;
objects[2, 4, 3] := -30;

objects[2, 5, 1] := -30;
objects[2, 5, 2] := -30;
objects[2, 5, 3] := +30;
objects[2, 6, 1] := +30;
objects[2, 6, 2] := -30;
objects[2, 6, 3] := +30;
objects[2, 7, 1] := +30;
objects[2, 7, 2] := +30;
objects[2, 7, 3] := +30;
objects[2, 8, 1] := -30;
objects[2, 8, 2] := +30;
objects[2, 8, 3] := +30;

objects[2, 9, 1] := -30;
objects[2, 9, 2] := -30;
objects[2, 9, 3] := +30;
objects[2, 10, 1] := -30;
objects[2, 10, 2] := -30;
objects[2, 10, 3] := -30;
objects[2, 11, 1] := -30;
objects[2, 11, 2] := +30;
objects[2, 11, 3] := -30;
objects[2, 12, 1] := -30;
objects[2, 12, 2] := +30;
objects[2, 12, 3] := +30;

objects[2, 13, 1] := +30;
objects[2, 13, 2] := -30;
objects[2, 13, 3] := +30;
objects[2, 14, 1] := +30;
objects[2, 14, 2] := -30;
objects[2, 14, 3] := -30;
objects[2, 15, 1] := +30;
objects[2, 15, 2] := +30;
objects[2, 15, 3] := -30;
objects[2, 16, 1] := +30;
objects[2, 16, 2] := +30;
objects[2, 16, 3] := +30;

objects[2, 17, 1] := +30;
objects[2, 17, 2] := -30;
objects[2, 17, 3] := +30;
objects[2, 18, 1] := +30;
objects[2, 18, 2] := -30;
objects[2, 18, 3] := -30;
objects[2, 19, 1] := -30;
objects[2, 19, 2] := -30;
objects[2, 19, 3] := -30;
objects[2, 20, 1] := -30;
objects[2, 20, 2] := -30;
objects[2, 20, 3] := +30;

objects[2, 21, 1] := +30;
objects[2, 21, 2] := +30;
objects[2, 21, 3] := +30;
objects[2, 22, 1] := +30;
objects[2, 22, 2] := +30;
objects[2, 22, 3] := -30;
objects[2, 23, 1] := -30;
objects[2, 23, 2] := +30;
objects[2, 23, 3] := -30;
objects[2, 24, 1] := -30;
objects[2, 24, 2] := +30;
objects[2, 24, 3] := +30;
//obtype 3   4 sided face
objects[3, 1, 1] := -20;
objects[3, 1, 2] := +20;
objects[3, 1, 3] := -20;
objects[3, 2, 1] := +20;
objects[3, 2, 2] := +20;
objects[3, 2, 3] := -20;
objects[3, 3, 1] := +20;
objects[3, 3, 2] := +20;
objects[3, 3, 3] := +20;
objects[3, 4, 1] := -20;
objects[3, 4, 2] := +20;
objects[3, 4, 3] := +20;
//3 sided face
objects[3, 5, 1] := -20;
objects[3, 5, 2] := +20;
objects[3, 5, 3] := -20;
objects[3, 6, 1] := 0;
objects[3, 6, 2] := -20;
objects[3, 6, 3] := 0;
objects[3, 7, 1] := +20;
objects[3, 7, 2] := +20;
objects[3, 7, 3] := -20;
//3 sided face
objects[3, 8, 1] := -20;
objects[3, 8, 2] := +20;
objects[3, 8, 3] := -20;
objects[3, 9, 1] := 0;
objects[3, 9, 2] := -20;
objects[3, 9, 3] := 0;
objects[3, 10, 1] := -20;
objects[3, 10, 2] := +20;
objects[3, 10, 3] := +20;
//3 sided face
objects[3, 11, 1] := -20;
objects[3, 11, 2] := +20;
objects[3, 11, 3] := +20;
objects[3, 12, 1] := 0;
objects[3, 12, 2] := -20;
objects[3, 12, 3] := 0;
objects[3, 13, 1] := +20;
objects[3, 13, 2] := +20;
objects[3, 13, 3] := +20;
//3 sided face
objects[3, 14, 1] := +20;
objects[3, 14, 2] := +20;
objects[3, 14, 3] := -20;
objects[3, 15, 1] := 0;
objects[3, 15, 2] := -20;
objects[3, 15, 3] := 0;
objects[3, 16, 1] := +20;
objects[3, 16, 2] := +20;
objects[3, 16, 3] := +20;
//obtype 4, a 4 point poly
objects[4, 1, 1] := -40;
objects[4, 1, 2] := -40;
objects[4, 1, 3] := -40;
objects[4, 2, 1] := +40;
objects[4, 2, 2] := -40;
objects[4, 2, 3] := -40;
objects[4, 3, 1] := +40;
objects[4, 3, 2] := -40;
objects[4, 3, 3] := +40;
objects[4, 4, 1] := -40;
objects[4, 4, 2] := -40;
objects[4, 4, 3] := +40;
//obtype 5, a 4 point poly
objects[5, 1, 1] := 0;
objects[5, 1, 2] := -80;
objects[5, 1, 3] := -80;
objects[5, 2, 1] := 0;
objects [5, 2, 2] := +80;
objects[5, 2, 3] := -80;
objects[5, 3, 1] := 0;
objects[5, 3, 2] := +80;
objects[5, 3, 3] := +80;
objects[5, 4, 1] := 0;
objects[5, 4, 2] := -80;
objects[5, 4, 3] := +80;
//obtype 6, a 4 point poly
objects[6, 1, 1] := -80;
objects[6, 1, 2] := -80;
objects[6, 1, 3] := 0;
objects[6, 2, 1] := -80;
objects[6, 2, 2] := +80;
objects[6, 2, 3] := 0;
objects[6, 3, 1] := +80;
objects[6, 3, 2] := +80;
objects[6, 3, 3] := 0;
objects[6, 4, 1] := +80;
objects[6, 4, 2] := -80;
objects[6, 4, 3] := 0;
//obtype 7, a tiny cube
objects[7, 1, 1] := -2;
objects[7, 1, 2] := -2;
objects[7, 1, 3] := -2;
objects[7, 2, 1] := +2;
objects[7, 2, 2] := -2;
objects[7, 2, 3] := -2;
objects[7, 3, 1] := +2;
objects[7, 3, 2] := +2;
objects[7, 3, 3] := -2;
objects[7, 4, 1] := -2;
objects[7, 4, 2] := +2;
objects[7, 4, 3] := -2;

objects[7, 5, 1] := -2;
objects[7, 5, 2] := -2;
objects[7, 5, 3] := +2;
objects[7, 6, 1] := +2;
objects[7, 6, 2] := -2;
objects[7, 6, 3] := +2;
objects[7, 7, 1] := +2;
objects[7, 7, 2] := +2;
objects[7, 7, 3] := +2;
objects[7, 8, 1] := -2;
objects[7, 8, 2] := +2;
objects[7, 8, 3] := +2;

objects[7, 9, 1] := -2;
objects[7, 9, 2] := -2;
objects[7, 9, 3] := +2;
objects[7, 10, 1] := -2;
objects[7, 10, 2] := -2;
objects[7, 10, 3] := -2;
objects[7, 11, 1] := -2;
objects[7, 11, 2] := +2;
objects[7, 11, 3] := -2;
objects[7, 12, 1] := -2;
objects[7, 12, 2] := +2;
objects[7, 12, 3] := +2;

objects[7, 13, 1] := +2;
objects[7, 13, 2] := -2;
objects[7, 13, 3] := +2;
objects[7, 14, 1] := +2;
objects[7, 14, 2] := -2;
objects[7, 14, 3] := -2;
objects[7, 15, 1] := +2;
objects[7, 15, 2] := +2;
objects[7, 15, 3] := -2;
objects[7, 16, 1] := +2;
objects[7, 16, 2] := +2;
objects[7, 16, 3] := +2;

objects[7, 17, 1] := +2;
objects[7, 17, 2] := -2;
objects[7, 17, 3] := +2;
objects[7, 18, 1] := +2;
objects[7, 18, 2] := -2;
objects[7, 18, 3] := -2;
objects[7, 19, 1] := -2;
objects[7, 19, 2] := -2;
objects[7, 19, 3] := -2;
objects[7, 20, 1] := -2;
objects[7, 20, 2] := -2;
objects[7, 20, 3] := +2;

objects[7, 21, 1] := +2;
objects[7, 21, 2] := +2;
objects[7, 21, 3] := +2;
objects[7, 22, 1] := +2;
objects[7, 22, 2] := +2;
objects[7, 22, 3] := -2;
objects[7, 23, 1] := -2;
objects[7, 23, 2] := +2;
objects[7, 23, 3] := -2;
objects[7, 24, 1] := -2;
objects[7, 24, 2] := +2;
objects[7, 24, 3] := +2;
end;

procedure setobsinmap;
begin
numofobsinmap := 94;

obsinmap[1, 1] := 1; //obtype
obsinmap[1, 2] := 300; //x
obsinmap[1, 3] := 500; //y
obsinmap[1, 4] := 400; //z
obsinmap[1, 5] := 4;   //colour code

obsinmap[2, 1] := 1;
obsinmap[2, 2] := 300;
obsinmap[2, 3] := 540;
obsinmap[2, 4] := 400;
obsinmap[2, 5] := 4;

obsinmap[3, 1] := 1;
obsinmap[3, 2] := 340;
obsinmap[3, 3] := 540;
obsinmap[3, 4] := 400;
obsinmap[3, 5] := 4;

obsinmap[4, 1] := 1;
obsinmap[4, 2] := 260;
obsinmap[4, 3] := 540;
obsinmap[4, 4] := 400;
obsinmap[4, 5] := 4;

obsinmap[5, 1] := 1;
obsinmap[5, 2] := 300;
obsinmap[5, 3] := 580;
obsinmap[5, 4] := 400;
obsinmap[5, 5] := 4;

obsinmap[6, 1] := 1;
obsinmap[6, 2] := 300;
obsinmap[6, 3] := 620;
obsinmap[6, 4] := 400;
obsinmap[6, 5] := 7;

obsinmap[7, 1] := 1;
obsinmap[7, 2] := 340;
obsinmap[7, 3] := 620;
obsinmap[7, 4] := 400;
obsinmap[7, 5] := 7;

obsinmap[8, 1] := 1;
obsinmap[8, 2] := 260;
obsinmap[8, 3] := 620;
obsinmap[8, 4] := 400;
obsinmap[8, 5] := 7;

obsinmap[9, 1] := 1;
obsinmap[9, 2] := 340;
obsinmap[9, 3] := 660;
obsinmap[9, 4] := 400;
obsinmap[9, 5] := 7;

obsinmap[10, 1] := 1;
obsinmap[10, 2] := 260;
obsinmap[10, 3] := 660;
obsinmap[10, 4] := 400;
obsinmap[10, 5] := 7;

obsinmap[11, 1] := 1;
obsinmap[11, 2] := 340;
obsinmap[11, 3] := 700;
obsinmap[11, 4] := 400;
obsinmap[11, 5] := 6;

obsinmap[12, 1] := 1;
obsinmap[12, 2] := 260;
obsinmap[12, 3] := 700;
obsinmap[12, 4] := 400;
obsinmap[12, 5] := 6;

obsinmap[13, 1] := 1;
obsinmap[13, 2] := 260;
obsinmap[13, 3] := 700;
obsinmap[13, 4] := 360;
obsinmap[13, 5] := 6;

obsinmap[14, 1] := 1;
obsinmap[14, 2] := 340;
obsinmap[14, 3] := 700;
obsinmap[14, 4] := 360;
obsinmap[14, 5] := 6;

obsinmap[15, 1] := 2;
obsinmap[15, 2] := 300;
obsinmap[15, 3] := 450;
obsinmap[15, 4] := 400;
obsinmap[15, 5] := 5;

obsinmap[16, 1] := 3;
obsinmap[16, 2] := 300;
obsinmap[16, 3] := 400;
obsinmap[16, 4] := 400;
obsinmap[16, 5] := 2;

obsinmap[17, 1] := 1;
obsinmap[17, 2] := 540;
obsinmap[17, 3] := 700;
obsinmap[17, 4] := 600;
obsinmap[17, 5] := 7;

obsinmap[18, 1] := 1;
obsinmap[18, 2] := 540;
obsinmap[18, 3] := 660;
obsinmap[18, 4] := 600;
obsinmap[18, 5] := 8;

obsinmap[19, 1] := 1;
obsinmap[19, 2] := 580;
obsinmap[19, 3] := 660;
obsinmap[19, 4] := 600;
obsinmap[19, 5] := 8;

obsinmap[20, 1] := 1;
obsinmap[20, 2] := 500;
obsinmap[20, 3] := 660;
obsinmap[20, 4] := 600;
obsinmap[20, 5] := 8;

obsinmap[21, 1] := 1;
obsinmap[21, 2] := 540;
obsinmap[21, 3] := 660;
obsinmap[21, 4] := 560;
obsinmap[21, 5] := 8;

obsinmap[22, 1] := 1;
obsinmap[22, 2] := 540;
obsinmap[22, 3] := 660;
obsinmap[22, 4] := 640;
obsinmap[22, 5] := 8;

obsinmap[23, 1] := 1;
obsinmap[23, 2] := 580;
obsinmap[23, 3] := 660;
obsinmap[23, 4] := 640;
obsinmap[23, 5] := 8;

obsinmap[24, 1] := 1;
obsinmap[24, 2] := 500;
obsinmap[24, 3] := 660;
obsinmap[24, 4] := 640;
obsinmap[24, 5] := 8;

obsinmap[25, 1] := 1;
obsinmap[25, 2] := 580;
obsinmap[25, 3] := 660;
obsinmap[25, 4] := 560;
obsinmap[25, 5] := 8;

obsinmap[26, 1] := 1;
obsinmap[26, 2] := 500;
obsinmap[26, 3] := 660;
obsinmap[26, 4] := 560;
obsinmap[26, 5] := 8;

obsinmap[27, 1] := 1;
obsinmap[27, 2] := 620;
obsinmap[27, 3] := 660;
obsinmap[27, 4] := 600;
obsinmap[27, 5] := 8;

obsinmap[28, 1] := 1;
obsinmap[28, 2] := 460;
obsinmap[28, 3] := 660;
obsinmap[28, 4] := 600;
obsinmap[28, 5] := 8;

obsinmap[29, 1] := 1;
obsinmap[29, 2] := 540;
obsinmap[29, 3] := 660;
obsinmap[29, 4] := 680;
obsinmap[29, 5] := 8;

obsinmap[30, 1] := 1;
obsinmap[30, 2] := 540;
obsinmap[30, 3] := 660;
obsinmap[30, 4] := 520;
obsinmap[30, 5] := 8;

obsinmap[31, 1] := 1;
obsinmap[31, 2] := 540;
obsinmap[31, 3] := 620;
obsinmap[31, 4] := 600;
obsinmap[31, 5] := 8;

obsinmap[32, 1] := 1;
obsinmap[32, 2] := 580;
obsinmap[32, 3] := 620;
obsinmap[32, 4] := 600;
obsinmap[32, 5] := 8;

obsinmap[33, 1] := 1;
obsinmap[33, 2] := 500;
obsinmap[33, 3] := 620;
obsinmap[33, 4] := 600;
obsinmap[33, 5] := 8;

obsinmap[34, 1] := 1;
obsinmap[34, 2] := 540;
obsinmap[34, 3] := 620;
obsinmap[34, 4] := 560;
obsinmap[34, 5] := 8;

obsinmap[35, 1] := 1;
obsinmap[35, 2] := 540;
obsinmap[35, 3] := 620;
obsinmap[35, 4] := 640;
obsinmap[35, 5] := 8;

obsinmap[36, 1] := 1;
obsinmap[36, 2] := 580;
obsinmap[36, 3] := 620;
obsinmap[36, 4] := 640;
obsinmap[36, 5] := 8;

obsinmap[37, 1] := 1;
obsinmap[37, 2] := 500;
obsinmap[37, 3] := 620;
obsinmap[37, 4] := 640;
obsinmap[37, 5] := 8;

obsinmap[38, 1] := 1;
obsinmap[38, 2] := 580;
obsinmap[38, 3] := 620;
obsinmap[38, 4] := 560;
obsinmap[38, 5] := 8;

obsinmap[39, 1] := 1;
obsinmap[39, 2] := 500;
obsinmap[39, 3] := 620;
obsinmap[39, 4] := 560;
obsinmap[39, 5] := 8;

obsinmap[40, 1] := 1;
obsinmap[40, 2] := 540;
obsinmap[40, 3] := 580;
obsinmap[40, 4] := 600;
obsinmap[40, 5] := 8;

obsinmap[41, 1] := 1;
obsinmap[41, 2] := 580;
obsinmap[41, 3] := 580;
obsinmap[41, 4] := 600;
obsinmap[41, 5] := 8;

obsinmap[42, 1] := 1;
obsinmap[42, 2] := 500;
obsinmap[42, 3] := 580;
obsinmap[42, 4] := 600;
obsinmap[42, 5] := 8;

obsinmap[43, 1] := 1;
obsinmap[43, 2] := 540;
obsinmap[43, 3] := 580;
obsinmap[43, 4] := 640;
obsinmap[43, 5] := 8;

obsinmap[44, 1] := 1;
obsinmap[44, 2] := 540;
obsinmap[44, 3] := 580;
obsinmap[44, 4] := 560;
obsinmap[44, 5] := 8;

obsinmap[45, 1] := 1;
obsinmap[45, 2] := 540;
obsinmap[45, 3] := 540;
obsinmap[45, 4] := 600;
obsinmap[45, 5] := 8;

obsinmap[46, 1] := 5;
obsinmap[46, 2] := 800;
obsinmap[46, 3] := 620;
obsinmap[46, 4] := 400;
obsinmap[46, 5] := 3;

obsinmap[47, 1] := 5;
obsinmap[47, 2] := 960;
obsinmap[47, 3] := 620;
obsinmap[47, 4] := 400;
obsinmap[47, 5] := 3;

obsinmap[48, 1] := 5;
obsinmap[48, 2] := 800;
obsinmap[48, 3] := 620;
obsinmap[48, 4] := 560;
obsinmap[48, 5] := 3;

obsinmap[49, 1] := 5;
obsinmap[49, 2] := 960;
obsinmap[49, 3] := 620;
obsinmap[49, 4] := 560;
obsinmap[49, 5] := 3;

//pikachu

for i := 1 to 3 do
for j := 1 to 3 do
for k := 1 to 3 do
begin
obsinmap[37 + 9 * i + 3 * j + k, 1] := 1;
obsinmap[37 + 9 * i + 3 * j + k, 2] := 220 + 40 * j;
obsinmap[37 + 9 * i + 3 * j + k, 3] := 720 - 40 * i;
obsinmap[37 + 9 * i + 3 * j + k, 4] := -420 + 40 * k;
obsinmap[37 + 9 * i + 3 * j + k, 5] := 10;
end;

obsinmap[77, 1] := 1;
obsinmap[77, 2] := 260;
obsinmap[77, 3] := 600;
obsinmap[77, 4] := -260;
obsinmap[77, 5] := 10;

obsinmap[78, 1] := 1;
obsinmap[78, 2] := 340;
obsinmap[78, 3] := 600;
obsinmap[78, 4] := -260;
obsinmap[78, 5] := 10;

for i := 1 to 3 do
begin
obsinmap[78 + i, 1] := 1;
obsinmap[78 + i, 2] := 260;
obsinmap[78 + i, 3] := 720;
obsinmap[78 + i, 4] := -420 + 40 * i;
obsinmap[78 + i, 5] := 10;
end;

for i := 1 to 3 do
begin
obsinmap[81 + i, 1] := 1;
obsinmap[81 + i, 2] := 340;
obsinmap[81 + i, 3] := 720;
obsinmap[81 + i, 4] := -420 + 40 * i;
obsinmap[81 + i, 5] := 10;
end;

for i := 1 to 2 do
for j := 1 to 2 do
for k := 1 to 2 do
begin
obsinmap[78 + 4 * i + 2 * j + k, 1] := 1;
obsinmap[78 + 4 * i + 2 * j + k, 2] := 240 + 40 * j;
obsinmap[78 + 4 * i + 2 * j + k, 3] := 600 - 40 * i;
obsinmap[78 + 4 * i + 2 * j + k, 4] := -400 + 40 * k;
obsinmap[78 + 4 * i + 2 * j + k, 5] := 10;
end;

obsinmap[93, 1] := 3;
obsinmap[93, 2] := 320;
obsinmap[93, 3] := 480;
obsinmap[93, 4] := -340;
obsinmap[93, 5] := 9;

obsinmap[94, 1] := 3;
obsinmap[94, 2] := 280;
obsinmap[94, 3] := 480;
obsinmap[94, 4] := -340;
obsinmap[94, 5] := 9;
end;

procedure getinput;
begin
if keypressed then
begin
case key of
'a' : begin
theta := protate + 2 * pi / 2;
magnitude := 20;
px := px + round(magnitude * cos(theta));
pz := pz + round(magnitude * sin(theta));
end;
'd' : begin
theta := protate + 0 * pi / 2;
magnitude := 20;
px := px + round(magnitude * cos(theta));
pz := pz + round(magnitude * sin(theta));
end;
'w' : begin
theta := protate + 1 * pi / 2;
magnitude := 20;
px := px + round(magnitude * cos(theta));
pz := pz + round(magnitude * sin(theta));
end;
's' : begin
theta := protate + 3 * pi / 2;
magnitude := 20;
px := px + round(magnitude * cos(theta));
pz := pz + round(magnitude * sin(theta));
end;
'i' : begin
py := py - 20;
end;
'k' : begin
py := py + 20;
end;
'm' : begin
protate := protate - pi / 36;
end;
'n' : begin
protate := protate + pi/36;
end;
end;
//Adjust angle protate if not in range 0-360 degrees.
if protate > 2 * pi then
protate := protate - 2 * pi;
if protate < 0 then
protate := protate + 2 * pi;
cleardevice;
setfillstyle(solidfill, LightGray);
setColor(LightGray);
numofpoly := 0;
for i := 1 to numofobsinmap do
begin
tempz1 := obsinmap[i, 4] - pz;  //z coord - z displacement
if (tempz1 <> 0) then
begin
//Pythagoras for x and z coords
magnitude := sqrt((obsinmap[i, 2] - px) * (obsinmap[i, 2] - px) + tempz1 * tempz1);
if(tempz1 >= 0) then
theta := arctan((obsinmap[i, 2] - px) / tempz1); //angle from x-axis
//Adjust angle if not in 0-360 degree range
if(tempz1 < 0) then
theta := arctan((obsinmap[i, 2] - px) / tempz1) + pi;
theta := theta + protate;
if theta > 2 * pi then
theta := theta - 2 * pi;
if theta < 0 then
theta := theta + 2 * pi;
//Call drawobject if theta is within suitable range
if NOT ((theta < 280 * pi / 180) AND (theta > 80 * pi / 180)) then
drawobject(obsinmap[i, 1], obsinmap[i, 2] , obsinmap[i, 3], obsinmap[i, 4], obsinmap[i, 5]);
end;
end;
//Draw background
setfillstyle(solidfill, Green);
fillrect(0, 400, 1000, 800);
setfillstyle(solidfill, cyan);
fillrect(0, 0, 1000, 400);
//Sort polygons in order of distance
allpolyorder[1] := 1;
for n := 2 to numofpoly do
begin
k := 0;
nope := true;
repeat
inc(k);
if allpolydist[n] <= allpolydist[allpolyorder[k]] then
begin
for l := k + 1 to numofpoly do
allpolyorder[numofpoly + k + 1 - l] := allpolyorder[numofpoly + k - l]; //shift rest up
allpolyorder[k] := n;
nope := false;
end;
until (nope = false) OR (k = n - 1);
if nope = true then
allpolyorder[k + 1] := n;
end;

for n := 1 to numofpoly do
begin
i := allpolyorder[numofpoly - n + 1];   //Reverse the order.
//Put all points in poly into temppolyarray.
//(Array allpolys is assigned values in drawobject procedure).
for j := 1 to allpolys[i, 1] do
begin
temppoint.x := allpolys[i, 2 * j];
temppoint.y := allpolys[i, 2 * j + 1];
temppolyarray[j] := temppoint;
end;
//First point in poly needs to be repeated, not 2 points?
temppoint.x := allpolys[i, 2];  //x coord of first point
temppoint.y := allpolys[i, 3];  //y coord of first point
temppolyarray[allpolys[i, 1] + 1] := temppoint;
temppoint.x := allpolys[i, 4];
temppoint.y := allpolys[i, 5];
// temppolyarray[allpolys[i, 1] + 2] := temppoint;
//Set colour of polygon
case allpolyscol[i] of
1 : setfillstyle(solidfill, Green);
2 : setfillstyle(solidfill, Red);
3 : setfillstyle(solidfill, LightGray);
4 : setfillstyle(solidfill, RobinEggBlue);
5 : setfillstyle(solidfill, Peach);
6 : setfillstyle(solidfill, GrayAsparagus);
7 : setfillstyle(solidfill, Peru);
8 : setfillstyle(solidfill, DarkGreen);
9 : setfillstyle(solidfill, Black);
10 : setfillstyle(solidfill, Yellow);
end;
//Draw coloured polygon. First argument of fillpoly must be one more than num of points.
fillpoly(allpolys[i, 1] + 1, temppolyarray);
//Draw black edges.
setColor(Black);
drawpoly(allpolys[i, 1] + 1, temppolyarray);
{PPS: Uncomment these lines to see polygons drawn in order.
UpdateGraph(UpdateNow);
sleep(30);}
end;
end;
end;

begin
Gd := 9;
Gm := 13;
setwindowsize(800, 700);
InitGraph(Gd, Gm, '');
px := 400;
py := 400;
pz := 0;
protate := 0;
setobsinmap;
setobs;
UpdateGraph(UpdateOff);
repeat
getinput;
UpdateGraph(UpdateNow);
delay(10);
until 'America' = 'Peaceful';
end.```

Remarks

Could you write a similar program constructing objects from polygons?

Programming - a skill for life!

Seven programs including GameOfLife, PixelSort and SuperHappyFunLand by James Hall