CentrED

(*

 * CDDL HEADER START

 *

 * The contents of this file are subject to the terms of the

 * Common Development and Distribution License, Version 1.0 only

 * (the "License").  You may not use this file except in compliance

 * with the License.

 *

 * You can obtain a copy of the license at

 * http://www.opensource.org/licenses/cddl1.php.

 * See the License for the specific language governing permissions

 * and limitations under the License.

 *

 * When distributing Covered Code, include this CDDL HEADER in each

 * file and include the License file at

 * http://www.opensource.org/licenses/cddl1.php.  If applicable,

 * add the following below this CDDL HEADER, with the fields enclosed

 * by brackets "[]" replaced with your own identifying * information:

 *      Portions Copyright [yyyy] [name of copyright owner]

 *

 * CDDL HEADER END

 *

 *

 *      Portions Copyright 2007 Andreas Schneider

 *)

unit ULandscape;

{$mode objfpc}{$H+}

interface

uses

  SysUtils, Classes, math, contnrs, LCLIntf, GL, GLU, ImagingOpenGL,

  Imaging, ImagingClasses, ImagingTypes, ImagingUtility,

  UGenericIndex, UMap, UStatics, UArt, UTexture, UTileData, UHue, UWorldItem,

  UMulBlock,

  UListSort, UVector, UEnhancedMemoryStream,

  UCacheManager, ULinkedList;

type

  TNormals = array[0..3] of TVector;

  PRadarBlock = ^TRadarBlock;

  TRadarBlock = array[0..7, 0..7] of Word;

  { TMaterial }

  TMaterial = class(TObject)

    constructor Create(AWidth, AHeight: Integer; AGraphic: TSingleImage);

    destructor Destroy; override;

  protected

    FWidth: Integer;

    FHeight: Integer;

    FRealWidth: Integer;

    FRealHeight: Integer;

    FTexture: GLuint;

    FGraphic: TSingleImage;

  public

    property Width: Integer read FWidth;

    property Height: Integer read FHeight;

    property RealWidth: Integer read FRealWidth;

    property RealHeight: Integer read FRealHeight;

    property Texture: GLuint read FTexture;

    property Graphic: TSingleImage read FGraphic;

    function HitTest(AX, AY: Integer): Boolean;

    procedure UpdateTexture;

  end;

  { TLandTextureManager }

  TLandTextureManager = class(TObject)

    constructor Create;

    destructor Destroy; override;

    function GetArtMaterial(ATileID: Word): TMaterial; overload;

    function GetArtMaterial(ATileID: Word; AHue: THue; APartialHue: Boolean): TMaterial; overload;

    function GetFlatLandMaterial(ATileID: Word): TMaterial;

    function GetTexMaterial(ATileID: Word): TMaterial;

  protected

    FArtCache: TCacheManager;

    FFlatLandArtCache: TCacheManager;

    FTexCache: TCacheManager;

  end;

  { TBlock }

  TBlock = class(TObject)

    constructor Create(AMap: TMapBlock; AStatics: TStaticBlock);

    destructor Destroy; override;

  protected

    FMapBlock: TMapBlock;

    FStaticBlock: TStaticBlock;

  public

    property Map: TMapBlock read FMapBlock;

    property Static: TStaticBlock read FStaticBlock;

  end;

  TLandscapeChangeEvent = procedure of object;

  TStaticFilter = function(AStatic: TStaticItem): Boolean of object;

  { TLandscape }

  TLandscape = class(TObject)

    constructor Create(AWidth, AHeight: Word);

    destructor Destroy; override;

  protected

    FWidth: Word;

    FHeight: Word;

    FCellWidth: Word;

    FCellHeight: Word;

    FBlockCache: TCacheManager;

    FOnChange: TLandscapeChangeEvent;

    FOpenRequests: array of Boolean;

    function Compare(left, right: TObject): Integer;

    function GetNormals(AX, AY: Word): TNormals;

    function GetMapCell(AX, AY: Word): TMapCell;

    function GetStaticList(AX, AY: Word): TList;

    function GetMapBlock(AX, AY: Word): TMapBlock;

    function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;

    procedure UpdateStaticsPriority(AStaticItem: TStaticItem;

      APrioritySolver: Integer);

    procedure OnBlockChanged(ABlock: TMulBlock);

    procedure OnRemoveCachedObject(AObject: TObject);

    procedure OnBlocksPacket(ABuffer: TEnhancedMemoryStream);

    procedure OnDrawMapPacket(ABuffer: TEnhancedMemoryStream);

    procedure OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream);

    procedure OnDeleteStaticPacket(ABuffer: TEnhancedMemoryStream);

    procedure OnElevateStaticPacket(ABuffer: TEnhancedMemoryStream);

    procedure OnMoveStaticPacket(ABuffer: TEnhancedMemoryStream);

    procedure OnHueStaticPacket(ABuffer: TEnhancedMemoryStream);

  public

    property Width: Word read FWidth;

    property Height: Word read FHeight;

    property CellWidth: Word read FCellWidth;

    property CellHeight: Word read FCellHeight;

    property MapCell[X, Y: Word]: TMapCell read GetMapCell;

    property StaticList[X, Y: Word]: TList read GetStaticList;

    property Normals[X, Y: Word]: TNormals read GetNormals;

    property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange;

    function GetDrawList(AX, AY: Word; AMinZ, AMaxZ: ShortInt;

      AGhostTile: TWorldItem; AVirtualLayer: TStaticItem; AMap,

      AStatics: Boolean; ANoDraw:Boolean; AStaticsFilter: TStaticFilter): TList;

    function GetEffectiveAltitude(ATile: TMapCell): ShortInt;

    function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;

    procedure MoveStatic(AStatic: TStaticItem; AX, AY: Word);

    procedure PrepareBlocks(AX1, AY1, AX2, AY2: Word);

  end;

  PBlockInfo = ^TBlockInfo;

  TBlockInfo = record

    ScreenRect: TRect;

    Item: TWorldItem;

    Material: TMaterial;

    Next: PBlockInfo;

  end;

  { TTileList }

  TTileList = class(TObject)

    constructor Create; virtual;

    destructor Destroy; override;

  protected

    FFirst: PBlockInfo;

    FLastBlock: PBlockInfo;

  public

    procedure Clear; virtual;

    function Iterate(var ABlockInfo: PBlockInfo): Boolean; virtual;

    procedure Add(AItem: TWorldItem); virtual;

    procedure Delete(AItem: TWorldItem); virtual;

    property LastBlock: PBlockInfo read FLastBlock;

  end;

  { TScreenBuffer }

  TScreenBuffer = class(TTileList)

  public

    procedure OnTileRemoved(ATile: TMulBlock);

    procedure Clear; override;

    function Find(AScreenPosition: TPoint): PBlockInfo;

    procedure Store(AScreenRect: TRect; AItem: TWorldItem; AMaterial: TMaterial);

  end;

  TStaticInfo = packed record

    X: Word;

    Y: Word;

    Z: ShortInt;

    TileID: Word;

    Hue: Word;

  end;

  //operator=(AStaticItem: TStaticItem; AStaticInfo: TStaticInfo): Boolean;

implementation

uses

  UGameResources, UdmNetwork, UPackets, UPacketHandlers;

const

  mMap = 0;

  mStatics = 1;

function GetID(AX, AY: Word): Integer;

begin

  Result := ((AX and $7FFF) shl 15) or (AY and $7FFF);

end;

{operator=(AStaticItem: TStaticItem; AStaticInfo: TStaticInfo): Boolean;

begin

  Result := (AStaticItem.X = AStaticInfo.X) and

    (AStaticItem.Y = AStaticInfo.Y) and

    (AStaticItem.Z = AStaticInfo.Z) and

    (AStaticItem.TileID = AStaticInfo.TileID) and

    (AStaticItem.Hue = AStaticInfo.Hue);

end;}

{ TLandTextureManager }

constructor TLandTextureManager.Create;

begin

  inherited Create;

  FArtCache := TCacheManager.Create(1024);

  FFlatLandArtCache := TCacheManager.Create(128);

  FTexCache := TCacheManager.Create(128);

end;

destructor TLandTextureManager.Destroy;

begin

  if FArtCache <> nil then FreeAndNil(FArtCache);

  if FFlatLandArtCache <> nil then FreeAndNil(FFlatLandArtCache);

  if FTexCache <> nil then FreeAndNil(FTexCache);

  inherited Destroy;

end;

function TLandTextureManager.GetArtMaterial(ATileID: Word): TMaterial;

var

  artEntry: TArt;

begin

  if not FArtCache.QueryID(ATileID, TObject(Result)) then

  begin

    artEntry := TArt(ResMan.Art.Block[ATileID]);

    Result := TMaterial.Create(artEntry.Graphic.Width, artEntry.Graphic.Height,

      artEntry.Graphic);

    FArtCache.StoreID(ATileID, Result);

    artEntry.Free;

  end;

end;

function TLandTextureManager.GetArtMaterial(ATileID: Word; AHue: THue; APartialHue: Boolean): TMaterial;

var

  artEntry: TArt;

  id: Integer;

begin

  if AHue = nil then

  begin

    Result := GetArtMaterial(ATileID);

  end else

  begin

    id := ATileID or ((AHue.ID and $3FFF) shl 15) or (Byte(APartialHue) shl 29);

    if not FArtCache.QueryID(id, TObject(Result)) then

    begin

      artEntry := ResMan.Art.GetArt(ATileID, 0, AHue, APartialHue);

      Result := TMaterial.Create(artEntry.Graphic.Width, artEntry.Graphic.Height,

        artEntry.Graphic);

      FArtCache.StoreID(id, Result);

      artEntry.Free;

    end;

  end;

end;

function TLandTextureManager.GetFlatLandMaterial(ATileID: Word): TMaterial;

var

  artEntry: TArt;

begin

  if not FFlatLandArtCache.QueryID(ATileID, TObject(Result)) then

  begin

    artEntry := ResMan.Art.GetFlatLand(ATileID);

    Result := TMaterial.Create(artEntry.Graphic.Width, artEntry.Graphic.Height,

      artEntry.Graphic);

    FFlatLandArtCache.StoreID(ATileID, Result);

    artEntry.Free;

  end;

end;

function TLandTextureManager.GetTexMaterial(ATileID: Word): TMaterial;

var

  texEntry: TTexture;

  texID: Integer;

begin

  if not FTexCache.QueryID(ATileID, TObject(Result)) then

  begin

    texID := ResMan.Tiledata.LandTiles[ATileID].TextureID;

    if texID > 0 then

    begin

      texEntry := TTexture(ResMan.Texmaps.Block[texID]);

      Result := TMaterial.Create(texEntry.Graphic.Width, texEntry.Graphic.Height,

        texEntry.Graphic);

      FTexCache.StoreID(ATileID, Result);

      texEntry.Free;

    end else

      Result := nil;

  end;

end;

{ TBlock }

constructor TBlock.Create(AMap: TMapBlock; AStatics: TStaticBlock);

begin

  inherited Create;

  FMapBlock := AMap;

  FStaticBlock := AStatics;

end;

destructor TBlock.Destroy;

begin

  if FMapBlock <> nil then FreeAndNil(FMapBlock);

  if FStaticBlock <> nil then FreeAndNil(FStaticBlock);

  inherited Destroy;

end;

{ TLandscape }

constructor TLandscape.Create(AWidth, AHeight: Word);

var

  blockID: Integer;

begin

  inherited Create;

  FWidth := AWidth;

  FHeight := AHeight;

  FCellWidth := FWidth * 8;

  FCellHeight := FHeight * 8;

  FBlockCache := TCacheManager.Create(256);

  FBlockCache.OnRemoveObject := @OnRemoveCachedObject;

  SetLength(FOpenRequests, FWidth * FHeight);

  for blockID := 0 to Length(FOpenRequests) - 1 do

    FOpenRequests[blockID] := False;

  RegisterPacketHandler($04, TPacketHandler.Create(0, @OnBlocksPacket));

  RegisterPacketHandler($06, TPacketHandler.Create(8, @OnDrawMapPacket));

  RegisterPacketHandler($07, TPacketHandler.Create(10, @OnInsertStaticPacket));

  RegisterPacketHandler($08, TPacketHandler.Create(10, @OnDeleteStaticPacket));

  RegisterPacketHandler($09, TPacketHandler.Create(11, @OnElevateStaticPacket));

  RegisterPacketHandler($0A, TPacketHandler.Create(14, @OnMoveStaticPacket));

  RegisterPacketHandler($0B, TPacketHandler.Create(12, @OnHueStaticPacket));

end;

destructor TLandscape.Destroy;

var

  i: Integer;

begin

  if FBlockCache <> nil then

  begin

    FBlockCache.OnRemoveObject := nil;

    FreeAndNil(FBlockCache);

  end;

  RegisterPacketHandler($04, nil);

  RegisterPacketHandler($06, nil);

  RegisterPacketHandler($07, nil);

  RegisterPacketHandler($08, nil);

  RegisterPacketHandler($09, nil);

  RegisterPacketHandler($0A, nil);

  RegisterPacketHandler($0B, nil);

  inherited Destroy;

end;

function TLandscape.GetMapCell(AX, AY: Word): TMapCell;

var

  block: TMapBlock;

begin

  Result := nil;

  if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then

  begin

    block := GetMapBlock(AX div 8, AY div 8);

    if block <> nil then

      Result := block.Cells[(AY mod 8) * 8 + AX mod 8];

  end;

end;

function TLandscape.GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;

var

  cell: TMapCell;

begin

  cell := MapCell[AX, AY];

  if cell <> nil then

    Result := cell.Altitude

  else

    Result := ADefault;

end;

function TLandscape.GetStaticList(AX, AY: Word): TList;

var

  block: TSeperatedStaticBlock;

begin

  Result := nil;

  if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then

  begin

    block := GetStaticBlock(AX div 8, AY div 8);

    if block <> nil then

      Result := block.Cells[(AY mod 8) * 8 + AX mod 8];

  end;

end;

function TLandscape.Compare(left, right: TObject): Integer;

begin

  Result := TWorldItem(right).Priority - TWorldItem(left).Priority;

  if Result = 0 then

  begin

    if (left is TMapCell) and (right is TStaticItem) then

      Result := 1

    else if (left is TStaticItem) and (right is TMapCell) then

      Result := -1;

  end;

  if Result = 0 then

    Result := TWorldItem(right).PriorityBonus - TWorldItem(left).PriorityBonus;

  if Result = 0 then

    Result := TWorldItem(right).PrioritySolver - TWorldItem(left).PrioritySolver;

end;

function TLandscape.GetDrawList(AX, AY: Word; AMinZ, AMaxZ: ShortInt;

  AGhostTile: TWorldItem; AVirtualLayer: TStaticItem; AMap,

  AStatics: Boolean; ANoDraw:Boolean; AStaticsFilter: TStaticFilter): TList;

var

  landAlt: ShortInt;

  drawMapCell: TMapCell;

  drawStatics: TList;

  i: Integer;

begin

  Result := TList.Create;

  if AMap then

  begin

    landAlt := GetLandAlt(AX, AY, 0);

    if (landAlt >= AMinZ) and (landAlt <= AMaxZ) then

    begin

      drawMapCell := GetMapCell(AX, AY);

      if (drawMapCell <> nil) and (ANoDraw or (drawMapCell.TileID > 2)) then

      begin

        drawMapCell.Priority := GetEffectiveAltitude(drawMapCell);

        drawMapCell.PriorityBonus := 0;

        drawMapCell.PrioritySolver := 0;

        Result.Add(drawMapCell);

      end;

      if AGhostTile is TMapCell then

      begin

        AGhostTile.X := AX;

        AGhostTile.Y := AY;

        AGhostTile.Priority := GetEffectiveAltitude(TMapCell(AGhostTile));

        AGhostTile.PriorityBonus := 0;

        AGhostTile.PrioritySolver := 0;

        Result.Add(AGhostTile);

      end;

    end;

  end;

  if AStatics then

  begin

    drawStatics := GetStaticList(AX, AY);

    if drawStatics <> nil then

      for i := 0 to drawStatics.Count - 1 do

        if (TStaticItem(drawStatics[i]).Z >= AMinZ) and

           (TStaticItem(drawStatics[i]).Z <= AMaxZ) and

           ((AStaticsFilter = nil) or AStaticsFilter(TStaticItem(drawStatics[i]))) then

        begin

          UpdateStaticsPriority(TStaticItem(drawStatics[i]), i + 1);

          Result.Add(Pointer(drawStatics[i]));

        end;

    if AGhostTile is TStaticItem then

    begin

      UpdateStaticsPriority(TStaticItem(AGhostTile), MaxInt);

      Result.Add(AGhostTile);

    end;

  end;

  if AVirtualLayer <> nil then

  begin

    UpdateStaticsPriority(AVirtualLayer, MaxInt-1);

    Result.Add(AVirtualLayer);

  end;

  ListSort(Result, @Compare);

end;

function TLandscape.GetEffectiveAltitude(ATile: TMapCell): ShortInt;

var

  north, west, south, east: ShortInt;

begin

  north := ATile.Altitude;

  west := GetLandAlt(ATile.X, ATile.Y + 1, north);

  south := GetLandAlt(ATile.X + 1, ATile.Y + 1, north);

  east := GetLandAlt(ATile.X + 1, ATile.Y, north);

  if Abs(north - south) > Abs(west - east) then

    Result := (north + south) div 2

  else

    Result := (west + east) div 2;

end;

function TLandscape.GetNormals(AX, AY: Word): TNormals;

var

  cells: array[0..2, 0..2] of TNormals;

  north, west, south, east: TVector;

  i, j: Integer;

  function GetPlainNormals(X, Y: SmallInt): TNormals;

  var

    cell: TMapCell;

    north, west, south, east: ShortInt;

    u, v: TVector;

  begin

    cell := GetMapCell(X, Y);

    if Assigned(cell) then

    begin

      north := cell.Altitude;

      west := GetLandAlt(cell.X, cell.Y + 1, north);

      south := GetLandAlt(cell.X + 1, cell.Y + 1, north);

      east := GetLandAlt(cell.X + 1, cell.Y, north);

    end else

    begin

      north := 0;

      west := 0;

      east := 0;

      south := 0;

    end;

    if (north = west) and (west = east) and (north = south) then

    begin

      Result[0] := Vector(0, 0, 1);

      Result[1] := Vector(0, 0, 1);

      Result[2] := Vector(0, 0, 1);

      Result[3] := Vector(0, 0, 1);

    end else

    begin

      u := Vector(-22, 22, (north - east) * 4);

      v := Vector(-22, -22, (west - north) * 4);

      Result[0] := VectorNorm(VectorCross(u, v));

      u := Vector(22, 22, (east - south) * 4);

      v := Vector(-22, 22, (north - east) * 4);

      Result[1] := VectorNorm(VectorCross(u, v));

      u := Vector(22, -22, (south - west) * 4);

      v := Vector(22, 22, (east - south) * 4);

      Result[2] := VectorNorm(VectorCross(u, v));

      u := Vector(-22, -22, (west - north) * 4);

      v := Vector(22, -22, (south - west) * 4);

      Result[3] := VectorNorm(VectorCross(u, v));

    end;

  end;

begin

  for i := 0 to 2 do

    for j := 0 to 2 do

      cells[i, j] := GetPlainNormals(AX - 1 + i, AY - 1 + j);

  north := cells[0, 0][2];

  west := cells[0, 1][1];

  east := cells[1, 0][3];

  south := cells[1, 1][0];

  Result[0] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south));

  north := cells[1, 0][2];

  west := cells[1, 1][1];

  east := cells[2, 0][3];

  south := cells[2, 1][0];

  Result[1] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south));

  north := cells[1, 1][2];

  west := cells[1, 2][1];

  east := cells[2, 1][3];

  south := cells[2, 2][0];

  Result[2] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south));

  north := cells[0, 1][2];

  west := cells[0, 2][1];

  east := cells[1, 1][3];

  south := cells[1, 2][0];

  Result[3] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south));

end;

procedure TLandscape.OnBlockChanged(ABlock: TMulBlock);

var

  block, old: TWorldBlock;

  mode: Byte;

  id, blockID: Integer;

begin

  {block := ABlock as TWorldBlock;

  if block <> nil then

  begin

    if block is TSeperatedStaticBlock then

      mode := mStatics

    else

      mode := mMap;

    id := GetID(block.X, block.Y, mode);

    blockID := (block.X * FHeight) + block.Y;

    if block.Changed or (block.RefCount > 0) then

    begin

      if FPersistentBlocks[blockID][mode] = nil then

      begin

        FPersistentBlocks[blockID][mode] := block;

        FBlockCache.DiscardID(id);

      end;

    end else

    begin

      FPersistentBlocks[blockID][mode] := nil;

      if not FBlockCache.QueryID(id, TObject(old)) then

        FBlockCache.StoreID(id, block);

    end;

  end;}

end;

procedure TLandscape.MoveStatic(AStatic: TStaticItem; AX, AY: Word);

var

  sourceBlock, targetBlock: TSeperatedStaticBlock;

  targetStaticList: TList;

  i: Integer;

begin

  if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then

  begin

    sourceBlock := AStatic.Owner as TSeperatedStaticBlock;

    targetBlock := GetStaticBlock(AX div 8, AY div 8);

    if (sourceBlock <> nil) and (targetBlock <> nil) then

    begin

      sourceBlock.Cells[(AStatic.Y mod 8) * 8 + AStatic.X mod 8].Remove(AStatic);

      targetStaticList := targetBlock.Cells[(AY mod 8) * 8 + AX mod 8];

      targetStaticList.Add(AStatic);

      for i := 0 to targetStaticList.Count - 1 do

        UpdateStaticsPriority(TStaticItem(targetStaticList.Items[i]), i);

      ListSort(targetStaticList, @Compare);

      AStatic.UpdatePos(AX, AY, AStatic.Z);

      AStatic.Owner := targetBlock;

    end;

  end;

end;

procedure TLandscape.PrepareBlocks(AX1, AY1, AX2, AY2: Word);

var

  x, y, i, mapID, staticID: Integer;

  coords: TBlockCoordsArray;

  obj: TObject;

begin

  AX1 := EnsureRange(AX1, 0, FWidth - 1);

  AY1 := EnsureRange(AY1, 0, FHeight - 1);

  AX2 := EnsureRange(AX2, 0, FWidth - 1);

  AY2 := EnsureRange(AY2, 0, FHeight - 1);

  SetLength(coords, 0);

  for x := AX1 to AX2 do

  begin

    for y := AY1 to AY2 do

    begin

      if (not FOpenRequests[y * FWidth + x]) and

         (not FBlockCache.QueryID(GetID(x, y), obj)) then

      begin

        SetLength(coords, Length(coords) + 1);

        i := High(coords);

        coords[i].X := x;

        coords[i].Y := y;

        FOpenRequests[y * FWidth + x] := True;

      end;

    end;

  end;

  if Length(coords) > 0 then

    dmNetwork.Send(TRequestBlocksPacket.Create(coords));

end;

function TLandscape.GetMapBlock(AX, AY: Word): TMapBlock;

var

  block: TBlock;

begin

  Result := nil;

  if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then

  begin

    if FBlockCache.QueryID(GetID(AX, AY), TObject(block)) then

      Result := block.Map;

  end;

end;

function TLandscape.GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;

var

  block: TBlock;

begin

  Result := nil;

  if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then

  begin

    if FBlockCache.QueryID(GetID(AX, AY), TObject(block)) then

      Result := TSeperatedStaticBlock(block.Static);

  end;

end;

procedure TLandscape.UpdateStaticsPriority(AStaticItem: TStaticItem;

  APrioritySolver: Integer);

var

  staticTileData: TStaticTileData;

begin

  staticTileData := ResMan.Tiledata.StaticTiles[AStaticItem.TileID];

  AStaticItem.PriorityBonus := 0;

  if not ((staticTileData.Flags and tdfBackground) = tdfBackground) then

    AStaticItem.PriorityBonus := AStaticItem.PriorityBonus + 1;

  if staticTileData.Height > 0 then

    AStaticItem.PriorityBonus := AStaticItem.PriorityBonus + 1;

  AStaticItem.Priority := AStaticItem.Z + AStaticItem.PriorityBonus;

  AStaticItem.PrioritySolver := APrioritySolver;

end;

procedure TLandscape.OnBlocksPacket(ABuffer: TEnhancedMemoryStream);

var

  index: TGenericIndex;

  map: TMapBlock;

  statics: TStaticBlock;

  coords: TBlockCoords;

  count: Word;

  id: Integer;

begin

  index := TGenericIndex.Create(nil);

  while ABuffer.Position < ABuffer.Size do

  begin

    ABuffer.Read(coords, SizeOf(TBlockCoords));

    id := GetID(coords.X, coords.Y);

    map := TMapBlock.Create(ABuffer, coords.X, coords.Y);

    count := ABuffer.ReadWord;

    if count > 0 then

      index.Lookup := ABuffer.Position

    else

      index.Lookup := $FFFFFFFF;

    index.Size := count * 7;

    statics := TSeperatedStaticBlock.Create(ABuffer, index, coords.X, coords.Y);

    FBlockCache.RemoveID(id);

    FBlockCache.StoreID(id, TBlock.Create(map, statics));

    FOpenRequests[coords.Y * FWidth + coords.X] := False;

  end;

  index.Free;

  if Assigned(FOnChange) then FOnChange;

end;

procedure TLandscape.OnDrawMapPacket(ABuffer: TEnhancedMemoryStream);

var

  x, y: Word;

  cell: TMapCell;

begin

  x := ABuffer.ReadWord;

  y := ABuffer.ReadWord;

  cell := GetMapCell(x, y);

  if cell <> nil then

  begin

    cell.Altitude := ABuffer.ReadShortInt;

    cell.TileID := ABuffer.ReadWord;

    if Assigned(FOnChange) then FOnChange;

  end;

end;

procedure TLandscape.OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream);

var

  x, y: Word;

  block: TSeperatedStaticBlock;

  staticItem: TStaticItem;

  targetStaticList: TList;

  i: Integer;

begin

  x := ABuffer.ReadWord;

  y := ABuffer.ReadWord;

  block := GetStaticBlock(x div 8, y div 8);

  if block <> nil then

  begin

    staticItem := TStaticItem.Create(nil, nil, 0, 0);

    staticItem.X := x;

    staticItem.Y := y;

    staticItem.Z := ABuffer.ReadShortInt;

    staticItem.TileID := ABuffer.ReadWord;

    staticItem.Hue := ABuffer.ReadWord;

    targetStaticList := block.Cells[(y mod 8) * 8 + x mod 8];

    targetStaticList.Add(staticItem);

    for i := 0 to targetStaticList.Count - 1 do

      UpdateStaticsPriority(TStaticItem(targetStaticList.Items[i]), i);

    ListSort(targetStaticList, @Compare);

    staticItem.Owner := block;

    if Assigned(FOnChange) then FOnChange;

  end;

end;

procedure TLandscape.OnDeleteStaticPacket(ABuffer: TEnhancedMemoryStream);

var

  block: TSeperatedStaticBlock;

  i: Integer;

  statics: TList;

  staticInfo: TStaticInfo;

  staticItem: TStaticItem;

begin

  ABuffer.Read(staticInfo, SizeOf(TStaticInfo));

  block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);

  if block <> nil then

  begin

    statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];

    for i := 0 to statics.Count - 1 do

    begin

      staticItem := TStaticItem(statics.Items[i]);

      if (staticItem.Z = staticInfo.Z) and

         (staticItem.TileID = staticInfo.TileID) and

         (staticItem.Hue = staticInfo.Hue) then

      begin

        statics.Delete(i);

        staticItem.Delete;

        if Assigned(FOnChange) then FOnChange;

        Break;

      end;

    end;

  end;

end;

procedure TLandscape.OnElevateStaticPacket(ABuffer: TEnhancedMemoryStream);

var

  block: TSeperatedStaticBlock;

  i,j : Integer;

  statics: TList;

  staticInfo: TStaticInfo;

  staticItem: TStaticItem;

begin

  ABuffer.Read(staticInfo, SizeOf(TStaticInfo));

  block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);

  if block <> nil then

  begin

    statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];

    for i := 0 to statics.Count - 1 do

    begin

      staticItem := TStaticItem(statics.Items[i]);

      if (staticItem.Z = staticInfo.Z) and

         (staticItem.TileID = staticInfo.TileID) and

         (staticItem.Hue = staticInfo.Hue) then

      begin

        staticItem.Z := ABuffer.ReadShortInt;

        for j := 0 to statics.Count - 1 do

          UpdateStaticsPriority(TStaticItem(statics.Items[j]), j);

        ListSort(statics, @Compare);

        if Assigned(FOnChange) then FOnChange;

        Break;

      end;

    end;

  end;

end;

procedure TLandscape.OnMoveStaticPacket(ABuffer: TEnhancedMemoryStream);

var

  sourceBlock, targetBlock: TSeperatedStaticBlock;

  i: Integer;

  statics: TList;

  staticInfo: TStaticInfo;

  staticItem: TStaticItem;

  newX, newY: Word;

  item: PLinkedItem;

begin

  staticItem := nil;

  ABuffer.Read(staticInfo, SizeOf(TStaticInfo));

  newX := EnsureRange(ABuffer.ReadWord, 0, FCellWidth - 1);

  newY := EnsureRange(ABuffer.ReadWord, 0, FCellHeight - 1);

  sourceBlock := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);

  targetBlock := GetStaticBlock(newX div 8, newY div 8);

  if sourceBlock <> nil then

  begin

    statics := sourceBlock.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];

    i := 0;

    while (i < statics.Count) and (staticItem = nil) do

    begin

      staticItem := TStaticItem(statics.Items[i]);

      if (staticItem.Z <> staticInfo.Z) or

         (staticItem.TileID <> staticInfo.TileID) or

         (staticItem.Hue <> staticInfo.Hue) then

      begin

        staticItem := nil;

      end;

      Inc(i);

    end;

    if staticItem <> nil then

    begin

      statics.Remove(staticItem);

      staticItem.Delete;

    end;

  end;

  if targetBlock <> nil then

  begin

    staticItem := TStaticItem.Create(nil, nil, 0, 0);

    staticItem.X := newX;

    staticItem.Y := newY;

    staticItem.Z := staticInfo.Z;

    staticItem.TileID := staticInfo.TileID;

    staticItem.Hue := staticInfo.Hue;

    statics := targetBlock.Cells[(newY mod 8) * 8 + newX mod 8];

    statics.Add(staticItem);

    for i := 0 to statics.Count - 1 do

      UpdateStaticsPriority(TStaticItem(statics.Items[i]), i);

    ListSort(statics, @Compare);

    staticItem.Owner := targetBlock;

  end;

  if Assigned(FOnChange) then FOnChange;

end;

procedure TLandscape.OnHueStaticPacket(ABuffer: TEnhancedMemoryStream);

var

  block: TSeperatedStaticBlock;

  i,j : Integer;

  statics: TList;

  staticInfo: TStaticInfo;

  staticItem: TStaticItem;

begin

  ABuffer.Read(staticInfo, SizeOf(TStaticInfo));

  block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);

  if block <> nil then

  begin

    statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];

    for i := 0 to statics.Count - 1 do

    begin

      staticItem := TStaticItem(statics.Items[i]);

      if (staticItem.Z = staticInfo.Z) and

         (staticItem.TileID = staticInfo.TileID) and

         (staticItem.Hue = staticInfo.Hue) then

      begin

        staticItem.Hue := ABuffer.ReadWord;

        if Assigned(FOnChange) then FOnChange;

        Break;

      end;

    end;

  end;

end;

procedure TLandscape.OnRemoveCachedObject(AObject: TObject);

var

  block: TBlock;

begin

  block := AObject as TBlock;

  if block <> nil then

    dmNetwork.Send(TFreeBlockPacket.Create(block.Map.X, block.Map.Y));

end;

{ TMaterial }

constructor TMaterial.Create(AWidth, AHeight: Integer;

  AGraphic: TSingleImage);

var

  caps: TGLTextureCaps;

begin

  inherited Create;

  FRealWidth := AWidth;

  FRealHeight := AHeight;

  GetGLTextureCaps(caps);

  if caps.PowerOfTwo then

  begin

    if IsPow2(AWidth) then FWidth := AWidth else FWidth := NextPow2(AWidth);

    if IsPow2(AHeight) then FHeight := AHeight else FHeight := NextPow2(AHeight);

  end else

  begin

    FWidth := AWidth;

    FHeight := AHeight;

  end;

  FGraphic := TSingleImage.CreateFromParams(FWidth, FHeight, ifA8R8G8B8);

  AGraphic.CopyTo(0, 0, AWidth, AHeight, FGraphic, 0, 0);

  UpdateTexture;

end;

destructor TMaterial.Destroy;

begin

  if FGraphic <> nil then FreeAndNil(FGraphic);

  if FTexture <> 0 then glDeleteTextures(1, @FTexture);

  inherited Destroy;

end;

function TMaterial.HitTest(AX, AY: Integer): Boolean;

var

  pixel: TColor32Rec;

begin

  Result := False;

  //writeln(FGraphic.Width, ',', FGraphic.Height, ',', AX, ',', AY);

  if InRange(AX, 0, FGraphic.Width - 1) and

     InRange(AY, 0, FGraphic.Height - 1) then

  begin

    pixel := GetPixel32(FGraphic.ImageDataPointer^, AX, AY);

    if pixel.A > 0 then

      Result := True;

  end;

end;

procedure TMaterial.UpdateTexture;

begin

  if FTexture <> 0 then glDeleteTextures(1, @FTexture);

  FTexture := CreateGLTextureFromImage(FGraphic.ImageDataPointer^, 0, 0, False, ifUnknown, @FWidth, @FHeight);

  glBindTexture(GL_TEXTURE_2D, FTexture);

  {glGetTexLevelParameteriv(GL_TEXTURE_2D, 0, GL_TEXTURE_WIDTH, @FWidth);

  glGetTexLevelParameteriv(GL_TEXTURE_2D, 0, GL_TEXTURE_HEIGHT, @FHeight);}

  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);

  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);

  glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);

  glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);

end;

{ TTileList }

constructor TTileList.Create;

begin

  inherited Create;

  FFirst := nil;

  FLastBlock := nil;

end;

destructor TTileList.Destroy;

begin

  Clear;

  inherited Destroy;

end;

procedure TTileList.Clear;

var

  current, next: PBlockInfo;

begin

  current := FFirst;

  while current <> nil do

  begin

    next := current^.Next;

    Dispose(current);

    current := next;

  end;

  FFirst := nil;

  FLastBlock := nil;

end;

function TTileList.Iterate(var ABlockInfo: PBlockInfo): Boolean;

begin

  if ABlockInfo = nil then

    ABlockInfo := FFirst

  else

    ABlockInfo := ABlockInfo^.Next;

  Result := ABlockInfo <> nil;

end;

procedure TTileList.Add(AItem: TWorldItem);

var

  current: PBlockInfo;

begin

  New(current);

  current^.Item := AItem;

  current^.Next := nil;

  if FFirst = nil then FFirst := current;

  if FLastBlock <> nil then FLastBlock^.Next := current;

  FLastBlock := current;

end;

procedure TTileList.Delete(AItem: TWorldItem);

var

  current, last, next: PBlockInfo;

begin

  last := nil;

  current := FFirst;

  while current <> nil do

  begin

    if current^.Item = AItem then

    begin

      if FFirst = current then FFirst := current^.Next;

      if FLastBlock = current then FLastBlock := last;

      if last <> nil then last^.Next := current^.Next;

      Dispose(current);

      next := nil;

    end else

      next := current^.Next;

    last := current;

    current := next;

  end;

end;

{ TScreenBuffer }

procedure TScreenBuffer.OnTileRemoved(ATile: TMulBlock);

var

  currentItem, lastItem, nextItem: PBlockInfo;

begin

  lastItem := nil;

  currentItem := FFirst;

  while currentItem <> nil do

  begin

    if currentItem^.Item = ATile then

    begin

      if FFirst = currentItem then FFirst := currentItem^.Next;

      if FLastBlock = currentItem then FLastBlock := lastItem;

      if lastItem <> nil then lastItem^.Next := currentItem^.Next;

      Dispose(currentItem);

      nextItem := nil;

    end else

      nextItem := currentItem^.Next;

    lastItem := currentItem;

    currentItem := nextItem;

  end;

end;

procedure TScreenBuffer.Clear;

var

  current, next: PBlockInfo;

begin

  current := FFirst;

  while current <> nil do

  begin

    next := current^.Next;

    current^.Item.Locked := False;

    current^.Item.OnDestroy.UnregisterEvent(@OnTileRemoved);

    Dispose(current);

    current := next;

  end;

  FFirst := nil;

  FLastBlock := nil;

end;

function TScreenBuffer.Find(AScreenPosition: TPoint): PBlockInfo;

var

  current: PBlockInfo;

begin

  Result := nil;

  current := FFirst;

  while (current <> nil) and (Result = nil) do

  begin

    if PtInRect(current^.ScreenRect, AScreenPosition) and

       current^.Material.HitTest(AScreenPosition.x - current^.ScreenRect.Left,

                                 AScreenPosition.y - current^.ScreenRect.Top) then

    begin

      Result := current;

    end;

    current := current^.Next;

  end;

end;

procedure TScreenBuffer.Store(AScreenRect: TRect; AItem: TWorldItem;

  AMaterial: TMaterial);

var

  current: PBlockInfo;

begin

  New(current);

  AItem.Locked := True;

  AItem.OnDestroy.RegisterEvent(@OnTileRemoved);

  current^.ScreenRect := AScreenRect;

  current^.Item := AItem;

  current^.Material := AMaterial;

  current^.Next := FFirst;

  FFirst := current;

  if FLastBlock = nil then FLastBlock := current;

end;

end.