CentrED/Client/ULandscape.pas

(*
 * 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 2009 Andreas Schneider
 *)
unit ULandscape;

{$mode objfpc}{$H+}

interface

uses
  SysUtils, Classes, math, matrix, LCLIntf, GL, GLu, ImagingOpenGL, Imaging,
  ImagingClasses, ImagingTypes, ImagingUtility, DOM, XMLRead,
  UGenericIndex, UMap, UStatics, UArt, UTexture, UTiledata, UHue, UWorldItem,
  UMulBlock, UAnimData, UfrmInitialize,
  UEnhancedMemoryStream, UGLFont,
  UCacheManager;

type
  TGlVector3f = array[0..2] of GLfloat;
  PNormals = ^TNormals;
  TNormals = array[0..3] of TGlVector3f;
  PRadarBlock = ^TRadarBlock;
  TRadarBlock = array[0..7, 0..7] of Word;
  
  { TMaterial }
  
  TMaterial = class(ICacheable)
    constructor Create;
    destructor Destroy; override;
  protected
    FRefCount: Integer;
    FWidth: Integer;
    FHeight: Integer;
    FRealWidth: Integer;
    FRealHeight: Integer;
    FGraphic: TMultiImage;
    class procedure CalculateTextureDimensions(ACaps: TGLTextureCaps; ARealWidth,
      ARealHeight: Integer; out AWidth, AHeight: Integer);
    function GenerateTexture(AImage: TBaseImage): TGLuint;
    function GetTexture: GLuint; virtual; abstract;
  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 GetTexture;

    procedure AddRef;
    procedure DelRef;
    function HitTest(AX, AY: Integer): Boolean;
    function HitTest(AX, AY: Integer; Zoom: Single): Boolean;

    {ICacheable}
    function CanBeRemoved: Boolean;
    procedure RemoveFromCache;
  end;

  { TSimpleMaterial }

  TSimpleMaterial = class(TMaterial)
    constructor Create(AGraphic: TBaseImage);
    destructor Destroy; override;
  protected
    FTexture: TGLuint;
    function GetTexture: GLuint; override;
  end;

  { TAnimMaterial }

  TAnimMaterial = class(TMaterial)
    constructor Create(ABaseID: LongWord; AAnimData: TAnimData; AHue: THue = nil;
      APartialHue: Boolean = False);
    destructor Destroy; override;
  protected
    FActiveFrame: Byte;
    FNextChange: DWord;
    FAnimData: TAnimData;
    FTextures: array of TGLuint;
    function GetTexture: GLuint; override;
  end;

  TMaterialCache = specialize TCacheManager<TMaterial>;
  
  { TLandTextureManager }
  
  TLandTextureManager = class
    constructor Create;
    destructor Destroy; override;
  protected
    FArtCache: TMaterialCache;
    FTexCache: TMaterialCache;
    FAnimCache: TMaterialCache;
    FUseAnims: Boolean;
  public
    property UseAnims: Boolean read FUseAnims write FUseAnims;
    function GetArtMaterial(ATileID: LongWord): TMaterial; overload;
    function GetArtMaterial(ATileID: LongWord; AHue: THue;
      APartialHue: Boolean): TMaterial; overload;
    function GetStaticMaterial(AStaticItem: TStaticItem;
      AOverrideHue: Integer = -1): TMaterial;
    function GetTexMaterial(ATileID: LongWord): TMaterial;
  end;

 { TSeperatedStaticBlock }

  TSeperatedStaticBlock = class(TStaticBlock)
    constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); overload;
    constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
    destructor Destroy; override;
  public
    Cells: array[0..63] of TStaticItemList;
    { Methods }
    function Clone: TSeperatedStaticBlock; override;
    function GetSize: Integer; override;
    procedure RebuildList;
  end;

  TLandscape = class;
  
  { TBlock }

  TBlock = class
    constructor Create(AMap: TMapBlock; AStatics: TStaticBlock);
    destructor Destroy; override;
  protected
    { Fields }
    FMapBlock: TMapBlock;
    FStaticBlock: TStaticBlock;
  public
    { Fields }
    property Map: TMapBlock read FMapBlock;
    property Static: TStaticBlock read FStaticBlock;
    { Methods }
    procedure UpdateBlockAcess(ALandscape: TLandscape);
  end;
  
  TLandscapeChangeEvent = procedure of object;
  TMapChangedEvent = procedure(AMapCell: TMapCell) of object;
  TNewBlockEvent = procedure(ABlock: TBlock) of object;
  TStaticChangedEvent = procedure(AStaticItem: TStaticItem) of object;

  TScreenBuffer = class;
  TBlockCache = specialize TCacheManager<TBlock>;

  { TLandscape }

  TLandscape = class
    constructor Create(AWidth, AHeight: Word);
    destructor Destroy; override;
  protected
    { Members }
    FWidth: Word;
    FHeight: Word;
    FCellWidth: Word;
    FCellHeight: Word;
    FBlockCache: TBlockCache;
    FBlockCacheBak: TBlockCache;
    FOnChange: TLandscapeChangeEvent;
    FOnMapChanged: TMapChangedEvent;
    FOnNewBlock: TNewBlockEvent;
    FOnStaticInserted: TStaticChangedEvent;
    FOnStaticDeleted: TStaticChangedEvent;
    FOnStaticElevated: TStaticChangedEvent;
    FOnStaticHued: TStaticChangedEvent;
    FOpenRequests: TBits;
    FWriteMap: TBits;
    FDrawMap: TBits;
    FMaxStaticID: Cardinal;
    BlockCacheSize: Integer;
    { Methods }
    function GetMapBlock(AX, AY: Word): TMapBlock;
    function GetMapCell(AX, AY: Integer): TMapCell;
    function GetNormals(AX, AY: Integer): TNormals;
    function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;
    function GetStaticList(AX, AY: Word): TStaticItemList;
    { Events }
    procedure OnRemoveCachedObject(ABlock: TBlock);
    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
    { Fields }
    property Width: Word read FWidth;
    property Height: Word read FHeight;
    property CellWidth: Word read FCellWidth;
    property CellHeight: Word read FCellHeight;
    property MapCell[X, Y: Integer]: TMapCell read GetMapCell;
    property StaticList[X, Y: Word]: TStaticItemList read GetStaticList;
    property Normals[X, Y: Integer]: TNormals read GetNormals;
    property MaxStaticID: Cardinal read FMaxStaticID;
    property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange;
    property OnMapChanged: TMapChangedEvent read FOnMapChanged write FOnMapChanged;
    property OnNewBlock: TNewBlockEvent read FOnNewBlock write FOnNewBlock;
    property OnStaticInserted: TStaticChangedEvent read FOnStaticInserted
      write FOnStaticInserted;
    property OnStaticDeleted: TStaticChangedEvent read FOnStaticDeleted
      write FOnStaticDeleted;
    property OnStaticElevated: TStaticChangedEvent read FOnStaticElevated
      write FOnStaticElevated;
    property OnStaticHued: TStaticChangedEvent read FOnStaticHued
      write FOnStaticHued;
    { Methods }
    function CanWrite(AX, AY: Word): Boolean;
    procedure FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth, AHeight: Word;
      AMap, AStatics, ATDWalls, ATDBridges, ATDRoofs, ATDSurfaces, ATDFoliage, ATDWet: Boolean;
      ANoDraw: Boolean; AAdditionalTiles: TWorldItemList = nil);
    function GetEffectiveAltitude(ATile: TMapCell): ShortInt;
    function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;
    procedure GetNormals(AX, AY: Word; var ANormals: TNormals);
    procedure LoadNoDrawMap(AFileName: String);
    procedure MoveStatic(AStatic: TStaticItem; AX, AY: Word);
    procedure PrepareBlocks(AX1, AY1, AX2, AY2: Word);
    procedure UpdateBlockAccess;
    procedure UpdateWriteMap(AStream: TEnhancedMemoryStream);
    procedure ResizeBlockCache(Count: Integer);
  end;

  { TGLText }

  TGLText = class
    constructor Create(AFont: TGLFont; AText: String);
  protected
    FFont: TGLFont;
    FText: String;
    FWidth: Integer;
    FHeight: Integer;
  public
    procedure Render(AScreenRect: TRect);
  end;

  TScreenState = (ssNormal, ssFiltered, ssGhost);
  TWalkRestriction = (wrNone, wrCanWalk, wrCannotWalk);

  PBlockInfo = ^TBlockInfo;
  TBlockInfo = record
    ScreenRect: TRect;
    DrawQuad: array[0..3,0..1] of TGLint;
    RealQuad: array[0..3,0..1] of TGLint;
    LineWidth: array[0..2] of GLfloat;
    LineDraw: array[0..2,0..1,0..1] of TGLint;
    Item: TWorldItem;
    HighRes: TMaterial;
    LowRes: TMaterial;
    Normals: PNormals;
    State: TScreenState;
    Highlighted: Boolean;
    HueOverride: Boolean;
    Hue: Word;
    CheckRealQuad: Boolean;
    Translucent: Boolean;
    WalkRestriction: TWalkRestriction;
    Text: TGLText;
    Next: PBlockInfo;
  end;

  { TScreenBuffer }

  TScreenBuffer = class
    constructor Create; virtual;
    destructor Destroy; override;
  protected
    { Members }
    FCount: Cardinal;
    FShortCuts: array[-1..10] of PBlockInfo; //-1 = last, 0 = first, 1..10 = other shortcuts
    FShortCutsValid: Boolean;
    FSerial: Cardinal;
  public
    { Methods }
    function Add(AItem: TWorldItem): PBlockInfo;
    procedure Clear;
    procedure Delete(AItem: TWorldItem);
    function Find(AScreenPosition: TPoint; Zoom: Single): PBlockInfo;
    function Find(AX, AY: Word): PBlockInfo;
    function GetSerial: Cardinal;
    function Insert(AItem: TWorldItem): PBlockInfo;
    function Iterate(var ABlockInfo: PBlockInfo): Boolean;
    procedure UpdateShortcuts;
    function UpdateSortOrder(AItem: TWorldItem): PBlockInfo;
    { Events }
    procedure OnTileRemoved(ATile: TMulBlock);
  end;
  
  TStaticInfo = packed record
    X: Word;
    Y: Word;
    Z: ShortInt;
    TileID: Word;
    Hue: Word;
  end;

implementation

uses
  UGameResources, UdmNetwork, UPackets, UPacketHandlers, Logging;

function GetID(AX, AY: Word): Integer; inline;
begin
  Result := (AX shl 16) or AY;
end;

operator := (AVector: Tvector3_single) GLVector: TGlVector3f;
begin
  GLVector[0] := AVector.data[0];
  GLVector[1] := AVector.data[1];
  GLVector[2] := AVector.data[2];
end;

{ TLandTextureManager }

constructor TLandTextureManager.Create;
begin
  inherited Create;
  FArtCache := TMaterialCache.Create(1024);
  FTexCache := TMaterialCache.Create(128);
  FAnimCache := TMaterialCache.Create(128);
  FUseAnims := True;
end;

destructor TLandTextureManager.Destroy;
begin
  FreeAndNil(FArtCache);
  FreeAndNil(FTexCache);
  FreeAndNil(FAnimCache);
  inherited Destroy;
end;

function TLandTextureManager.GetArtMaterial(ATileID: LongWord): TMaterial;
var
  artEntry: TArt;
  animData: TAnimData;
begin
  Result := nil;

  if FUseAnims and (ATileID >= $4000) and (tdfAnimation in
      ResMan.Tiledata.StaticTiles[ATileID - $4000].Flags) then
  begin
    animData := ResMan.Animdata.AnimData[ATileID - $4000];
    if (animData.FrameCount > 0) and not FAnimCache.QueryID(ATileID, Result) then
    begin
      Result := TAnimMaterial.Create(ATileID, animData);
      FAnimCache.StoreID(ATileID, Result);
    end;
  end;

  if (Result = nil) and not FArtCache.QueryID(ATileID, Result) then
  begin
    artEntry := TArt(ResMan.Art.Block[ATileID]);

    Result := TSimpleMaterial.Create(artEntry.Graphic);
    FArtCache.StoreID(ATileID, Result);

    artEntry.Free;
  end;

  Result.AddRef;
end;

function TLandTextureManager.GetArtMaterial(ATileID: LongWord; AHue: THue;
  APartialHue: Boolean): TMaterial;
var
  artEntry: TArt;
  animData: TAnimData;
  id: Integer;
begin
  if AHue = nil then
  begin
    Result := GetArtMaterial(ATileID);
  end else
  begin
    Result := nil;
    id := ATileID or (((AHue.ID + 1) and $3FFF) shl 16) or (Byte(APartialHue) shl 30);

    if FUseAnims and (ATileID >= $4000) and (tdfAnimation in
      ResMan.Tiledata.StaticTiles[ATileID - $4000].Flags) then
    begin
      animData := ResMan.Animdata.AnimData[ATileID - $4000];
      if (animData.FrameCount > 0) and not FAnimCache.QueryID(id, Result) then
      begin
        Result := TAnimMaterial.Create(ATileID, animData, AHue, APartialHue);
        FAnimCache.StoreID(id, Result);
      end;
    end;

    if (Result = nil) and not FArtCache.QueryID(id, Result) then
    begin
      artEntry := ResMan.Art.GetArt(ATileID, 0, AHue, APartialHue);

      Result := TSimpleMaterial.Create(artEntry.Graphic);
      FArtCache.StoreID(id, Result);

      artEntry.Free;
    end;
    Result.AddRef;
  end;
end;

function TLandTextureManager.GetStaticMaterial(AStaticItem: TStaticItem;
  AOverrideHue: Integer = -1): TMaterial;
var
  staticTiledata: TStaticTiledata;
  hue: THue;
begin
  staticTiledata := ResMan.Tiledata.StaticTiles[AStaticItem.TileID];
  if AOverrideHue < 0 then
    AOverrideHue := AStaticItem.Hue;

  if AOverrideHue > 0 then
    hue := ResMan.Hue.Hues[AOverrideHue - 1]
  else
    hue := nil;

  Result := GetArtMaterial($4000 + AStaticItem.TileID, hue,
    tdfPartialHue in staticTiledata.Flags);
end;

function TLandTextureManager.GetTexMaterial(ATileID: LongWord): TMaterial;
var
  texEntry: TTexture;
  texID: Integer;
begin
  if not FTexCache.QueryID(ATileID, Result) then
  begin
    texID := ResMan.Tiledata.LandTiles[ATileID].TextureID;
    if texID > 0 then
    begin
      texEntry := TTexture(ResMan.Texmaps.Block[texID]);

      Result := TSimpleMaterial.Create(texEntry.Graphic);
      FTexCache.StoreID(ATileID, Result);

      texEntry.Free;
    end else
      Result := nil;
  end;

  if Result <> nil then
    Result.AddRef;
end;

{ TSeperatedStaticBlock }

constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex;
  AX, AY: Word);
var
  i, ts: Integer;
  item: TStaticItem;
  block: TMemoryStream;
begin
  inherited Create;
  FItems := TStaticItemList.Create(False);

  FX := AX;
  FY := AY;

  for i := 0 to 63 do
    Cells[i] := TStaticItemList.Create;

  if not UseStaticsOldFormat
     then ts := 7
     else ts := 11;

  if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
  begin
    AData.Position := AIndex.Lookup;
    block := TMemoryStream.Create;
    block.CopyFrom(AData, AIndex.Size);
    block.Position := 0;

    for i := 1 to (AIndex.Size div ts) do
    begin
      item := TStaticItem.Create(Self, block, AX, AY);
      Cells[(item.Y mod 8) * 8 + (item.X mod 8)].Add(item);
    end;
    block.Free;
  end;
end;

constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex);
begin
  Create(AData, AIndex, 0, 0);
end;

destructor TSeperatedStaticBlock.Destroy;
var
  i: Integer;
begin
  FreeAndNil(FItems);

  for i := 0 to 63 do
  begin
    if Cells[i] <> nil then
      FreeAndNil(Cells[i]);
  end;

  inherited Destroy;
end;

function TSeperatedStaticBlock.Clone: TSeperatedStaticBlock;
begin
  raise Exception.Create('TSeperatedStaticBlock.Clone is not implemented (yet).');
  Result := nil;
end;

function TSeperatedStaticBlock.GetSize: Integer;
begin
  RebuildList;
  Result := inherited GetSize;
end;

procedure TSeperatedStaticBlock.RebuildList;
var
  i, j, solver: Integer;
begin
  FItems.Clear;
  solver := 0;
  for i := 0 to 63 do
  begin
    if Cells[i] <> nil then
    begin
      for j := 0 to Cells[i].Count - 1 do
      begin
        FItems.Add(Cells[i].Items[j]);
        TStaticItem(Cells[i].Items[j]).UpdatePriorities(
          ResMan.Tiledata.StaticTiles[TStaticItem(Cells[i].Items[j]).TileID],
          solver);
        Inc(solver);
      end;
    end;
  end;
  Sort;
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;

procedure TBlock.UpdateBlockAcess(ALandscape: TLandscape);
var
  staticItem: TStaticItem;
  i: Integer;
begin
  for i := Low(FMapBlock.Cells) to High(FMapBlock.Cells) do
  begin
    FMapBlock.Cells[i].CanBeEdited := ALandscape.CanWrite(FMapBlock.Cells[i].X,
      FMapBlock.Cells[i].Y);
  end;

  if FStaticBlock is TSeperatedStaticBlock then
    TSeperatedStaticBlock(FStaticBlock).RebuildList; //fill items

  for i := 0 to FStaticBlock.Items.Count - 1 do
  begin
    staticItem := FStaticBlock.Items[i];
    staticItem.CanBeEdited := ALandscape.CanWrite(staticItem.X,
      staticItem.Y);
  end;
end;

{ TLandscape }

constructor TLandscape.Create(AWidth, AHeight: Word);
var
  i: Integer;
begin
  inherited Create;
  FWidth := AWidth;
  FHeight := AHeight;
  FCellWidth := FWidth * 8;
  FCellHeight := FHeight * 8;
  BlockCacheSize := 256;
  FBlockCache := TBlockCache.Create(BlockCacheSize); //856
  FBlockCache.OnRemoveObject := @OnRemoveCachedObject;

  FOnChange := nil;
  FOnNewBlock := nil;
  FOnStaticDeleted := nil;
  FOnStaticElevated := nil;
  FOnStaticHued := nil;
  FOnStaticInserted := nil;

  FOpenRequests := TBits.Create(FWidth * FHeight);
  FOpenRequests.Clearall; //set all to 0
  FWriteMap := TBits.Create(FCellWidth * FCellHeight);
  for i := 0 to FWriteMap.Size - 1 do
    FWriteMap[i] := True;

  //FMaxStaticID := $1FFDC;
  FMaxStaticID := Min(Min(ResMan.Animdata.AnimCount, ResMan.Tiledata.StaticCount),
    ResMan.Art.EntryCount - $4000);
  Logger.Send([lcClient, lcInfo], 'Landscape recognizes $%x StaticTile IDs.',
    [FMaxStaticId]);

  FDrawMap := TBits.Create($4000 + FMaxStaticID);
  for i := 0 to FDrawMap.Size - 1 do
    FDrawMap[i] := True;

  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;
begin
  if (FBlockCacheBak <> nil) then
  begin
    FBlockCacheBak.OnRemoveObject := nil;
    FreeAndNil(FBlockCacheBak);
  end;
  if FBlockCache <> nil then
  begin
    FBlockCache.OnRemoveObject := nil;
    FreeAndNil(FBlockCache);
  end;

  FreeAndNil(FOpenRequests);
  FreeAndNil(FWriteMap);
  FreeAndNil(FDrawMap);
  
  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.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), block) then
      Result := block.Map;
  end;
end;

function TLandscape.GetMapCell(AX, AY: Integer): 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.GetNormals(AX, AY: Integer): TNormals;
begin
  GetNormals(AX, AY, Result);
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), block) then
      Result := TSeperatedStaticBlock(block.Static);
  end;
end;

function TLandscape.GetStaticList(AX, AY: Word): TStaticItemList;
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;

procedure TLandscape.OnRemoveCachedObject(ABlock: TBlock);
begin
  if ABlock <> nil then
    dmNetwork.Send(TFreeBlockPacket.Create(ABlock.Map.X, ABlock.Map.Y));
end;

procedure TLandscape.OnBlocksPacket(ABuffer: TEnhancedMemoryStream);
var
  index: TGenericIndex;
  map: TMapBlock;
  statics: TStaticBlock;
  coords: TBlockCoords;
  count: Word;
  id: Integer;
  block: TBlock;
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 := -1;
    if not UseStaticsOldFormat
      then index.Size := count * 7
      else index.Size := count * 11;
    statics := TSeperatedStaticBlock.Create(ABuffer, index, coords.X, coords.Y);

    FBlockCache.RemoveID(id);
    block := TBlock.Create(map, statics);
    block.UpdateBlockAcess(Self);
    FBlockCache.StoreID(id, block);

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

    if Assigned(FOnNewBlock) then FOnNewBlock(block);
  end;
  index.Free;
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(FOnMapChanged) then FOnMapChanged(cell);
  end;
end;

procedure TLandscape.OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream);
var
  x, y: Word;
  block: TSeperatedStaticBlock;
  staticItem: TStaticItem;
  targetStaticList: TStaticItemList;
  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
      targetStaticList.Items[i].UpdatePriorities(
        ResMan.Tiledata.StaticTiles[targetStaticList.Items[i].TileID],
        i);
    targetStaticList.Sort(@CompareStaticItems);
    staticItem.Owner := block;
    staticItem.CanBeEdited := CanWrite(x, y);

    if Assigned(FOnStaticInserted) then FOnStaticInserted(staticItem);
  end;
end;

procedure TLandscape.OnDeleteStaticPacket(ABuffer: TEnhancedMemoryStream);
var
  block: TSeperatedStaticBlock;
  i: Integer;
  statics: TStaticItemList;
  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 := statics.Items[i];
      if (staticItem.Z = staticInfo.Z) and
         (staticItem.TileID = staticInfo.TileID) and
         (staticItem.Hue = staticInfo.Hue) then
      begin
        if Assigned(FOnStaticDeleted) then FOnStaticDeleted(staticItem);
        staticItem.Delete;
        statics.Delete(i);

        Break;
      end;
    end;
  end;
end;

procedure TLandscape.OnElevateStaticPacket(ABuffer: TEnhancedMemoryStream);
var
  block: TSeperatedStaticBlock;
  i,j : Integer;
  statics: TStaticItemList;
  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 := 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
          statics.Items[j].UpdatePriorities(
            ResMan.Tiledata.StaticTiles[statics.Items[j].TileID],
            j);
        statics.Sort(@CompareStaticItems);

        if Assigned(FOnStaticElevated) then FOnStaticElevated(staticItem);

        Break;
      end;
    end;
  end;
end;

procedure TLandscape.OnMoveStaticPacket(ABuffer: TEnhancedMemoryStream);
var
  sourceBlock, targetBlock: TSeperatedStaticBlock;
  i: Integer;
  statics: TStaticItemList;
  staticInfo: TStaticInfo;
  staticItem: TStaticItem;
  newX, newY: Word;
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 := 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
      if Assigned(FOnStaticDeleted) then FOnStaticDeleted(staticItem);
      staticItem.Delete;
      statics.Remove(staticItem);
    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
      TStaticItem(statics.Items[i]).UpdatePriorities(
        ResMan.Tiledata.StaticTiles[TStaticItem(statics.Items[i]).TileID],
        i);
    statics.Sort(@CompareStaticItems);
    staticItem.Owner := targetBlock;
    staticItem.CanBeEdited := CanWrite(newX, newY);

    if Assigned(FOnStaticInserted) then FOnStaticInserted(staticItem);
  end;
end;

procedure TLandscape.OnHueStaticPacket(ABuffer: TEnhancedMemoryStream);
var
  block: TSeperatedStaticBlock;
  i : Integer;
  statics: TStaticItemList;
  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 := 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(FOnStaticHued) then FOnStaticHued(staticItem);
        Break;
      end;
    end;
  end;
end;

function TLandscape.CanWrite(AX, AY: Word): Boolean;
begin
  Result := FWriteMap[AX * FCellHeight + AY];
end;

procedure TLandscape.FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth,
  AHeight: Word; AMap, AStatics, ATDWalls, ATDBridges, ATDRoofs, ATDSurfaces, ATDFoliage, ATDWet: Boolean;
  ANoDraw: Boolean; AAdditionalTiles: TWorldItemList = nil);
var
  drawMapCell: TMapCell;
  drawStatics: TStaticItemList;
  i, x, y: Integer;
  tempDrawList: TWorldItemList;
  staticTileData: TStaticTiledata;
begin
  ADrawList.Clear;
  tempDrawList := TWorldItemList.Create(False);
  for x := AX to AX + AWidth do
  begin
    for y := AY to AY + AWidth do
    begin
      if AMap then
      begin
        drawMapCell := GetMapCell(x, y);
        if (drawMapCell <> nil) and (ANoDraw or FDrawMap[drawMapCell.TileID]) then
        begin
          drawMapCell.Priority := GetEffectiveAltitude(drawMapCell);
          drawMapCell.PriorityBonus := 0;
          drawMapCell.PrioritySolver := 0;
          tempDrawList.Add(drawMapCell);
        end;
      end;

      if AStatics then
      begin
        drawStatics := GetStaticList(x, y);
        if drawStatics <> nil then
          for i := 0 to drawStatics.Count - 1 do
          begin
            staticTileData := ResMan.Tiledata.StaticTiles[drawStatics[i].TileID];
            if ANoDraw or FDrawMap[drawStatics[i].TileID + $4000] then
            begin
              if not ATDWalls and ((tdfWall in staticTileData.Flags) or (tdfWindow in staticTileData.Flags)) then continue;
              if not ATDBridges and ((tdfBridge in staticTileData.Flags) or (tdfStairBack in staticTileData.Flags) or (tdfStairRight in staticTileData.Flags)) then continue;
              if not ATDRoofs and (tdfRoof in staticTileData.Flags) then continue;
              if not ATDSurfaces and (tdfSurface in staticTileData.Flags) then continue;
              if not ATDFoliage  and (tdfFoliage in staticTileData.Flags) then continue;
              if not ATDWet  and (tdfWet in staticTileData.Flags) then continue;
              drawStatics[i].UpdatePriorities(staticTileData, ADrawList.GetSerial);
              tempDrawList.Add(drawStatics[i]);
            end;
          end;
      end;
    end;
  end;

  for i := 0 to AAdditionalTiles.Count - 1 do
    tempDrawList.Add(AAdditionalTiles[i]);

  tempDrawList.Sort(@CompareWorldItems);
  for i := 0 to tempDrawList.Count - 1 do
    ADrawList.Add(TWorldItem(tempDrawList[i]));
  tempDrawList.Free;
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 := Min(north, south) + Abs(west - east) div 2
  else
    Result := Min(north, south) + Abs(north - south) div 2;
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;

procedure TLandscape.GetNormals(AX, AY: Word; var ANormals: TNormals);
type
  _Normals = array[0..3] of Tvector3_single;
var
  cells: array[0..2, 0..2] of _Normals;
  north, west, south, east: Tvector3_single;
  i, j: Integer;

  function Normalize(const AVector: Tvector3_single): Tvector3_single; inline;
  begin
    Result := AVector / AVector.length;
  end;

  function GetPlainNormals(X, Y: SmallInt): _Normals;
  var
    cell: TMapCell;
    north, west, south, east: ShortInt;
    u, v: Tvector3_single;
  begin
    cell := GetMapCell(X, Y);
    if cell <> nil 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].init(0, 0, 1);
      Result[1].init(0, 0, 1);
      Result[2].init(0, 0, 1);
      Result[3].init(0, 0, 1);
    end else
    begin
      u.init(-22, 22, (north - east) * 4);
      v.init(-22, -22, (west - north) * 4);
      Result[0] := Normalize(u >< v);

      u.init(22, 22, (east - south) * 4);
      v.init(-22, 22, (north - east) * 4);
      Result[1] := Normalize(u >< v);

      u.init(22, -22, (south - west) * 4);
      v.init(22, 22, (east - south) * 4);
      Result[2] := Normalize(u >< v);

      u.init(-22, -22, (west - north) * 4);
      v.init(22, -22, (south - west) * 4);
      Result[3] := Normalize(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];
  ANormals[0] := Normalize(north + west + east + south);

  north := cells[1, 0][2];
  west := cells[1, 1][1];
  east := cells[2, 0][3];
  south := cells[2, 1][0];
  ANormals[1] := Normalize(north + west + east + south);

  north := cells[1, 1][2];
  west := cells[1, 2][1];
  east := cells[2, 1][3];
  south := cells[2, 2][0];
  ANormals[2] := Normalize(north + west + east + south);

  north := cells[0, 1][2];
  west := cells[0, 2][1];
  east := cells[1, 1][3];
  south := cells[1, 2][0];
  ANormals[3] := Normalize(north + west + east + south);
end;

procedure TLandscape.LoadNoDrawMap(AFileName: String);
var
  XMLDoc:  TXMLDocument;
  iNode, node: TDOMNode;
  s: string;
  i, id: Integer;

begin
  frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['VirtualTiles.xml']));
  // Читаем xml файл с жесткого диска
  ReadXMLFile(XMLDoc, AFileName);
  if LowerCase(XMLDoc.DocumentElement.NodeName) = 'virtualtiles' then
  begin
    iNode := XMLDoc.DocumentElement.FirstChild;
    while iNode <> nil do
    begin
      if LowerCase(iNode.NodeName) = 'nodraw' then
      begin
        node := iNode.FirstChild;
        while node <> nil do
        begin
          s := LowerCase(node.NodeName);
          if (s = 'tile') or (s = 'land') or (s = 'item') then
            for i := node.Attributes.Length - 1 downto 0 do
              if LowerCase(node.Attributes[i].NodeName) = 'id' then
                if TryStrToInt(node.Attributes[i].NodeValue, id) then
                begin
                  if s = 'item'
                    then Inc(id, $4000);
                  if (id >= 0) and (id < FDrawMap.Size)
                    then FDrawMap[id] := False;
                end;
          node := node.NextSibling;
        end;
      end;
      iNode := iNode.NextSibling;
    end;
  end;
end;

procedure TLandscape.MoveStatic(AStatic: TStaticItem; AX, AY: Word);
var
  sourceBlock, targetBlock: TSeperatedStaticBlock;
  targetStaticList: TStaticItemList;
  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
        targetStaticList.Items[i].UpdatePriorities(
          ResMan.Tiledata.StaticTiles[targetStaticList.Items[i].TileID],
          i);
      targetStaticList.Sort(@CompareStaticItems);
      AStatic.UpdatePos(AX, AY, AStatic.Z);
      AStatic.Owner := targetBlock;
    end;
  end;
end;

procedure TLandscape.PrepareBlocks(AX1, AY1, AX2, AY2: Word);
var
  x, y, i: Integer;
  coords: TBlockCoordsArray;
  block: TBlock;
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), block)) 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;

procedure TLandscape.UpdateBlockAccess;
var
  cacheEntry: TBlockCache.PCacheEntry;
begin
  cacheEntry := nil;
  while FBlockCache.Iterate(cacheEntry) do
    if cacheEntry^.Obj <> nil then
      cacheEntry^.Obj.UpdateBlockAcess(Self);
end;

procedure TLandscape.UpdateWriteMap(AStream: TEnhancedMemoryStream);
var
  x1, y1, x2, y2: Word;
  i, areaCount, cellX, cellY: Integer;
begin
  Logger.EnterMethod([lcLandscape, lcDebug], 'TLandscape.UpdateWriteMap');

  areaCount := AStream.ReadWord;
  Logger.Send([lcLandscape, lcDebug], 'AreaCount', areaCount);

  if areaCount > 0 then
  begin
    FWriteMap.Clearall;
    for i := 0 to areaCount - 1 do
    begin
      x1 := AStream.ReadWord;
      y1 := AStream.ReadWord;
      x2 := AStream.ReadWord;
      y2 := AStream.ReadWord;
      for cellX := x1 to x2 do
        for cellY := y1 to y2 do
          FWriteMap[cellX * FCellHeight + cellY] := True;
    end;
  end else
    for i := 0 to FWriteMap.Size - 1 do
      FWriteMap[i] := True;

  Logger.Send([lcLandscape, lcDebug], 'WriteMap @ 0,0', FWriteMap[0]);

  UpdateBlockAccess;
  Logger.ExitMethod([lcLandscape, lcDebug], 'TLandscape.UpdateWriteMap');
end;

procedure TLandscape.ResizeBlockCache(Count: Integer);
begin
    if Count < 0 then Count:= 256;
    if FBlockCache <> nil then
    begin
      if BlockCacheSize = Count then exit;

      FBlockCache.OnRemoveObject := nil;
      if (FBlockCacheBak <> nil) then begin
        FBlockCacheBak.Clear;
        FreeAndNil(FBlockCacheBak);
        FBlockCacheBak := nil;
      end;
      if Count = 0 then exit;
      FBlockCacheBak := FBlockCache;

      BlockCacheSize:= Count;
      FBlockCache := TBlockCache.Create(BlockCacheSize); //256
      FBlockCache.OnRemoveObject := @OnRemoveCachedObject;
    end;
end;

{ TMaterial }

constructor TMaterial.Create;
begin
  FRefCount := 1;
end;

destructor TMaterial.Destroy;
begin
  FreeAndNil(FGraphic);
  inherited Destroy;
end;

class procedure TMaterial.CalculateTextureDimensions(ACaps: TGLTextureCaps;
  ARealWidth, ARealHeight: Integer; out AWidth, AHeight: Integer);
begin
  if ACaps.NonPowerOfTwo then
  begin
    AWidth := ARealWidth;
    AHeight := ARealHeight;
  end else
  begin
    if IsPow2(ARealWidth) then
      AWidth := ARealWidth
    else
      AWidth := NextPow2(ARealWidth);

    if IsPow2(ARealHeight) then
      AHeight := ARealHeight
    else
      AHeight := NextPow2(ARealHeight);
  end;
end;

function TMaterial.GenerateTexture(AImage: TBaseImage): TGLuint;
begin
  Result := CreateGLTextureFromImage(AImage.ImageDataPointer^);
  glBindTexture(GL_TEXTURE_2D, Result);
  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;

procedure TMaterial.AddRef;
begin
  Inc(FRefCount);
end;

procedure TMaterial.DelRef;
begin
  Dec(FRefCount);
  if FRefCount < 1 then
    Free;
end;

function TMaterial.HitTest(AX, AY: Integer; Zoom: Single): Boolean;
begin
  AX := Trunc(AX / Zoom);
  AY := Trunc(AY / Zoom);
  Result := HitTest(AX, AY);
end;

function TMaterial.HitTest(AX, AY: Integer): Boolean;
var
  pixel: TColor32Rec;
begin
  Result := False;
  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;

function TMaterial.CanBeRemoved: Boolean;
begin
  Result := FRefCount <= 1;
end;

procedure TMaterial.RemoveFromCache;
begin
  DelRef;
end;

{ TScreenBuffer }

constructor TScreenBuffer.Create;
begin
  inherited Create;
  FCount := 0;
  FSerial := 0;
  UpdateShortcuts;
end;

destructor TScreenBuffer.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TScreenBuffer.Add(AItem: TWorldItem): PBlockInfo;
begin
  New(Result);
  AItem.Locked := True;
  AItem.OnDestroy.RegisterEvent(@OnTileRemoved);
  Result^.Item := AItem;
  Result^.HighRes := nil;
  Result^.LowRes := nil;
  Result^.Normals := nil;
  Result^.State := ssNormal;
  Result^.Highlighted := False;
  Result^.Translucent := False;
  Result^.Text := nil;
  Result^.Next := nil;

  if FShortCuts[0] = nil then //First element
  begin
    FShortCuts[0] := Result;
    FShortCuts[-1] := Result; //Last element
  end else
  begin
    FShortCuts[-1]^.Next := Result;
    FShortCuts[-1] := Result;
  end;

  Inc(FCount);
end;

procedure TScreenBuffer.Clear;
var
  current, next: PBlockInfo;
begin
  current := FShortCuts[0];
  while current <> nil do
  begin
    next := current^.Next;
    current^.Item.Locked := False;
    current^.Item.OnDestroy.UnregisterEvent(@OnTileRemoved);
    if current^.Normals <> nil then Dispose(current^.Normals);
    if current^.HighRes <> nil then current^.HighRes.DelRef;
    if current^.LowRes <> nil then current^.LowRes.DelRef;
    current^.Text.Free;
    Dispose(current);
    current := next;
  end;
  FShortCuts[0] := nil;
  FShortCuts[-1] := nil;

  FCount := 0;
  FSerial := 0;

  UpdateShortcuts;
end;

procedure TScreenBuffer.Delete(AItem: TWorldItem);
var
  current, last, next: PBlockInfo;
begin
  last := nil;
  current := FShortCuts[0];
  while current <> nil do
  begin
    if current^.Item = AItem then
    begin
      if FShortCuts[-1] = current then FShortCuts[-1] := last;
      if FShortCuts[0] = current then FShortCuts[0] := current^.Next;
      if last <> nil then last^.Next := current^.Next;

      if current^.Normals <> nil then Dispose(current^.Normals);
      if current^.HighRes <> nil then current^.HighRes.DelRef;
      if current^.LowRes <> nil then current^.LowRes.DelRef;
      current^.Text.Free;

      Dispose(current);
      Dec(FCount);
      FShortCutsValid := False;
      next := nil;
    end else
      next := current^.Next;

    last := current;
    current := next;
  end;
end;

function TScreenBuffer.Find(AScreenPosition: TPoint; Zoom: Single): PBlockInfo;
var
  current: PBlockInfo;
  buff: array[0..3] of GLuint;
begin
  Result := nil;
  current := FShortCuts[0];
  while current <> nil do //search the last matching tile
  begin
    if (current^.State = ssNormal) and
       PtInRect(current^.ScreenRect, AScreenPosition)then
    begin
      if current^.CheckRealQuad then
      begin
        //OpenGL hit test
        //We use the "real quad" here to prevent the draw-preview from
        //intercepting with our actual tiles (which are "hidden" then).
        glSelectBuffer(4, @buff[0]);
        glViewport(current^.ScreenRect.Left, current^.ScreenRect.Top,
          current^.ScreenRect.Right, current^.ScreenRect.Bottom);
        glRenderMode(GL_SELECT);
        glInitNames;
        glPushName(0);

        glPushMatrix;
          glMatrixMode(GL_PROJECTION);
          glLoadIdentity;
          gluOrtho2D(AScreenPosition.x, AScreenPosition.x + 1,
            AScreenPosition.y + 1, AScreenPosition.y);
          glMatrixMode(GL_MODELVIEW);
          glLoadIdentity;

          glBegin(GL_QUADS);
            glVertex2iv(@current^.RealQuad[0]);
            glVertex2iv(@current^.RealQuad[3]);
            glVertex2iv(@current^.RealQuad[2]);
            glVertex2iv(@current^.RealQuad[1]);
          glEnd;
        glPopMatrix;
        glFlush;

        if glRenderMode(GL_RENDER) > 0 then //glRenderMode now returns the number of hits
          Result := current;
      end else
      if current^.LowRes.HitTest(AScreenPosition.x - current^.ScreenRect.Left,
         AScreenPosition.y - current^.ScreenRect.Top, Zoom) then
        Result := current;
    end;
    current := current^.Next;
  end;
end;

function TScreenBuffer.Find(AX, AY: Word): PBlockInfo;
var
  current: PBlockInfo;
  tile: TWorldItem;
  staticTileData: TStaticTiledata;
  tileZ: Integer;
begin
  Result := nil;
  current := FShortCuts[0];
  while current <> nil do //search the last matching tile
  begin
    if current^.State = ssNormal then begin
      tile := current^.Item;
      if (tile.X = AX) and (tile.Y = AY) then begin

        tileZ := $FFFF;
        if tile is TStaticItem then begin
          staticTileData := ResMan.Tiledata.StaticTiles[tile.TileID];
          if tdfSurface in staticTileData.Flags then
            tileZ := tile.Z + staticTileData.Height;
        end else if tile is TMapCell then begin
          tileZ := ResMan.Landscape.GetEffectiveAltitude(tile as TMapCell)
        end else if tile is TVirtualTile then
          tileZ := tile.Z;

        if (tileZ <> $FFFF) and ((Result = nil) or (tile.Z > Result^.Item.Z)) then
         Result := current;
      end;
    end;
    current := current^.Next;
  end;
end;

function TScreenBuffer.GetSerial: Cardinal;
begin
  Result := FSerial;
  Inc(FSerial);
end;

function TScreenBuffer.Insert(AItem: TWorldItem): PBlockInfo;
var
  current: PBlockInfo;
  shortcut: Integer;
begin
  if not FShortCutsValid then
    UpdateShortcuts;

  New(Result);
  AItem.Locked := True;
  AItem.OnDestroy.RegisterEvent(@OnTileRemoved);
  Result^.Item := AItem;
  Result^.HighRes := nil;
  Result^.LowRes := nil;
  Result^.Normals := nil;
  Result^.State := ssNormal;
  Result^.Highlighted := False;
  Result^.Translucent := False;
  Result^.Text := nil;

  if (FShortCuts[0] = nil) or (CompareWorldItems(AItem, FShortCuts[0]^.Item) < 0) then
  begin
    if FShortCuts[0] = nil then
      FShortCuts[-1] := Result;  //Update last item

    Result^.Next := FShortCuts[0];
    FShortCuts[0] := Result;
  end else
  begin
    //find best entry point
    shortcut := 0;
    while (shortcut <= 10) and (FShortCuts[shortcut] <> nil) and
      (CompareWorldItems(AItem, FShortCuts[shortcut]^.Item) >= 0) do
    begin
      current := FShortCuts[shortcut];
      Inc(shortcut);
    end;

    //now find the real match
    while (current^.Next <> nil) and
          (CompareWorldItems(AItem, current^.Next^.Item) > 0) do
    begin
      current := current^.Next;
    end;

    if FShortCuts[-1] = current^.Next then
      FShortCuts[-1] := Result;  //Update last item

    Result^.Next := current^.Next;
    current^.Next := Result;
  end;

  Inc(FCount);
end;

function TScreenBuffer.Iterate(var ABlockInfo: PBlockInfo): Boolean;
begin
  if ABlockInfo = nil then
    ABlockInfo := FShortCuts[0]
  else
    ABlockInfo := ABlockInfo^.Next;
  Result := ABlockInfo <> nil;
end;

procedure TScreenBuffer.UpdateShortcuts;
var
  shortcut, step, nextStep, stepSize: Integer;
  blockInfo: PBlockInfo;
begin
  if FCount < 10 then
  begin
    for shortcut := 1 to 10 do
      FShortCuts[shortcut] := nil;
  end
  else if FShortCuts[0] <> nil then
  begin
    stepSize := FCount div 10;
    nextStep := stepSize;
    step := 0;
    shortcut := 1;
    blockInfo := FShortCuts[0];
    repeat
      if (step = nextStep) and (shortcut <= 10) then
      begin
        FShortCuts[shortcut] := blockInfo;
        Inc(shortcut);
        Inc(nextStep, stepSize);
      end;

      Inc(step);

      FShortCuts[-1] := blockInfo; //update last known item
      blockInfo := blockInfo^.Next;
    until (blockInfo = nil);
  end;
  FShortCutsValid := True;
end;

function TScreenBuffer.UpdateSortOrder(AItem: TWorldItem): PBlockInfo;
var
  newNodePosition, oldNode, oldNodePrev, current: PBlockInfo;
begin
  newNodePosition := nil;
  oldNode := nil;
  oldNodePrev := nil;
  current := FShortCuts[0];

  while (current <> nil) and ((oldNode = nil) or (newNodePosition = nil)) do
  begin
    if current^.Item = AItem then
      oldNode := current
    else if oldNode = nil then
      oldNodePrev := current;

    if newNodePosition = nil then
    begin
      if (current^.Next = nil) or (CompareWorldItems(AItem, current^.Next^.Item) < 0) then
        newNodePosition := current;
    end;

    current := current^.Next;
  end;

  //oldNode = nil, if the change happend out-of-screen
  if (oldNode <> nil ) and (oldNode <> newNodePosition) then
  begin
    if oldNodePrev <> oldNode then
    begin
      if oldNodePrev = nil then
        FShortCuts[0] := oldNode^.Next
      else
        oldNodePrev^.Next := oldNode^.Next;
    end;

    if (newNodePosition = FShortCuts[0]) and (CompareWorldItems(AItem, FShortCuts[0]^.Item) < 0) then
    begin
      oldNode^.Next := FShortCuts[0];
      FShortCuts[0] := oldNode;
    end else
    begin
      oldNode^.Next := newNodePosition^.Next;
      newNodePosition^.Next := oldNode;
    end;
  end;

  Result := oldNode;
end;

procedure TScreenBuffer.OnTileRemoved(ATile: TMulBlock);
begin
  Delete(TWorldItem(ATile));
end;

{ TGLText }

constructor TGLText.Create(AFont: TGLFont; AText: String);
begin
  FFont := AFont;
  FText := AText;
  FWidth := FFont.GetTextWidth(AText);
  FHeight := FFont.GetTextHeight('A');
end;

procedure TGLText.Render(AScreenRect: TRect);
var
  x, y: Integer;
begin
  y := AScreenRect.Top + (AScreenRect.Bottom - AScreenRect.Top - FHeight) div 2;
  x := AScreenRect.Left + (AScreenRect.Right - AScreenRect.Left - FWidth) div 2;
  FFont.DrawText(x, y, FText);
end;

{ TSimpleMaterial }

constructor TSimpleMaterial.Create(AGraphic: TBaseImage);
var
  caps: TGLTextureCaps;
begin
  inherited Create;
  FRealWidth := AGraphic.Width;
  FRealHeight := AGraphic.Height;

  GetGLTextureCaps(caps);
  CalculateTextureDimensions(caps, FRealWidth, FRealHeight, FWidth, FHeight);
  FGraphic := TMultiImage.CreateFromParams(FWidth, FHeight, ifA8R8G8B8, 1);
  AGraphic.CopyTo(0, 0, FRealWidth, FRealHeight, FGraphic, 0, 0);
  FTexture := GenerateTexture(FGraphic);
end;

destructor TSimpleMaterial.Destroy;
begin
  if FTexture <> 0 then glDeleteTextures(1, @FTexture);
  inherited Destroy;
end;

function TSimpleMaterial.GetTexture: GLuint;
begin
  Result := FTexture;
end;

{ TAnimMaterial }

constructor TAnimMaterial.Create(ABaseID: LongWord; AAnimData: TAnimData;
  AHue: THue = nil; APartialHue: Boolean = False);
var
  i: Integer;
  art: array of TArt;
  caps: TGLTextureCaps;
begin
  inherited Create;

  FAnimData := AAnimData;

  FRealWidth := 0;
  FRealHeight := 0;

  SetLength(FTextures, AAnimData.FrameCount);
  SetLength(art, AAnimData.FrameCount);

  for i := 0 to AAnimData.FrameCount - 1 do
  begin
    art[i] := ResMan.Art.GetArt(ABaseID + AAnimData.FrameData[i], 0, AHue,
      APartialHue);

    if art[i].Graphic.Width > FRealWidth then
      FRealWidth := art[i].Graphic.Width;
    if art[i].Graphic.Height > FRealHeight then
      FRealHeight := art[i].Graphic.Height;
  end;

  GetGLTextureCaps(caps);
  CalculateTextureDimensions(caps, FRealWidth, FRealHeight, FWidth, FHeight);
  FGraphic := TMultiImage.CreateFromParams(FWidth, FHeight, ifA8R8G8B8,
    AAnimData.FrameCount);

  for i := 0 to AAnimData.FrameCount - 1 do
  begin
    FGraphic.ActiveImage := i;
    art[i].Graphic.CopyTo(0, 0, art[i].Graphic.Width, art[i].Graphic.Height,
      FGraphic, 0, 0);
    FTextures[i] := GenerateTexture(FGraphic);
    art[i].Free;
  end;

  FGraphic.ActiveImage := 0;
  FActiveFrame := 0;
  FNextChange := GetTickCount + AAnimData.FrameStart * 100;
end;

destructor TAnimMaterial.Destroy;
begin
  glDeleteTextures(Length(FTextures), @FTextures[0]);
  inherited Destroy;
end;

function TAnimMaterial.GetTexture: GLuint;
begin
  if FNextChange <= GetTickCount then
  begin
    FActiveFrame := (FActiveFrame + 1) mod FAnimData.FrameCount;
    FGraphic.ActiveImage := FActiveFrame;

    if FActiveFrame = 0 then
      FNextChange := GetTickCount + FAnimData.FrameStart * 100
    else
      FNextChange:= GetTickCount + FAnimData.FrameInterval * 100;
  end;

  Result := FTextures[FActiveFrame];
end;

end.