Code of Web Version of SuperHappyFunLand

by James Hall: L6 Age ~17 (converted to run in Smart Mobile Studio by PPS)

Introduction

In this web version of James Hall's SuperHappyFunland, much of his original Pascal code remains unchanged. We have transferred a lot of code from the event-handling procedures of the original to PaintView. A few lines of code at the end of PaintView render the faces and edges (the equivalent of FillPoly and DrawPoly in WinGraph).

The conversion demonstrates:
  • input from the keyboard;
  • the display of each polygon by creating a path then drawing the outline with Canvas.Stroke and filling it with Canvas.Fill;
  • the display of customised colours.

You can try the program on the preceding page.

The Program

unit SuperHappyFunlandJS;
{
    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/

    Converted to run in Smart Mobile Studio by PPS
}
interface

uses 
  W3System, W3Components, W3Application, W3Game, W3GameApp, W3Graphics;

type
  TApplication = class(TW3CustomGameApplication)
  private
    currline, numofobsinmap, numofpoly, px, py, pz, tempx1, tempy1, tempz1 : integer;
    //Integers px, py, and pz are the player's coordinates (your coordinates as you move relative to the object).
    //This program has not been turned into a game but the notion of player indicates this intention.
    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 : TPointF; //TPointF defined in Smart is for x and y coords
    temppolyarray : array[1 .. 10000] of TPointF;
    allpolys : array[1 .. 5000, 1 .. 10000] of integer; //num of points in poly, x and y coords of each point
    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
    key : string;
    protate, theta, magnitude : real;
    nope : boolean;

  protected
    procedure  ApplicationStarting; override;
    procedure  ApplicationClosing; override;
    procedure  PaintView(Canvas: TW3Canvas); override;
    procedure SetObjects;
    procedure SetObjectsInMap;
    procedure KeyDownEvent(mCode : integer);
  end;

implementation
procedure TApplication.KeyDownEvent(mCode : integer);
begin
  case mCode of
    27 : Application.Terminate;
    65 : begin  //a
           //Adjust the angle of rotation of each point
           theta := protate + 2 * pi / 2;
           //and the position of the player.
           magnitude := 20;
           px := px + round(magnitude * cos(theta));
           pz := pz + round(magnitude * sin(theta));
         end;
      68 : begin  //d
             theta := protate + 0 * pi / 2;
             magnitude := 20;
             px := px + round(magnitude * cos(theta));
             pz := pz + round(magnitude * sin(theta));
           end;
      87 : begin  //w
             theta := protate + 1 * pi / 2;
             magnitude := 20;
             px := px + round(magnitude * cos(theta));
             pz := pz + round(magnitude * sin(theta));
           end;
      83 : begin  //s
             theta := protate + 3 * pi / 2;
             magnitude := 20;
             px := px + round(magnitude * cos(theta));
             pz := pz + round(magnitude * sin(theta));
           end;
      73 : begin  //i
             py := py - 20; //Player moves with no angle change.
           end;
      75 : begin  //k
             py := py + 20; //Player moves with no angle change.
           end;
      77 : begin //m
             protate := protate - pi / 36;
           end;
      78 : begin //n
             protate := protate + pi / 36;
           end;
     end;
    numofpoly := 0;
end;

procedure TApplication.SetObjects;
var
  i : integer;
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 poly 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.

  //objects(type 1 to 7), face, coord(x=1, y=2, z=3)
  //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 larger cube
  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 1
  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 2
  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 3
  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 4
  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 TApplication.SetObjectsInMap;
var
  i, j, k : integer;
begin
  numofobsinmap := 94;
  // Start of RobinEggBlue cubes
  obsinmap[1, 1] := 1; //obtype cube
  obsinmap[1, 2] := 300; //x
  obsinmap[1, 3] := 500; //y
  obsinmap[1, 4] := 400; //z
  obsinmap[1, 5] := 4;   //colour code RobinEggBlue

  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;
  //8 Peru Cubes
  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;  //Cube
  obsinmap[14, 2] := 340;
  obsinmap[14, 3] := 700;
  obsinmap[14, 4] := 360;
  obsinmap[14, 5] := 6;  //GrayAsparagus
  // Larger peach cube
  obsinmap[15, 1] := 2;  //Larger
  obsinmap[15, 2] := 300;
  obsinmap[15, 3] := 450;
  obsinmap[15, 4] := 400;
  obsinmap[15, 5] := 5;  //Peach

  obsinmap[16, 1] := 3;  //Type 3 is square based pyramid
  obsinmap[16, 2] := 300;
  obsinmap[16, 3] := 400;
  obsinmap[16, 4] := 400;
  obsinmap[16, 5] := 2;  //Red

  obsinmap[17, 1] := 1; //Cube
  obsinmap[17, 2] := 540;
  obsinmap[17, 3] := 700;
  obsinmap[17, 4] := 600;
  obsinmap[17, 5] := 7;  //Peru
  //28 dark green pyramids
  obsinmap[18, 1] := 1;  //Cube
  obsinmap[18, 2] := 540;
  obsinmap[18, 3] := 660;
  obsinmap[18, 4] := 600;
  obsinmap[18, 5] := 8;    //Dark Green

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

  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;

  //Start of 2 pairs of light gray planes
  obsinmap[46, 1] := 5;
  obsinmap[46, 2] := 800;
  obsinmap[46, 3] := 620;
  obsinmap[46, 4] := 400;
  obsinmap[46, 5] := 3;  //Light gray

  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
  //Large cube of 9 yellow cubes 
  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;  //Cube
          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; //yellow
        end;
 //More yellow cubes
  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;
  //and two black squared based pyramids
  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 TApplication.ApplicationStarting;
begin
  inherited;
  asm
    window.onkeydown=function(e)
    {
    TApplication.KeyDownEvent(Self,e.keyCode);
    }
  end;
  KeyDownEvent(0);
  GameView.Width := 800;
  GameView.Height := 700;
  px := 400;
  py := 400;
  pz := 0;
  protate := 0;
  SetObjects;
  SetObjectsInMap;
  GameView.Delay := 10;
  GameView.StartSession(True);
end;

procedure TApplication.ApplicationClosing;
begin
  GameView.EndSession;
  inherited;
end;
 
procedure TApplication.PaintView(Canvas: TW3Canvas);

procedure drawobject(typeob, x, y, z, col  : integer);
begin
  currline := 0;
  for var l := 1 to pointsofobjects[typeob, 1] do  //l represents line from origin (player) to point
    begin
      inc(numofpoly);  //(Integer numofpoly is initialised to 0 on each key press.)
      allpolydist[numofpoly] := 0;
      for var k := 1 to pointsofobjects[typeob, l + 1] do
        begin
          inc(currline);
          //Calculate tempz1, the z-displacement of the current point from player.
          //The z coordinate of the point is the z coord of its object plus its z coordinate within the object.
          tempz1 := z - pz + objects[typeob, currline, 3];
          if (tempz1 <> 0) then
            begin
              //Pythagoras to find distance from origin (the player) to point
              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
              if (tempz1 < 0) then
                theta := arctan(( x - px + objects[typeob, currline, 1]) / tempz1) + pi;
              theta := theta + protate;
              //Adjust theta if not in 0-360 degree range.
              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 * 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;
                  allpolys[numofpoly, 2 * k + 1] := tempy1;
                end;
            end;
          //Add the contribution of the point to the distance of the poly from the player.  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;

var
  i, k, l : integer;
begin
  //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;
//  numofpoly := 0;
  for i := 1 to numofobsinmap do
    begin
      tempz1 := obsinmap[i, 4] - pz;  //z coord of point - z coord of player
      if (tempz1 <> 0) then
        begin
          //Pythagoras for x and z coords to obtain magnitude (radius in polar coords)
          magnitude := sqrt((obsinmap[i, 2] - px) * (obsinmap[i, 2] - px) + tempz1 * tempz1);
          if tempz1 >= 0 then
            theta := arctan((obsinmap[i, 2] - px) / tempz1); //polar angle
          //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;
  Canvas.FillStyle := 'green';
  Canvas.FillRectF(0, 400, 1000, 800);
  Canvas.FillStyle := 'cyan';
  Canvas.FillRectF(0, 0, 1000, 400);
  //Sort polygons in order of distance from origin (player)
  allpolyorder[1] := 1;
  for var 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 var 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 var 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
      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;
      //Set colour of polygon
      case allpolyscol[i] of
        1 : Canvas.FillStyle := 'green';
        2 : Canvas.FillStyle := 'red';
        3 : Canvas.FillStyle := 'rgb(211, 211, 211)'; //LightGray
        4 : Canvas.FillStyle := 'rgb(189, 200 , 179)'; //RobinEggBlue
        5 : Canvas.FillStyle := 'rgb(255, 240, 219)'; //Peach
        6 : Canvas.FillStyle := 'rgb(70, 89, 69)';  //GrayAsparagus
        7 : Canvas.FillStyle := 'rgb(206, 133, 63)'; //Peru
        8 : Canvas.FillStyle := 'rgb(0, 100, 0)';  //DarkGreen
        9 : Canvas.FillStyle := 'black';
        10 : Canvas.FillStyle := 'yellow';
      end;
      //Draw coloured polygon with black edges.
      Canvas.StrokeStyle := 'black';
      Canvas.BeginPath;
      Canvas.MoveToF(temppolyarray[1].x, temppolyarray[1].y);
      for var v := 2 to allpolys[i, 1] + 1 do
        Canvas.LineToF(temppolyarray[v].x, temppolyarray[v].y);
      Canvas.Fill;
      Canvas.Stroke;
      Canvas.ClosePath;
    end;
end;

end.
Programming - a skill for life!

by James Hall: L6 Age ~17