unit G2F_to_4Charsets;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, Mask, ComCtrls, StrUtils;

type
  TForm1 = class(TForm)
    StaticText1: TStaticText;
    LabeledEdit1: TLabeledEdit;
    BitBtn1: TBitBtn;
    StaticText3: TStaticText;
    BitBtn3: TBitBtn;
    OpenDialog1: TOpenDialog;
    StaticText6: TStaticText;
    StaticText10: TStaticText;
    StaticText11: TStaticText;
    StaticText12: TStaticText;
    Image1: TImage;
    Image2: TImage;
    ColorBox1: TColorBox;
    ColorBox2: TColorBox;
    ColorBox3: TColorBox;
    ColorBox4: TColorBox;
    StaticText13: TStaticText;
    StaticText14: TStaticText;
    StaticText15: TStaticText;
    StaticText16: TStaticText;
    StaticText17: TStaticText;
    StaticText5: TStaticText;
    StaticText2: TStaticText;
    StaticText4: TStaticText;
    StaticText7: TStaticText;
    Label1: TLabel;
    UpDown1: TUpDown;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;

    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    LabeledEdit4: TLabeledEdit;
    OpenDialog4: TOpenDialog;
    Button5: TButton;
    Label6: TLabel;
    StaticText8: TStaticText;
    UpDown2: TUpDown;
    CheckBox1: TCheckBox;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure ColorBox1Change(Sender: TObject);
    procedure ColorBox2Change(Sender: TObject);
    procedure ColorBox3Change(Sender: TObject);
    procedure ColorBox4Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
    procedure FormCreate(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses G2F_to_4Charsets2;

{$R *.dfm}

type
  one_fnt= record
    font: array[0..1023] of byte;
  end;

var
  g2f_fnt: array[0..7] of one_fnt;
  g2f_scr: array[0..959] of Byte;
  g2f_col: array[0..1279] of Byte;
  g2f_cnv: array[0..30*5] of Byte;
  teb_font: array[0..3] of one_fnt;
  con_font: array[0..1023] of Byte;
  index_char_in_teb_font: array[0..3] of Integer;
  screen: array[0..1023] of byte;
  handle_File_FNT, size_File_FNT: Integer;
  i, ii, iii, col, row: Integer;
  byte0, byte1, byte2, byte3, byte4, byte5, byte6, byte7: byte;
  number_font_teb: byte;
  result_find: Integer;
  ifont, ichar, ibyte: byte;
  xx, yy: Integer;
  tab_color: array[0..3] of TColor;
  Is_File_Readed1, Is_File_Readed2, Is_File_Readed3, Is_File_Readed4: Boolean;
  FileName, Dir: String;

procedure Draw_Picture;
begin
    // narysuj wgrany font na ekranie
    for ifont:=0 to 7 do
      for ichar:=0 to 127 do
        for ibyte:=0 to 7 do
          with Form1.Image1.Canvas do begin
            byte1:= g2f_fnt[ifont].font[ichar*8+ibyte];
            xx:= (ichar mod 32)*8;
            yy:= ifont*32+ibyte+(ichar div 32)*8;
            MoveTo(xx, yy);
            Pen.Color:= tab_color[(byte1 and $C0) shr 6]; LineTo(xx+2, yy);
            Pen.Color:= tab_color[(byte1 and $30) shr 4]; LineTo(xx+4, yy);
            Pen.Color:= tab_color[(byte1 and $0C) shr 2]; LineTo(xx+6, yy);
            Pen.Color:= tab_color[(byte1 and $03) shr 0]; LineTo(xx+8, yy);
          end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var zm: string;
label
  skip1;
begin
    tab_color[0]:= ColorBox1.Selected;
    tab_color[1]:= ColorBox2.Selected;
    tab_color[2]:= ColorBox3.Selected;
    tab_color[3]:= ColorBox4.Selected;

    if OpenDialog1.Execute then begin

    zm:=OpenDialog1.FileName;

// FNT
    zm:=ChangeFileExt(zm,'.FNT');
    handle_File_FNT:= FileOpen(zm, fmOpenRead);
    size_File_FNT:= FileSeek(handle_File_FNT, 0, 2);
    if size_File_FNT<>8192 then begin
      MessageDlg('Bad size of the *.FNT file! Must be 8192 bytes.', mtError, [mbOk], 0);
      goto skip1;
    end;
    LabeledEdit1.Text:= zm;
    FileSeek(handle_File_FNT, 0, 0);
    FileRead(handle_File_FNT, g2f_fnt, size_File_FNT);
    FileClose(handle_File_FNT);
    Is_File_Readed1:= True;
    Draw_Picture();

// SCR
      zm:=ChangeFileExt(zm,'.SCR');
      handle_File_FNT:= FileOpen(zm, fmOpenRead);
      size_File_FNT:= FileSeek(handle_File_FNT, 0, 2);
      if size_File_FNT<>960 then begin
        MessageDlg('Bad size of the *.SCR file! Must be 960 bytes.', mtError, [mbOk], 0);
        goto skip1;
      end;
      FileSeek(handle_File_FNT, 0, 0);
      FileRead(handle_File_FNT, g2f_scr, size_File_FNT);
      FileClose(handle_File_FNT);
      Is_File_Readed2:= True;

// COL
      zm:=ChangeFileExt(zm,'.COL');
      handle_File_FNT:= FileOpen(zm, fmOpenRead);
      size_File_FNT:= FileSeek(handle_File_FNT, 0, 2);
      if size_File_FNT<>1280 then begin
        MessageDlg('Bad size of the *.COL file! Must be 1280 bytes.', mtError, [mbOk], 0);
        goto skip1;
      end;
      FileSeek(handle_File_FNT, 0, 0);
      FileRead(handle_File_FNT, g2f_col, size_File_FNT);
      Is_File_Readed3:= True;


skip1:
    FileClose(handle_File_FNT);
  end;
end;

function Find_Char_in_teb_font(coll, roww, fontt_g2f, fontt_teb: Integer): Integer;
begin
  byte0:= g2f_FNT[fontt_g2f].font[coll*8+roww*8*32+0];
  byte1:= g2f_FNT[fontt_g2f].font[coll*8+roww*8*32+1];
  byte2:= g2f_FNT[fontt_g2f].font[coll*8+roww*8*32+2];
  byte3:= g2f_FNT[fontt_g2f].font[coll*8+roww*8*32+3];
  byte4:= g2f_FNT[fontt_g2f].font[coll*8+roww*8*32+4];
  byte5:= g2f_FNT[fontt_g2f].font[coll*8+roww*8*32+5];
  byte6:= g2f_FNT[fontt_g2f].font[coll*8+roww*8*32+6];
  byte7:= g2f_FNT[fontt_g2f].font[coll*8+roww*8*32+7];

  if index_char_in_teb_font[fontt_teb]<>0 then begin
    result:= -1;
    for i:=0 to index_char_in_teb_font[fontt_teb]-1 do
      if (byte0=teb_font[fontt_teb].font[i*8+0]) and
         (byte1=teb_font[fontt_teb].font[i*8+1]) and
         (byte2=teb_font[fontt_teb].font[i*8+2]) and
         (byte3=teb_font[fontt_teb].font[i*8+3]) and
         (byte4=teb_font[fontt_teb].font[i*8+4]) and
         (byte5=teb_font[fontt_teb].font[i*8+5]) and
         (byte6=teb_font[fontt_teb].font[i*8+6]) and
         (byte7=teb_font[fontt_teb].font[i*8+7]) then begin
           result:= i;
           result_find:= i;
           break;
         end;
   end else result:= -1;
end;

procedure Draw_Output_Char(number_font, index_char, number_char: Integer);
begin
  for i:=0 to 7 do begin
    byte0:= teb_font[number_font].font[number_char*8+i];
    with Form1.Image2.Canvas do begin
      xx:= (index_char mod 32)*8;
      yy:= (index_char div 32)*8+i;
      MoveTo(xx, yy);
      Pen.Color:= tab_color[(byte0 and $C0) shr 6]; LineTo(xx+2, yy);
      Pen.Color:= tab_color[(byte0 and $30) shr 4]; LineTo(xx+4, yy);
      Pen.Color:= tab_color[(byte0 and $0C) shr 2]; LineTo(xx+6, yy);
      Pen.Color:= tab_color[(byte0 and $03) shr 0]; LineTo(xx+8, yy);
    end;
  end;
end;

procedure Draw_Output_Font(number_font: Integer);
var
  index1: Integer;
begin
  if Is_File_Readed1=FALSE or Is_File_Readed2=FALSE or Is_File_Readed3=FALSE then exit;
  for index1:=  0 to  31 do Draw_Output_Char(number_font, index1+number_font*32, screen[index1+number_font*32]);
  for index1:=128 to 159 do Draw_Output_Char(number_font, index1+number_font*32, screen[index1+number_font*32]);
  for index1:=256 to 287 do Draw_Output_Char(number_font, index1+number_font*32, screen[index1+number_font*32]);
  for index1:=384 to 415 do Draw_Output_Char(number_font, index1+number_font*32, screen[index1+number_font*32]);
  for index1:=512 to 543 do Draw_Output_Char(number_font, index1+number_font*32, screen[index1+number_font*32]);
  for index1:=640 to 671 do Draw_Output_Char(number_font, index1+number_font*32, screen[index1+number_font*32]);
  for index1:=768 to 799 do Draw_Output_Char(number_font, index1+number_font*32, screen[index1+number_font*32]);
  for index1:=896 to 927 do Draw_Output_Char(number_font, index1+number_font*32, screen[index1+number_font*32]);
end;

procedure Draw_All_Output_Font;
begin
  Form1.Image2.Canvas.Rectangle(0, 0, 256, 240);
  Draw_Output_Font(0);
  Draw_Output_Font(1);
  Draw_Output_Font(2);
  Draw_Output_Font(3);
 {
  if Form1.CheckBox1.Checked then Draw_Output_Font(0);
  if Form1.CheckBox2.Checked then Draw_Output_Font(1);
  if Form1.CheckBox3.Checked then Draw_Output_Font(2);
  if Form1.CheckBox4.Checked then Draw_Output_Font(3); }
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var
  char: Integer;
label
  skip1;
begin
  Form1.Label2.Font.Color:= clWHITE;
  Form1.Label3.Font.Color:= clWHITE;
  Form1.Label4.Font.Color:= clWHITE;
  Form1.Label5.Font.Color:= clWHITE; 

  if Is_File_Readed1=FALSE or Is_File_Readed2=FALSE or Is_File_Readed3=FALSE then exit;
  index_char_in_teb_font[0]:= 0;
  index_char_in_teb_font[1]:= 0;

  index_char_in_teb_font[2]:= 0;
  index_char_in_teb_font[3]:= 0;

  for number_font_teb:= 0 to 3 do
    for row:= 0 to 7 do
      for col:=0 to 31 do
        if Find_Char_in_teb_font(col, number_font_teb, row, number_font_teb)<>-1 then
          screen[col+row*128+number_font_teb*32]:= result_find else begin
    //      begin
   //        if index_char_in_teb_font[number_font_teb]=UpDown1.Position then begin
   //           MessageDlg('All chars for the font no.'+IntToStr(number_font_teb)+' are used!', mtError, [mbOK], 0);
   //           goto skip1;
   //         end;
            teb_font[number_font_teb].font[index_char_in_teb_font[number_font_teb]*8+0]:= byte0;
            teb_font[number_font_teb].font[index_char_in_teb_font[number_font_teb]*8+1]:= byte1;
            teb_font[number_font_teb].font[index_char_in_teb_font[number_font_teb]*8+2]:= byte2;
            teb_font[number_font_teb].font[index_char_in_teb_font[number_font_teb]*8+3]:= byte3;
            teb_font[number_font_teb].font[index_char_in_teb_font[number_font_teb]*8+4]:= byte4;
            teb_font[number_font_teb].font[index_char_in_teb_font[number_font_teb]*8+5]:= byte5;
            teb_font[number_font_teb].font[index_char_in_teb_font[number_font_teb]*8+6]:= byte6;
            teb_font[number_font_teb].font[index_char_in_teb_font[number_font_teb]*8+7]:= byte7;
            screen[col+row*128+number_font_teb*32]:= index_char_in_teb_font[number_font_teb];
            inc(index_char_in_teb_font[number_font_teb]);
          end;

  Draw_All_Output_Font();

  // dopelnij do 1024 bajtów wartoscia $FF
  for i:=0 to 3 do
    for ii:=0 to (256-index_char_in_teb_font[i]) do
      teb_font[i].font[index_char_in_teb_font[i]*8+ii]:= $FF;

  // dopisz "znaki stale" do FONTów #00-#03
  char:= 128-32-StrToInt(Label6.Caption); // '32' - 8 Software Sprites
  for i:=0 to 3 do
    for ii:=char to char+StrToInt(Label6.Caption)-1 do
      for iii:= 0 to 7 do
        teb_font[i].font[ii*8+iii]:= con_font[(ii-char)*8+iii];

  // nagraj na dysk ekran w przeformatowanym formacie
  FileName:= LeftStr(OpenDialog1.FileName, Length(OpenDialog1.FileName)-4);

  handle_File_FNT:= FileCreate(FileName+'.dat');

  for i:=0 to 3 do FileWrite(handle_File_FNT, teb_font[i].font[0], 1024);    // save - 4 fonts x 1024 bytes

  for i:=0 to (32*30)-1 do if g2f_scr[i]>127 then screen[i]:= screen[i]+128;

  FileWrite(handle_File_FNT,  screen[0],  32*30);                            // save - screen 32 x 30

  for i:=0 to 29 do g2f_cnv[i+30*0]:= g2f_col[i*8+$0000];
  for i:=0 to 29 do g2f_cnv[i+30*1]:= g2f_col[i*8+$0100];
  for i:=0 to 29 do g2f_cnv[i+30*2]:= g2f_col[i*8+$0200];
  for i:=0 to 29 do g2f_cnv[i+30*3]:= g2f_col[i*8+$0300];
  for i:=0 to 29 do g2f_cnv[i+30*4]:= g2f_col[i*8+$0400];

  FileWrite(handle_File_FNT,  g2f_cnv[0],  5*30);                            // save - 5th colors x 30 rows

  FileClose(handle_File_FNT);

skip1:
  StaticText6.Caption:=  IntToStr(index_char_in_teb_font[0]);
  StaticText10.Caption:= IntToStr(index_char_in_teb_font[1]);
  StaticText11.Caption:= IntToStr(index_char_in_teb_font[2]);
  StaticText12.Caption:= IntToStr(index_char_in_teb_font[3]);

  if StrToInt(Label1.Caption)<StrToInt(StaticText6.Caption) then Label2.Font.Color:= clRED;
  if StrToInt(Label1.Caption)<StrToInt(StaticText10.Caption) then Label3.Font.Color:= clRED;
  if StrToInt(Label1.Caption)<StrToInt(StaticText11.Caption) then Label4.Font.Color:= clRED;
  if StrToInt(Label1.Caption)<StrToInt(StaticText12.Caption) then Label5.Font.Color:= clRED;
end;

procedure TForm1.ColorBox1Change(Sender: TObject);
begin
  tab_color[0]:= ColorBox1.Selected;
  Draw_Picture();
end;

procedure TForm1.ColorBox2Change(Sender: TObject);
begin
  tab_color[1]:= ColorBox2.Selected;
  Draw_Picture();
end;

procedure TForm1.ColorBox3Change(Sender: TObject);
begin
  tab_color[2]:= ColorBox3.Selected;
  Draw_Picture();
end;

procedure TForm1.ColorBox4Change(Sender: TObject);
begin
  tab_color[3]:= ColorBox4.Selected;
  Draw_Picture();
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  If CheckBox1.Checked then LabeledEdit4.Enabled:= TRUE else LabeledEdit4.Enabled:= FALSE;
end;

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
  Label1.Caption:= IntToStr(UpDown1.Position);
end;

procedure Draw_Byte(byte_char: Integer);
begin
  with Form2.Image1.Canvas do begin
    Pen.Color:= tab_color[(byte_char and $C0) shr 6]; LineTo(xx+2, yy+ii);
    Pen.Color:= tab_color[(byte_char and $30) shr 4]; LineTo(xx+4, yy+ii);
    Pen.Color:= tab_color[(byte_char and $0C) shr 2]; LineTo(xx+6, yy+ii);
    Pen.Color:= tab_color[(byte_char and $C3) shr 0]; LineTo(xx+8, yy+ii);
  end;
end;

procedure Draw_Char(char, font: Integer);
begin
  for ii:=0 to 7 do begin
    Form2.Image1.Canvas.MoveTo(xx,yy+ii);
    Draw_Byte(teb_font[font].font[char*8+ii]);
  end;
end;

procedure Draw_Charset(font: Integer);
begin
  Form2.Image1.Canvas.Pen.Color:= clYellow;

  for i:= 1 to 15 do begin
    Form2.Image1.Canvas.MoveTo(i*9-1, 0);
    Form2.Image1.Canvas.LineTo(i*9-1, Form2.Image1.Height);
  end;

  for i:= 1 to 7 do begin
    Form2.Image1.Canvas.MoveTo(0, i*9-1);
    Form2.Image1.Canvas.LineTo(Form2.Image1.Width, i*9-1);
  end;

  xx:= 0; yy:= 0;
  for i:=0 to index_char_in_teb_font[font]-1 do begin
    Draw_Char(i, font);
    xx:= xx+9; if xx>=16*9 then begin xx:= 0; yy:= yy+9; end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
//  if index_char_in_teb_font[0]= 0 then exit;

  Form2:=TForm2.Create(nil);
  Form2.Caption:= IntToStr(index_char_in_teb_font[0])+' Chars is used in Charset #00 (max.128 chars)';
  Draw_Charset(0);
  Form2.Image1.Width:= 143*4; Form2.Image1.Height:= 71*4;
  Form2.ShowModal
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//  if index_char_in_teb_font[1]= 0 then exit;

  Form2:=TForm2.Create(nil);
  Form2.Caption:= IntToStr(index_char_in_teb_font[1])+' Chars is used in Charset #01 (max.128 chars)';
  Draw_Charset(1);
  Form2.Image1.Width:= 143*4; Form2.Image1.Height:= 71*4;
  Form2.ShowModal
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
//  if index_char_in_teb_font[2]= 0 then exit;

  Form2:=TForm2.Create(nil);
  Form2.Caption:= IntToStr(index_char_in_teb_font[2])+' Chars is used in Charset #02 (max.128 chars)';
  Draw_Charset(2);
  Form2.Image1.Width:= 143*4; Form2.Image1.Height:= 71*4;
  Form2.ShowModal
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
//  if index_char_in_teb_font[3]= 0 then exit;

  Form2:=TForm2.Create(nil);
  Form2.Caption:= IntToStr(index_char_in_teb_font[3])+' Chars is used in Charset #03 (max.128 chars)';
  Draw_Charset(3);
  Form2.Image1.Width:= 143*4; Form2.Image1.Height:= 71*4;
  Form2.ShowModal
end;

procedure TForm1.Button5Click(Sender: TObject);
label
  skip1;
begin
    if OpenDialog4.Execute then begin
      handle_File_FNT:= FileOpen(OpenDialog4.FileName, fmOpenRead);
      size_File_FNT:= FileSeek(handle_File_FNT, 0, 2);
      if size_File_FNT<>1024 then begin
        MessageDlg('Bad size of the *.FNT file! Must be 1024 bytes.', mtError, [mbOk], 0);
        goto skip1;
      end;
      LabeledEdit4.Text:= OpenDialog4.FileName;
      FileSeek(handle_File_FNT, 0, 0);
      FileRead(handle_File_FNT, con_font, size_File_FNT);
      Is_File_Readed4:= True;

skip1:
      FileClose(handle_File_FNT);
    end;
end;

procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
begin
  Label6.Caption:= IntToStr(UpDown2.Position);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
 OpenDialog1.InitialDir:=Application.ExeName;
 OpenDialog4.InitialDir:=Application.ExeName;
end;

end.
