//DJXTexFonts v1.1
unit DJXTexFonts;

interface

uses
  Classes,
  Types,
  SysUtils,
  Graphics,
  DJXClasses,
  DJXTextures,
  PNGImage,
  Direct3D9,
  D3DX9;

type
  TCharProp = packed record
    Width: byte;
    Height: byte;
  end;
  TDJTF = packed record
    CharProps: array[0..255] of TCharProp;
  end;
  TDJXTexFont = class(TObject)
  private
    m_DanJetX: Pointer;
    m_Name: string;
    m_FontTexture: TDJXTexture;
    m_CharWidth: integer;
    m_CharHeight: integer;
    m_DJTF: TDJTF;
  public
    property DanJetX: Pointer read m_DanJetX write m_DanJetX;
    property Name: string read m_Name write m_Name;
    constructor Create(const DanJetX: Pointer);
    destructor Destroy; override;
    procedure LoadFromFile(f: string);
    procedure Print(x, y: single; Color: TDJXColor; text: string); overload;
    procedure Print(x, y: single; Color: TDJXColor; ScaleX, ScaleY: single; text: string); overload;
    procedure Print4col(x, y: single; Color1, Color2, Color3, Color4: TDJXColor; text: string); overload;
    procedure Print4col(
      x, y: single;
      Color1, Color2, Color3, Color4: TDJXColor;
      ScaleX, ScaleY: single;
      text: string
    ); overload;
    function GetTextHeight(text: string): integer;
    function GetTextWidth(text: string): integer;
  end;

  TDJXTexFontList = class(TDJXComponent)
  protected
    m_TexFonts: Tlist;
    function getItem(Index: integer): TDJXTexFont;
    procedure setItem(Index: integer; Value: TDJXTexFont);
  public
    property DanJetX: Pointer read m_DanJetX write m_DanJetX;
    function CreateFont(NameInList: string; DJTFFileName: string): TDJXTexFont;
    property Fonts[Index: integer]: TDJXTexFont read getItem write setItem;
    function Find(name: string): TDJXTexFont;
    procedure Add(Font: TDJXTexFont);
    procedure Init(DanJetX: Pointer); override;
    procedure OnLostDevice; override;
    procedure OnResetDevice; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
  end;

implementation

uses
  DJX;

//TDJXTexFontList BEGIN
constructor TDJXTexFontList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;
destructor TDJXTexFontList.Destroy;
begin
  if m_TexFonts <> nil then
  begin
    while m_TexFonts.Count > 0 do
    begin
      TDJXTexFont(m_TexFonts.Items[0]).Free;
      m_TexFonts.Delete(0);
    end;
    m_TexFonts.Free;
  end;
  inherited destroy;
end;
procedure TDJXTexFontList.Init(DanJetX: Pointer);
begin
  m_TexFonts := Tlist.Create;
  inherited Init(DanJetX);
end;
procedure TDJXTexFontList.OnLostDevice;
begin

end;
procedure TDJXTexFontList.OnResetDevice;
begin

end;
procedure TDJXTexFontList.Add(Font: TDJXTexFont);
begin
  m_TexFonts.Add(Font);
end;
function TDJXTexFontList.Find(name: string): TDJXTexFont;
var
  i: integer;
begin
  for i := 0 to m_TexFonts.Count - 1 do
  if TDJXTexFont(m_TexFonts.Items[i]).Name = name then
  begin
    result := TDJXTexFont(m_TexFonts.Items[i]);
    exit;
  end;
  result := nil;
end;
function TDJXTexFontList.getItem(Index: integer): TDJXTexFont;
begin
  result := TDJXTexFont(m_TexFonts.items[Index]);
end;
procedure TDJXTexFontList.setItem(Index: integer; Value: TDJXTexFont);
begin
  m_TexFonts.items[Index] := Value;
end;
function TDJXTexFontList.CreateFont(NameInList: string;DJTFFileName: string): TDJXTexFont;
var
  DJXTexFont: TDJXTexFont;
begin
  result := nil;
  if not FileExists(DJTFFileName) then exit;
  DJXTexFont := TDJXTexFont.Create(m_DanJetX);
  DJXTexFont.LoadFromFile(DJTFFileName);
  DJXTexFont.Name := NameInList;
  m_TexFonts.Add(DJXTexFont);
  Result := DJXTexFont;
end;
//TDJXTexFontList END

constructor TDJXTexFont.Create(const DanJetX: Pointer);
begin
  inherited Create;
  m_DanJetX := DanJetX;
  m_FontTexture := TDJXTexture.create('font texture', m_DanJetX);
end;
destructor TDJXTexFont.Destroy;
begin
  m_FontTexture.Free;
  inherited Destroy;
end;
procedure TDJXTexFont.LoadFromFile(f: string);
type
  THeader = packed record
    Definition: string[4];
    Version: DWORD;
  end;
var
  Header: THeader;
  FStream: TFileStream;
  png: TPNGObject;
const
  Definition = 'DJTF';
  Version = $00010000;
begin
  FStream := TFileStream.Create(f, fmOpenRead);
  FStream.Position := 0;
  FStream.ReadBuffer(Header, SizeOf(Header));
  if (Header.Definition <> Definition)
  or (Header.Version <> Version) then
  begin
    FStream.Free;
    Exit;
  end;
  FStream.ReadBuffer(m_DJTF, sizeof(m_DJTF));
  png := TPNGObject.Create;
  png.LoadFromStream(FStream);
  m_CharWidth := png.Width div 16;
  m_CharHeight := png.Height div 16;
  m_FontTexture.LoadFromGraphic(png, 1);
  png.Free;
  FStream.Free;
end;
procedure TDJXTexFont.Print4col(x, y: single; Color1, Color2, Color3, Color4: TDJXColor; text: string);
var
  cXpos, Xpos: single;
  i: integer;
begin
  cXpos := x;
  for i := 1 to length(text) do
  begin
    Xpos := (m_DJTF.CharProps[Ord(text[i])].Width - m_CharWidth) / 2;
    m_FontTexture.Draw4col(
      cXpos + Xpos, y,
      cXpos + Xpos + m_CharWidth, y,
      cXpos + Xpos + m_CharWidth, y + m_CharHeight,
      cXpos + Xpos, y + m_CharHeight,
      Color1, Color2, Color3, Color4,
      Ord(text[i]),
      m_CharWidth,
      m_CharHeight
    );
    cXpos := cXpos + m_DJTF.CharProps[Ord(text[i])].Width;
  end;
end;
procedure TDJXTexFont.Print4col(
  x, y: single;
  Color1, Color2, Color3, Color4: TDJXColor;
  ScaleX, ScaleY: single;
  text: string
);
var
  cXpos, Xpos: single;
  i: integer;
begin
  cXpos := x;
  for i := 1 to length(text) do
  begin
    Xpos := (m_DJTF.CharProps[Ord(text[i])].Width * ScaleX - m_CharWidth * ScaleX) / 2;
    m_FontTexture.Draw4col(
      cXpos + Xpos, y,
      cXpos + Xpos + m_CharWidth, y,
      cXpos + Xpos + m_CharWidth, y + m_CharHeight,
      cXpos + Xpos, y + m_CharHeight,
      Color1, Color2, Color3, Color4,
      0, 0, 0, ScaleX, ScaleY,
      false, false,
      Ord(text[i]),
      m_CharWidth,
      m_CharHeight
    );
    cXpos := cXpos + m_DJTF.CharProps[Ord(text[i])].Width * ScaleX;
  end;
end;
procedure TDJXTexFont.Print(x, y: single; Color: TDJXColor; text: string);
var
  cXpos, Xpos: single;
  i: integer;
begin
  cXpos := x;
  for i := 1 to length(text) do
  begin
    Xpos := (m_DJTF.CharProps[Ord(text[i])].Width - m_CharWidth) / 2;
    m_FontTexture.Draw4col(
      cXpos + Xpos, y,
      cXpos + Xpos + m_CharWidth, y,
      cXpos + Xpos + m_CharWidth, y + m_CharHeight,
      cXpos + Xpos, y + m_CharHeight,
      Color, Color, Color, Color,
      Ord(text[i]),
      m_CharWidth,
      m_CharHeight
    ); 
    cXpos := cXpos + m_DJTF.CharProps[Ord(text[i])].Width;
  end;
end;
procedure TDJXTexFont.Print(x, y: single; Color: TDJXColor; ScaleX, ScaleY: single; text: string);
var
  cXpos, Xpos: single;
  i: integer;
begin
  cXpos := x;
  for i := 1 to length(text) do
  begin
    Xpos := (m_DJTF.CharProps[Ord(text[i])].Width * ScaleX - m_CharWidth * ScaleX) / 2;
    m_FontTexture.Draw4col(
      cXpos + Xpos, y,
      cXpos + Xpos + m_CharWidth * ScaleX, y,
      cXpos + Xpos + m_CharWidth * ScaleX, y + m_CharHeight * ScaleY,
      cXpos + Xpos, y + m_CharHeight * ScaleY,
      Color, Color, Color, Color,
      Ord(text[i]),
      m_CharWidth,
      m_CharHeight
    );
    cXpos := cXpos + m_DJTF.CharProps[Ord(text[i])].Width * ScaleX;
  end;
end;
function TDJXTexFont.GetTextHeight(text: string): integer;
var
  i: integer;
begin
  result := 0;
  for i := 1 to length(text) do
  if m_DJTF.CharProps[Ord(text[i])].Height > result then
  result := m_DJTF.CharProps[Ord(text[i])].Height;
end;
function TDJXTexFont.GetTextWidth(text: string): integer;
var
  i: integer;
begin
  result := 0;
  for i := 1 to length(text) do
  result := result + m_DJTF.CharProps[Ord(text[i])].Width;
end;

end.
