unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Math, Buttons, ExtCtrls;

type
  t_abs=record
    block_size:byte;
    player_size: word;
    tbl_size: word;
    trk_size: word;
    p_size: word;
    end;
  t_ay_dump = record
    a_tone_low: byte;
    a_tone_hi: byte;
    b_tone_low: byte;
    b_tone_hi: byte;
    c_tone_low: byte;
    c_tone_hi: byte;
    noise: byte;
    control: byte;
    a_volume: byte;
    b_volume: byte;
    c_volume: byte;
    env_per_low: byte;
    env_per_hi: byte;
    env_form: byte;
    end;
  t_tonevol_patt = record
    index: byte;
    volume: byte;
    end;
  t_index_patt = record
    index: byte;
    end;
  t_reg_dump_patt = record
    noise: byte;
    control: byte;
    end;
  t_variants = record
  	byte0: byte; //tone_low  env_low  noise
  	byte1: byte; //tone_hi   env_hi   control
   	byte2: byte; //volume*   form
  	end;

  TForm1 = class(TForm)
    Button_selectfile: TButton;
    OpenDialog1: TOpenDialog;
    Edit_FileAYdump: TEdit;
    Memo1: TMemo;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Edit_PlayerADR: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Edit_TrackADR: TEdit;
    Label4: TLabel;
    Combo_Compile: TComboBox;
    Label5: TLabel;
    Edit_TablesADR: TEdit;
    Edit_BlockSize: TEdit;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label_FileSize: TLabel;
    Label_FileDumpCount: TLabel;
    Label11: TLabel;
    Label_FileType: TLabel;
    Panel2: TPanel;
    Label12: TLabel;
    Button_compile: TButton;
    Button_save: TButton;
    Label1: TLabel;
    Edit_PattADR: TEdit;
    Edit_PlayerEND: TEdit;
    Edit_TablesEND: TEdit;
    Edit_TrackEND: TEdit;
    Edit_PattEND: TEdit;
    Label7: TLabel;
    Label13: TLabel;
    Label6: TLabel;
    Label14: TLabel;
    Combo_BlockSize: TComboBox;
    Combo_ADRView: TComboBox;
    Label15: TLabel;
    Panel3: TPanel;
    Label16: TLabel;
    Panel1: TPanel;
    CheckBox_FixedTakts: TCheckBox;
    CheckBox_Loop: TCheckBox;
    Label17: TLabel;
    Edit_Loop: TEdit;
    Panel4: TPanel;
    Bevel1: TBevel;
    Memo_Player: TMemo;
    GroupBox4: TGroupBox;
    Button_calctbl: TButton;
    Button_trymerge: TButton;
    ComboBox_Merge_from: TComboBox;
    ComboBox_Merge_to: TComboBox;
    Label18: TLabel;
    Label19: TLabel;
    Button_confirmmerge: TButton;
    Panel5: TPanel;
    procedure Button_selectfileClick(Sender: TObject);
    procedure Combo_CompileChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Panel2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button_compileClick(Sender: TObject);
    procedure Button_saveClick(Sender: TObject);
    procedure Combo_BlockSizeChange(Sender: TObject);
    procedure Combo_ADRViewChange(Sender: TObject);
    procedure Edit_PlayerADRKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit_TablesADRKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit_TrackADRKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit_PattADRKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Panel3Click(Sender: TObject);
    procedure Panel1Click(Sender: TObject);
    procedure Panel4Click(Sender: TObject);
    procedure Button_calctblClick(Sender: TObject);
    procedure Button_trymergeClick(Sender: TObject);
    procedure Button_confirmmergeClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
const
   direction_a=1;
   direction_b=2;
   direction_c=3;
   direction_env=4;
   direction_reg=5;
var
  Form1: TForm1;

  AyFlyDLL : THandle;
  dechex_view: byte;
//ay_initsongindirect: procedure (unsigned char *module, unsigned long sr, AY_CHAR *type, unsigned long size, AbstractAudio *player = 0);
  ay_initsongindirect: function (module: Pointer; sr: dword; size:dword; player:Pointer): Pointer;stdcall;
//ay_sethwnd(void *info, HWND hWnd);
  ay_sethwnd: procedure (p: Pointer; xHWND:hWnd);stdcall;
//ay_resetsong(void *info);
  ay_resetsong: procedure (p: Pointer);stdcall;
//unsigned long ay_getsonglength(void *info);
//unsigned long ay_getelapsedtime(void *info);
//unsigned long ay_getsongloop(void *info);
  ay_getsonglength: function (p: Pointer):dword;stdcall;
  ay_getelapsedtime: function (p: Pointer):dword;stdcall;
//const unsigned char *ay_getregs(void *info, unsigned char chip_num = 0);
  ay_getregs: function(p: Pointer; chip:byte):Pointer;stdcall;
//void ay_seeksong(void *info, long new_position);
  ay_seeksong: procedure(p: Pointer; new_position:dword);stdcall;

  Song: array [0..65535] of byte;
  ay_dump: array [0..65535] of t_ay_dump;
  temp_patt_tonevol: array [0..255] of t_tonevol_patt;
  temp_patt_index: array [0..255] of t_index_patt;
  cha_patt: array [0..1023] of array [0..255] of t_tonevol_patt;
  chb_patt: array [0..1023] of array [0..255] of t_tonevol_patt;
  chc_patt: array [0..1023] of array [0..255] of t_tonevol_patt;
  env_patt: array [0..1023] of array [0..255] of t_index_patt;
  reg_patt: array [0..1023] of array [0..255] of t_index_patt;
  cha_patt_count: dword;
  chb_patt_count: dword;
  chc_patt_count: dword;
  env_patt_count: dword;
  reg_patt_count: dword;
  max_block_size: byte;
  ay_dump_count: word;

  var_variants:array [0..4,0..16383] of T_Variants;
  var_variants_count:array [0..4] of word;
  var_tonevol_type:array[0..4] of byte; //0-ToneVol 1-Tone
  //-- временный массив для слияния таблиц
  var_merge: array [0..16383] of T_Variants;
  var_merge_count:word;
  var_merge_type:byte;
  index_from,index_to:byte;
  //-- флаги слияния 0-норм, >0- перемещен в (индекс-1)
  merge_tables:array[0..4] of byte;
  //-- смещения адресов таблиц
  TBL_ADR:array[0..4] of word;
  TBL_SIZE:word;
  //--
  channel_a_size: word;
  channel_b_size: word;
  channel_c_size: word;
  channel_e_size: word;
  channel_r_size: word;
  track_a: array [0..4095] of word;
  track_b: array [0..4095] of word;
  track_c: array [0..4095] of word;
  track_e: array [0..4095] of word;
  track_r: array [0..4095] of word;
  track_a_count: word;
  track_b_count: word;
  track_c_count: word;
  track_e_count: word;
  track_r_count: word;
  arr_block_size: array [0..7] of t_abs;
  abs_count: byte;
  FileName_aydump: string;
  ProgDir:string;

  temp_block_size: integer;
  trk_size,p_size: word;

procedure Update_compile_adr;
implementation

{$R *.dfm}

//---------------------------------- вычисляем длину и адреса таблиц
procedure Calc_adr_tbl();
var CURR_ADR:word; i:integer;
begin
//--- вычисляем смещения таблиц
CURR_ADR:=0;
for i:=0 to 4 do //располагаем таблицы последовательно
  begin
  if (merge_tables[i]=0) then
    begin
    TBL_ADR[i]:=CURR_ADR;
    CURR_ADR:=CURR_ADR+768-var_tonevol_type[i]*256;
    end;
  end;
TBL_SIZE:=CURR_ADR;
for i:=0 to 4 do //настраиваем адреса влитых таблиц
  begin
  if (merge_tables[i]<>0) then
    begin
    TBL_ADR[i]:=TBL_ADR[merge_tables[i]-1];
    end;
  end;
end;
//-------------------------------------------- OPEN AY DUMP
procedure TForm1.Button_selectfileClick(Sender: TObject);
var F: file of byte;
  fs: dword;
  file_ext: string;
  i: integer;
  MusicHandle: pointer;
  bf: Pointer;
  MusicLen:dword;
begin
if (Form1.OpenDialog1.Execute) then
  begin
  Form1.Memo1.Lines.Clear;
  Form1.Button_calctbl.Enabled:=true;
  Form1.Button_trymerge.Enabled:=false;
  Form1.Button_compile.Enabled:=false;
  Form1.Button_save.Enabled:=false;  
  Form1.Edit_FileAYdump.Text:=Form1.OpenDialog1.FileName;
  FileName_aydump:=Form1.OpenDialog1.FileName;
  file_ext:= LowerCase(copy(FileName_aydump,Length(FileName_aydump)-2,3));
  Form1.Caption:=file_ext;
  //--- raw ay-registers dump
  if (file_ext='bin') or (file_ext='raw') then
    begin
    AssignFile (F,Form1.OpenDialog1.FileName);
    Reset (F);
    Label_Filetype.Caption:='raw ay dump';
    Label_FileSize.Caption:=IntToStr(FileSize(F));
    Label_FileDumpCount.Caption:=IntToStr(floor(FileSize(F)/14))+' ['+IntToStr(floor(FileSize(F)))+' bytes]';
    ay_dump_count:=floor(FileSize(F)/14);
    for i:=0 to ay_dump_count-1 do
      begin
      Read (F,ay_dump[i].a_tone_low);	//0
      Read (F,ay_dump[i].a_tone_hi);	//1
      Read (F,ay_dump[i].b_tone_low);	//2
      Read (F,ay_dump[i].b_tone_hi);  	//3
      Read (F,ay_dump[i].c_tone_low);	//4
      Read (F,ay_dump[i].c_tone_hi);	//5
      Read (F,ay_dump[i].noise);	//6
      Read (F,ay_dump[i].control);	//7
      Read (F,ay_dump[i].a_volume);	//8
      Read (F,ay_dump[i].b_volume);	//9
      Read (F,ay_dump[i].c_volume);	//10
      Read (F,ay_dump[i].env_per_low);	//11
      Read (F,ay_dump[i].env_per_hi);	//12
      Read (F,ay_dump[i].env_form);	//13
      end;
    CloseFile (F);
    end
  else  //--- tracker module or other filetype supported by ayfly.dll
    begin
    AssignFile (F,Form1.OpenDialog1.FileName);
    Reset (F);
    fs:=FileSize(F);
    for i:=0 to fs-1 do Read (F,Song[i]);
    MusicHandle:=ay_initsongindirect(@Song, 44100, fs, 0);
    ay_sethwnd(MusicHandle,Form1.Handle);
    ay_resetsong(MusicHandle);
    MusicLen:=ay_getsonglength(MusicHandle);
    Label_Filetype.Caption:=file_ext;
    Label_FileSize.Caption:=IntToStr(FileSize(F));
    Label_FileDumpCount.Caption:=IntToStr(MusicLen)+' ['+IntToStr(MusicLen*14)+' bytes]';
    ay_dump_count:=MusicLen;
   for i:=0 to MusicLen-1 do
      begin
      ay_seeksong(MusicHandle,ay_getelapsedtime(MusicHandle)+1);
      bf:=ay_getregs(MusicHandle,0);
      CopyMemory(@ay_dump[i],bf,14); //14
      end;
    end;
  end;
end;

procedure TForm1.Combo_CompileChange(Sender: TObject);
begin
if Combo_Compile.ItemIndex=0 then
  begin
  Edit_TrackADR.Enabled:=false;
  Edit_TablesADR.Enabled:=false;
  Edit_PattADR.Enabled:=false;
  end
else
  begin
  Edit_TrackADR.Enabled:=true;
  Edit_TablesADR.Enabled:=true;
  Edit_PattADR.Enabled:=true;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ProgDir:=GetCurrentDir;
AyFlyDLL:=LoadLibrary('ayfly.dll');
@ay_initsongindirect:=nil;
@ay_sethwnd:=nil;
@ay_resetsong:=nil;
@ay_getsonglength:=nil;
@ay_getelapsedtime:=nil;
@ay_getregs:=nil;
@ay_seeksong:=nil;
@ay_initsongindirect:=GetProcAddress(AyFlyDLL,'ay_initsongindirect');
@ay_sethwnd:=GetProcAddress(AyFlyDLL,'ay_sethwnd');
@ay_resetsong:=GetProcAddress(AyFlyDLL,'ay_resetsong');
@ay_getsonglength:=GetProcAddress(AyFlyDLL,'ay_getsonglength');
@ay_getelapsedtime:=GetProcAddress(AyFlyDLL,'ay_getelapsedtime');
@ay_getregs:=GetProcAddress(AyFlyDLL,'ay_getregs');
@ay_seeksong:=GetProcAddress(AyFlyDLL,'ay_seeksong');
//if (@ay_initsongindirect<>nil) then form1.Caption:='dll load ok';
end;

procedure TForm1.Panel2Click(Sender: TObject);
begin
ShowMessage ('Введите максимальный размер блока для поиска повторений (2..256)'+#13#10+
              '(Как правило это размер дампа наименьшего паттерна)'+#13#10+#13#10+
              'Например если в исходном треке минимальный размер паттерна = 32,'+#13#10+
              'скорость = 4, то указываем размер блока 32*4 = 128,'+#13#10+
              'если в исходном треке минимальный размер паттерна = 16,'+#13#10+
              'скорость = 3, то указываем размер блока 16*3 = 48 и т.п.'+#13#10+#13#10+
              'Можно компилировать модули с плавающей скорость, но'+#13#10+
              'эта скорость должна быть одинаковой для каждого паттерна, тогда'+#13#10+
              'указываем сколько прерываний играется наименьший паттерн:'+#13#10+
              'Например для постоянно меняющейся скорости 2-3-2-3...,'+#13#10+
              'для размера паттерна 64 указываем 32*2+32*3=160'+#13#10+#13#10+
              'Будет произведена компиляция модуля с размерами:'+#13#10+
              'для указанного размера блока, его половины, четверти и т.д.'+#13#10+
              'Далее Вам остается выбрать подходящий вариант и сохранит результат');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeLibrary (AyFlyDLL);
end;
//-----------------------------------------------------------
//--- вычисляем варианты значений
Procedure calc_var_tonevol_a;
var i,j:integer; flag: boolean;
begin
var_variants_count[0]:=0;
var_tonevol_type[0]:=0;
zeromemory (@var_variants[0],sizeof(var_variants[0]));
for i:=0 to ay_dump_count-1 do
  begin
  j:=0; flag:=false;
  While ( (j<var_variants_count[0]) and (flag=false) ) do
    begin
    if(
      (var_variants[0,j].byte0=ay_dump[i].a_tone_low) and
      (var_variants[0,j].byte1=ay_dump[i].a_tone_hi) and
      (var_variants[0,j].byte2=ay_dump[i].a_volume)
      ) then flag:=true;
    inc (j);
    end;
  if not(flag) then
    begin
    var_variants[0,var_variants_count[0]].byte0:=ay_dump[i].a_tone_low;
    var_variants[0,var_variants_count[0]].byte1:=ay_dump[i].a_tone_hi;
    var_variants[0,var_variants_count[0]].byte2:=ay_dump[i].a_volume;
    inc (var_variants_count[0]);
    end;
  end;
end;
//---------------------------
Procedure calc_var_tonevol_b;
var i,j:integer; flag: boolean;
begin
var_variants_count[1]:=0;
var_tonevol_type[1]:=0;
zeromemory (@var_variants[1],sizeof(var_variants[1]));
for i:=0 to ay_dump_count-1 do
  begin
  j:=0; flag:=false;
  While ( (j<var_variants_count[1]) and (flag=false) ) do
    begin
    if(
      (var_variants[1,j].byte0=ay_dump[i].b_tone_low) and
      (var_variants[1,j].byte1=ay_dump[i].b_tone_hi) and
      (var_variants[1,j].byte2=ay_dump[i].b_volume)
      ) then flag:=true;
    inc (j);
    end;
  if not(flag) then
    begin
    var_variants[1,var_variants_count[1]].byte0:=ay_dump[i].b_tone_low;
    var_variants[1,var_variants_count[1]].byte1:=ay_dump[i].b_tone_hi;
    var_variants[1,var_variants_count[1]].byte2:=ay_dump[i].b_volume;
    inc (var_variants_count[1]);
    end;
  end;
end;
//---------------------------
Procedure calc_var_tonevol_c;
var i,j:integer; flag: boolean;
begin
var_variants_count[2]:=0;
var_tonevol_type[2]:=0;
zeromemory (@var_variants[2],sizeof(var_variants[2]));
for i:=0 to ay_dump_count-1 do
  begin
  j:=0; flag:=false;
  While ( (j<var_variants_count[2]) and (flag=false) ) do
    begin
    if(
      (var_variants[2,j].byte0=ay_dump[i].c_tone_low) and
      (var_variants[2,j].byte1=ay_dump[i].c_tone_hi) and
      (var_variants[2,j].byte2=ay_dump[i].c_volume)
      ) then flag:=true;
    inc (j);
    end;
  if not(flag) then
    begin
    var_variants[2,var_variants_count[2]].byte0:=ay_dump[i].c_tone_low;
    var_variants[2,var_variants_count[2]].byte1:=ay_dump[i].c_tone_hi;
    var_variants[2,var_variants_count[2]].byte2:=ay_dump[i].c_volume;
    inc (var_variants_count[2]);
    end;
  end;
end;
//-----------------------------
Procedure calc_var_tone_a;
var i,j:integer; flag: boolean;
begin
var_variants_count[0]:=0;
var_tonevol_type[0]:=1;
zeromemory (@var_variants[0],sizeof(var_variants[0]));
for i:=0 to ay_dump_count-1 do
  begin
  j:=0; flag:=false;
  While ( (j<var_variants_count[0]) and (flag=false) ) do
    begin
    if(
      (var_variants[0,j].byte0=ay_dump[i].a_tone_low) and
      (var_variants[0,j].byte1=ay_dump[i].a_tone_hi)
      ) then flag:=true;
    inc (j);
    end;
  if not(flag) then
    begin
    var_variants[0,var_variants_count[0]].byte0:=ay_dump[i].a_tone_low;
    var_variants[0,var_variants_count[0]].byte1:=ay_dump[i].a_tone_hi;
    var_variants[0,var_variants_count[0]].byte2:=0;
    inc (var_variants_count[0]);
    end;
  end;
end;
//---------------------------
Procedure calc_var_tone_b;
var i,j:integer; flag: boolean;
begin
var_variants_count[1]:=0;
var_tonevol_type[1]:=1;
zeromemory (@var_variants[1],sizeof(var_variants[1]));
for i:=0 to ay_dump_count-1 do
  begin
  j:=0; flag:=false;
  While ( (j<var_variants_count[1]) and (flag=false) ) do
    begin
    if(
      (var_variants[1,j].byte0=ay_dump[i].b_tone_low) and
      (var_variants[1,j].byte1=ay_dump[i].b_tone_hi)
      ) then flag:=true;
    inc (j);
    end;
  if not(flag) then
    begin
    var_variants[1,var_variants_count[1]].byte0:=ay_dump[i].b_tone_low;
    var_variants[1,var_variants_count[1]].byte1:=ay_dump[i].b_tone_hi;
    var_variants[1,var_variants_count[1]].byte2:=0;
    inc (var_variants_count[1]);
    end;
  end;
end;
//---------------------------
Procedure calc_var_tone_c;
var i,j:integer; flag: boolean;
begin
var_variants_count[2]:=0;
var_tonevol_type[2]:=1;
zeromemory (@var_variants[2],sizeof(var_variants[2]));
for i:=0 to ay_dump_count-1 do
  begin
  j:=0; flag:=false;
  While ( (j<var_variants_count[2]) and (flag=false) ) do
    begin
    if(
      (var_variants[2,j].byte0=ay_dump[i].c_tone_low) and
      (var_variants[2,j].byte1=ay_dump[i].c_tone_hi)
      ) then flag:=true;
    inc (j);
    end;
  if not(flag) then
    begin
    var_variants[2,var_variants_count[2]].byte0:=ay_dump[i].c_tone_low;
    var_variants[2,var_variants_count[2]].byte1:=ay_dump[i].c_tone_hi;
    var_variants[2,var_variants_count[2]].byte2:=0;
    inc (var_variants_count[2]);
    end;
  end;
end;
//------------------
Procedure calc_var_env;
var i,j:integer; flag: boolean;
begin
var_variants_count[3]:=0;
var_tonevol_type[3]:=0;
zeromemory (@var_variants[3],sizeof(var_variants[3]));
for i:=0 to ay_dump_count-1 do
  begin
  j:=0; flag:=false;
  While ( (j<var_variants_count[3]) and (flag=false) ) do
    begin
    if(
      (var_variants[3,j].byte0=ay_dump[i].env_per_low) and
      (var_variants[3,j].byte1=ay_dump[i].env_per_hi) and
      (var_variants[3,j].byte2=ay_dump[i].env_form)
      ) then flag:=true;
    inc (j);
    end;
  if not(flag) then
    begin
    var_variants[3,var_variants_count[3]].byte0:=ay_dump[i].env_per_low;
    var_variants[3,var_variants_count[3]].byte1:=ay_dump[i].env_per_hi;
    var_variants[3,var_variants_count[3]].byte2:=ay_dump[i].env_form;
    inc (var_variants_count[3]);
    end;
  end;
end;
//------------------
Procedure calc_var_reg;
var i,j:integer; flag: boolean;
begin
var_variants_count[4]:=0;
var_tonevol_type[4]:=1;
zeromemory (@var_variants[4],sizeof(var_variants[4]));
for i:=0 to ay_dump_count-1 do
  begin
  j:=0; flag:=false;
  While ( (j<var_variants_count[4]) and (flag=false) ) do
    begin
    if(
      (var_variants[4,j].byte0=ay_dump[i].noise) and
      (var_variants[4,j].byte1=ay_dump[i].control)
      ) then flag:=true;
    inc (j);
    end;
  if not(flag) then
    begin
    var_variants[4,var_variants_count[4]].byte0:=ay_dump[i].noise;
    var_variants[4,var_variants_count[4]].byte1:=ay_dump[i].control;
    inc (var_variants_count[4]);
    end;
  end;
end;
//-------------------------
procedure create_temp_patt_a(n,pattsize:integer);
var i: integer;
  j,index: byte;
  id:byte;
begin
if (merge_tables[0]=0) then id:=0 else id:=merge_tables[0]-1;
for i:=0 to pattsize-1 do
  begin
  //--- ищем индекс
  index:=255;
  for j:=0 to var_variants_count[id]-1 do
    begin
    if (var_tonevol_type[0]=0) then
      begin //проверка tonevol
      if((var_variants[id,j].byte0=ay_dump[pattsize*n+i].a_tone_low) and (var_variants[id,j].byte1=ay_dump[pattsize*n+i].a_tone_hi) and (var_variants[id,j].byte2=ay_dump[pattsize*n+i].a_volume)) then index:=j;
      end;
    if (var_tonevol_type[0]=1) then
      begin //проверка tone
      if((var_variants[id,j].byte0=ay_dump[pattsize*n+i].a_tone_low) and (var_variants[id,j].byte1=ay_dump[pattsize*n+i].a_tone_hi)) then index:=j;
      end;
    end; //ищем индекс
  //--- сохраняем индекс
  temp_patt_tonevol[i].index:=index;
  temp_patt_tonevol[i].volume:=ay_dump[pattsize*n+i].a_volume;
  end;
end;
//-------------------------------------
procedure create_temp_patt_b(n,pattsize:integer);
var i: integer;
  j,index: integer;
  id:byte;
begin
if (merge_tables[1]=0) then id:=1 else id:=merge_tables[1]-1;
for i:=0 to pattsize-1 do
  begin
  //--- ищем индекс
  index:=256;
  for j:=0 to var_variants_count[id]-1 do
    begin
    if (var_tonevol_type[1]=0) then
      begin
      if( //проверка tonevol
        (var_variants[id,j].byte0=ay_dump[pattsize*n+i].b_tone_low) and
        (var_variants[id,j].byte1=ay_dump[pattsize*n+i].b_tone_hi) and
        (var_variants[id,j].byte2=ay_dump[pattsize*n+i].b_volume)
        ) then index:=j;
      end;
    if (var_tonevol_type[1]=1) then
      begin
      if( //проверка tone
        (var_variants[id,j].byte0=ay_dump[pattsize*n+i].b_tone_low) and
        (var_variants[id,j].byte1=ay_dump[pattsize*n+i].b_tone_hi)
        ) then index:=j;
      end;
    end; //ищем индекс
  //--- сохраняем индекс
  temp_patt_tonevol[i].index:=index;
  temp_patt_tonevol[i].volume:=ay_dump[pattsize*n+i].b_volume;
  end;
end;
//-------------------------------------
procedure create_temp_patt_c(n,pattsize:integer);
var i: integer;
  j,index: byte;
  id:byte;
begin
if (merge_tables[2]=0) then id:=2 else id:=merge_tables[2]-1;
for i:=0 to pattsize-1 do
  begin
  //--- ищем индекс
  index:=255;
  for j:=0 to var_variants_count[id]-1 do
    begin
    if (var_tonevol_type[2]=0) then
      begin
      if( //проверка tonevol
        (var_variants[id,j].byte0=ay_dump[pattsize*n+i].c_tone_low) and
        (var_variants[id,j].byte1=ay_dump[pattsize*n+i].c_tone_hi) and
        (var_variants[id,j].byte2=ay_dump[pattsize*n+i].c_volume)
        ) then index:=j;
      end;
    if (var_tonevol_type[2]=1) then
      begin
      if( //проверка tone
        (var_variants[id,j].byte0=ay_dump[pattsize*n+i].c_tone_low) and
        (var_variants[id,j].byte1=ay_dump[pattsize*n+i].c_tone_hi)
        ) then index:=j;
      end;
    end; //ищем индекс
  //--- сохраняем индекс
  temp_patt_tonevol[i].index:=index;
  temp_patt_tonevol[i].volume:=ay_dump[pattsize*n+i].c_volume;
  end;
end;
//---------------------------------------
procedure create_temp_patt_env(n,pattsize:integer);
var i: integer; j,index: byte;
  id:byte;
begin
if (merge_tables[3]=0) then id:=3 else id:=merge_tables[3]-1;
for i:=0 to pattsize-1 do
  begin
  //--- ищем индекс
  index:=255;
  for j:=0 to var_variants_count[id]-1 do
    begin
    if( //проверка env
      (var_variants[id,j].byte0=ay_dump[pattsize*n+i].env_per_low) and
      (var_variants[id,j].byte1=ay_dump[pattsize*n+i].env_per_hi) and
      (var_variants[id,j].byte2=ay_dump[pattsize*n+i].env_form)
      ) then index:=j;
    end; //ищем индекс
  //--- сохраняем индекс
  temp_patt_index[i].index:=index;
  end;
end;
//---------------------------------------
procedure create_temp_patt_reg(n,pattsize:integer);
var i: integer;
  j,index: byte;
  id:byte;
begin
if (merge_tables[4]=0) then id:=4 else id:=merge_tables[4]-1;
for i:=0 to pattsize-1 do
  begin
  //--- ищем индекс
  index:=255;
  for j:=0 to var_variants_count[id]-1 do
    begin
    if( //проверка env
      (var_variants[id,j].byte0=ay_dump[pattsize*n+i].noise) and
      (var_variants[id,j].byte1=ay_dump[pattsize*n+i].control)
      ) then index:=j;
    end; //ищем индекс
  //--- сохраняем индекс
  temp_patt_index[i].index:=index;
  end;
end;
//---------------------------------------
Procedure calc_patterns_a(pattsize:byte);
var dump_patt_count: word;
  i,j,k: integer;
  flag: boolean;
begin
dump_patt_count:=floor(ay_dump_count/pattsize);
track_a_count:=0;
cha_patt_count:=0;
zeromemory (@cha_patt,sizeof(cha_patt));
for i:=0 to dump_patt_count-1 do
  begin
  //--- создаем временный паттерн
  create_temp_patt_a(i,pattsize);
  //--- ищем подобный паттерн в уже созданных
  j:=0; flag:=false;
  while ((j<cha_patt_count) and (flag=false)) do
    begin
    flag:=true;
    for k:=0 to pattsize-1 do // цикл по длине паттерна
      begin
      if (var_tonevol_type[0]=0) then
        begin
        if(cha_patt[j][k].index<>temp_patt_tonevol[k].index) then flag:=false;
        end;
      if (var_tonevol_type[0]=1) then
        begin
        if((cha_patt[j][k].index<>temp_patt_tonevol[k].index) or (cha_patt[j][k].volume<>temp_patt_tonevol[k].volume)) then flag:=false;
        end;
      end; // цикл по длине паттерна
    inc(j);
    end;
  //--- проверяем флаг поиска
  if (flag) then
    begin //нашли (j-1)=номер найденного
    end
  else
    begin //новый
    for k:=0 to pattsize-1 do
      begin
      cha_patt[cha_patt_count][k].index:=temp_patt_tonevol[k].index;
      cha_patt[cha_patt_count][k].volume:=temp_patt_tonevol[k].volume;
      end;
    inc (cha_patt_count); j:=cha_patt_count;
    end;
  //записываем трек
  if (var_tonevol_type[0]=0) then track_a[track_a_count]:=(j-1)*pattsize
    else  track_a[track_a_count]:=2*(j-1)*pattsize;
  inc(track_a_count);
  end;
// вычисляем размеры
channel_a_size:=cha_patt_count*pattsize;
if (var_tonevol_type[0]=1) then channel_a_size:=channel_a_size*2;
end;
//---------------------------------------
Procedure calc_patterns_b(pattsize:byte);
var dump_patt_count: word;
  i,j,k: integer;
  flag: boolean;
begin
dump_patt_count:=floor(ay_dump_count/pattsize);
track_b_count:=0;
chb_patt_count:=0;
zeromemory (@chb_patt,sizeof(chb_patt));
for i:=0 to dump_patt_count-1 do
  begin
  //--- создаем временный паттерн
  create_temp_patt_b(i,pattsize);
  //--- ищем подобный паттерн в уже созданных
  j:=0; flag:=false;
  while ((j<chb_patt_count) and (flag=false)) do
    begin
    flag:=true;
    for k:=0 to pattsize-1 do // цикл по длине паттерна
      begin
      if (var_tonevol_type[1]=0) then
        begin
        if(chb_patt[j][k].index<>temp_patt_tonevol[k].index) then flag:=false;
        end;
      if (var_tonevol_type[1]=1) then
        begin
        if((chb_patt[j][k].index<>temp_patt_tonevol[k].index) or (chb_patt[j][k].volume<>temp_patt_tonevol[k].volume)) then flag:=false;
        end;
      end; // цикл по длине паттерна
    inc(j);
    end;
  //--- проверяем флаг поиска
  if (flag) then
    begin //нашли (j-1)=номер найденного
    end
  else
    begin //новый
    for k:=0 to pattsize-1 do
      begin
      chb_patt[chb_patt_count][k].index:=temp_patt_tonevol[k].index;
      chb_patt[chb_patt_count][k].volume:=temp_patt_tonevol[k].volume;
      end;
    inc (chb_patt_count); j:=chb_patt_count;
    end;
  //записываем трек
  if (var_tonevol_type[1]=0) then track_b[track_b_count]:=(j-1)*pattsize
    else  track_b[track_b_count]:=2*(j-1)*pattsize;
  inc(track_b_count);
  end;
// вычисляем размеры
channel_b_size:=chb_patt_count*pattsize;
if (var_tonevol_type[1]=1) then channel_b_size:=channel_b_size*2;
end;
//---------------------------------------
Procedure calc_patterns_c(pattsize:byte);
var dump_patt_count: word;
  i,j,k: integer;
  flag: boolean;
begin
dump_patt_count:=floor(ay_dump_count/pattsize);
track_c_count:=0;
chc_patt_count:=0;
zeromemory (@chc_patt,sizeof(chc_patt));
for i:=0 to dump_patt_count-1 do
  begin
  //--- создаем временный паттерн
  create_temp_patt_c(i,pattsize);
  //--- ищем подобный паттерн в уже созданных
  j:=0; flag:=false;
  while ((j<chc_patt_count) and (flag=false)) do
    begin
    flag:=true;
    for k:=0 to pattsize-1 do // цикл по длине паттерна
      begin
      if (var_tonevol_type[2]=0) then
        begin
        if(chc_patt[j][k].index<>temp_patt_tonevol[k].index) then flag:=false;
        end;
      if (var_tonevol_type[2]=1) then
        begin
        if((chc_patt[j][k].index<>temp_patt_tonevol[k].index) or (chc_patt[j][k].volume<>temp_patt_tonevol[k].volume)) then flag:=false;
        end;
      end; // цикл по длине паттерна
    inc(j);
    end;
  //--- проверяем флаг поиска
  if (flag) then
    begin //нашли (j-1)=номер найденного
    end
  else
    begin //новый
    for k:=0 to pattsize-1 do
      begin
      chc_patt[chc_patt_count][k].index:=temp_patt_tonevol[k].index;
      chc_patt[chc_patt_count][k].volume:=temp_patt_tonevol[k].volume;
      end;
    inc (chc_patt_count); j:=chc_patt_count;
    end;
  //записываем трек
  if (var_tonevol_type[2]=0) then track_c[track_c_count]:=(j-1)*pattsize
    else  track_c[track_c_count]:=2*(j-1)*pattsize;
  inc(track_c_count);
  end;
// вычисляем размеры
channel_c_size:=chc_patt_count*pattsize;
if (var_tonevol_type[2]=1) then channel_c_size:=channel_c_size*2;
end;
//---------------------------------------
Procedure calc_patterns_env(pattsize:byte);
var dump_patt_count: word;
  i,j,k: integer;
  flag: boolean;
begin
dump_patt_count:=floor(ay_dump_count/pattsize);
track_e_count:=0;
env_patt_count:=0;
zeromemory (@env_patt,sizeof(env_patt));
for i:=0 to dump_patt_count-1 do
  begin
  //--- создаем временный паттерн
  create_temp_patt_env(i,pattsize);
  //--- ищем подобный паттерн в уже созданных
  j:=0; flag:=false;
  while ((j<env_patt_count) and (flag=false)) do
    begin
    flag:=true;
    for k:=0 to pattsize-1 do // цикл по длине паттерна
      begin
        if(env_patt[j][k].index<>temp_patt_index[k].index) then flag:=false;
      end; // цикл по длине паттерна
    inc(j);
    end;
  //--- проверяем флаг поиска
  if (flag) then
    begin //нашли (j-1)=номер найденного
    end
  else
    begin //новый
    for k:=0 to pattsize-1 do env_patt[env_patt_count][k].index:=temp_patt_index[k].index;
    inc (env_patt_count); j:=env_patt_count;
    end;
  //записываем трек
  track_e[track_e_count]:=(j-1)*pattsize;
  inc(track_e_count);
  end;
// вычисляем размеры
channel_e_size:=env_patt_count*pattsize;
end;
//---------------------------------------
Procedure calc_patterns_reg(pattsize:byte);
var dump_patt_count: word;
  i,j,k: integer;
  flag: boolean;
begin
dump_patt_count:=floor(ay_dump_count/pattsize);
track_r_count:=0;
reg_patt_count:=0;
zeromemory (@reg_patt,sizeof(reg_patt));
for i:=0 to dump_patt_count-1 do
  begin
  //--- создаем временный паттерн
  create_temp_patt_reg(i,pattsize);
  //--- ищем подобный паттерн в уже созданных
  j:=0; flag:=false;
  while ((j<reg_patt_count) and (flag=false)) do
    begin
    flag:=true;
    for k:=0 to pattsize-1 do // цикл по длине паттерна
      begin
        if(reg_patt[j][k].index<>temp_patt_index[k].index) then flag:=false;
      end; // цикл по длине паттерна
    inc(j);
    end;
  //--- проверяем флаг поиска
  if (flag) then
    begin //нашли (j-1)=номер найденного
    end
  else
    begin //новый
    for k:=0 to pattsize-1 do reg_patt[reg_patt_count][k].index:=temp_patt_index[k].index;
    inc (reg_patt_count); j:=reg_patt_count;
    end;
  //записываем трек
  track_r[track_r_count]:=(j-1)*pattsize;
  inc(track_r_count);
  end;
// вычисляем размеры
channel_r_size:=reg_patt_count*pattsize;
end;

function HexToDec(s:string):integer;
const hexdata:string='0123456789ABCDEF';
var i,j:word; mult, val:integer;
begin
mult:=1; val:=0;
for i:=Length(s) downto 1 do
  begin
  j:=Pos(copy(s,i,1),hexdata);
  val:=val+mult*(j-1);
  mult:=mult*16;
  end;
HexToDec:=val;
end;
function GetDecimal(s:string): dword;
begin
if (Form1.Combo_ADRView.ItemIndex=0) then
  begin //decimal
  GetDecimal:=StrToInt(s);
  end
else
  begin //hex
  GetDecimal:=HexToDec(s);
  end;
end;

procedure TForm1.Button_compileClick(Sender: TObject);
begin
Form1.Memo1.Lines.Clear;
Form1.Button_save.Enabled:=true;
//-- вычисляем длину и адреса таблиц
Calc_adr_tbl();
//--------------------------------------------------
//Шаг 3. - Создаем треки и паттерны для каналов
//--------------------------------------------------
max_block_size:=StrToInt(Form1.Edit_BlockSize.Text);
Form1.Memo1.Lines.Add(''); Form1.Memo1.Lines.Add ('-------------------- Step 3. -------------------- Calc patterns');
temp_block_size:=max_block_size*2;
abs_count:=0;
Combo_BlockSize.Items.Clear;
While (temp_block_size=2*floor(temp_block_size/2)) do
  begin
  temp_block_size:=floor(temp_block_size/2);
  Form1.Memo1.Lines.Add(''); Form1.Memo1.Lines.Add('Compile with block-size: '+IntToStr(temp_block_size)+', track_count: '+IntToStr(floor(ay_dump_count/temp_block_size)));
  calc_patterns_a(temp_block_size);
  Memo1.Lines.Add('   - patterns_A: '+IntToStr(cha_patt_count) +' of max '+IntToStr(floor(ay_dump_count/temp_block_size))+'  size: '+IntToStr(channel_a_size)+', track size: '+IntToStr(track_a_count*2)+ ', total byte size: '+IntToStr(channel_a_size+track_a_count*2));
  calc_patterns_b(temp_block_size);
  Memo1.Lines.Add('   - patterns_B: '+IntToStr(chb_patt_count) +' of max '+IntToStr(floor(ay_dump_count/temp_block_size))+'  size: '+IntToStr(channel_b_size)+', track size: '+IntToStr(track_b_count*2)+ ', total byte size: '+IntToStr(channel_b_size+track_b_count*2));
  calc_patterns_c(temp_block_size);
  Memo1.Lines.Add('   - patterns_C: '+IntToStr(chc_patt_count) +' of max '+IntToStr(floor(ay_dump_count/temp_block_size))+'  size: '+IntToStr(channel_c_size)+', track size: '+IntToStr(track_c_count*2)+ ', total byte size: '+IntToStr(channel_c_size+track_c_count*2));
  calc_patterns_env(temp_block_size);
  Memo1.Lines.Add('   - patterns_E: '+IntToStr(env_patt_count) +' of max '+IntToStr(floor(ay_dump_count/temp_block_size))+'  size: '+IntToStr(channel_e_size)+', track size: '+IntToStr(track_e_count*2)+ ', total byte size: '+IntToStr(channel_e_size+track_e_count*2));
  calc_patterns_reg(temp_block_size);
  Memo1.Lines.Add('   - patterns_R: '+IntToStr(reg_patt_count) +' of max '+IntToStr(floor(ay_dump_count/temp_block_size))+'  size: '+IntToStr(channel_r_size)+', track size: '+IntToStr(track_r_count*2)+ ', total byte size: '+IntToStr(channel_r_size+track_r_count*2));
  trk_size:=5*track_a_count*2+2;
  p_size:=channel_a_size+channel_b_size+channel_c_size+channel_e_size+channel_r_size;
  Memo1.Lines.Add('   - Total size track: '+IntToStr(trk_size)+', table:'+IntToStr(tbl_size)+', patterns: '+IntToStr(p_size));
  Memo1.Lines.Add('   ----- ALL SIZE: '+IntToStr(trk_size+p_size+tbl_size));
  Combo_BlockSize.Items.Add(IntToStr(temp_block_size));
  arr_block_size[abs_count].block_size:=temp_block_size;
  arr_block_size[abs_count].player_size:=512;
  arr_block_size[abs_count].tbl_size:=tbl_size;
  arr_block_size[abs_count].trk_size:=trk_size;
  arr_block_size[abs_count].p_size:=p_size;
  inc (abs_count);
  end;
Combo_BlockSize.ItemIndex:=0;
Update_compile_adr;
end;

procedure TForm1.Button_saveClick(Sender: TObject);
var ADR:word;
  F: file of byte; FT: textfile;
  xlow,xhi:byte;
  temp_block_size: byte;
  i,j: integer;
  ADR_PLAYER,ADR_TBL,ADR_TRK,ADR_PATT: word;
  s: string;
  flag_fixed_t,flag_loop,loop_adr:string;
  takts_min,takts_max:integer;
begin
//--- вычисляем смещения таблиц
Memo1.Lines.Add('');Memo1.Lines.Add('--- Step 4. ---------- Save');
//---
if(Form1.CheckBox_FixedTakts.Checked) then flag_fixed_t:='1' else flag_fixed_t:='0';
if(Form1.CheckBox_Loop.Checked) then flag_loop:='1' else flag_loop:='0';
loop_adr:=(Form1.Edit_Loop.Text);
//---
takts_min:=24;
if var_tonevol_type[0]=0 then takts_min:=takts_min+189 else takts_min:=takts_min+191;
if var_tonevol_type[1]=0 then takts_min:=takts_min+192 else takts_min:=takts_min+194;
if var_tonevol_type[2]=0 then takts_min:=takts_min+192 else takts_min:=takts_min+194;
takts_max:=takts_min+219+139+31+14+(194+10);
takts_min:=takts_min+192+139+31+14;
if (flag_loop='1') then takts_max:=takts_max+50;
//---
temp_block_size:=arr_block_size[Form1.Combo_BlockSize.ItemIndex].block_size;
calc_patterns_a(temp_block_size);
calc_patterns_b(temp_block_size);
calc_patterns_c(temp_block_size);
calc_patterns_env(temp_block_size);
calc_patterns_reg(temp_block_size);
Memo1.Lines.Add('');Memo1.Lines.Add('------ Selected block size: '+IntToStr(temp_block_size));
Calc_adr_tbl(); //tbl_size:=768+512+768*3-(256*(var_tonevol_type[0]+var_tonevol_type[1]+var_tonevol_type[2]));
trk_size:=5*track_a_count*2+2;
p_size:=channel_a_size+channel_b_size+channel_c_size+channel_e_size+channel_r_size;
Memo1.Lines.Add('   - Total size track: '+IntToStr(trk_size)+', table:'+IntToStr(tbl_size)+', patterns: '+IntToStr(p_size));
Memo1.Lines.Add('   ----- ALL SIZE (without player): '+IntToStr(trk_size+p_size+tbl_size));
Memo1.Lines.Add('   ----- ALL SIZE (together player): '+IntToStr(512+trk_size+p_size+tbl_size));
Memo1.Lines.Add('');
if (flag_fixed_t='1') then
  Memo1.Lines.Add('   Tacts (fixed) = '+IntToStr(takts_max))
else
  Memo1.Lines.Add('   Tacts min = '+IntToStr(takts_min)+', max = '+IntToStr(takts_max));
//-------------------------
ADR_PLAYER:=GetDecimal(Form1.Edit_PlayerADR.Text);
ADR_TBL:=GetDecimal(Form1.Edit_TablesADR.Text);
ADR_TRK:=GetDecimal(Form1.Edit_TrackADR.Text);
ADR_PATT:=GetDecimal(Form1.Edit_PattADR.Text);
//-------------------------
Memo1.Lines.Add(' ');Memo1.Lines.Add('Saving tables...');
  AssignFile (F,ProgDir+'\TABLES.BIN');
  ReWrite (F);
  //Write table Ch_A
  if (merge_tables[0]=0) then begin
      for i:=0 to 255 do Write (F,var_variants[0,i].byte0); for i:=0 to 255 do Write (F,var_variants[0,i].byte1);
      if var_tonevol_type[0]=0 then for i:=0 to 255 do Write (F,var_variants[0,i].byte2);
  end;
  //Write table Ch_B
  if (merge_tables[1]=0) then begin
      for i:=0 to 255 do Write (F,var_variants[1,i].byte0); for i:=0 to 255 do Write (F,var_variants[1,i].byte1);
      if var_tonevol_type[1]=0 then for i:=0 to 255 do Write (F,var_variants[1,i].byte2);
  end;
  //Write table Ch_C
  if (merge_tables[2]=0) then begin
      for i:=0 to 255 do Write (F,var_variants[2,i].byte0); for i:=0 to 255 do Write (F,var_variants[2,i].byte1);
      if var_tonevol_type[2]=0 then for i:=0 to 255 do Write (F,var_variants[2,i].byte2);
  end;
  // Write table ENV
  if (merge_tables[3]=0) then begin
      for i:=0 to 255 do Write (F,var_variants[3,i].byte0); for i:=0 to 255 do Write (F,var_variants[3,i].byte1);  for i:=0 to 255 do Write (F,var_variants[3,i].byte2);
  end;
  // write table REG
  if (merge_tables[4]=0) then begin
      for i:=0 to 255 do Write (F,var_variants[4,i].byte0);  for i:=0 to 255 do Write (F,var_variants[4,i].byte1);
  end;      
  CloseFile (F); Memo1.Lines.Add(' - TABLES.BIN'); Application.ProcessMessages;
//--------------  
Memo1.Lines.Add(' ');Memo1.Lines.Add('Saving track...');
  AssignFile (F,ProgDir+'\TRACK.BIN');
  ReWrite (F);  
  For i:=0 to Track_A_count-1 do
    begin
    ADR:=track_a[i] + ADR_PATT;
      xhi:=floor(ADR/256); xlow:=ADR-xhi*256; Write (F,xlow); Write (F,xhi);
    ADR:=track_b[i] + ADR_PATT + channel_A_size;
      xhi:=floor(ADR/256); xlow:=ADR-xhi*256; Write (F,xlow); Write (F,xhi);
    ADR:=track_c[i] + ADR_PATT + channel_A_size + channel_B_size;
      xhi:=floor(ADR/256); xlow:=ADR-xhi*256; Write (F,xlow); Write (F,xhi);
    ADR:=track_e[i] + ADR_PATT + channel_A_size + channel_B_size + channel_C_size;
      xhi:=floor(ADR/256); xlow:=ADR-xhi*256; Write (F,xlow); Write (F,xhi);
    ADR:=track_r[i] + ADR_PATT + channel_A_size + channel_B_size + channel_C_size + channel_e_size;
      xhi:=floor(ADR/256); xlow:=ADR-xhi*256; Write (F,xlow); Write (F,xhi);
    end;
  xhi:=0; xlow:=0; Write (F,xlow); Write (F,xhi);
  CloseFile (F); Memo1.Lines.Add(' - TRACK.BIN'); Application.ProcessMessages;
//--------------------------------------------------------
Memo1.Lines.Add(' ');Memo1.Lines.Add('Saving patterns...');
  AssignFile (F,ProgDir+'\PATTERNS.BIN');
  ReWrite (F);
  //-- ch_a
  for i:=0 to cha_patt_count-1 do
    for j:=0 to temp_block_size-1 do
      begin
      Write (F,cha_patt[i][j].index);
      if (var_tonevol_type[0]=1) then Write (F,cha_patt[i][j].volume);
      end;
  //-- ch_b
  for i:=0 to chb_patt_count-1 do
    for j:=0 to temp_block_size-1 do
      begin
      Write (F,chb_patt[i][j].index);
      if (var_tonevol_type[1]=1) then Write (F,chb_patt[i][j].volume);
      end;
  //-- ch_c
  for i:=0 to chc_patt_count-1 do
    for j:=0 to temp_block_size-1 do
      begin
      Write (F,chc_patt[i][j].index);
      if (var_tonevol_type[2]=1) then Write (F,chc_patt[i][j].volume);
      end;
  //-- ch_env
  for i:=0 to env_patt_count-1 do
    for j:=0 to temp_block_size-1 do
      Write (F,env_patt[i][j].index);
  //-- ch_reg
  for i:=0 to reg_patt_count-1 do
    for j:=0 to temp_block_size-1 do
      Write (F,reg_patt[i][j].index);
  CloseFile (F); Memo1.Lines.Add(' - PATTERNS.BIN'); Application.ProcessMessages;
//--------------------------------------------------------
Memo1.Lines.Add(' ');Memo1.Lines.Add('Saving player...');
AssignFile (FT,ProgDir+'\PLAYER.ASM');
ReWrite (FT);
Writeln (FT,';============================================================');
Writeln (FT,'	DEVICE ZXSPECTRUM128');
Writeln (FT,';============================================================');
Writeln (FT,'ORG_PLAYER	EQU	#'+IntToHex(ADR_PLAYER,4));
Writeln (FT,'ORG_TBL		EQU	#'+IntToHex(ADR_TBL,4));
Writeln (FT,'ORG_TRACK	EQU	#'+IntToHex(ADR_TRK,4));
Writeln (FT,'ORG_PATT	EQU	#'+IntToHex(ADR_PATT,4));
Writeln (FT,';-------');
Writeln (FT,'PATTSIZE	EQU	'+IntToStr(temp_block_size)+'	;размер паттерна (block_size)');
Writeln (FT,'CHA_TYPE 	EQU	'+IntToStr(var_tonevol_type[0])+'	;Тип канала A');
Writeln (FT,'CHB_TYPE 	EQU	'+IntToStr(var_tonevol_type[1])+'	;Тип канала B	;0-громкость в таблице');
Writeln (FT,'CHC_TYPE 	EQU	'+IntToStr(var_tonevol_type[2])+'	;Тип канала C	;1-громкость в паттерне');
Writeln (FT,';-------');
Writeln (FT,'PL_CONST_T	EQU	'+flag_fixed_t+'	;Тип плеера: 0-простой, 1-фиксированный по тактам');
Writeln (FT,'PL_LOOPFLAG	EQU	'+flag_loop+'	;Зацикливание 0-не надо, 1-надо зацикливать');
Writeln (FT,'PL_LOOP		EQU	'+loop_adr+'	;адрес в треке для зацикливания');
Writeln (FT,';-------');
Writeln (FT,'TBL_NV_A	EQU	#'+IntToHex(ADR_TBL+TBL_ADR[0],4));
Writeln (FT,'TBL_NV_B	EQU	#'+IntToHex(ADR_TBL+TBL_ADR[1],4));
Writeln (FT,'TBL_NV_C	EQU	#'+IntToHex(ADR_TBL+TBL_ADR[2],4));
Writeln (FT,'TBL_ENV		EQU	#'+IntToHex(ADR_TBL+TBL_ADR[3],4));
Writeln (FT,'TBL_REG		EQU	#'+IntToHex(ADR_TBL+TBL_ADR[4],4));
for i:=0 to Form1.Memo_Player.Lines.Count do
  begin
  Writeln (FT,Form1.Memo_Player.Lines[i]);
  end;
if (Form1.Combo_Compile.ItemIndex=0) then
begin //save monoblock
Writeln (FT,'	SAVETRD "ay_zip_play.trd","MODULE.C",PLAYER,END_MODULE-PLAYER');
end
else
begin //save separately blocks
Writeln (FT,'	SAVETRD "ay_zip_play.trd","PLAYER.C",PLAYER,PLAYER_END-PLAYER');
Writeln (FT,'	SAVETRD "ay_zip_play.trd","TABLES.C",ORG_TBL,END_TBL-ORG_TBL');
Writeln (FT,'	SAVETRD "ay_zip_play.trd","TRACK.C",ORG_TRACK,END_TRACK-ORG_TRACK');
Writeln (FT,'	SAVETRD "ay_zip_play.trd","PATTERNS.C",ORG_PATT,END_PATT-ORG_PATT');
end;
Writeln (FT,'//----------------- Пример работы плейера');
Writeln (FT,'		ORG	#8000');
Writeln (FT,'		CALL	PLAYER');
Writeln (FT,'LOOP		EI');
Writeln (FT,'		HALT');
Writeln (FT,'		CALL	PLAYER+3');
Writeln (FT,'		JP	LOOP');
Writeln (FT,'END_PR');
Writeln (FT,'	SAVETRD "ay_zip_play.trd","CODE.C",#8000,END_PR-#8000');
Writeln (FT,'		ORG	#9000');
Writeln (FT,'BEGIN_BAS');
if (Form1.Combo_Compile.ItemIndex=0) then
//save monoblock loader
Writeln (FT,'	INCBIN	"loader_m.bas"')
else
//save separately loader
Writeln (FT,'	INCBIN	"loader_s.bas"');
Writeln (FT,'END_BAS');    
Writeln (FT,'	SAVETRD "ay_zip_play.trd","PLAYER.B",BEGIN_BAS,END_BAS-BEGIN_BAS');
CloseFile (FT);
Memo1.Lines.Add(' - PLAYER.ASM');
end;

procedure Update_compile_adr;
var adr_player,adr_tbl,adr_trk,adr_p: dword;
    end_player,end_tbl,end_trk,end_p: dword;
    player_size,tbl_size,trk_size,p_size: word;
begin
player_size:=arr_block_size[Form1.Combo_BlockSize.ItemIndex].player_size;
tbl_size:=arr_block_size[Form1.Combo_BlockSize.ItemIndex].tbl_size;
trk_size:=arr_block_size[Form1.Combo_BlockSize.ItemIndex].trk_size;
p_size:=arr_block_size[Form1.Combo_BlockSize.ItemIndex].p_size;
if (Form1.Combo_Compile.ItemIndex=0) then
  begin
  //берем данные
  adr_player:=GetDecimal(Form1.Edit_PlayerADR.Text);
  adr_tbl:=adr_player+player_size;
  adr_trk:=adr_tbl+tbl_size;
  adr_p:=adr_trk+trk_size;
  if (Form1.Combo_ADRView.ItemIndex=0) then
    begin
    Form1.Edit_TablesADR.Text:=IntToStr(adr_tbl);
    Form1.Edit_TrackADR.Text:=IntToStr(adr_trk);
    Form1.Edit_PattADR.Text:=IntToStr(adr_p);
    end
  else
    begin
    Form1.Edit_TablesADR.Text:=IntToHex(adr_tbl,1);
    Form1.Edit_TrackADR.Text:=IntToHex(adr_trk,1);
    Form1.Edit_PattADR.Text:=IntToHex(adr_p,1);
    end;
  end;
//---
adr_player:=GetDecimal(Form1.Edit_PlayerADR.Text);
adr_tbl:=GetDecimal(Form1.Edit_TablesADR.Text);
adr_trk:=GetDecimal(Form1.Edit_TrackADR.Text);
adr_p:=GetDecimal(Form1.Edit_PattADR.Text);
end_player:=adr_player+player_size;
end_tbl:=adr_tbl+tbl_size;
end_trk:=adr_trk+trk_size;
end_p:=adr_p+p_size;
if (Form1.Combo_ADRView.ItemIndex=0) then
  begin
  Form1.Edit_PlayerEND.Text:=IntToStr(end_player);
  Form1.Edit_TablesEND.Text:=IntToStr(end_tbl);
  Form1.Edit_TrackEND.Text:=IntToStr(end_trk);
  Form1.Edit_PattEND.Text:=IntToStr(end_p);
  end
else
  begin
  Form1.Edit_PlayerEND.Text:=IntToHex(end_player,1);
  Form1.Edit_TablesEND.Text:=IntToHex(end_tbl,1);
  Form1.Edit_TrackEND.Text:=IntToHex(end_trk,1);
  Form1.Edit_PattEND.Text:=IntToHex(end_p,1);
  end;
end;

procedure TForm1.Combo_BlockSizeChange(Sender: TObject);
begin
Update_compile_adr;
end;

procedure TForm1.Combo_ADRViewChange(Sender: TObject);
begin
if (Combo_ADRView.ItemIndex=0) and (dechex_view=1) then
  begin //переход hex->dec
  dechex_view:=0;
  Form1.Edit_PlayerADR.Text:=IntToStr(HexToDec(Form1.Edit_PlayerADR.Text));
  Form1.Edit_TablesADR.Text:=IntToStr(HexToDec(Form1.Edit_TablesADR.Text));
  Form1.Edit_TrackADR.Text:=IntToStr(HexToDec(Form1.Edit_TrackADR.Text));
  Form1.Edit_PattADR.Text:=IntToStr(HexToDec(Form1.Edit_PattADR.Text));
  Form1.Edit_PlayerEND.Text:=IntToStr(HexToDec(Form1.Edit_PlayerEND.Text));
  Form1.Edit_TablesEND.Text:=IntToStr(HexToDec(Form1.Edit_TablesEND.Text));
  Form1.Edit_TrackEND.Text:=IntToStr(HexToDec(Form1.Edit_TrackEND.Text));
  Form1.Edit_PattEND.Text:=IntToStr(HexToDec(Form1.Edit_PattEND.Text));
  end;
if (Combo_ADRView.ItemIndex=1) and (dechex_view=0) then
  begin //переход dec->hex
  dechex_view:=1;
  Form1.Edit_PlayerADR.Text:=IntToHex(StrToInt(Form1.Edit_PlayerADR.Text),1);
  Form1.Edit_TablesADR.Text:=IntToHex(StrToInt(Form1.Edit_TablesADR.Text),1);
  Form1.Edit_TrackADR.Text:=IntToHex(StrToInt(Form1.Edit_TrackADR.Text),1);
  Form1.Edit_PattADR.Text:=IntToHex(StrToInt(Form1.Edit_PattADR.Text),1);
  Form1.Edit_PlayerEND.Text:=IntToHex(StrToInt(Form1.Edit_PlayerEND.Text),1);
  Form1.Edit_TablesEND.Text:=IntToHex(StrToInt(Form1.Edit_TablesEND.Text),1);
  Form1.Edit_TrackEND.Text:=IntToHex(StrToInt(Form1.Edit_TrackEND.Text),1);
  Form1.Edit_PattEND.Text:=IntToHex(StrToInt(Form1.Edit_PattEND.Text),1);
  Update_compile_adr;
  end;
end;

procedure TForm1.Edit_PlayerADRKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
Update_compile_adr;
end;

procedure TForm1.Edit_TablesADRKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
Update_compile_adr;
end;

procedure TForm1.Edit_TrackADRKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
Update_compile_adr;
end;

procedure TForm1.Edit_PattADRKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
Update_compile_adr;
end;

procedure TForm1.Panel3Click(Sender: TObject);
begin
ShowMessage ('Supported files:'+#13#10+
' *.raw, *.bin - raw ay dump'+#13#10+
' and all ayfly.dll supported files');
end;

procedure TForm1.Panel1Click(Sender: TObject);
begin
ShowMessage(
'Fast ZX AY-Dump Player (with PC Compiler)'+#13#10+
''+#13#10+
'codename: ay_zip_player ver 1.2'+#13#10+
''+#13#10+
'thx to Robus for cool idea'+#13#10+
'thx to GriV for optimization'+#13#10+
'thx to ayfly.dlls authors for cool stuff!'+#13#10+
''+#13#10+
'(с)2010-2012 TmK^[deMarche]'+#13#10);
end;

procedure TForm1.Panel4Click(Sender: TObject);
begin
ShowMessage ('Для вычисления данного параметра надо:'+#13#10+
'1. Вычислить длину в прерываниях до нужного вам паттерна'+#13#10+
'int_len = нужная позиция зацикливания * длину паттерна * скорость'+#13#10+
'2. Вычичислить параметр по формуле: 10 * int_len / Selected block_size'+#13#10+#13#10+
'Например:'+#13#10+
'Длина паттернов 64, скорость 3, хотим зациклить на позицию 4,'+#13#10+
'а выбранный при компиляции block_size = 24 тогда:'+#13#10+
'int_len = 4*64*3 = 768'+#13#10+
'Искомый адрес зацикливания: 10*768/24 = 320'

);
end;

procedure TForm1.Button_calctblClick(Sender: TObject);
begin
Form1.Memo1.Lines.Clear;
zeromemory (@merge_tables,sizeof(merge_tables));
//--------------------------------------------------
//Шаг 1. - вычисляем варианты для каждого из каналов
//--------------------------------------------------
max_block_size:=StrToInt(Form1.Edit_BlockSize.Text);
Form1.Memo1.Lines.Add ('-------------------- Step 2. -------------------- Calc variants');
//--- Calc variants Channel_A
Form1.Memo1.Lines.Add (''); Form1.Memo1.Lines.Add('Calculating variants for Channel_A:');
calc_var_tonevol_a;
Form1.Memo1.Lines.Add (' - count: '+IntToStr(var_variants_count[0]));
if (var_variants_count[0]>256) then
  begin
  calc_var_tone_a; Form1.Memo1.Lines.Add ('   - out of range. use tone table, variants count: '+IntToStr(var_variants_count[0])+' [size=512]');
  end
else Form1.Memo1.Lines.Add ('   use tonevol table [size=768]');

//--- Calc variants Channel_B
Form1.Memo1.Lines.Add (''); Form1.Memo1.Lines.Add('Calculating variants for Channel_B:');
calc_var_tonevol_b; Form1.Memo1.Lines.Add (' - count: '+IntToStr(var_variants_count[1]));
if (var_variants_count[1]>256) then
  begin
  calc_var_tone_b; Form1.Memo1.Lines.Add ('   - out of range. use tone table, variants count: '+IntToStr(var_variants_count[1])+' [size=512]');
  end
else Form1.Memo1.Lines.Add ('   use tonevol table [size=768]');

//--- Calc variants Channel_C
Form1.Memo1.Lines.Add (''); Form1.Memo1.Lines.Add('Calculating variants for Channel_C:');
calc_var_tonevol_c; Form1.Memo1.Lines.Add (' - count: '+IntToStr(var_variants_count[2]));
if (var_variants_count[2]>256) then
  begin
  calc_var_tone_c; Form1.Memo1.Lines.Add ('   - out of range. use tone table, variants count: '+IntToStr(var_variants_count[2])+' [size=512]');
  end
else Form1.Memo1.Lines.Add ('   use tonevol table [size=768]');

//--- Calc variants Channel_Env
Form1.Memo1.Lines.Add (''); Form1.Memo1.Lines.Add('Calculating variants for Channel_Env:');
calc_var_env; Form1.Memo1.Lines.Add (' - count: '+IntToStr(var_variants_count[3])+' [size=768]');

//--- Calc variants Channel_Reg
Form1.Memo1.Lines.Add (''); Form1.Memo1.Lines.Add('Calculating variants for Channel_Reg:');
calc_var_reg; Form1.Memo1.Lines.Add (' - count: '+IntToStr(var_variants_count[4])+' [size=512]');

//--- Проверка возможности компиляции
if(
  (var_variants_count[0]>256) or
  (var_variants_count[1]>256) or
  (var_variants_count[2]>256) or
  (var_variants_count[4]>256) or
  (var_variants_count[3]>256)
  ) then
    begin
    Form1.Memo1.Lines.Add(''); Form1.Memo1.Lines.Add('ERROR: variants overflow, compilation is not possible!');
    ShowMessage('ВНИМАНИЕ'+#13#10+'Для одного из каналов получилось больше значений чем 256'+#13#10+'КОМПИЛЯЦИЯ НЕВОЗМОЖНА');
    end
else
    begin
    Calc_adr_tbl();
    Form1.Memo1.Lines.Add('');
    Form1.Memo1.Lines.Add('All tables size = '+IntToStr(TBL_SIZE));
    Form1.Button_trymerge.Enabled:=true;
    Form1.Button_compile.Enabled:=true;
    end;
end;

procedure TForm1.Button_trymergeClick(Sender: TObject);
const ch_text:array[0..4]of string=('A','B','C','Env','Reg');
var from_size,to_size:integer;
  i,j,find_count:integer;
  merge_err,flag:boolean;
begin
merge_err:=false;
Button_confirmmerge.Enabled:=false;
//------------------------------------------
// 2.1 Ручная склейка таблиц для уменьшения
// занимаемого места
//------------------------------------------
index_from:=Form1.ComboBox_Merge_from.ItemIndex;
index_to:=Form1.ComboBox_Merge_to.ItemIndex;
//-- проверка слияния из уже соединенного канала (надо убрать возможность такого выбора)
if (merge_tables[index_from]<>0) then
  begin
  merge_err:=true;
  ShowMessage('ОШИБКА!!!'+#13#10+'Таблица этого канала уже слита в таблицу канала '+ch_text[merge_tables[index_from]]);
  end;
flag:=false;
for i:=0 to 4 do
  begin
  if (merge_tables[i]=index_from+1) then
    begin
    flag:=true;
    end;
  end;
if (flag=true) then
  begin
  merge_err:=true;
  ShowMessage('ОШИБКА!!!'+#13#10+'В эту таблицу канала '+ch_text[index_from]+' сливались другие, она может быть только приемником');
  end;
//-- проверка слияния в самого себя
if(Form1.ComboBox_Merge_from.ItemIndex=Form1.ComboBox_Merge_to.ItemIndex) then
  begin
  merge_err:=true;
  ShowMessage('ОШИБКА!!!'+#13#10+'Попытка слияния канала с самим собой');
  end;
//-- проверка размера слияния
  var_merge_type:=var_tonevol_type[index_to];
  to_size:=768-var_merge_type*256;
  var_merge_type:=var_tonevol_type[index_from];
  from_size:=768-var_merge_type*256;
if (to_size<from_size) then
  begin
  merge_err:=true;
  ShowMessage('ОШИБКА!!!'+#13#10+'Нельзя из большего размера делать слияние в меньший');
  end;
//-- если нет ошибок считаем слияние
if(merge_err=false) then
  begin
//-- очищаем
zeromemory (@var_merge,sizeof(var_merge));
//-- копируем TO массив
for i:=0 to var_variants_count[index_to]-1 do
  begin
  var_merge[i].byte0:=var_variants[index_to,i].byte0;
  var_merge[i].byte1:=var_variants[index_to,i].byte1;
  var_merge[i].byte2:=var_variants[index_to,i].byte2;
  end;
var_merge_count:=var_variants_count[index_to];
//-- сравниваем с FROM массивом
find_count:=0;
for i:=0 to var_variants_count[index_from]-1 do
  begin
  j:=0; flag:=false;
  While ( (j<var_variants_count[index_to]) and (flag=false) ) do
    begin
    if ((var_tonevol_type[index_from]=1) and (var_variants[index_from,i].byte0=var_variants[index_to,i].byte0) and (var_variants[index_from,i].byte1=var_variants[index_to,i].byte1)) then begin flag:=true; inc(find_count); end;
    if ((var_tonevol_type[index_from]=0) and (var_variants[index_from,i].byte0=var_variants[index_to,i].byte0) and (var_variants[index_from,i].byte1=var_variants[index_to,i].byte1) and (var_variants[index_from,i].byte2=var_variants[index_to,i].byte2)) then begin flag:=true; inc(find_count); end;
    inc (j);
    end;
  if not(flag) then
    begin
    var_merge[var_merge_count].byte0:=var_variants[index_from,i].byte0;
    var_merge[var_merge_count].byte1:=var_variants[index_from,i].byte1;
   if (var_tonevol_type[index_from]=0) then var_merge[var_merge_count].byte2:=var_variants[index_from,i].byte2;
    inc (var_merge_count);
    end;
  end;
  //--- результат
  Form1.Memo1.Lines.Add('');
  Form1.Memo1.Lines.Add('Calculate merge channels '+
  ch_text[index_from]+' => '+ch_text[index_to]
  +': size='+IntToStr(var_merge_count)+' (save '+IntToStr(find_count)+' values)');
  //--- реакция на кнопку подтвердить
  if (var_merge_count<=256) then
    begin
    Button_confirmmerge.Enabled:=true;
    end
  else Form1.Memo1.Lines.Add('overflow, merge impossible');
  end; //считаем слияние
end;

procedure TForm1.Button_confirmmergeClick(Sender: TObject);
const ch_text:array[0..4]of string=('A','B','C','Env','Reg');
var i,save_bytes:integer;
begin
Button_confirmmerge.Enabled:=false;
for i:=0 to var_merge_count-1 do
  begin
  var_variants[index_to,i].byte0:=var_merge[i].byte0;
  var_variants[index_to,i].byte1:=var_merge[i].byte1;
  var_variants[index_to,i].byte2:=var_merge[i].byte2;
  end;
var_variants_count[index_to]:=var_merge_count;  
merge_tables[index_from]:=index_to+1;
//---
save_bytes:=0;
Memo1.Lines.Add('');Memo1.Lines.Add('Merge tables ---------');
for i:=0 to 4 do
  begin
  if (merge_tables[i]=0) then
    begin
    Memo1.Lines.Add('Channel_'+ch_text[i]+' variants: '+IntToStr(var_variants_count[i])+' [size='+IntToStr(768-256*var_tonevol_type[i])+']');
    end
  else
    begin
    Memo1.Lines.Add('Channel_'+ch_text[i]+' => '+ch_text[merge_tables[i]-1]);
    save_bytes:=save_bytes+768-(256*var_tonevol_type[i]);
    end;
  end;
Calc_adr_tbl();
Form1.Memo1.Lines.Add('All tables size = '+IntToStr(TBL_SIZE));
Memo1.Lines.Add('Saved: '+IntToStr(save_bytes)+' bytes');
end;
end.

