program patches(input,output);

{Patches - Casio CZ 101 patch librarian program for the Atari ST
Version 1.01 dated July 16, 1987 by John H. Marable, III LT,USN
Created using OSS Personal Pascal (PP) and the Kuma Resource
Construction Set (RCS)}

const
  MIDI=3;
  {$I gemconst.pas}     {standard GEM constants}
  {$I patch.i}          {constant file created by RCS}

type
  {$I gemtype.pas}      {standard GEM types}

var
  def_path,full_name:string[80];       {file names with path}
  dummy,choice,voice:integer;
  patch_data:array [0..255] of char;   {array for tone data}
  data_file:file of char;              {file variable for data file}
  status:boolean;
  title_box:dialog_ptr;

{$I gemsubs.pas}        {standard GEM subroutines}

function bconin(device:integer):long_integer;       {functions for input and}
  bios(2);                                          {output of characters at}
function bconstat(device:integer):boolean;          {the system level}
  bios(1);
procedure bconout(device,c:integer);
  bios(3);
function bcostat(device:integer):boolean;
  bios(8);

function get_data:char;                {retrieves an integer from the midi}
begin                                  {port and or's it with $ff to strip}
    get_data:=chr(bconin(MIDI) & $ff)  {any information in the high byte}
end;

procedure empty_buffer;                {checks midi port status and as long}
var                                    {as there is a character waiting,}
  dummy:char;                          {retrieves this character to a dummy}
begin                                  {status to clear all midi data}
  while (bconstat(MIDI)) do
    dummy:=get_data;
end;

procedure get_patch;     {this procedure uses a system exclusive call to}
var                      {the Casio to get a dump of tone data over midi}
  i:integer;             {channel 0, stores in an array (patch_data) and}
  c:char;                {then saves the array to disc}
begin
  empty_buffer;          {empty any old data}
  bconout(MIDI,$f7);     {end system exclusive, just in case}
  bconout(MIDI,$f0);     {system exclusive call}
  bconout(MIDI,$44);     {to a Casio}
  bconout(MIDI,$00);     {CZ 101 or CZ 1000}
  bconout(MIDI,$00);
  bconout(MIDI,$70);     {$70 + midi channel number}
  bconout(MIDI,$10);     {send patch data from synth}
  bconout(MIDI,voice);   {voice program to send from synth}
  empty_buffer;          {dump the synth's answer}
  bconout(MIDI,$70);     {tell the Casio to begin sending}
  bconout(MIDI,$31);
  for i:=1 to 5 do       {dump the five byte preamble}
    c:=get_data;
  for i:=0 to 255 do     {capture the 256 bytes of tone data}
    patch_data[i]:=get_data;
  bconout(MIDI,$f7);     {end system exclusive}
  rewrite(data_file,full_name);  {open the data file for writing}
  for i:=0 to 255 do             {put the 256 bytes of data into}
  begin                          {data file}
    data_file^:=patch_data[i];   {NOTE: because data was not packed,}
    put(data_file);              {each byte takes a full word or 16}
  end;                           {bits of file space}
  close(data_file);
end;

procedure send_patch;   {this procedure is similiar to the last, only}
var                     {it loads the array from a disc file and sends}
  i:integer;            {the tone data to the Casio}
  j:char;
begin
  empty_buffer;          {dump old data}
  bconout(MIDI,$f7);     {end system exclusive, just in case}
  bconout(MIDI,$f0);     {begin system exclusive call}
  bconout(MIDI,$44);     {to a Casio}
  bconout(MIDI,$00);     {CZ 101 or CZ 1000}
  bconout(MIDI,$00);
  bconout(MIDI,$70);     {$70 + midi channel nr}
  bconout(MIDI,$20);     {tells synth to prepare to receive tone data}
  bconout(MIDI,voice);   {program voice to receive to}
  empty_buffer;          {dump the Casio's answer}
  reset(data_file,full_name);      {open the data file for reading}
  for i:=0 to 255 do
  begin                  {load the tone data from the data file}
    get(data_file);      {directly to the synthesizer}
    j:=data_file^;
    bconout(MIDI,ord(j));
  end;
  close(data_file);
  bconout(MIDI,$f7);     {end system exclusive}
end;

function get_voice:integer;   {this function uses a dialog box (FORM2)}
var                           {created with the RCS and returns the}
  voice_box:Dialog_ptr;       {the program number for the patch to be}
  no,pushed:Tree_Index;          {loaded or saved}
  voice_str:string[255];
begin
  Find_Dialog(FORM2,voice_box);   {find the dialog box in the resource file}
  Center_Dialog(voice_box);       {center the dialog box on the screen}
  no:=Add_DItem(voice_box,G_FText,None,30,2,2,1,0,$1180);
  Set_DEdit(voice_box,no,'__','99','32',System_Font,TE_Left);
  pushed:=Do_Dialog(voice_box,no);  {display the dialog box}
  Get_DEdit(voice_box,no,voice_str);{get the edited string from the box}
  End_Dialog(voice_box);          {discard the dialog box}
  get_voice:=10*(ord(voice_str[1])-$30)+(ord(voice_str[2])-$30);
end;                              {convert the string to an integer}

begin
  if Init_GEM>=0 then
  begin
    Set_Mouse(M_Arrow);  {make the mouse shape an arrow, GEM forgets sometimes}
    if not Load_Resource('patch.rsc') then  {load the resource file or}
    begin                                   {display error alert box}
      dummy:=Do_Alert('[3][No resource file!][Quit]',1);
      Exit_Gem;
      Halt;
    end;
    Find_Dialog(FORM1,title_box);       {find the title screen dialog box}
    Center_Dialog(title_box);           {center it on screen}
    dummy:=Do_Dialog(title_box,dummy);  {display the dialog box}
    End_Dialog(title_box);              {discard the dialog box}
    voice:=get_voice;                   {function call to get the program no}
    choice:=Do_Alert(                   {alert box to choose options}
    '[2][LOAD a patch from disk|         or|SAVE a patch to disk?][LOAD|SAVE]'
                     ,0);
    def_path:='A:*.PAT';     {sets default path for patch files}
    case choice of
      1:if Get_In_File(def_path,full_name) then send_patch;
      2:if Get_Out_File('Filename to save data in:',full_name) then get_patch;
    end;   {these are the canned PP dialog boxes for getting the files}
  end;     {for saving data to or retrieving data from}
end.
