openglapp.~dpr

游戏地图编辑器游戏地图编辑器游戏地图编辑器游戏地图编辑器

program OpenGLApp;

uses
  Windows,
  Forms,
  Dialogs,
  Messages,
  Classes,
  OpenGL,
  SysUtils,
  Textures;

const
  WND_TITLE = '迷宫';
  MapFileIdentifier = 'Map Editor Generated. Programed by Yang.';
  FPS_TIMER = 1;                     // Timer to calculate FPS
  FPS_INTERVAL = 500;               // Calculate FPS every 1000 ms

  DrawFloor = True;
  DrawCeiling = False;

  StepHeading = 8;
  StepGo = 0.2;

  Floor = 0;
  Wall = 1;
  Door = 2;
  Lift = 3;

  TexWidth = 4;

type
  TCoord = Record
    X, Y, Z : glFLoat;
  end;

  TFaceType = (Left, Right, Up, Down, None);

  TFace = Record
    V1, V2, V3, V4 : Integer;
    U, V : glFloat;
    TextureIndex : Integer;
  end;

  TGate = Record
    PosX, PosY : Integer;
    UpDown : boolean;
    Opened : boolean;
  end;

var
  h_Wnd  : HWND;                     // Global window handle
  h_DC   : HDC;                      // Global device context
  h_RC   : HGLRC;                    // OpenGL rendering context
  keys : Array[0..255] of Boolean;   // Holds keystrokes
  FPSCount : Integer = 0;            // Counter for FPS
  ElapsedTime : Integer;             // Elapsed time between frames
  FrameTime : Integer;

  // Textures
  Texture : Array [ 0 .. 3 ] of glUint;

  LightAmbient: array [0 .. 3 ] of GLFloat =	 ( 0.8, 0.9, 0.9, 1.0 );
  LightDiffuse : array [0 .. 3 ] of GLFloat =	( 1.0, 1.0, 1.0, 1.0 );
  LightPosition :array [0 .. 3 ] of GLFloat =	( 0.5, 0.5, 0.5, 1.0 );
  LightOn : boolean;

  // User variables
  TextureCount : Integer;
  VertexCount  : Integer;
  FaceCount    : Integer;
  Vertex : Array of TCoord;
  Face   : Array [ 0 .. 3 ] of Array of Array of TFace;
  Gates  : Array of TGate;

  MapWidth, MapHeight : integer;
  Map : array of array of integer;
  InitX, InitY : integer;

  LittleMapOn : boolean;

  X, Z : glFloat;
  HeadMovement, HeadMovAngle : glFloat;
  mpos : TPoint;
  Heading : glFloat;
  Tilt    : glFloat;

  MouseSpeed : Integer = 7;
  MoveSpeed  : glFloat = 0.03;

{$R *.RES}

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


function Min(a, b : integer):integer;
begin
  Result := a;
  if a>b then Result := b;
end;

function GetLRFaceType(dX, dY : integer): TFaceType;
begin
  Result := None;
  if ((Map[ dX-1, dY ] = Floor) and (Map[ dX, dY ] = Wall)) then
    Result := Left;
  if ((Map[ dX, dY ] = Floor) and (Map[ dX-1, dY ] = Wall)) then
    Result := Right;
end;

function GetUDFaceType(dx, dy : integer): TFaceType;
begin
  Result := None;
  if ((Map[ dx, dy-1 ] = Floor) and (Map[ dx, dy ] = Wall)) then
    Result := Up;
  if ((Map[ dx, dy ] = Floor) and (Map[ dx, dy-1 ] = Wall)) then
    Result := Down;
end;

procedure AddFace(FaceType : TFaceType; Line : integer; Start, Term : integer; ObjectType : integer);
  var len : integer;
begin
//  Showmessage(inttostr(integer(FaceType)));
  len := Length( Face[integer(FaceType)][Line-1] );
  SetLength( Face[integer(FaceType)][Line-1], Len+1 );
  with Face[integer(FaceType)][Line-1][Len] do
  begin
    U := TexWidth*(Term - Start);
    V := TexWidth;
    V1 := Start;
    V2 := Term;
    V3 := 1;
    V4 := 1;
    TextureIndex := ObjectType;
  end;
end;

procedure AddGate(dX, dY : integer);
  var len : integer;
begin
  len := Length(Gates);
  SetLength(Gates, len+1);
  with Gates[len] do
  begin
    PosY := dY;
    PosX := dX;
    Opened := False;
    if Map[dX-1, dY]=Floor then
      UpDown := False
    else
      UpDown := True;
  end;
end;

function GateNear(Index, dX, dY : integer): boolean;
begin
  with Gates[Index] do
      Result := ((abs(PosX-dX)=1) and (abs(PosY-dY)=0))
             or ((abs(PosX-dX)=0) and (abs(PosY-dY)=1));
end;

function GateOpened(dX, dY: integer): boolean;
  var i: integer;
begin
  Result := False;
  for i:= 0 to Length(Gates) do
  begin
    if (Gates[i].Opened and (Gates[i].PosX = dX) and (Gates[i].PosY = dY)) then
    begin
      Result:= True;
      exit;
    end;
  end;
end;

{------------------------------------------------------------------}
{  Load the map info from the map.txt files                        }
{------------------------------------------------------------------}
procedure LoadMap;
var F : Textfile;
    Tex : Array of String;
    S : String;
    I, J : Integer;

    mapStr : TStringList;
    FaceBeginY, FaceEndY : integer;
    FaceType, LastType : TFaceType;
    Opendialog : TOpenDialog;
begin
try

   mapStr:=TStringList.Create;

   OpenDialog := TOpendialog.Create(nil);
   OpenDialog.Filter :='*.map|*.map';
   OpenDialog.InitialDir := ExtractFilePath(Application.ExeName);

   if (not Opendialog.Execute) then
   begin
     Application.Terminate;
     exit;
   end;

   mapStr.LoadFromFile(Opendialog.FileName);

   if mapStr[0]<>MapFileIdentifier then
   begin
     showmessage('不是地图文件！');
     Application.Terminate;
     exit;
   end;

   MapWidth := StrToInt(mapStr[2]);
   MapHeight := StrToInt(mapStr[3]);
   InitX := StrToInt(mapStr[4]);
   InitY := StrToInt(mapStr[5]);
   X := -InitY+1.5;
   Z := -InitX+1.5;

   SetLength(Map, MapWidth);
   for i:= 0 to MapWidth-1 do
     SetLength(Map[i], MapHeight);

   for i:= 0 to MapHeight-1 do
     for j:= 0 to MapWidth-1 do
     begin
       try
         Map[j, i]:= Ord(mapStr[i+7][j+1])-Ord('0');
       except
         showmessage('非法字符 : '+mapStr[i+7][j+1]+' !');
         Application.Terminate;
         exit;
       end;
     end;
   mapStr.Free;

  SetLength( Face[0], MapWidth+2);
  SetLength( Face[1], MapWidth+2);
  SetLength( Face[2], MapHeight+2);
  SetLength( Face[3], MapHeight+2);

  // Begin to Generate the Left Right faces
  for i := 1 to MapWidth do
  begin
    LastType := None;

    for j := 1 to MapHeight do
    begin
      FaceType := GetLRFaceType(i, j);
      if FaceType = LastType then
      begin
          FaceEndY := j;
      end
      else
      begin
        if LastType <> None then
        begin
          AddFace(LastType, i, FaceBeginY, FaceEndY, 1);
        end;

        if FaceType <> None then
        begin
          FaceBeginY := j-1;
          FaceEndY := j;
        end;
      end;  // else

      LastType := FaceType;
    end;

    if LastType <> None then
      AddFace(LastType, i, FaceBeginY, FaceEndY, 1);

  end;  // of  for

  //  Begin to Generate Up Down Faces
  for i := 1 to MapHeight do
  begin
    for j := 1 to MapWidth do
    begin
      FaceType := GetUDFaceType(j, i);
      if FaceType = LastType then
      begin
          FaceEndY := j;
      end
      else
      begin
        if LastType <> None then
        begin
          AddFace(LastType, i, FaceBeginY, FaceEndY, 1);
        end;

        if FaceType <> None then
        begin
          FaceBeginY := j-1;
          FaceEndY := j;
        end;
      end;  // else

      LastType := FaceType;
    end;

    if LastType <> None then
      AddFace(LastType, i, FaceBeginY, FaceEndY, 1);

  end;  // of  for

  // Ganerate Gates
  for i:= 1 to MapWidth-1 do
    for j:= 1 to MapHeight-1 do
      if Map[i, j] = Door then
        AddGate(i, j);

except
  Showmessage('错误!');
  Application.Terminate;
end;

end;

procedure DrawSurface(x1, y1, x2, y2, TexIndex : integer; PicCount : integer =1);
begin
    glBindTexture(GL_TEXTURE_2D, Texture[2]);
    glBegin(GL_QUADS);
      glTexCoord(PicCount, 0);             glVertex3f(X1, 0, Y1);
      glTexCoord(PicCount, PicCount);      glVertex3f(X1, 1, Y1);
      glTexCoord(0, PicCount);             glVertex3f(X2, 1, Y2);
      glTexCoord(0, 0);                    glVertex3f(X2, 0, Y2);
    glEnd();
end;

procedure ShowFaces;
var I, J, K : Integer;
    DeltaX, DeltaY : Integer;
    PosX, PosZ : integer;
begin
  PosX := Trunc(-X );
  PosZ := Trunc(-Z );

  I :=0;
  For K :=PosZ to Length(Face[i])-1 do
  For J :=0 to Length(Face[i, k])-1 do
  with face[i][k][j] do
  begin
    DeltaX := V1 - 1;
    DeltaY := K - 1;

    glBindTexture(GL_TEXTURE_2D, Texture[TextureIndex]);
    glBegin(GL_QUADS);
      glTexCoord(U, 0);  glVertex3f(DeltaX, 0, DeltaY);
      glTexCoord(U, V);  glVertex3f(DeltaX, 1, DeltaY);
      glTexCoord(0, V);  glVertex3f(DeltaX + V2 - V1, 1, DeltaY);