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