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.
dita powered™.