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 right

View from left

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;
{
    Copyright (c) 2011 James Hall

    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/
}
{$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
      key := readkey;
      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