unit MyCRT;

interface

uses
  NewUnit1, windows, sysutils, graphics, forms;

const
  Black = clBlack;
  Blue = clBlue;
  Green = clGreen;
  Cyan = $00E8E800;
  Red = clRed;
  Magenta = clFuchsia;
  Brown = $00005CB9;
  LightGray = $009D9D9D; //clSilver;
  DarkGray = $00454545; //clGray;
  LightBlue = $00FF8000;
  LightGreen = $0040FF00;
  LightCyan = clAqua;
  LightRed = $008080FF;
  LightMagenta = $00FF80FF;
  Yellow = clYellow;
  White = clWhite;

  RESOLUTION_X = 100;
  RESOLUTION_Y = 50;

  SYMBOLWIDTH = 8;
  SYMBOLHEIGHT = 11;


function ReadKey: char;
procedure Write(s: string);
procedure WriteLn(s: string); overload;
procedure WriteLn; overload;
procedure WriteChrXY(x, y: integer; c: char);
procedure GoToXY(x, y: integer);
procedure TextColor(color: TColor);
procedure TextBackground(color: TColor);
procedure ClrScr;
function WhereX: integer;
function WhereY: integer;
procedure ReadLn(var s: string; MaxLength: integer = 0);
procedure DrawSymbol(x, y: integer; c: char; col: TColor);
procedure GraphicClearHud;
function KeyPressed: boolean;
procedure SaveToFile(s: string);
procedure InitializeFont(filename: string);

var
  screen: array[1..RESOLUTION_X, 1..RESOLUTION_Y + 10] of char;
  screencolor: array[1..RESOLUTION_X, 1..RESOLUTION_Y + 10] of TColor;
  Chars: array[1..255] of record
    char: array[1..SYMBOLHEIGHT, 1..SYMBOLWIDTH] of boolean;
    IsInit: boolean;
  end;

implementation

var
  anX, anY: integer;

function KeyPressed: boolean;
begin
  Result := pressed;
end;

procedure InitializeFont(filename: string);
var
  f: TextFile;
  s: string;
  i, j, num: integer;
begin
  for i := 1 to 255 do
    Chars[i].IsInit := false;
  AssignFile(f, filename);
  reset(f);
  s := '';
  while not eof(f) do
  begin
    while (not eof(f)) and ((s = '') or (s[1] <> '/')) do
      System.Readln(f, s);
    if (not eof(f)) then
    begin
      num := StrToInt(Copy(s, 2, Length(s) - 1));
      Chars[num].IsInit := true;
      for j := 1 to SYMBOLHEIGHT do
      begin
        System.Readln(f, s);
        for i := 1 to SYMBOLWIDTH do
          Chars[num].char[i, j] := (s[i] = '*');
      end;
    end;
  end;
end;

function ReadKey: char;
begin
  pressed := false;
  repeat
    Application.ProcessMessages;
  until (pressed);
  Result := PressedChar;
end;

procedure Write(s: string);
var
  i, w, h, x, y, m: integer;
begin
  for i := 1 to Length(s) do
  begin
    if not Chars[ord(s[i])].IsInit then
      Form1.Image1.Canvas.TextOut((anX - 2 + i) * SYMBOLWIDTH + 1, (anY - 1) * SYMBOLHEIGHT + 1, s[i])
    else
    begin
      x := (anX - 2 + i) * SYMBOLWIDTH + 1;
      y := (anY - 1) * SYMBOLHEIGHT + 1;
      m := ord(s[i]);
      for h := 1 to SYMBOLHEIGHT do
        for w := 1 to SYMBOLWIDTH do
          if (Chars[m].char[w, h]) then
            Form1.Image1.Picture.Bitmap.Canvas.Pixels[x + w - 1, y + h - 1] := Form1.Image1.Canvas.Font.Color
          else
            Form1.Image1.Picture.Bitmap.Canvas.Pixels[x + w - 1, y + h - 1] := Form1.Image1.Canvas.Brush.Color;
    end;
    screen[anX - 1 + i, anY] := s[i];
    screencolor[anX - 1 + i, anY] := Form1.Image1.Canvas.Font.Color;
  end;
  anX := anX + Length(s);
end;

procedure WriteLn(s: string);
begin
  Write(s);
  anX := 1;
  anY := anY + 1;
end;

procedure WriteLn;
begin
  anY := anY + 1;
  anX := 1;
end;

procedure WriteChrXY(x, y: integer; c: char);
begin
  Form1.Image1.Canvas.TextOut((x - 1) * SYMBOLWIDTH + 1, (y - 1) * SYMBOLHEIGHT, c);
  screen[x, y] := c;
  screencolor[x, y] := Form1.Image1.Canvas.Font.Color;
end;


procedure GoToXY(x, y: integer);
begin
  anX := x;
  anY := y;
end;

procedure TextColor(color: TColor);
begin
  Form1.Image1.Canvas.Font.Color := color;
end;

procedure TextBackground(color: TColor);
begin
  Form1.Image1.Canvas.Brush.Color := color;
end;

procedure ClrScr;
var
  i, j: integer;
begin
  Form1.Image1.Canvas.Rectangle(0, 0, Form1.Image1.Width, Form1.Image1.Height);
  GoToXY(1, 1);
  for i := 1 to RESOLUTION_X do
    for j := 1 to RESOLUTION_Y + 10 do
    begin
      screen[i, j] := ' ';
      screencolor[i, j] := Form1.Image1.Canvas.Font.Color;
    end;
end;

function WhereX: integer;
begin
  Result := anX;
end;

function WhereY: integer;
begin
  Result := anY;
end;

procedure SaveToFile(s: string);
var
  i, j, k: integer;
  f: TextFile;
begin
  AssignFile(f, s);
  ReWrite(f);
  for i := 1 to 255 do
  begin
    GoToXY(1, 1);
    System.Writeln(f, '/', i);
    write(chr(i));
    for j := 1 to SYMBOLHEIGHT do
    begin
      for k := 1 to SYMBOLWIDTH do
      begin
        if (Form1.Image1.Picture.Bitmap.Canvas.Pixels[k, j] = clBlack) then
          System.Write(f, '.')
        else
          System.Write(f, '*');
      end;
      System.Writeln(f);
    end;
    System.Writeln(f);
  end;
  CloseFile(f);
end;

procedure ReadLn(var s: string; MaxLength: integer = 0);
var
  c: char;
  Result: string;
begin
  Result := '';
  repeat
    c := ReadKey;
    if ((c = #8) and (Result <> '')) then
    begin
      GoToXY(WhereX - 1, Wherey);
      Write(' ');
      GoToXY(WhereX - 1, WhereY);
      Result := Copy(Result, 1, Length(Result) - 1);
    end
    else if ((c <> #27) and (c <> #13)) and
      ((MaxLength = 0) or (Length(Result) < MaxLength)) then
    begin
      Result := Result + c;
      Write(c);
    end;
  until ((c = #13) or (c = #27));
  WriteLn;
  if (c = #13) then
    s := Result
  else
    s := '';
end;

procedure DrawSymbol(x, y: integer; c: char; col: TColor);
var
  temp: TColor;
begin
  temp := Form1.Image1.Canvas.Font.Color;
  Form1.Image1.Canvas.Font.Color := col;
  Form1.Image1.Canvas.TextOut((x - 1) * SYMBOLWIDTH + 1, (y - 1) * SYMBOLHEIGHT, c);
  screen[x, y] := c;
  screencolor[x, y] := Form1.Image1.Canvas.Font.Color;
  Form1.Image1.Canvas.Font.Color := temp;
end;

procedure GraphicClearHud;
var
  i, j: integer;
begin
  Form1.Image1.Canvas.Rectangle(1, (RESOLUTION_Y + 1) * SYMBOLHEIGHT - 2, Form1.Image1.Width, Form1.Image1.Height);
  for i := RESOLUTION_Y + 1 to RESOLUTION_Y + 10 do
    for j := 1 to RESOLUTION_X do
    begin
      screen[j, i] := ' ';
      screencolor[j, i] := Form1.Image1.Canvas.Font.Color;
    end;
end;

end.

