heightmap.dpr

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

    MapInfo.ExternalLight[Cx - 1, Cy] := MapInfo.ExternalLight[Cx - 1, Cy] - 5;
    MapInfo.ExternalLight[Cx, Cy] := MapInfo.ExternalLight[Cx, Cy] - 8;
    MapInfo.ExternalLight[Cx + 1, Cy] := MapInfo.ExternalLight[Cx + 1, Cy] - 5;

    MapInfo.ExternalLight[Cx - 1, Cy + 1] := MapInfo.ExternalLight[Cx - 1, Cy + 1] - 3;
    MapInfo.ExternalLight[Cx, Cy + 1] := MapInfo.ExternalLight[Cx, Cy + 1] - 5;
    MapInfo.ExternalLight[Cx + 1, Cy + 1] := MapInfo.ExternalLight[Cx + 1, Cy + 1] - 3;
  end
  else
  begin
    MapInfo.ExternalLight[Cx - 1, Cy - 1] := MapInfo.ExternalLight[Cx - 1, Cy - 1] + 3;
    MapInfo.ExternalLight[Cx, Cy - 1] := MapInfo.ExternalLight[Cx, Cy - 1] + 5;
    MapInfo.ExternalLight[Cx + 1, Cy - 1] := MapInfo.ExternalLight[Cx + 1, Cy - 1] + 3;

    MapInfo.ExternalLight[Cx - 1, Cy] := MapInfo.ExternalLight[Cx - 1, Cy] + 5;
    MapInfo.ExternalLight[Cx, Cy] := MapInfo.ExternalLight[Cx, Cy] + 8;
    MapInfo.ExternalLight[Cx + 1, Cy] := MapInfo.ExternalLight[Cx + 1, Cy] + 5;

    MapInfo.ExternalLight[Cx - 1, Cy + 1] := MapInfo.ExternalLight[Cx - 1, Cy + 1] + 3;
    MapInfo.ExternalLight[Cx, Cy + 1] := MapInfo.ExternalLight[Cx, Cy + 1] + 5;
    MapInfo.ExternalLight[Cx + 1, Cy + 1] := MapInfo.ExternalLight[Cx + 1, Cy + 1] + 3;
  end;
  CalculateDarkness;
end;

//------------------------------------------------------------------------------
//  Make shadows and bright areas
//------------------------------------------------------------------------------
procedure SaveMap;
var
  i, j, l: Integer;
  Stream: TFileStream;
  TempFileName: string;
begin
  TempFileName := Lowercase(ExtractFilePath(paramstr(0))) + 'WorldMap.sav';

  try
    Stream := TFileStream.Create(TempFileName, fmcreate);
    with Stream do
    begin
      Write(Player.Tx, SizeOf(Player.Tx));
      Write(Player.Ty, SizeOf(Player.Ty));

      for j := 0 to MAPXSIZE do // save the map
        for i := 0 to MAPXSIZE do
        begin
          for l := 1 to NUMLAYERS do
            Write(MapInfo.Layers[l].Plane[i, j], SizeOf(MapInfo.Layers[l].Plane[i, j]));
          Write(MapInfo.Ph[i, j], SizeOf(MapInfo.Ph[i, j]));
          Write(MapInfo.Darkness[i, j], SizeOf(MapInfo.Darkness[i, j]));
          Write(MapInfo.ExternalLight[i, j], SizeOf(MapInfo.ExternalLight[i, j]));
        end;
    end;
  finally
    if Stream <> nil then Stream.Free;
  end;
end;


procedure DrawPanel;
var
  X: Integer;
  p: Integer;
begin
  p := 0;
  for X := 0 to 3 do
  begin
    Canvas.Draw(Images.Image['Panel'],p, X * 256, 510, Blend_Default);
    Inc(p);
  end;
end;

procedure DoMouseDown;
var
  i, j, NewAlpha: Integer;

  function AlphaUp: Integer;
  begin
    if NewAlpha < 20 then Result := 20;
    if NewAlpha > 255 then Result := 255;
    //if ssCtrl in Shift then Result := 255; // Control key
    //if ssAlt in Shift then Result := 0; // Left menu = Alt
  end;

begin
  if HGE.Input_KeyDown(HGEK_LBUTTON) then // holding down left mouse button, i.e. removing a layers alpha value (less visible)
  begin
    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX - 1, CellY - 1].Alpha * 0.90); if NewAlpha < 2 then NewAlpha := 2; // top left
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX - 1, CellY - 1].Alpha := NewAlpha;
    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX, CellY - 1].Alpha * 0.7); if NewAlpha < 2 then NewAlpha := 2; // top middle
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX, CellY - 1].Alpha := NewAlpha;
    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX + 1, CellY - 1].Alpha * 0.90); if NewAlpha < 2 then NewAlpha := 2; // top right
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX + 1, CellY - 1].Alpha := NewAlpha;

    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX - 1, CellY].Alpha * 0.7); if NewAlpha < 2 then NewAlpha := 2; // left
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX - 1, CellY].Alpha := NewAlpha;
    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX, CellY].Alpha * 0.5); if NewAlpha < 2 then NewAlpha := 2; // middle
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX, CellY].Alpha := NewAlpha;
    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX + 1, CellY].Alpha * 0.7); if NewAlpha < 2 then NewAlpha := 2; // right
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX + 1, CellY].Alpha := NewAlpha;

    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX - 1, CellY + 1].Alpha * 0.90); if NewAlpha < 2 then NewAlpha := 2; // Bot left
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX - 1, CellY + 1].Alpha := NewAlpha;
    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX, CellY + 1].Alpha * 0.7); if NewAlpha < 2 then NewAlpha := 2; // Bot middle
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX, CellY + 1].Alpha := NewAlpha;
    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX + 1, CellY + 1].Alpha * 0.90); if NewAlpha < 2 then NewAlpha := 2; // Bot right
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX + 1, CellY + 1].Alpha := NewAlpha;
  end;

  if HGE.Input_KeyDown(HGEK_RBUTTON) then // holding down left mouse button, i.e. adding to a layer's alpha value(more visible)
  begin
    if MapInfo.Layers[MapInfo.CurrentLayer].CurrentImage < 0 then MapInfo.Layers[MapInfo.CurrentLayer].CurrentImage := MUDPIC;

    for i := CellX - 1 to CellX + 1 do
      for j := CellY - 1 to CellY + 1 do
      begin
        MapInfo.Layers[MapInfo.CurrentLayer].Plane[i, j].PicNumber := MapInfo.Layers[MapInfo.CurrentLayer].CurrentImage;
        MapInfo.Layers[MapInfo.CurrentLayer].Plane[i, j].CellNumber := Random(Images.Items[MapInfo.Layers[MapInfo.CurrentLayer].CurrentImage].PatternCount);
      end;

    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX - 1, CellY - 1].Alpha * 1.1); NewAlpha := AlphaUp; // top left
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX - 1, CellY - 1].Alpha := NewAlpha;
    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX, CellY - 1].Alpha * 1.25); NewAlpha := AlphaUp; // top middle
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX, CellY - 1].Alpha := NewAlpha;
    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX + 1, CellY - 1].Alpha * 1.1); NewAlpha := AlphaUp; // top right
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX + 1, CellY - 1].Alpha := NewAlpha;

    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX - 1, CellY].Alpha * 1.25); NewAlpha := AlphaUp; // left
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX - 1, CellY].Alpha := NewAlpha;
    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX, CellY].Alpha * 4); NewAlpha := AlphaUp; // middle
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX, CellY].Alpha := NewAlpha;
    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX + 1, CellY].Alpha * 1.25); NewAlpha := AlphaUp; // right
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX + 1, CellY].Alpha := NewAlpha;

    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX - 1, CellY + 1].Alpha * 1.1); NewAlpha := AlphaUp; // Bot left
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX - 1, CellY + 1].Alpha := NewAlpha;
    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX, CellY + 1].Alpha * 1.25); NewAlpha := AlphaUp; // Bot middle
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX, CellY + 1].Alpha := NewAlpha;
    NewAlpha := Round(MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX + 1, CellY + 1].Alpha * 1.1); NewAlpha := AlphaUp; // Bot right
    MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX + 1, CellY + 1].Alpha := NewAlpha;

    // if drawing the water level then flaten the land. i.e. set heigt o Plateau height
    if MapInfo.Layers[MapInfo.CurrentLayer].Plane[CellX, CellY].PicNumber = WATERPIC then
    begin
      if (CellX > 2) and (CellY > 2) then
      begin
        while MapInfo.Ph[CellX - 1, CellY - 1] > PlateauHeight do MoveGround(True, CellX - 1, CellY - 1);
        while MapInfo.Ph[CellX, CellY - 1] > PlateauHeight do MoveGround(True, CellX, CellY - 1);
        while MapInfo.Ph[CellX + 1, CellY - 1] > PlateauHeight do MoveGround(True, CellX + 1, CellY - 1);

        while MapInfo.Ph[CellX - 1, CellY] > PlateauHeight do MoveGround(True, CellX - 1, CellY);
        while MapInfo.Ph[CellX, CellY] > PlateauHeight do MoveGround(True, CellX, CellY);
        while MapInfo.Ph[CellX + 1, CellY] > PlateauHeight do MoveGround(True, CellX + 1, CellY);

        while MapInfo.Ph[CellX - 1, CellY + 1] > PlateauHeight do MoveGround(True, CellX - 1, CellY + 1);
        while MapInfo.Ph[CellX, CellY + 1] > PlateauHeight do MoveGround(True, CellX, CellY + 1);
        while MapInfo.Ph[CellX + 1, CellY + 1] > PlateauHeight do MoveGround(True, CellX + 1, CellY + 1);
      end;

      // alter light pattern over the water
      for i := CellX - 1 to CellX + 1 do
        for j := CellY - 1 to CellY + 1 do
        begin
          MapInfo.ExternalLight[i, j] := Random(20);
        end;

      MapInfo.Ph[CellX - 1, CellY - 1] := PlateauHeight;
      MapInfo.Ph[CellX, CellY - 1] := PlateauHeight;
      MapInfo.Ph[CellX + 1, CellY - 1] := PlateauHeight;

      MapInfo.Ph[CellX - 1, CellY] := PlateauHeight;
      MapInfo.Ph[CellX, CellY] := PlateauHeight;
      MapInfo.Ph[CellX + 1, CellY] := PlateauHeight;

      MapInfo.Ph[CellX - 1, CellY + 1] := PlateauHeight;
      MapInfo.Ph[CellX, CellY + 1] := PlateauHeight;
      MapInfo.Ph[CellX + 1, CellY + 1] := PlateauHeight;
    end;
  end;
end;

function FrameFunc: Boolean;
var
w:integer;
begin
  HGE.Input_GetMousePos(MouseX, MouseY);
  HGE.Input_GetEvent(Event);
  DoMouseDown;
  DoMouseMove;
  DoMouseAndKeyboard;

  if Event.Wheel=1 then
     MoveGround(False, CellX, CellY);
  if Event.Wheel=-1 then
     MoveGround(True, CellX, CellY);
   Event.Wheel:=0;
  if  HGE.Input_GetKeyState(HGEK_ADD) then Inc(PlateauHeight, 5);
  if  HGE.Input_GetKeyState(HGEK_SUBTRACT) then dec(PlateauHeight, 5);

 // select a new drawing layer
  if HGE.Input_KeyDown(HGEK_COMMA) then
  begin
    Inc(MapInfo.CurrentLayer);
    if MapInfo.CurrentLayer > 5 then MapInfo.CurrentLayer := 1;
  end;

  if HGE.Input_KeyDown(HGEK_PERIOD) then
  begin
    dec(MapInfo.CurrentLayer);
    if MapInfo.CurrentLayer < 1 then MapInfo.CurrentLayer := 5;
  end;

  if HGE.Input_KeyDown(HGEK_M) then MakeMountains;

  if HGE.Input_KeyDown(HGEK_C) then ShowCheckers := not ShowCheckers;

  if HGE.Input_KeyDown(HGEK_B) then
  begin
    Inc(Blendmode);

    if Blendmode > 13 then Blendmode := 0;
  end;

  if HGE.Input_GetKeyState(HGEK_S) then
  begin
    SaveMap;
  end;

  if HGE.Input_GetKeyState(HGEK_0) then
  begin
    LoadMap;
  end;

  case HGE.Input_GetKey of
    HGEK_ESCAPE:
    begin
      FreeAndNil(Canvas);
      FreeAndNil(Images);
      FreeAndNil(Font);
      FreeObjects;
      Result := True;
      Exit;
    end;
  end;
  Result := False;
end;

function RenderFunc: Boolean;
var
  X, Y, i, j, dk1, dk2, dk3, dk4: Integer; PosX, PosY: Integer;
  sX1, sX2, sY1, sY2: Integer;
  DontDrawAnyMOre: Boolean;
begin
  //HGE.Gfx_Clear(0);
  Player.HasNotDrawnThisFrame := True;
  // calculate visible area
  sX1 := Trunc(Abs(LEFTOFFSET) / TileWidth);
  sX2 := sX1 + 14; //(SCRWIDTH div TILEWIDTH)+2;
  sY1 := Trunc(abs(TOPOFFSET) / TileHeight) - 3;
  sY2 := Trunc(sY1 + (SCRHEIGHT / TileHeight) + 3);
  if sY1 < 1 then sY1 := 0;
  HGE.Gfx_BeginScene;
  for Y := sY1 to sY2 do
  begin
      X := sX1;
      while X <= sX2 do
      begin
        dk1 := MapInfo.Darkness[X, Y]; // get the light/darkness values for these vertices
        dk2 := MapInfo.Darkness[X + 1, Y]; //
        dk3 := MapInfo.Darkness[X + 1, Y + 1];
        dk4 := MapInfo.Darkness[X, Y + 1];

        PosX := Trunc(LEFTOFFSET + (X * TileWidth));
        PosY := Trunc(TOPOFFSET + (Y * TileHeight));

        if not ShowCheckers then
        begin
          DontDrawAnyMOre := False; // if top of tile actually below screen then don't draw rest of the row

          if not DrawLowerRocks(X, Y, PosX, PosY, dk1, dk2, dk3, dk4) then DontDrawAnyMOre := True;
          if not DontDrawAnyMOre then
            DrawGrass1(X, Y, PosX, PosY, dk1, dk2, dk3, dk4);
          if not DontDrawAnyMOre then
            DrawWater(X, Y, PosX, PosY, dk1, dk2, dk3, dk4);

          if not (DontDrawAnyMOre) then
            DrawMud(X, Y, PosX, PosY, dk1, dk2, dk3, dk4);
        end
        else
        begin
          DrawCheckers(X, Y, PosX, PosY, dk1, dk2, dk3, dk4);
        end;

        if (X = CellX) and (Y = CellY) then
        begin
          HGE.Quadrangle4Color(
            PosX, PosY - MapInfo.Ph[X, Y] + 1,
            PosX + TileWidth, PosY - MapInfo.Ph[X + 1, Y] + 1,
            PosX + TileWidth, PosY + TileHeight - MapInfo.Ph[X + 1, Y + 1] + 1,
            PosX, PosY + TileHeight - MapInfo.Ph[X, Y + 1] + 1,
            ARGB(205, 255, 125, 255),
            ARGB(50, 125, 0, 255),
            ARGB(5, 5, 0, 5),
            ARGB(50, 125, 0, 255),
            True,
            Blend_Default);
            Font.Print(PosX - 5, PosY - MapInfo.Ph[X, Y] + 1,IntToStr(MapInfo.Ph[X + 1, Y]),255, 255, 255,255);
        end;

        if (X = Player.Tx) and (Y = Player.Ty) then Drawplayer(X, Y, PosX, PosY); // in current tile
        if (X = Player.Tx + 1) and (Y = Player.Ty) and (Player.Fx > 16) then Drawplayer(X - 1, Y, PosX, PosY); // in previous tile
        if (X = Player.Tx) and (Y = Player.Ty + 1) then Drawplayer(X, Y - 1, PosX, PosY - TileHeight); // in previous tile

        if MapInfo.ContainsObject[X, Y] then
          for i := ObjectList.count - 1 downto 0 do
            if (X = TGroundObject(ObjectList[i]).Tx) and (Y = TGroundObject(ObjectList[i]).Ty) then
              DrawGroundObject(PosX, PosY - MapInfo.Ph[X, Y], i);

        Inc(X);
      end; // while x :<=sx2 do
    end;
    DrawPanel;
    if MapInfo.Layers[MapInfo.CurrentLayer].CurrentImage >= 0 then
      Canvas.DrawStretch(Images[MapInfo.Layers[MapInfo.CurrentLayer].CurrentImage], 0, 700, 10, 764, 74, False, False, $FFFFFFFF, Blend_Default);
  Font.Print(8,25,'Current Water Level = ' + IntToStr(PlateauHeight));
  Font.Print(8,525,'Mousewheel = change height; c = Toggle Landscape / checkers; Shift + Move mouse = flattens ground');
  Font.Print(8,550,'"," & "." = change drawing Image; Right Mouse (ctrl or alt) = add image to the landscape');
  Font.Print(8,575,'Left Mouse = Remove Image; "+" & "-" = change water level; s & l = save and load landscape');

  //Font.Print(100,100,IntToStr(HGE.Timer_GetFPS));
  HGE.Gfx_EndScene;
  Result := False;
end;

procedure Main;
var
  I: Integer;
begin
  HGE := HGECreate(HGE_VERSION);
  HGE.System_SetState(HGE_FRAMEFUNC,FrameFunc);
  HGE.System_SetState(HGE_RENDERFUNC,RenderFunc);
  HGE.System_SetState(HGE_USESOUND, False);
  HGE.System_SetState(HGE_WINDOWED,False);
  HGE.System_SetState(HGE_SCREENWIDTH, 800);
  HGE.System_SetState(HGE_SCREENHEIGHT,600);
  HGE.System_SetState(HGE_SCREENBPP,16);
  HGE.System_SetState(HGE_TEXTUREFILTER, False);
  HGE.System_SetState(HGE_FPS,HGEFPS_VSYNC);
  HGE.System_SetState(HGE_HIDEMOUSE, False);
  Canvas := THGeCanvas.Create;
  Images := THGEImages.Create;

  if (HGE.System_Initiate) then
  begin
    Font:=TSysFont.Create;
    Font.CreateFont('arial',12,[]);
    Images.LoadFromFile('Grass.jpg',256, 256);
    Images.LoadFromFile('Rocks.jpg', 256, 256);
    Images.LoadFromFile('Water.png');
    Images.LoadFromFile('Dirt.jpg',256, 256);
    Images.LoadFromFile('Grass2.jpg', 256, 256);
    Images.LoadFromFile('CheckBlue.png');
    Images.LoadFromFile('CheckWhite.png');
    Images.LoadFromFile('Ball.png',32, 64);
    Images.LoadFromFile('Palm.png', 96, 101);
    Images.LoadFromFile('RunningEast.png',128,128);
    Images.LoadFromFile('RunningSouth.png',128,128);
    Images.LoadFromFile('RunningWest.png',128,128);
    Images.LoadFromFile('RunningNorth.png',128,128);
    Images.LoadFromFile('Objects.png',96,101);
    Images.LoadFromFile('Panel.jpg',256, 90);
    CreateGame;
    HGE.System_Start;
  end
  else
    MessageBox(0,PChar(HGE.System_GetErrorMessage),'Error',MB_OK or MB_ICONERROR or MB_SYSTEMMODAL);

  HGE.System_Shutdown;
  HGE := nil;
end;

begin
  ReportMemoryLeaksOnShutdown := True;
  Main;
end.