democode.pas

delphi与图形学结合的一个小程虚

unit demoCode;


interface

Uses OpenGL, Windows, Textures;

var ElapsedTime : Integer;
    base : glUint;                // base to the font display lists

  procedure initData;
  procedure drawDemo;


implementation

procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32;

const // Blob Constants
      xRows =48;
      yRows =16;
      numVertices = 2*yrows*xrows+xrows+2;   //842;
      numTriangles = 2*xrows+yrows*xrows*4;  //1680;

const TUNNEL_SPEED = 1/50;
      PI_8 = 0.3926990816987;    // PI/8

type TNormal = record
       X, Y, Z : glFloat;             // X, Y, Z coordinates
     end;
     TVertex = record
       X, Y, Z : glFloat;             // X, Y, Z coordinates
     end;
     TTexCoord = record
       U, V : glFloat;                // U and V Texture coordinates
     end;
     TTriangle = record
       V : Array[0..2] of Integer;     // Vertices
       T : Array[0..2] of TTexCoord;   // Texture coordinates
       n : TNormal;                    // Triangle normal
     end;
     TBlob = Record
       vertex : Array[0..numVertices-1] of TVertex;
       Triangle : Array[0..numTriangles-1] of TTriangle;
     end;

//--- Textures  ---//
var ColorsTex : glUint;
    BlueTex   : glUint;

//--- User variables ---//
var Blob : TBlob;
    Sphere : TBlob;
    LU : Array[0..numVertices-1] of TVertex;   // blob lookup tables
    Tunnels : Array[0..64, 0..32] of TVertex;
    CubeDL : glUint;


{------------------------------------------------------------------}
{  Function to do an arctan                                        }
{------------------------------------------------------------------}
function ArcTan(X, Y : glFloat) : glFloat;
asm
  FLD     Y
  FLD     X
  FPATAN
  FWAIT
end;


procedure glWrite(X, Y : GLUint; text : PChar);
var drawRect : TRect;
begin
  glPushAttrib(GL_DEPTH_TEST);  // Save the current Depth test settings (Used for blending )
  glDisable(GL_DEPTH_TEST);     // Turn off depth testing (otherwise we get no FPS)
  glDisable(GL_TEXTURE_2D);     // Turn off textures, don't want our text textured
  glMatrixMode(GL_PROJECTION);  // Switch to the projection matrix
  glPushMatrix();               // Save current projection matrix
  glLoadIdentity();

  GetWindowRect(GetDesktopWindow(), drawRect);  // Get current window size
  glOrtho(0, drawRect.right, 0, drawRect.bottom, -1, 1);  // Change the projection matrix using an orthgraphic projection
  glMatrixMode(GL_MODELVIEW);  // Return to the modelview matrix
  glPushMatrix();              // Save the current modelview matrix
  glLoadIdentity();
  glColor3f(1.0, 1.0, 1.0);    // Text color

  glRasterPos2i(X, Y);                                // Position the Text
  glPushAttrib(GL_LIST_BIT);                          // Save's the current base list
  glListBase(base - 32);                              // Set the base list to our character list
  glCallLists(length(text), GL_UNSIGNED_BYTE, PChar(text));  // Display the text
  glPopAttrib();                                      // Restore the old base list

  glMatrixMode(GL_PROJECTION);  //Switch to projection matrix
  glPopMatrix();                // Restore the old projection matrix
  glMatrixMode(GL_MODELVIEW);   // Return to modelview matrix
  glPopMatrix();                // Restore old modelview matrix
  glEnable(GL_TEXTURE_2D);      // Turn on textures, don't want our text textured
  glPopAttrib();                // Restore depth testing
end;


{------------------------------------------------------------------}
{  Function to normalize a vector                                  }
{------------------------------------------------------------------}
procedure Normalize(var vector : TNormal);
var length : glFLoat;
begin
  // Calculates The Length Of The Vector
  length := sqrt((vector.X*vector.X) + (vector.Y*vector.Y) + (vector.Z*vector.Z));
  if Length = 0 then
    Length :=1;

  vector.X :=vector.X / length;
  vector.Y :=vector.Y / length;
  vector.Z :=vector.Z / length;
end;


{------------------------------------------------------------------}
{  Function to calculate the normal given 2 vectors (3 vertices)   }
{------------------------------------------------------------------}
function calcNormal(const v : Array of TVertex) : TNormal;
var a, b : TVertex;
begin
  // Calculate The Vector From Point 1 To Point 0
  a.X := V[0].X - V[1].X;
  a.Y := V[0].Y - V[1].Y;
  a.Z := V[0].Z - V[1].Z;
  // Calculate The Vector From Point 2 To Point 1
  b.X := V[1].X - V[2].X;
  b.Y := V[1].Y - V[2].Y;
  b.Z := V[1].Z - V[2].Z;
  // Compute The Cross Product To Give Us A Surface Normal
  result.X := a.Y*b.Z - a.Z*b.Y;      	// Cross Product For Y - Z
  result.Y := a.Z*b.X - a.X*b.Z;      	// Cross Product For Z - X
  result.Z := a.X*b.Y - a.Y*b.X;      	// Cross Product For X - Y

  Normalize(result);	 			// Normalize The Vectors
end;


{------------------------------------------------------------------}
{  Function to create a sphere                                     }
{------------------------------------------------------------------}
procedure CreateSphere(var obj : TBlob);
const R = 10;
      yRing =yRows*4 + 4;
      uTex = 3.0 / (xRows);
      vTex = 3.0 / (3+2*yRows);
var X, Y, I, J : Integer;
    yLevel, Radius : glFloat;
    offset : Integer;
begin
  // Top center
  obj.vertex[0].x := 0;
  obj.vertex[0].z := 0;
  obj.vertex[0].y := -r;
  offset := 1;

  // Top half and center
  for Y :=0 to yRows do
  begin
    yLevel := -r*cos(2*pi*(y+1) / yring);
    radius := r*sin(2*pi*(y+1) / yring);

    for X :=0 to xRows-1 do
    begin
      obj.vertex[offset].x := radius * sin(2*pi*x / xRows);
      obj.vertex[offset].z := radius * cos(2*pi*x / xRows);
      obj.vertex[offset].y := yLevel;
      Inc(offset);
    end;
  end;

  // Bottom half
  for Y :=0 to yRows-1 do
  begin
    yLevel := r*sin(2*pi*(y+1) / yring);
    radius := r*cos(2*pi*(y+1) / yring);

    for X :=0 to xRows-1 do
    begin
      obj.vertex[offset].x := radius * sin(2*pi*x / xRows);
      obj.vertex[offset].z := radius * cos(2*pi*x / xRows);
      obj.vertex[offset].y := ylevel;
      Inc(offset);
    end;
  end;

  // Bottom center
  obj.vertex[offset].x := 0;
  obj.vertex[offset].z := 0;
  obj.vertex[offset].y := r;

  with Obj do
  begin
    for i :=0 to xRows-1 do
    begin
      Triangle[i].v[0] := 0;
      Triangle[i].v[1] := (i+1) MOD xRows +1;
      Triangle[i].v[2] := (i+1);

      Triangle[i].T[0].u := 0.5;
      Triangle[i].T[0].v := 0.0;
      Triangle[i].T[1].u := (i+1)*uTex;
      Triangle[i].T[1].v := vTex;
      Triangle[i].T[2].u := i*uTex;
      Triangle[i].T[2].v := vTex;
    end;

    for J :=0 to yRows*2 -1 do
    begin
      for I :=0 to xRows-1 do
      begin
        offset := xRows+(i+j*xRows)*2;
        Triangle[offset].v[0] := j*xRows+1 + i;
        Triangle[offset].v[1] := j*xRows+1 + (i+1) MOD xRows;
        Triangle[offset].v[2] := j*xRows+1 + i +xRows;

        Triangle[offset].T[0].u := i*uTex;
        Triangle[offset].T[0].v := (1+j) * vTex;
        Triangle[offset].T[1].u := (1+i) * uTex;
        Triangle[offset].T[1].v := (1+j) * vTex;
        Triangle[offset].T[2].u := i     * uTex;
        Triangle[offset].T[2].v := (2+j) * vTex;

        offset := xRows+(i+j*xRows)*2 + 1;
        Triangle[offset].v[0] := j*xRows+1+ (i+1) MOD xRows;
        Triangle[offset].v[1] := j*xRows+1+ (i+1) MOD xRows + xRows;
        Triangle[offset].v[2] := j*xRows+1+   i+xRows;

        Triangle[offset].T[0].u := (i+1) * uTex;
        Triangle[offset].T[0].v := (1+j) * vTex;
        Triangle[offset].T[1].u := (i+1) * uTex;
        Triangle[offset].T[1].v := (2+j) * vTex;
        Triangle[offset].T[2].u := i     * uTex;
        Triangle[offset].T[2].v := (2+j) * vTex;
      end;

      for i := 0 to xRows-1 do
      begin
        offset := xRows+xRows*2*yRows*2 + i;
        Triangle[offset].v[0] := 2*yRows*xRows+1+i;
        Triangle[offset].v[1] := 2*yRows*xRows+1+ (i+1) MOD xRows;
        Triangle[offset].v[2] := 2*yRows*xRows+1+xRows;

        Triangle[offset].T[0].u := i           * uTex;
        Triangle[offset].T[0].v := (yRows*2+1) * vTex;
        Triangle[offset].T[1].u := (i+1)       * uTex;
        Triangle[offset].T[1].v := (yRows*2+1) * vTex;
        Triangle[offset].T[2].u := 0.5;
        Triangle[offset].T[2].v := 1.0;
      end;
    end;
  end;

  // Calculate Normals
  for i :=0 to numTriangles-1 do
    obj.triangle[i].n :=calcNormal([Obj.Vertex[Obj.Triangle[i].V[0]], Obj.Vertex[Obj.Triangle[i].V[1]], Obj.Vertex[Obj.Triangle[i].V[2]]]);
end;


{------------------------------------------------------------------}
{  Function to draw the blob (warped sphere)                       }
{------------------------------------------------------------------}
procedure RenderBlob(const obj : TBlob);
var I : Integer;
begin
  glBindTexture (GL_TEXTURE_2D, ColorsTex);
  glBegin (GL_TRIANGLES);
    begin
      for I :=0 to numTriangles-1 do
      begin
        with obj.Triangle[i] do
        begin
          glTexCoord2f(T[0].u, T[0].v);
          glVertex3f(obj.vertex[v[0]].x, obj.vertex[v[0]].y, obj.vertex[v[0]].z);

          glTexCoord2f (T[1].u, T[1].v);
          glVertex3f (obj.vertex[v[1]].x, obj.vertex[v[1]].y, obj.vertex[v[1]].z);

          glTexCoord2f (T[2].u, T[2].v);
          glVertex3f (obj.vertex[v[2]].x, obj.vertex[v[2]].y, obj.vertex[v[2]].z);
        end;
      end;
    end;
  glEnd();
end;


{------------------------------------------------------------------}
{  Draw the bouncing blob                                          }
{------------------------------------------------------------------}
procedure drawBlob;
var DemoTime : Integer;
    X, Y, C : glFloat;
    I : Integer;
begin
  DemoTime :=ElapsedTime - 4000;

  // --- Drawing the Blob and Rectangle --- //
  glDisable(GL_BLEND);
  glEnable(GL_DEPTH_TEST);
  glColor3f(1.0, 1.0, 1.0);

  // bring in BLob
  if DemoTime < 16900 then
  begin
    X :=DemoTime/250;
    if X > 2 then X :=2;
    glScale(X, X, 1);
  end
  else    // fly away blob
  begin
    X :=(18000 - DemoTime)/500;
    glScale(X, X, 1);
  end;

  glTranslate(0, 0, -2);

  // Rectangle (blob frame)
  glDisable(GL_TEXTURE_2D);
  glLineWidth(3);
  glBegin(GL_LINE_LOOP);
    glVertex3f(-0.32, -0.28, 0.0);
    glVertex3f( 0.32, -0.28, 0.0);
    glVertex3f( 0.32,  0.28, 0.0);
    glVertex3f(-0.32,  0.28, 0.0);
  glEnd;
  glEnable(GL_TEXTURE_2D);

  // Blob
  if (DemoTime > 2800) AND (DemoTime < 10400) OR
     (DemoTime > 10800) AND (DemoTime < 17000) then
    glTranslate(0, 0, abs(0.7*sin(DemoTime/400*pi)));