unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  {set_byte_in_player = record
    lda: word;
    sta: array[0..2] of byte;
  end;

  set_byte_in_missile1 = record
    lda: array[0..2] of byte;
    and: word;
    sta: array[0..2] of byte;
  end;

  set_byte_in_missile2 = record
    lda: array[0..2] of byte;
    and: word;
    ora: word;
    sta: array[0..2] of byte;
  end;

  set_byte_in_missile3 = record
    lda: array[0..2] of byte;
    ora: word;
    sta: array[0..2] of byte;
  end;
    }
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Label2: TLabel;
    Label3: TLabel;
    UpDown1: TUpDown;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  i, ii, col, row: Integer;
  code, code_miss: array[0..255] of byte;
  handle_File_FNT, size_File_FNT: Integer;
  mic_file: array[0..9603] of byte;
  tab_pmg: array[0..20] of byte;
  tab_pmg_miss: array[0..20] of byte;
  tab_sort_line: array[0..20] of byte;
  min_value: byte;
  value, address: byte;
  old_value: integer;
  pmg_base, pmg_player, pmg_missile: word;
  len_code, len_code_miss: integer;
  and_miss: byte;
  cut_bits: byte;
  all_bytes: integer;
  y_pmg: byte;
  
implementation

{$R *.dfm}

// pobranie 21 bajtów dla 1-szej i 2-giej kolumny sprite'a oraz dwa pixele z 3-ciego bajtu
procedure get21_values(col, row: Integer);
var byte1, byte2, byte3, byte_pmg1, byte_pmg2, byte_pmg3: byte;
begin
  cut_bits:= 0;
  all_bytes:= 0;
  
// oblicz ile bitów z lewej strony przesunąc
  for i:=0 to 20 do begin
    byte1 := mic_file[col*3+0+row*24*40+i*40];
    byte2 := mic_file[col*3+1+row*24*40+i*40];
    byte3 := mic_file[col*3+2+row*24*40+i*40];
    all_bytes:= all_bytes or (byte1 shl 16) or (byte2 shl 8) or byte3;
  end;

// pobierz 1-szy bajt z trzech kolumn
  cut_bits:= all_bytes shr 16;

       if  cut_bits=0          then cut_bits:= 8
  else if (cut_bits and $fc)=0 then cut_bits:= 6
  else if (cut_bits and $f0)=0 then cut_bits:= 4
  else if (cut_bits and $c0)=0 then cut_bits:= 2
  else                              cut_bits:= 0;

  for i:=0 to 20 do begin
    byte1:= mic_file[col*3+0+row*24*40+i*40];
    byte2:= mic_file[col*3+1+row*24*40+i*40];
    byte3:= mic_file[col*3+2+row*24*40+i*40];
    all_bytes:= ((byte1 shl 16) or (byte2 shl 8) or byte3) shl cut_bits;

    byte1:= (all_bytes and $00ff0000) shr 16;
    byte2:= (all_bytes and $0000ff00) shr 8;
    byte3:= (all_bytes and $000000ff);
    
    byte_pmg1:= (byte1 and 64) shl 1 + (byte1 and 16) shl 2 + (byte1 and 4) shl 3 + (byte1 and 1) shl 4;
    byte_pmg2:= (byte2 and 64) shr 3 + (byte2 and 16) shr 2 + (byte2 and 4) shr 1 + (byte2 and 1) shr 0;
    byte_pmg3:= (byte3 and 64) shl 1 + (byte3 and 16) shl 2;

            tab_pmg[i]:= byte_pmg1 + byte_pmg2;
       tab_pmg_miss[i]:= byte_pmg3 + (byte_pmg3 shr 2) + (byte_pmg3 shr 4) + (byte_pmg3 shr 6);
  end;

end;

// sortowanie tych wartości
procedure sort21_values();
begin
  for i:=0 to 20 do tab_sort_line[i]:= i;

  for ii:=0 to 20 do
    for i:=0 to 20-1 do
      if tab_pmg[i] > tab_pmg[i+1] then begin
        min_value:= tab_pmg[i+1];
        tab_pmg[i+1]:= tab_pmg[i];
        tab_pmg[i]:= min_value;
        min_value:= tab_sort_line[i+1];
        tab_sort_line[i+1]:= tab_sort_line[i];
        tab_sort_line[i]:= min_value;
      end;
end;

// tworzenie kodu dla ATARI
procedure create_code();
begin

// pierwszy bajt to zawsze o ile bitów przesunąc
  code[0]:= cut_bits div 2;

  len_code:= 1;
  old_value:= -1;
    
  for i:=0 to 20 do begin
    value:=   tab_pmg[i];
    address:= tab_sort_line[i];

    if value = old_value then begin
      code[0+len_code]:= $99;                                   // sta $ffff,y
      code[1+len_code]:= lo(pmg_base+pmg_player+address);
      code[2+len_code]:= hi(pmg_base+pmg_player+address);
      len_code:= len_code+3;
    end else begin
      code[0+len_code]:= $A9;                                   // lda #$ff
      code[1+len_code]:= value;
      code[2+len_code]:= $99;                                   // sta $ffff,y
      code[3+len_code]:= lo(pmg_base+pmg_player+address);
      code[4+len_code]:= hi(pmg_base+pmg_player+address);
      len_code:= len_code+5;
    end;

    old_value:= value;
  end;

  len_code_miss:= 0;
  for i:=0 to 20 do begin
    value:=   tab_pmg_miss[i];

    if (value and 3) = $00 then begin
      code_miss[0+len_code_miss]:= $B9;                                   // lda $ffff,y
      code_miss[1+len_code_miss]:= lo(pmg_base+$0300+i);
      code_miss[2+len_code_miss]:= hi(pmg_base+$0300+i);
      code_miss[3+len_code_miss]:= $29;                                   // and #%11111111
      code_miss[4+len_code_miss]:= and_miss;
      code_miss[5+len_code_miss]:= $99;                                   // sta $ffff,y
      code_miss[6+len_code_miss]:= lo(pmg_base+$0300+i);
      code_miss[7+len_code_miss]:= hi(pmg_base+$0300+i);
      len_code_miss:= len_code_miss+8;
    end else if ((value and 3) = $01) or ((value and 3) = $02) then begin
      code_miss[0+len_code_miss]:= $B9;                                   // lda $ffff,y
      code_miss[1+len_code_miss]:= lo(pmg_base+$0300+i);
      code_miss[2+len_code_miss]:= hi(pmg_base+$0300+i);
      code_miss[3+len_code_miss]:= $29;                                   // and #%11111111
      code_miss[4+len_code_miss]:= and_miss;
      code_miss[5+len_code_miss]:= $09;                                   // ora #%11111111
      code_miss[6+len_code_miss]:= (value and (255-and_miss));
      code_miss[7+len_code_miss]:= $99;                                   // sta $ffff,y
      code_miss[8+len_code_miss]:= lo(pmg_base+$0300+i);
      code_miss[9+len_code_miss]:= hi(pmg_base+$0300+i);
      len_code_miss:= len_code_miss+10;
    end else begin
      code_miss[0+len_code_miss]:= $B9;                                   // lda $ffff,y
      code_miss[1+len_code_miss]:= lo(pmg_base+$0300+i);
      code_miss[2+len_code_miss]:= hi(pmg_base+$0300+i);
      code_miss[3+len_code_miss]:= $09;                                   // ora #%11111111
      code_miss[4+len_code_miss]:= (value and (255-and_miss));
      code_miss[5+len_code_miss]:= $99;                                   // sta $ffff,y
      code_miss[6+len_code_miss]:= lo(pmg_base+$0300+i);
      code_miss[7+len_code_miss]:= hi(pmg_base+$0300+i);
      len_code_miss:= len_code_miss+8;
    end;
  end;
end;

// zapisanie wygenerowanego kodu dla danej klatki do pliku
procedure save_code(col, row: Integer);
var handle_File_PMG: integer;
    //         player: string;
begin
    case pmg_player  of
      $0400: pmg_player:= 0;
      $0500: pmg_player:= 1;
      $0600: pmg_player:= 2;
      $0700: pmg_player:= 3;
    end;

 //   player:= IntToStr(hi(pmg_player));
    handle_File_PMG:= FileCreate('pmg'+IntToHex(hi(pmg_base),2)+'00_pla'+IntToStr(pmg_player)+'_'+IntToHex(col,2)+'x'+IntToHex(row,2)+'.pmg');
    FileWrite(handle_File_PMG, code[0], len_code);
    FileClose(handle_File_PMG);

  //  player:= IntToStr(hi(pmg_player));
    handle_File_PMG:= FileCreate('pmg'+IntToHex(hi(pmg_base),2)+'00_mis'+IntToStr(pmg_missile)+'_'+IntToHex(col,2)+'x'+IntToHex(row,2)+'.pmg');
    FileWrite(handle_File_PMG, code_miss[0], len_code_miss);
    FileClose(handle_File_PMG);

end;

// tworzenie kodu PMG dla jednej klatki
procedure create_clip_PMG(col, row: Integer);
begin

// generuj programy rysujące na 1-szym buforze PMG
  pmg_base:=   $0000+y_pmg;

  pmg_player:= $0400;
  pmg_missile:= 0;
  and_miss:= 255-3;
  get21_values(col, row);
  sort21_values();
  create_code();
  save_code(col, row);

  pmg_player:= $0500;
  pmg_missile:= 1;
  and_miss:= 255-12;
  get21_values(col, row);
  sort21_values();
  create_code();
  save_code(col, row);

  pmg_player:= $0600;
  pmg_missile:= 2;
  and_miss:= 255-48;
  get21_values(col, row);
  sort21_values();
  create_code();
  save_code(col, row);

  pmg_player:= $0700;
  pmg_missile:= 3;
  and_miss:= 255-192;
  get21_values(col, row);
  sort21_values();
  create_code();
  save_code(col, row);

// generuj programy rysujące na 2-gim buforze PMG
  pmg_base:=   $0800+y_pmg;

  pmg_player:= $0400;
  pmg_missile:= 0;
  and_miss:= 255-3;
  get21_values(col, row);
  sort21_values();
  create_code();
  save_code(col, row);

  pmg_player:= $0500;
  pmg_missile:= 1;
  and_miss:= 255-12;
  get21_values(col, row);
  sort21_values();
  create_code();
  save_code(col, row);

  pmg_player:= $0600;
  pmg_missile:= 2;
  and_miss:= 255-48;
  get21_values(col, row);
  sort21_values();
  create_code();
  save_code(col, row);

  pmg_player:= $0700;
  pmg_missile:= 3;
  and_miss:= 255-192;
  get21_values(col, row);
  sort21_values();
  create_code();
  save_code(col, row);
end;

procedure TForm1.Button2Click(Sender: TObject);
var zm: string;
label skip1;
begin
    if OpenDialog1.Execute then begin

// wczytanie pliku *.MIC i test czy jest odpowiedniej długości
      zm:=OpenDialog1.FileName;
      handle_File_FNT:= FileOpen(zm, fmOpenRead);
      size_File_FNT:= FileSeek(handle_File_FNT, 0, 2);
      if size_File_FNT<>9604 then begin
        MessageDlg('Bad size of the *.MIC file! Must be 9604 bytes.', mtError, [mbOk], 0);
        goto skip1;
      end;
      FileSeek(handle_File_FNT, 0, 0);
      FileRead(handle_File_FNT, mic_file, size_File_FNT);
      Edit1.Text:= zm;
    end;
    
skip1:
    FileClose(handle_File_FNT);
end;

// tworzenie rozpiski PMG dla wszystkich klatek(24x24) w pliku *.MIC
procedure TForm1.Button1Click(Sender: TObject);
begin
      y_pmg:= StrToInt(Label3.Caption);
      for row:=0 to 9 do
        for col:=0 to 12 do begin
          create_clip_PMG(col, row);
        end;
end;

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

end.
