Rising Force the Roguelike Code

{   This file is a part of Rising Force Roguelike, the roguelike game.
    Copyright (C) 2010 Konovod Andrey (kipar@front.ru).

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see http://www.gnu.org/licenses/
}
unit uLogger;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics,
  uRWFile;

type

  { TLogger }

  TLogger = class
    Lines:     TStringList;
    Picture, Mask: TBitmap;
    //    Canvas:    TCanvas;
    DrawRect:  TRect;
    Width, Height: integer;
    ScrollPos: integer;
    CurLine:   string;
    constructor Create(aRect: TRect);
    destructor Destroy; override;
    procedure RW;
    procedure RepaintPicture;
    procedure PaintStr(var X: integer; Y: integer; S: string; C: TColor);
    procedure Draw(aCanvas: TCanvas);
    procedure Writeln(s: string = '');
    procedure InterWriteln(s: string = '');
    procedure Write(s: string);
    procedure ClearPicture;
    procedure SetRect(aRect: TRect; NoFormUpdate: boolean = False);
  end;

implementation

uses Math,
  MyToken, uChoice, uMain, uGlobalConfig;

{ TLogger }

constructor TLogger.Create(aRect: TRect);
begin
  inherited Create;
  Lines   := TStringList.Create;
  CurLine := '';
  Picture := TBitmap.Create;
  with Picture.Canvas do
  begin
    //    Brush.Color := clNavy;
    Brush.Color := clBlack;
    Font.Color  := clBtnFace;
    TheConfig.LogFont.SetFont(Font);
  end;
  Mask := TBitmap.Create;
  with Mask.Canvas do
  begin
    Brush.Color := clWhite;
    Font.Color  := clBlack;
    TheConfig.LogFont.SetFont(Font);
  end;
  SetRect(aRect, True);
  ScrollPos := 0;
  RepaintPicture;
end;

destructor TLogger.Destroy;
begin
  Lines.Free;
  Picture.Free;
  Mask.Free;
  inherited Destroy;
end;

procedure TLogger.RW;
begin
  RWStrings(Lines);
  RWBuffer(SizeOf(DrawRect), DrawRect);
  RWInteger(ScrollPos);
  if not IsWrite then
    SetRect(DrawRect);

  RWString(CurLine);
  if not IsWrite then
    RepaintPicture;
end;

procedure TLogger.RepaintPicture;
var
  X, Y, I, N, D: integer;
  S, S1: string;
  C:     TColor;

begin
  ClearPicture;
  D := TheConfig.LOGSTRINGDELTA;
  N := Height div D;
  Y := Height - D * min(N, Lines.Count - ScrollPos);
  for I := min(N, Lines.Count - ScrollPos) downto 1 do
  begin
    X := 10;
    S := Lines[Lines.Count - I - ScrollPos];
    while S <> '' do
    begin
      S1 := TokenStrS(S, '{');
      PaintStr(X, Y, S1, clBtnFace);
      S1 := TokenStrS(S, ':');
      if S1 = '' then
        break;
      C  := StringToColor(Trim(S1));
      S1 := TokenStrS(S, '}');
{      if S1 = '' then
        break;}
      PaintStr(X, Y, S1, C);
    end;
    Inc(Y, D);
  end;
end;

procedure TLogger.PaintStr(var X: integer; Y: integer; S: string; C: TColor);
begin
  if C = clBlack then
    C := clWhite;
  Picture.Canvas.Font.Color := C;
  Picture.Canvas.TextOut(X, Y, S);
  Mask.Canvas.TextOut(X, Y, S);
  Inc(X, Picture.Canvas.TextWidth(S));
end;

procedure TLogger.Draw(aCanvas: TCanvas);
begin
  aCanvas.CopyMode := cmSrcAnd;
  aCanvas.CopyRect(DrawRect, Mask.Canvas, Rect(0, 0, Width, Height));
  aCanvas.CopyMode := cmSrcPaint;
  aCanvas.CopyRect(DrawRect, Picture.Canvas, Rect(0, 0, Width, Height));
end;

procedure TLogger.Writeln(s: string = '');
begin
  Lines.Add(CurLine + s);
  while Lines.Count > 100 do
    Lines.Delete(0);
  Lines.SaveToFile('.\debuglog.txt');
  fmMain.ScrollBar1.Max := max(1, Lines.Count - Height div TheConfig.LOGSTRINGDELTA);
  fmMain.ScrollBar1.Position := fmMain.ScrollBar1.Max - ScrollPos;
  CurLine := '';
  RepaintPicture;
end;

procedure TLogger.InterWriteln(s: string);
begin
  if CurLine = '' then
    Writeln(s)
  else
  begin
    Writeln;
    Write(s);
  end;
end;

procedure TLogger.Write(s: string);
begin
  CurLine := CurLine + s;
  //  RepaintPicture;
end;

procedure TLogger.ClearPicture;
begin
  Picture.Canvas.FillRect(0, 0, Width, Height);
  Mask.Canvas.FillRect(0, 0, Width, Height);
end;

procedure TLogger.SetRect(aRect: TRect; NoFormUpdate: boolean = False);
begin
  DrawRect   := aRect;
  Width      := aRect.Right - aRect.Left;
  Height     := aRect.Bottom - aRect.Top;
  Picture.Width := Width;
  Picture.Height := Height;
  Mask.Width := Width;
  Mask.Height := Height;
  if not NoFormUpdate then
    fmMain.UpdateLeftBar;
  RepaintPicture;
end;

end.