heightmap.dpr

此為國外大名鼎鼎的2D遊戲引擎HGE的Delphi版本 原官方是C++的,現在完全改為Delphi可使用,另外再增加許多單元與功能 新增的單元有HGEImages,HGECanvas,HGEDef

program HeightMap;

{$R *.res}

uses
  Windows,  SysUtils,  Classes,  HGEImages,  HGECanvas, HGEDef,
  MMSystem, Math, HGE;

const
  MAPXSIZE = 100; MAPYSIZE = 120;
  ROCKPIC = 1; GRASSPIC = 0; WATERPIC = 2;
  MUDPIC = 3; GRASSPIC2 = 4;
  BACKMUD = 6; playerPIC = 7; PALMPIC = 8;

  NUMLAYERS = 5; // only using 4 at the moment
  e = 230; // the normal darkness level. Make your textures quite bright and it works fine
  SCRWIDTH = 800;
  SCRHEIGHT = 600;

type
  Tcell = record
    Alpha: Integer;
    PicNumber: Integer;
    CellNumber: Integer;
  end;

  TPlanes = record
    Plane: array[0..MAPXSIZE + 1, 0..MAPYSIZE + 1] of Tcell;
    CurrentImage: Integer;
  end;

  TMapInfo = record
      { Following three affect all layers equally }
    Ph: array[0..MAPXSIZE + 1, 0..MAPYSIZE + 1] of Integer; // height of the vertices
    Darkness: array[0..MAPXSIZE + 1, 0..MAPYSIZE + 1] of Integer; // darkness of the vertices
    ContainsObject: array[0..MAPXSIZE + 1, 0..MAPYSIZE + 1] of Boolean; // Does this tile have an object, then seacrh wich one
    ExternalLight: array[0..MAPXSIZE + 1, 0..MAPYSIZE + 1] of Integer; // Add to darkness calculations

    Layers: array[1..NUMLAYERS] of TPlanes; // 1 rock, 2 grass, 3 dirt, 4 objects, 5 canopy
    CurrentLayer: Integer; // 1..5
    ShowCursorTime: Cardinal;
    EditTimer: Cardinal; // prevent from editing too quickly
    Cutoff: Integer; // point at what alpha to start drawing. Setting it high prevents drawing speeding up gfx
  end;
  // probably better to have polayer as another object in the ObjectList
  TPlayer = record
    Tx, Ty: Integer;
    Fx, Fy: real;
    PicNum: Integer;
    CellPic: Integer;
    CellReal: Double;
    Anim: Cardinal;
    HasNotDrawnThisFrame: Boolean; //only update player once, even though he has to drawn a few times each frame
    MoveDir: Integer; //0,1,2,3,4 still, east, south, west, north
  end;
  // Like trees etc
  TGroundObject = class
    Tx, Ty: Integer;
    Fx, Fy: Integer;
    PicNum: Integer;
    CellPic: Integer;
  end;

var
  HGE: IHGE = nil;
  Images: THGEimages;
  Canvas: THGECanvas;
  Font: TSysFont;
  CellX, CellY: Integer; // where mouse cursor is
  Blendmode: Integer;
  MapInfo: TMapInfo; // contains all the map information
  PlateauHeight: Integer; //
  LEFTOFFSET: Double; // Where left and top of the world is
  TOPOFFSET: Double;
  TileWidth: Integer; // size of tiles
  TileHeight: Integer;
  Player: TPlayer;
  ShowCheckers: Boolean; // checker mode
  ObjectList: Tlist; // contains the trees
  ObjectInst: TGroundObject;
  MouseX, MouseY: Single;
  Event:THGEInputEvent;

function Dan_Limit(Num, Min, Max: Integer): Integer;
begin
  if Num < Min then Result := Min
  else if Num > Max then Result := Max
  else Result := Num;
end;

procedure CentrePlayer;
begin
    // move the world and keep the player centred
  LEFTOFFSET := -1 * (Player.Tx * TileWidth) + 400 - (Player.Fx);
  TOPOFFSET := -1 * (Player.Ty * TileHeight) + 300 - (Player.Fy);
end;

procedure DoMouseAndKeyboard;
var
  deltaX, deltaY: Double; // speed at which player moves
  StdSpeed: Integer; // pixels per second
  OldFx, OldFy: Double; // Starting pos on tile. Go back if illegal move
begin

  Player.MoveDir := 0;
  if HGE.Input_GetKeyState(HGEK_UP) or
    HGE.Input_GetKeyState(HGEK_LEFT) or
    HGE.Input_GetKeyState(HGEK_RIGHT) or
    HGE.Input_GetKeyState(HGEK_DOWN) then
  begin
    StdSpeed := 1; // speed of the player
    deltaX := (StdSpeed) * 5; // the size of the movement based on speed of rendering
    deltaY := (StdSpeed) * 5; // run slower up teh screen

    OldFx := Player.Fx;
    OldFy := Player.Fy;
    if HGE.Input_GetKeyState(HGEK_RIGHT) then begin Player.Fx := Trunc(Player.Fx + deltaX); Player.MoveDir := 1; end;
    if HGE.Input_GetKeyState(HGEK_LEFT) then begin Player.Fx := Trunc(Player.Fx - deltaX); Player.MoveDir := 3; end;
    if HGE.Input_GetKeyState(HGEK_UP) then begin Player.Fy := Trunc(Player.Fy - deltaY); Player.MoveDir := 4; end;
    if HGE.Input_GetKeyState(HGEK_DOWN) then begin Player.Fy := Trunc(Player.Fy + deltaY); Player.MoveDir := 2; end;
    // don't go over the bounds of the map
    if (Player.Fx < 0) and (Player.Tx <= 1) then Player.Fx := OldFx;
    if (Player.Fx >= TileWidth - 1) and (Player.Tx >= MAPXSIZE - 2) then Player.Fx := OldFx;
    if (Player.Fy < 0) and (Player.Ty <= 4) then Player.Fy := OldFy;
    if (Player.Fy >= TileHeight - 1) and (Player.Ty >= MAPYSIZE - 5) then Player.Fy := OldFy;

   //  if tile goes off the tile then recalculate what tile they are in
   //  and change the fine X and Y coordinates within that new tile
    if (Player.Fx >= TileWidth - 1) or (Player.Fx < 0) then
    begin
      Player.Tx := ((Player.Tx * TileWidth) + Trunc(Player.Fx)) div TileWidth;

      if (Player.Fx >= TileWidth) then Player.Fx := Player.Fx - TileWidth
      else
        if (Player.Fx < 0) then Player.Fx := Player.Fx + TileWidth;
    end;
   // if the fine Y coord goes off the tile
   // recalculate the the actual tile that the player is in
   // and reset the fine Y coord
    if (Player.Fy >= TileHeight) or (Player.Fy < 0) then
    begin
      Player.Ty := (((Player.Ty * TileHeight) + Trunc(Player.Fy)) div TileHeight);
      if (Player.Fy >= TileHeight) then Player.Fy := Player.Fy - TileHeight
      else
        if (Player.Fy < 0) then Player.Fy := Player.Fy + TileHeight;
    end;
    CentrePlayer;
  end; //  if OmegaInput1.Keyboard.States <> [] then

 // shift the screen around with the mouse
  if MouseX < (10) then LEFTOFFSET := LEFTOFFSET + 20;
  if MouseX > (SCRWIDTH - 10) then LEFTOFFSET := LEFTOFFSET - 20;
  if MouseY < (10) then TOPOFFSET := TOPOFFSET + 20;
  if MouseY > (SCRHEIGHT - 10) then TOPOFFSET := TOPOFFSET - 20;

  // work out where left and top of the world is
  if LEFTOFFSET > 0 then LEFTOFFSET := 0;
  if TOPOFFSET > -120 then TOPOFFSET := -120;
  if TOPOFFSET < -1 * ((TileHeight * MAPYSIZE) - (SCRHEIGHT + 60)) then TOPOFFSET := -1 * ((TileHeight * MAPYSIZE) - (SCRHEIGHT + 60));
  if LEFTOFFSET < -1 * ((TileWidth * MAPXSIZE) - (SCRWIDTH + 60)) then LEFTOFFSET := -1 * ((TileWidth * MAPXSIZE) - (SCRWIDTH + 60));
end;

function DrawLowerRocks(X, Y, PosX, PosY, dk1, dk2, dk3, dk4: Integer): Boolean; // true is did draw
var
  a, b, c, d: Integer;
begin
  Result := False;
  if (PosY - MapInfo.Ph[X, Y] > SCRHEIGHT) or (PosY + TileHeight - MapInfo.Ph[X, Y + 1] < -30) then exit;

  if (MapInfo.Layers[1].Plane[X, Y].Alpha > 1) then // alpha value higher than zero, i.e. does layer contain visible info?
  begin
    a := MapInfo.Layers[1].Plane[X, Y].Alpha; // get the alpha values for these vertices
    b := MapInfo.Layers[1].Plane[X + 1, Y].Alpha;
    c := MapInfo.Layers[1].Plane[X + 1, Y + 1].Alpha;
    d := MapInfo.Layers[1].Plane[X, Y + 1].Alpha;

    Canvas.Draw4V(Images[MapInfo.Layers[1].Plane[X, Y].PicNumber],
      MapInfo.Layers[1].Plane[X, Y].CellNumber,
      PosX, PosY - MapInfo.Ph[X, Y],
      PosX + TileWidth, PosY - MapInfo.Ph[X + 1, Y],
      PosX + TileWidth, PosY + TileHeight - MapInfo.Ph[X + 1, Y + 1],
      PosX, PosY + TileHeight - MapInfo.Ph[X, Y + 1],
      False, False,
      ARGB(a, dk1, dk1, dk1),
      ARGB(b, dk2, dk2, dk2),
      ARGB(c, dk3, dk3, dk3),
      ARGB(d, dk4, dk4, dk4),
      Blend_Default);
  end;
  Result := True;
end;

procedure DrawGrass1(X, Y, PosX, PosY, dk1, dk2, dk3, dk4: Integer);
var
  a, b, c, d: Integer;
begin
  if (PosY - MapInfo.Ph[X, Y] > SCRHEIGHT) or (PosY + TileHeight - MapInfo.Ph[X, Y + 1] < -30) then exit;

  if (MapInfo.Layers[2].Plane[X, Y].Alpha > MapInfo.Cutoff) then // alpha value higher than zero, i.e. does layer contain visible info?
  begin
    a := MapInfo.Layers[2].Plane[X, Y].Alpha; // get the alpha values for these vertices
    b := MapInfo.Layers[2].Plane[X + 1, Y].Alpha;
    c := MapInfo.Layers[2].Plane[X + 1, Y + 1].Alpha;
    d := MapInfo.Layers[2].Plane[X, Y + 1].Alpha;

      Canvas.Draw4V(Images[MapInfo.Layers[2].Plane[X, Y].PicNumber],
      MapInfo.Layers[2].Plane[X, Y].CellNumber,
      PosX, PosY - MapInfo.Ph[X, Y],
      PosX + TileWidth, PosY - MapInfo.Ph[X + 1, Y],
      PosX + TileWidth, PosY + TileHeight - MapInfo.Ph[X + 1, Y + 1],
      PosX, PosY + TileHeight - MapInfo.Ph[X, Y + 1],
      False, False,
      ARGB(a, dk1, dk1, dk1),
      ARGB(b, dk2, dk2, dk2),
      ARGB(c, dk3, dk3, dk3),
      ARGB(d, dk4, dk4, dk4),
      Blend_Default);
  end;
end;

procedure DrawWater(X, Y, PosX, PosY, dk1, dk2, dk3, dk4: Integer);
var
  a, b, c, d: Integer;
begin
  if (PosY - MapInfo.Ph[X, Y] > SCRHEIGHT) or (PosY + TileHeight - MapInfo.Ph[X, Y + 1] < -30) then exit;

  if (MapInfo.Layers[3].Plane[X, Y].Alpha > MapInfo.Cutoff) then // alpha value higher than zero, i.e. does layer contain visible info?
  begin
    a := MapInfo.Layers[3].Plane[X, Y].Alpha; // get the alpha values for these vertices
    b := MapInfo.Layers[3].Plane[X + 1, Y].Alpha;
    c := MapInfo.Layers[3].Plane[X + 1, Y + 1].Alpha;
    d := MapInfo.Layers[3].Plane[X, Y + 1].Alpha;
    // the actual drawing of tiles
      Canvas.Draw4V(Images[MapInfo.Layers[3].Plane[X, Y].PicNumber],
      MapInfo.Layers[3].Plane[X, Y].CellNumber,
      PosX, PosY - MapInfo.Ph[X, Y],
      PosX + TileWidth, PosY - MapInfo.Ph[X + 1, Y],
      PosX + TileWidth, PosY + TileHeight - MapInfo.Ph[X + 1, Y + 1],
      PosX, PosY + TileHeight - MapInfo.Ph[X, Y + 1],
      False, False,
      ARGB(a, dk1, dk1, dk1),
      ARGB(b, dk2, dk2, dk2),
      ARGB(c, dk3, dk3, dk3),
      ARGB(d, dk4, dk4, dk4),
      Blend_Default);
  end;
end;

procedure DrawMud(X, Y, PosX, PosY, dk1, dk2, dk3, dk4: Integer);
var
  a, b, c, d: Integer;
begin
  if (PosY - MapInfo.Ph[X, Y] > SCRHEIGHT) or (PosY + TileHeight - MapInfo.Ph[X, Y + 1] < -30) then exit;

  if (MapInfo.Layers[4].Plane[X, Y].Alpha > MapInfo.Cutoff) then // alpha value higher than zero, i.e. does layer contain visible info?
  begin
    a := MapInfo.Layers[4].Plane[X, Y].Alpha; // get the alpha values for these vertices
    b := MapInfo.Layers[4].Plane[X + 1, Y].Alpha;
    c := MapInfo.Layers[4].Plane[X + 1, Y + 1].Alpha;
    d := MapInfo.Layers[4].Plane[X, Y + 1].Alpha;
    // the actual drawing of tiles
      Canvas.Draw4V(Images[MapInfo.Layers[4].Plane[X, Y].PicNumber],
      MapInfo.Layers[4].Plane[X, Y].CellNumber,
      PosX, PosY - MapInfo.Ph[X, Y],
      PosX + TileWidth, PosY - MapInfo.Ph[X + 1, Y],
      PosX + TileWidth, PosY + TileHeight - MapInfo.Ph[X + 1, Y + 1],
      PosX, PosY + TileHeight - MapInfo.Ph[X, Y + 1],
      False, False,
      ARGB(a, dk1, dk1, dk1),
      ARGB(b, dk2, dk2, dk2),
      ARGB(c, dk3, dk3, dk3),
      ARGB(d, dk4, dk4, dk4),
      Blend_Default);
   end;
end;
// checker mode

procedure DrawCheckers(X, Y, PosX, PosY, dk1, dk2, dk3, dk4: Integer);
var
  a, b, c, d: Integer;
begin
  if (MapInfo.Layers[5].Plane[X, Y].Alpha > 10) then // alpha value higher than zero, i.e. does layer contain visible info?
  begin
    a := MapInfo.Layers[5].Plane[X, Y].Alpha; // get the alpha values for these vertices
    b := MapInfo.Layers[5].Plane[X + 1, Y].Alpha;
    c := MapInfo.Layers[5].Plane[X + 1, Y + 1].Alpha;
    d := MapInfo.Layers[5].Plane[X, Y + 1].Alpha;

    // the actual drawing of tiles

     Canvas.Draw4V(Images[MapInfo.Layers[5].Plane[X, Y].PicNumber],
      MapInfo.Layers[5].Plane[X, Y].CellNumber,
      PosX, PosY - MapInfo.Ph[X, Y],
      PosX + TileWidth, PosY - MapInfo.Ph[X + 1, Y],
      PosX + TileWidth, PosY + TileHeight - MapInfo.Ph[X + 1, Y + 1],
      PosX, PosY + TileHeight - MapInfo.Ph[X, Y + 1],
      False, False,
      ARGB(a, dk1, dk1, dk1),
      ARGB(b, dk2, dk2, dk2),
      ARGB(c, dk3, dk3, dk3),
      ARGB(d, dk4, dk4, dk4),
      Blend_Default);
  end;
end;

//------------------------------------------------------------------------------
// GetplayerPosition     (Codetapper)
//
// tL = Height at top left vertex
// tR = Height at top right vertex
// bL = Height at bottom left vertex
// bR = Height at bottom right vertex
// percX = Percentage in from the left of the tile (range 0 - 1)
// percY = Percentage down from the top of the tile (range 0 - 1)
// TileWidth = Gap between each tile (horizontally)
// TileDepth = Gap between each tile (backwards, into the screen)
//------------------------------------------------------------------------------
procedure GetplayerPosition(tL, tR, bL, bR: Double; percX, PercY: Double; var newX, newY: Integer);
var
  bXMidpoint, tXMidpoint: real; HeightMidpoint: Integer;
begin
  tXMidpoint := tL + (percX * (tR - tL));
  bXMidpoint := bL + (percX * (bR - bL));
  HeightMidpoint := Round(tXMidpoint + (PercY * (bXMidpoint - tXMidpoint)));

  newX := Round(percX * TileWidth);
  newY := HeightMidpoint;
end;

//------------------------------------------------------------------------------
// draw the player
//------------------------------------------------------------------------------

procedure Drawplayer(X, Y: Integer; PosX, PosY: Integer);
var
  vertex: array[1..4] of Double;
  PercentageDownTile, PercentageAcrossTile: Double;
begin
  PercentageDownTile := (Player.Fy / TileHeight);
  PercentageAcrossTile := (Player.Fx / TileWidth);

  vertex[1] := PosY - MapInfo.Ph[X, Y];
  vertex[2] := PosY - MapInfo.Ph[X + 1, Y];
  vertex[3] := PosY + TileHeight - MapInfo.Ph[X + 1, Y + 1];
  vertex[4] := PosY + TileHeight - MapInfo.Ph[X, Y + 1];

  GetplayerPosition(vertex[1], vertex[2], vertex[4], vertex[3], PercentageAcrossTile, PercentageDownTile, PosX, PosY);
  PosX := PosX + Trunc(LEFTOFFSET + (X * TileWidth));

  if (Player.MoveDir <> 0) and (Player.HasNotDrawnThisFrame) then
  begin
    Player.HasNotDrawnThisFrame := False;
    Player.Anim := timeGetTime + 10;

     // update the animation of player. Double makes for smoother animation
    Player.CellReal := Player.CellReal + (0.55);
    if Player.CellReal > Images.Items[Player.PicNum].PatternCount - 1 then Player.CellReal := frac(Player.CellReal); // - OmegaImageList1.ImageList.Items[player.picnum].NumOfColumns-2;
    Player.CellPic := Trunc(Player.CellReal);

    case Player.MoveDir of
      1: Player.PicNum := 9;
      2: Player.PicNum := 10;
      3: Player.PicNum := 11;
      4: Player.PicNum := 12;
    end; // case
    
    if ShowCheckers then Player.PicNum := playerPIC;
  end
  else // if standing still show end cell
    if Player.MoveDir = 0 then Player.CellPic := Images.Items[Player.PicNum].PatternCount; // OmegaImageList1.ImageList.Items[Player.picnum].NumOfColumns - 1;}

  if not ShowCheckers then // i.e drawing the landscape
  begin
   // the actual drawing of tiles
   // draw shadow

     Canvas.Draw4V(Images[Player.PicNum],
      Player.CellPic,
      PosX - 66, PosY - 40,
      PosX - 2, PosY - 40,
      PosX + 48, PosY,
      PosX, PosY,
      False, False,
      ARGB(48, 0, 0, 0),
      ARGB(48, 0, 0, 0),
      ARGB(48, 0, 0, 0),
      ARGB(48, 0, 0, 0),
      Blend_Default);