Tunnel: Delphi Version


{*****************************************************************************
*                                                                            *
*  Tunnel.dpr                                                                *
*  TunnelU.pas                                                               *
*                                                                            *
*  This program draws a Gouraud-shaded tunnel and allows the viewer to move  *
*  through the tunnel using keyboard controls.                               *
*                                                                            *
*****************************************************************************}
unit TunnelU;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, FGWin;
type
  TForm1 = class(TForm)
    procedure AppOnActivate(Sender: TObject);
    procedure AppIdle(Sender: TObject; var Done: Boolean);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  end;
var
  Form1: TForm1;
implementation
{$R *.DFM}
type
  POINT3D = record
    x : double;
    y : double;
    z : double;
  end;
const
  { virtual buffer dimensions }
  vbWidth = 640;
  vbHeight = 480;
  { four sides of a 20x40x100 tunnel, defined in 3D world coordinates }
  Floor : array [1..4] of POINT3D = (
    (x:-10.0; y: 0.0; z:100.0),
    (x:-10.0; y: 0.0; z:200.0),
    (x: 10.0; y: 0.0; z:200.0),
    (x: 10.0; y: 0.0; z:100.0));
  WestSide : array [1..4] of POINT3D = (
    (x:-10.0; y: 0.0; z:100.0),
    (x:-10.0; y:40.0; z:100.0),
    (x:-10.0; y:40.0; z:200.0),
    (x:-10.0; y: 0.0; z:200.0));
  EastSide : array [1..4] of POINT3D = (
    (x: 10.0; y: 0.0; z:100.0),
    (x: 10.0; y: 0.0; z:200.0),
    (x: 10.0; y:40.0; z:200.0),
    (x: 10.0; y:40.0; z:100.0));
  Ceiling : array [1..4] of POINT3D = (
    (x:-10.0; y:40.0; z:100.0),
    (x: 10.0; y:40.0; z:100.0),
    (x: 10.0; y:40.0; z:200.0),
    (x:-10.0; y:40.0; z:200.0));
  { RGB color values at each vertex of each side }
  FloorRGB : array [1..4*3] of byte =
    (192,192,192,  64, 64, 64,  64, 64, 64, 192,192,192);
  WestSideRGB : array [1..4*3] of byte =
    ( 32, 32,255,  32, 32,255,  32, 32, 96,  32, 32, 96);
  EastSideRGB : array [1..4*3] of byte =
    ( 32, 32,255,  32, 32, 96,  32, 32, 96,  32, 32,255);
  CeilingRGB : array [1..4*3] of byte =
    (192,192,192, 192,192,192,  64, 64, 64,  64, 64, 64);
  { for convenience, an array of pointers to each of the four sides }
  Faces : array [1..4] of ^POINT3D =
    (@Floor,@WestSide,@EastSide,@Ceiling);
  { a similar array of pointers to each side's RGB values }
  FacesRGB : array [1..4] of ^byte =
    (@FloorRGB,@WestSideRGB,@EastSideRGB,@CeilingRGB);
var
  dc : hDC;
  hPal : hPalette;
  hVB : integer;
  cxClient, cyClient : integer;
  hZB : integer;
  Redraw : boolean;
{*****************************************************************************
*                                                                            *
*  DrawTunnel()                                                              *
*                                                                            *
*  Draws each of the tunnel's four sides in 3D world space.                  *
*                                                                            *
*****************************************************************************}
procedure DrawTunnel;
var
  i : integer;
begin
  for i := 1 to 4 do
  begin
    fg_3Dshade(Faces[i]^,FacesRGB[i]^,4);
  end;
end;
{*****************************************************************************
*                                                                            *
*  CheckForMovement()                                                        *
*                                                                            *
*  The CheckForMovement() function checks for key presses that control the   *
*  user's movement, and if required redraws the tunnel viewed from the new   *
*  camera position. It is called from the WinMain() message loop when there  *
*  are no messages waiting.                                                  *
*                                                                            *
*****************************************************************************}
procedure CheckForMovement;
begin
  { up arrow moves viewer forward }
  if (fg_kbtest(72) = 1) then
  begin
    fg_3Dmoveforward(2.0);
    Redraw := True;
  end
  { down arrow moves viewer backward }
  else if (fg_kbtest(80) = 1) then
  begin
    fg_3Dmoveforward(-2.0);
    Redraw := True;
  end
  { right arrow turns viewer to the right }
  else if (fg_kbtest(77) = 1) then
  begin
    fg_3Drotateright(6*10);
    Redraw := True;
  end
  { left arrow turns viewer to the left }
  else if (fg_kbtest(75) = 1) then
  begin
    fg_3Drotateright(-6*10);
    Redraw := True;
  end;
  { if the viewer's position or rotation changed, redraw the tunnel }
  if (Redraw) then
  begin
    { prepare the z-buffer for the next frame }
    fg_zbframe;
    { erase the previous frame from the virtual buffer }
    fg_setcolor(-1);
    fg_fillpage;
    { draw the tunnel }
    DrawTunnel;
    { display what we just drew }
    fg_vbscale(0,vbWidth-1,0,vbHeight-1,0,cxClient-1,0,cyClient-1);
    Redraw := False;
  end;
end;
{****************************************************************************}
procedure TForm1.AppOnActivate(Sender: TObject);
begin
  fg_realize(hPal);
  Invalidate;
end;
procedure TForm1.AppIdle(Sender: Tobject; var Done: Boolean);
begin
  CheckForMovement;
  Done := False;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
  fg_realize(hPal);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
  vbDepth : integer;
begin
  dc := GetDC(Form1.Handle);
  fg_setdc(dc);
  hPal := fg_defpal;
  fg_realize(hPal);
  fg_vbinit;
  vbDepth := fg_colors;
  if (vbDepth < 16) then vbDepth := 16;
  fg_vbdepth(vbDepth);
  hVB := fg_vballoc(vbWidth,vbHeight);
  fg_vbopen(hVB);
  fg_vbcolors;
  hZB := fg_zballoc(vbWidth,vbHeight);
  fg_zbopen(hZB);
  fg_setcolor(-1);
  fg_fillpage;
  fg_3Dviewport(0,vbWidth-1,0,vbHeight-1,1.0);
  fg_3Drenderstate(FG_ZBUFFER or FG_ZCLIP);
  fg_3Dlookat(0.0,10.0,50.0,0.0,10.0,100.0);
  Redraw := True;
  Application.OnActivate := AppOnActivate;
  Application.OnIdle := AppIdle;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
  fg_vbscale(0,vbWidth-1,0,vbHeight-1,0,cxClient-1,0,cyClient-1);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
  cxClient := ClientWidth;
  cyClient := ClientHeight;
  Invalidate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  fg_vbclose;
  fg_zbfree(hZB);
  fg_vbfree(hVB);
  fg_vbfin;
  DeleteObject(hPal);
  ReleaseDC(Form1.Handle,dc);
end;
end.

<< Prev

Next >>

Contents
Fastgraph Home Page

 

copyright 2001 Ted Gruber Software, Inc.