unit ASTable;

{ **************************************************************************** }
{ Rejbrand AlgoSim table types and functions                                   }
{ Copyright © 2017 Andreas Rejbrand                                            }
{ https://english.rejbrand.se/                                                 }
{ **************************************************************************** }

interface

uses
  SysUtils, Types, Classes, ASAttributes;

type
  ETableException = class(Exception);

  TASTable = class
  protected type
    TTableOf<T> = array of array of T;
    TCell = record
      Text: string;
      Style: TASAttributes;
      function MemorySize: UInt64; inline;
    end;
  const
    EmptyCell: TCell = (Text: ''; Style: (Data: nil));
  strict private var
    FCells: TTableOf<TCell>;
    FTableStyle: TASAttributes;
    FFirstRowStyle,
    FLastRowStyle,
    FFirstColStyle,
    FLastColStyle,
    FEvenRowStyle,
    FOddRowStyle,
    FEvenColStyle,
    FOddColStyle: TASAttributes;
    FColSepChar: Char;
    function GetCellStyle(const ACell: TPoint): TASAttributes;
    function GetString(const ACell: TPoint): string;
    procedure SetCellStyle(const ACell: TPoint; const Value: TASAttributes);
    procedure SetString(const ACell: TPoint; const Value: string);
    function GetHeight: Integer; inline;
    function GetWidth: Integer; inline;
    procedure SetHeight(const Value: Integer);
    procedure SetWidth(const Value: Integer);
    procedure CellMustExist(const ACell: TPoint); inline;
    function GetComputedStyle(const ACell: TPoint): TASAttributes;
    function GetMemorySize: Int64;
  public
    constructor Create; overload;
    constructor Create(const ATable: TASTable); overload;
    procedure Assign(const ATable: TASTable);
    function CellExists(const ACell: TPoint): boolean;
    function Equals(Obj: TObject): Boolean; override;
    function ToString: string; override;
    property Strings[const ACell: TPoint]: string read GetString write SetString; default;
    property Style: TASAttributes read FTableStyle write FTableStyle;
    property CellStyles[const ACell: TPoint]: TASAttributes read GetCellStyle write SetCellStyle;
    property ComputedStyles[const ACell: TPoint]: TASAttributes read GetComputedStyle;
    property FirstRow: TASAttributes read FFirstRowStyle write FFirstRowStyle;
    property LastRow: TASAttributes read FLastRowStyle write FLastRowStyle;
    property FirstCol: TASAttributes read FFirstColStyle write FFirstColStyle;
    property LastCol: TASAttributes read FLastColStyle write FLastColStyle;
    property EvenRows: TASAttributes read FEvenRowStyle write FEvenRowStyle;
    property OddRows: TASAttributes read FOddRowStyle write FOddRowStyle;
    property EvenCols: TASAttributes read FEvenColStyle write FEvenColStyle;
    property OddCols: TASAttributes read FOddColStyle write FOddColStyle;
    property Width: integer read GetWidth write SetWidth;
    property Height: integer read GetHeight write SetHeight;
    property ColSepChar: char read FColSepChar write FColSepChar default #9;
    property MemorySize: Int64 read GetMemorySize;
    procedure SetSize(AWidth, AHeight: Integer);
    procedure ClearCellStyles;
    procedure ClearAllStyles;
    procedure ClearAllText;
    procedure ClearAllTextAndStyle;
    procedure ClearTableStyles;
    function Clone: TASTable; inline;
    procedure SaveTextToFile(const AFileName: string);
  end;

implementation

uses
  Math;

{ TASTable }

function TASTable.CellExists(const ACell: TPoint): Boolean;
begin
  Result := InRange(ACell.Y, 0, High(FCells)) and InRange(ACell.X, 0, High(FCells[0]));
end;

procedure TASTable.CellMustExist(const ACell: TPoint);
begin
  if not CellExists(ACell) then
    raise ETableException.CreateFmt('Table has no cell with index %d, %d.',
      [ACell.X, ACell.Y]);
end;

procedure TASTable.ClearAllStyles;
begin
  ClearCellStyles;
  ClearTableStyles;
end;

procedure TASTable.ClearAllText;
begin
  for var i := 0 to Height - 1 do
    for var j := 0 to Width - 1 do
      FCells[i, j].Text := '';
end;

procedure TASTable.ClearAllTextAndStyle;
begin
  ClearAllText;
  ClearAllStyles;
end;

procedure TASTable.ClearCellStyles;
begin
  for var i := 0 to Height - 1 do
    for var j := 0 to Width - 1 do
      FCells[i, j].Style := EmptyAttributes;
end;

procedure TASTable.ClearTableStyles;
begin
  FTableStyle := EmptyAttributes;
  FFirstRowStyle := EmptyAttributes;
  FLastRowStyle := EmptyAttributes;
  FFirstColStyle := EmptyAttributes;
  FLastColStyle := EmptyAttributes;
  FEvenRowStyle := EmptyAttributes;
  FOddRowStyle := EmptyAttributes;
  FEvenColStyle := EmptyAttributes;
  FOddColStyle := EmptyAttributes;
end;

function TASTable.Clone: TASTable;
begin
  Result := TASTable.Create(Self);
end;

constructor TASTable.Create(const ATable: TASTable);
begin
  inherited Create;
  Assign(ATable);
end;

procedure TASTable.Assign(const ATable: TASTable);
var
  x: Integer;
  y: Integer;
begin
  if not Assigned(ATable) then
    raise Exception.Create('TASTable.Assign: Source is nil.');

  SetSize(ATable.Width, ATable.Height);
  for y := 0 to Height - 1 do
    for x := 0 to Width - 1 do
    begin
      Strings[Point(x, y)] := ATable.Strings[Point(x, y)];
      CellStyles[Point(x, y)] := ATable.CellStyles[Point(x, y)];
    end;
  Style := ATable.Style;
  FirstRow := ATable.FirstRow;
  FirstCol := ATable.FirstCol;
  LastRow := ATable.LastRow;
  LastCol := ATable.LastCol;
  EvenRows := ATable.EvenRows;
  OddRows := ATable.OddRows;
  EvenCols := ATable.EvenCols;
  OddCols := ATable.OddCols;
  ColSepChar := ATable.ColSepChar;
end;

function TASTable.Equals(Obj: TObject): Boolean;
var
  i: Integer;
  j: Integer;
begin

  if not (Obj is TASTable) then
    Exit(False);

  if TASTable(Obj).Width <> Self.Width then
    Exit(False);

  if TASTable(Obj).Height <> Self.Height then
    Exit(False);

  for i := 0 to Height - 1 do
    for j := 0 to Width - 1 do
      if TASTable(Obj)[Point(i, j)] <> Self[Point(i, j)] then
        Exit(False);

  Result := True;

end;

constructor TASTable.Create;
begin
  inherited;
  FColSepChar := #9;
  SetSize(1, 1);
end;

function TASTable.GetCellStyle(const ACell: TPoint): TASAttributes;
begin
  CellMustExist(ACell);
  Result := FCells[ACell.Y, ACell.X].Style;
end;

function TASTable.GetComputedStyle(const ACell: TPoint): TASAttributes;
begin

  CellMustExist(ACell);

  Result := CellStyles[ACell];

  if ACell.Y = 0 then
    Result := FirstRow * Result
  else if ACell.Y = Height - 1 then
    Result := LastRow * Result;

  if ACell.X = 0 then
    Result := FirstCol * Result
  else if ACell.X = Width - 1 then
    Result := LastCol * Result;

  if Odd(ACell.Y) then
    Result := OddRows * Result
  else
    Result := EvenRows * Result;

  if Odd(ACell.X) then
    Result := OddCols * Result
  else
    Result := EvenCols * Result;

  Result := Style * Result;

end;

function TASTable.GetMemorySize: Int64;
var
  y: Integer;
  x: Integer;
begin
  Result := InstanceSize + FTableStyle.MemorySize + FFirstRowStyle.MemorySize +
    FLastRowStyle.MemorySize + FFirstColStyle.MemorySize + FLastColStyle.MemorySize +
    FEvenRowStyle.MemorySize + FOddRowStyle.MemorySize + FEvenColStyle.MemorySize +
    FOddColStyle.MemorySize + Length(FCells) * sizeof(Pointer);

  for y := 0 to high(FCells) do
    for x := 0 to high(FCells[y]) do
      inc(Result, FCells[y, x].MemorySize);

end;

function TASTable.GetHeight: Integer;
begin
  Result := Length(FCells);
end;

function TASTable.GetString(const ACell: TPoint): string;
begin
  CellMustExist(ACell);
  Result := FCells[ACell.Y, ACell.X].Text;
end;

function TASTable.GetWidth: Integer;
begin
  if Height = 0 then
    Result := 0
  else
    Result := Length(FCells[0]);
end;

procedure TASTable.SaveTextToFile(const AFileName: string);
begin
  with TStreamWriter.Create(AFileName, False, TEncoding.UTF8) do
    try
      Write(Self.ToString);
    finally
      Free;
    end;
end;

procedure TASTable.SetCellStyle(const ACell: TPoint; const Value: TASAttributes);
begin
  CellMustExist(ACell);
  FCells[ACell.Y, ACell.X].Style := Value;
end;

procedure TASTable.SetHeight(const Value: Integer);
var
  OldHeight, i: Integer;
  j: Integer;
begin
  if Value < 1 then
    raise ETableException.CreateFmt('Invalid table height %d.', [Value]);
  OldHeight := Height;
  SetLength(FCells, Value, Width);
  for i := OldHeight to Value - 1 do
    for j := 0 to Width - 1 do
      FCells[i, j] := EmptyCell;
end;

procedure TASTable.SetSize(AWidth, AHeight: Integer);
var
  OldHeight, OldWidth, i: Integer;
  j: Integer;
begin
  if (AHeight < 1) or (AWidth < 1) then
    raise ETableException.CreateFmt('Invalid table size %d×%d.', [AWidth, AHeight]);
  OldHeight := Height;
  OldWidth := Width;
  SetLength(FCells, AHeight, AWidth);
  for i := OldHeight to AHeight - 1 do
    for j := 0 to AWidth - 1 do
      FCells[i, j] := EmptyCell;
  for i := 0 to Min(OldHeight, AHeight) - 1 do
    for j := OldWidth to AWidth - 1 do
      FCells[i, j] := EmptyCell;
end;

procedure TASTable.SetString(const ACell: TPoint; const Value: string);
begin
  CellMustExist(ACell);
  FCells[ACell.Y, ACell.X].Text := Value;
end;

procedure TASTable.SetWidth(const Value: Integer);
var
  OldWidth, i: Integer;
  j: Integer;
begin
  if Value < 1 then
    raise ETableException.CreateFmt('Invalid table width %d.', [Value]);
  OldWidth := Width;
  SetLength(FCells, Height, Value);
  for i := 0 to Height - 1 do
    for j := OldWidth to Value - 1 do
      FCells[i, j] := EmptyCell;
end;

function TASTable.ToString: string;
var
  i: Integer;
  j: Integer;
begin
  Result := '';
  for i := 0 to Height - 1 do
  begin
    if i > 0 then
      Result := Result + sLineBreak;
    if Width > 0 then
      Result := Result + Self[Point(0, i)];
    for j := 1 to Width - 1 do
      Result := Result + FColSepChar + Self[Point(j, i)];
  end;
end;

{ TASTable.TCell }

function TASTable.TCell.MemorySize: UInt64;
begin
  Result := sizeof(Self) + Text.Length * sizeof(Char) + Style.MemorySize;
end;

end.
