home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 300-399 / ff339.lzh / PCQ / Examples / 3d.p < prev    next >
Text File  |  1990-03-19  |  6KB  |  262 lines
  1. Program ThreeDee;
  2.  
  3. {
  4.     This program has been laying around for years.  I wrote
  5.     it years ago, and I've translated it from C64 BASIC to
  6.     Turbo Pascal on the PC to BASIC, Modula-2, F-BASIC, C
  7.     and now Pascal on the Amiga.
  8.  
  9.     The process described above accounts for the odd structure
  10.     (or lack of it) in the program itself.  It has at least one
  11.     significant error (which I once found, in one version, but
  12.     I can no longer find the correction), but I included it
  13.     anyway as a demonstration of the double buffering stuff.
  14. }
  15.  
  16. {$I ":Include/Ports.i"}
  17. {$I ":Include/Graphics.i"}
  18. {$I ":Include/Intuition.i"}
  19. {$I ":Include/DoubleBuffer.i"}
  20. {$I ":Include/DeadKeyConvert.i"}
  21. {$I ":Include/ExecIO.i"}
  22. {$I ":Include/InputEvent.i"}
  23. {$I ":Include/ConsoleUtils.i"}
  24. {$I ":Include/Exec.i"}
  25.  
  26. CONST
  27.    outoff = 128.0;
  28.  
  29. TYPE
  30.    PlayerInfo = RECORD
  31.       X, Y, Z : REAL;
  32.       Elevation,
  33.       Angle,
  34.       Tilt    : REAL;
  35.    END;
  36.  
  37.    VertexInfo = RECORD
  38.     OffX,
  39.     OffY,
  40.     OffZ,
  41.     EffX,
  42.     EffY,
  43.     EffZ    : REAL;
  44.     DisplayX,
  45.     DisplayY    : Short;
  46.     Connection    : ARRAY [1..3] OF Short;
  47.    END;
  48.  
  49.    TruckInfo = RECORD
  50.       X, Y, Z,
  51.       RelX, RelY, RelZ,
  52.       Elevation,
  53.       Angle, Tilt : REAL;
  54.    END;
  55.  
  56. VAR
  57.     CX, CY, CZ,
  58.     SX, SY, SZ        : REAL;
  59.     TempX, TempY, TempZ    : REAL;
  60.     Other, Point    : INTEGER;
  61.     MyWindow        : WindowPtr;
  62.     RP            : RastPortPtr;
  63.     Term1, Term2, Term3,
  64.     Term4, Term5, Term6,
  65.     Term7, Term8    : REAL;
  66.     QuitTheProgram    : Boolean;
  67.  
  68. Const
  69.     Player : PlayerInfo = (0.0, 0.0, 0.0, 0.0, 0.0, 0.0);
  70.  
  71.     Truck : TruckInfo = (0.0, 0.0, 200.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0);
  72.  
  73.     Vertex : Array [1..8] of VertexInfo =
  74.        ((-10.0, 10.0, 25.0, 0.0, 0.0, 0.0, 0, 0, (2, 4, 8)),
  75.     ( 10.0, 10.0, 25.0, 0.0, 0.0, 0.0, 0, 0, (3, 7, 0)),
  76.     ( 10.0,-10.0, 25.0, 0.0, 0.0, 0.0, 0, 0, (4, 7, 0)),
  77.     (-10.0,-10.0, 25.0, 0.0, 0.0, 0.0, 0, 0, (8, 0, 0)),
  78.     (-10.0, 10.0,-25.0, 0.0, 0.0, 0.0, 0, 0, (0, 0, 0)),
  79.     ( 10.0, 10.0,-25.0, 0.0, 0.0, 0.0, 0, 0, (0, 0, 0)),
  80.     ( 10.0,-10.0,-25.0, 0.0, 0.0, 0.0, 0, 0, (8, 0, 0)),
  81.     (-10.0,-10.0,-25.0, 0.0, 0.0, 0.0, 0, 0, (0, 0, 0)));
  82.  
  83. Procedure GetCommand;
  84. var
  85.     IM    : IntuiMessagePtr;
  86.     Response    : Array [0..9] of Char;
  87.     Len    : Integer;
  88. BEGIN
  89.     IM:= IntuiMessagePtr(WaitPort(MyWindow^.UserPort));
  90.     IM := IntuiMessagePtr(GetMsg(MyWindow^.UserPort));
  91.     Len := DeadKeyConvert(IM, Adr(Response), 10, Nil);
  92.     ReplyMsg(MessagePtr(IM));
  93.     if Len = 1 then
  94.     QuitTheProgram := True
  95.     else if Len = 2 then
  96.     case Response[1] of
  97.       'A' : Truck.Z := Truck.Z + 5.0; { Up Arrow }
  98.       'B' : Truck.Z := Truck.Z - 5.0; { Down Arrow }
  99.       'C' : Truck.Angle := Truck.Angle + 0.08; { Right Arrow }
  100.       'D' : Truck.Angle := Truck.Angle - 0.08; { Left Arrow }
  101.       'T' : with Player do begin
  102.             Z := Z + cos(Angle) * 5.0; { Shift Up }
  103.             X := X + sin(Angle) * 5.0;
  104.         end;
  105.       'S' : with Player do begin
  106.             Z := Z - cos(Angle) * 5.0; { Shift Down }
  107.             X := X - sin(Angle) * 5.0;
  108.         end;
  109.     else
  110.         DisplayBeep(Nil);
  111.      end
  112.     else if Len = 3 then
  113.     case Response[2] of
  114.       'A' : Player.Angle := Player.Angle + 0.08; { Shift Right }
  115.       '@' : Player.Angle := Player.Angle - 0.08; { Shift Left }
  116.     else
  117.         DisplayBeep(Nil)
  118.     end;
  119. end;
  120.  
  121. Procedure OpenTheWindow;
  122. var
  123.     ns : NewScreen;
  124. begin
  125.     with ns do begin
  126.     LeftEdge := 0;
  127.     TopEdge  := 0;
  128.     Width    := 640;
  129.     Height   := 200;
  130.     Depth    := 2;
  131.     DetailPen := 3;
  132.     BlockPen  := 2;
  133.     ViewModes := 32768;
  134.     SType     := CUSTOMSCREEN_f;
  135.     Font      := nil;
  136.     DefaultTitle := "";
  137.     Gadgets   := nil;
  138.     CustomBitMap := nil;
  139.     end;
  140.     MyWindow := OpenDoubleBuffer(Adr(ns));
  141.     if MyWindow = Nil then
  142.     Exit(20);
  143.     ModifyIDCMP(MyWindow, RAWKEY_f);
  144. end;
  145.  
  146. begin
  147.     GfxBase:= OpenLibrary("graphics.library", 0);
  148.     OpenTheWindow;
  149.     OpenConsoleDevice;
  150.     RP:= MyWindow^.RPort;
  151.     SetAPen(RP, 1);
  152.  
  153.     QuitTheProgram := False;
  154.  
  155.     while not QuitTheProgram do begin
  156.  
  157.     { Normalize relative to Player position }
  158.  
  159.     with Truck do begin
  160.         RelX:= X - Player.X;
  161.         RelY:= Y - Player.Y;
  162.         RelZ:= Z - Player.Z;
  163.     end;
  164.  
  165.     { Rotate to Player's point of view }
  166.  
  167.     with Player do begin
  168.         CX := cos(-Elevation);
  169.         CY := cos(-Angle);
  170.         CZ := cos(-Tilt);
  171.         SX := sin(-Elevation);
  172.         SY := sin(-Angle);
  173.         SZ := sin(-Tilt);
  174.     end;
  175.     with Truck do begin
  176.         TempX := RelX*(CY*CZ) - RelY*(CY*SZ) - RelZ*SY;
  177.         TempY := RelX*(CX*SZ - SX*SY*CZ) + RelY*(CX*CZ + SX*SY*SZ) -
  178.             RelZ*(SX*CY);
  179.         TempZ := RelX*(SX*SZ + CX*SY*CZ) + RelY*(SX*CZ-CX*SY*SZ) +
  180.             RelZ*CX*CY;
  181.         RelX:= TempX;
  182.         RelY:= TempY;
  183.         RelZ:= TempZ;
  184.     end;
  185.  
  186.     if Truck.RelZ > 0.0 then begin { if it's in front of us }
  187.  
  188.         { Get attitude }
  189.  
  190.         with Truck do begin
  191.         CX:= cos(-Elevation);
  192.         CY:= cos(Angle - Player.Angle);
  193.         CZ:= cos(-Tilt);
  194.         SX:= sin(-Elevation);
  195.         SY:= sin(Angle - Player.Angle);
  196.         SZ:= sin(-Tilt);
  197.         end;
  198.  
  199.     { Each point is rotated the same angles, so we'll figure
  200.       these once }
  201.  
  202.         Term1:= CY*CZ;
  203.         Term2:= CY*SZ;
  204.         Term3:= CX*SZ - SX*SY*CZ;
  205.         Term4:= CX*CZ + SX*SY*SZ;
  206.         Term5:= SX*CY;
  207.         Term6:= SX*SZ + CX*SY*CZ;
  208.         Term7:= SX*CZ - CX*SY*SZ;
  209.         Term8:= CX*CY;
  210.  
  211.     { Figure the coordinates of all the points, all at once }
  212.  
  213.         For Point := 1 to 8 do
  214.         with Vertex[Point] do begin
  215.  
  216.             EffX := OffX * Term1 - OffY * Term2 - OffZ * SY + Truck.RelX;
  217.             EffY := OffX * Term3 + OffY * Term4 - OffZ * Term5 + Truck.RelY;
  218.             EffZ := OffX * Term6 + OffY * Term7 + OffZ * Term8 + Truck.RelZ;
  219.  
  220.             if EffZ < 1.0 then
  221.             EffZ := 1.0; { avoid blowups }
  222.  
  223.             TempX := outoff * EffX / EffZ;
  224.             TempY := outoff * EffY / EffZ;
  225.  
  226.             if TempX > 32000.0 then
  227.             TempX:= 32000.0
  228.             else if TempX < -32000.0 then
  229.             TempX:= -32000.0;
  230.             if TempY > 32000.0 then
  231.             TempY:= 32000.0
  232.             else if TempY < -32000.0 then
  233.             TempY:= -32000.0;
  234.  
  235.             DisplayX := 320 + TRUNC(TempX);
  236.             DisplayY := 100 + (TRUNC(TempY) div 2)
  237.         end;
  238.  
  239.         SetRast(RP, 0); { Clear background raster }
  240.  
  241.     { Draw all the edges }
  242.  
  243.         for Point:= 1 to 8 do
  244.         with Vertex[Point] do
  245.             for Other:= 1 to 3 do
  246.             if Connection[Other] > 0 then begin
  247.                 Move(RP, DisplayX, DisplayY);
  248.                 Draw(RP, Vertex[Connection[Other]].DisplayX,
  249.                     Vertex[Connection[Other]].DisplayY);
  250.             end;
  251.  
  252.     end else { Behind, so erase it }
  253.         SetRast(RP, 0);
  254.  
  255.     SwapBuffers(MyWindow); { Actually display what we've done }
  256.     GetCommand; { And get next position }
  257.     end;
  258.  
  259.     CloseDoubleBuffer(MyWindow);
  260.     CloseLibrary(GfxBase);
  261. end.
  262.