Program Point_Shoot;
{
 *    Point and shoot sound file player
 *
 *
 *
}



uses dos,crt;


const  numfiles = 200;
       defspeed = 1;    { 22 KHZ }

       { This is used to indicate directories and unknown speeds
         in the speed field on slist }


       vnul = 255;
       vdir = 250;
       vunk = 20;

       speedstr:array[0..9] of string[8] =
       ('44000 Hz','22000 Hz','16000 Hz','13500 Hz','11000 Hz',
        ' 8000 Hz',' 7000 Hz',' 6500 Hz',' 5500 Hz',' 5000 Hz');

       portstr :array[0..3,0..1] of string[10] = (
                                                 ('Autodetect',''),
                                                 ('LPT 1     ','-p1 '),
                                                 ('LPT 2     ','-p2 '),
                                                 ('LPT 3     ','-p3 ')  );



type slist = record
             name:string[12];
             speed:byte;
             size:integer;
             end;


var
    dirinfo:searchrec; { Needed for directory operations }

    Splay: PathStr; { the path and filename to SPLAY.EXE }

    sl:array[1..numfiles] of slist; { main storage array }


    top,    { this is record number at top of window }
    mslect, { to tell if mouse did selection }
    slect,  { the selected record number }
    sli:    { this is and index when loadinf dir and max record # afterwards }
            integer;

    mmouse,         { if mouse is present it's true }
    schange,        { indicted if there has been changes mode to sample rates}
    done:boolean;
    port:integer;   { points ti entry in portstr }


{ ******************** mouse code ************************** }

procedure m_int;
var   regs : Registers;
begin

   mmouse := true;

    regs.AX := 0;
    regs.BX := 0;
    regs.CX := 0;
    regs.DX := 0;
    Intr($33,regs); { Call MOUSE driver }

   if regs.AX <> $FFFF then
   begin
     mmouse := false;
  {   writeln('MOUSE NOT detected'); }
   end;

end;


procedure m_on;
var   regs : Registers;
begin
    regs.AX := 1;
    regs.BX := 0;
    regs.CX := 0;
    regs.DX := 0;
    Intr($33,regs); { Call MOUSE driver }

     {mouse cursor on}
end;

procedure m_off;
var   regs : Registers;
begin
    regs.AX := 2;
    regs.BX := 0;
    regs.CX := 0;
    regs.DX := 0;
    Intr($33,regs); { Call MOUSE driver }
        {mouse cursor on}
end;

procedure m_stat(var x,y,button:word);
var   regs : Registers;
begin
    regs.AX := 3;
    regs.BX := 0;
    regs.CX := 0;
    regs.DX := 0;
    Intr($33,regs); { Call MOUSE driver }

    button := regs.BX;
    x      := regs.CX;
    y      := regs.DX;
end;

procedure move_m(x,y:word);
var   regs : Registers;
begin
    regs.AX := 4;
    regs.BX := 0;
    regs.CX := x;
    regs.DX := y;
    Intr($33,regs); { Call MOUSE driver }
end;

procedure m_move(var x,y:word);
var   regs : Registers;
begin
    regs.AX := 11;
    regs.BX := 0;
    regs.CX := 0;
    regs.DX := 0;
    Intr($33,regs); { Call MOUSE driver }
    x      := regs.CX;
    y      := regs.DX;

 {gets mouse movement in mickies 1/100 of an inch}
end;


{ ************************** main code **************************}


function base(s:string):string;  { pulls out the BASE of a filename }
var a:integer;
    o:string;
begin

 o := '';
 a := 1;
 while (a <= length(s)) and ( s[a] <> '.' ) do
 begin
   o := o + s[a];
   inc(a);
 end;
 base := o;
end;


function extn(s:string):string;  { pulls out the EXTENTION of a filename }
var a:integer;
    o:string;
begin

 o := '';
 a := length(s);
 while (a >= 1 ) and ( s[a] <> '.' ) do
 begin
   o := s[a] + o;
   dec(a);
 end;
 extn := o;
end;


{ CALLS EXTERNALY SPLAY.EXE
  this sets up the command line parameters for speed and port useage also }

procedure playit(fn:string;speed:integer);
var oper,sp:string;
begin
   if mmouse then m_off;

   gotoxy(50,8);
   write('Playing ',fn,'       ');

   str(speed,sp);
   oper  := '-s'+sp+' '+portstr[port,1] + fn ; { assemble command line }

      {$M 15000,0,64000}           { Leave memory for child process }
      SwapVectors;
        Exec( Splay, oper );        { Call it }
      SwapVectors;

      gotoxy(50,8);

      if DosError <> 0 then
        WriteLn('Could not execute SPLAY.EXE');

      write('                          ');

   if mmouse then m_on;

end;



function fixfn(s:string):string;  { fixup of filename to look good on screen}
var b,e:string;
begin
  b := base(s) + '            ';
  e := extn(s) + '    ';
  b[0] := chr(8);
  e[0] := chr(3);
  fixfn := b + '.' + e;
end;

function fixdn(s:string):string;
var b,e:string;
begin
  s := s + '                 ';
  s[0] := chr(12);
  fixdn := s;
end;


procedure savespeedfile;
var f:text;
    err,a,speed:integer;
    fn:string;
begin

  assign(f,'speeds.txt');
  {$I-}
  rewrite(f);
  err := ioresult;

  if err = 0 then
  begin
    gotoxy(50,3);
    write('SAVING Speed database  ');

      a := 1;
      while (a < sli) do
      begin

        if sl[a].speed < 10 then
        begin
          writeln(f,sl[a].name);
          err := ioresult;
          writeln(f,sl[a].speed);
          err := ioresult;
        end;

        inc(a);
      end;
    close(f);
  end
  else
  begin
    gotoxy(50,3);
    write('Error writeln database  ');
  end;

  {$I+}
end;


procedure chkspeedfile;
var f:text;
    err,a,speed:integer;
    fn:string;
begin

  schange := false;
  assign(f,'speeds.txt');
  {$I-}
  reset(f);
  err := ioresult;

  if err = 0 then
  begin
    gotoxy(50,3);
    write('Speed database found  ');

    while (not eof(f)) and (err = 0) do
    begin
      readln(f,fn);
      readln(f,speed);
      err := ioresult;

      a := 1;
      while (a < sli) and (fn <> sl[a].name ) do
        inc(a);

      if fn = sl[a].name then
        sl[a].speed := speed;
    end;
   close(f);
  end
  else
  begin
    gotoxy(50,3);
    write('                      ');
  end;

  {$I+}
end;




procedure loadsfiles(ext:string;speed:integer);
begin

 findfirst('*.'+ext ,archive,dirinfo);

 while (doserror = 0) and (sli < numfiles) do
  begin

     sl[sli].name := fixfn(dirinfo.name);
     sl[sli].speed := speed;
     sl[sli].size := dirinfo.size div 1000 ; { IN K Byte units }
     inc(sli);

    findnext(dirinfo);
  end;

end;



{ LOAD DIRECTORY AND SOUND FILE LIST }

procedure loaddir;
begin

for sli := 1 to numfiles do
 begin
  sl[sli].name := '';
  sl[sli].speed := vnul;
  sl[sli].size := 0;
 end;

 sli := 1;
{ load sound file list }


findfirst('*.*',directory,dirinfo);

 while (doserror = 0) and (sli < numfiles) do
  begin
  if dirinfo.attr and directory <> 0 then
   if dirinfo.name <> '.' then
    begin
      sl[sli].name := dirinfo.name;
      sl[sli].speed := vdir;
      inc(sli);
    end;

    findnext(dirinfo);
  end;

  loadsfiles('M44',0);
  loadsfiles('M22',1);
  loadsfiles('M16',2);
  loadsfiles('M11',4);
  loadsfiles('M8' ,5);
  loadsfiles('M7' ,6);
  loadsfiles('M55',8);
  loadsfiles('SND',vunk);
  loadsfiles('VOC',vunk);
  loadsfiles('SAM',vunk);


  chkspeedfile;

end;



procedure find_splay;
begin
{ find SPLAY path to save loading time }

  Splay := FSearch('SPLAY.EXE',GetEnv('PATH'));
    if Splay = '' then
      begin
        WriteLn('SPLAY.EXE not found in path');
        halt(1);
      end;

  splay := FExpand(splay);

end;



procedure disp_port;
begin
  gotoxy(50,5);
  write('Port to use');
  gotoxy(50,6);
  write(portstr[port,0] );;
end;



procedure disp_list;
var a,speed,start:integer;
begin
 if mmouse then m_off;

 start := top;
 for a := 0 to 22 do
 begin
  gotoxy(1,a+3);

  if (a+start) < sli then
   begin

     if a + start = slect then
       begin
         TextBackground(3);
         TextColor(0);
       end;

     speed := sl[a+start].speed;

     if speed = vdir then
         write(fixdn(SL[a+start].name):12,'       Directory ');
     if speed = vunk then
         write(SL[a+start].name:12,'  Unknown   ',SL[a+start].size:3,' K');
     if speed = vnul then
         write(SL[a+start].name:12,'  Null            ');
     if speed < 10 then
         write(SL[a+start].name:12,'  ',speedstr[speed]:8 ,'  ',
                                                   SL[a+start].size:3,' K');


     if a + start = slect then
       begin
         TextBackground(1);
         TextColor(7);
       end;


   end
   else
     write('-----------------------------');

 end;
 if mmouse then m_on;
end;

procedure fixslc;
begin
 if slect < top then slect := top;
 if slect > top+22 then slect := top + 22;
end;


procedure fixtop;
begin
 if slect < top then top := slect;
 if slect > top+22 then top := slect - 22;
end;


{
  Perform action when Charage return is pressed on a selected item
  this can be a Directory to change to is play a sample
 }
procedure dobutton;
 var a,speed:integer;
     c :char;
begin
  mslect := 0;

   speed := sl[slect].speed;

   if speed < 10 then
      playit( sl[slect].name, speed );

   if speed = vdir then
     begin
       if schange then savespeedfile;
       chdir( sl[slect].name );
       loaddir;
       slect := 1;
       top := 1;
       disp_list;
     end;

   if speed = vunk then
      playit( sl[slect].name, defspeed );

   if speed = vnul then
     begin
        gotoxy(1,1);
        write('  Null  ENTRY  ');
     end;

  while keypressed do  { wipe buffer }
    c := readkey;


end;



procedure chkmouse;
var x,y,b,ox,oy:word;
    play:boolean;
    speed:byte;
begin
 m_stat(x,y,b);
 if b <> 0 then
 begin
   x := (x div 8)+1;
   y := (y div 8)+1;
   ox := x;
   oy := y;


{*********** in file name area ************}
   if (x < 13) and (y > 2) then
    begin
      play := false;
      slect := (y - 3 )+ top;
      if slect > sli - 1 then slect := sli - 1;
      disp_list;

      if mslect = slect then play := true;  { allows to 2 click before playing}
      mslect := slect;


     { test for button release and scrolling }
      m_move(x,y);
      while b <> 0 do
       begin
         m_stat(x,y,b);
         m_move(x,y);

         if y > 0 then  { scroll here }
         begin
         if y > $7fff then
           begin
             if slect > 1    then dec(slect);
             fixtop;
             disp_list;
             play := false;
           end;

         if y <= $7fff then
           begin
             if slect < sli - 1 then inc(slect);
             fixtop;
             disp_list;
             play := false;
           end;

          move_m((ox - 1) * 8,( (slect - top) + 2) * 8); { position mouse }

         end;
       end;

      if play then dobutton;

    end;

{************************* in speed listing area (change speed) ********}

   if (x >= 14) and (x < 23) and (y > 2) then
    begin
      slect := (y - 3 )+ top;
      if slect > sli - 1 then slect := sli - 1;
      disp_list;

      if mslect = slect then
      begin
      if b >= 2 then
            begin
              speed := sl[slect].speed;
              if speed = 9 then
                speed := 0
               else
                if speed < 9 then inc(speed);
              if speed = vunk then speed := defspeed;
              sl[slect].speed := speed ;
              disp_list;
              schange := true;
            end;
      if b = 1 then
            begin
              speed := sl[slect].speed;
              if speed = 0 then
                speed := 9
              else
                if (speed < 10) and (speed > 0) then dec(speed);
              if speed = vunk then speed := defspeed;
              sl[slect].speed := speed ;
              disp_list;
              schange := true;
            end;

      end;

      mslect := slect;

      while b <> 0 do
       begin
         m_stat(x,y,b);
       end;

    end;


{******************* in END and port select area *************}
   if x >= 50 then
   begin
     if y = 20 then done := true;

     if (y = 5) or (y = 6) then
     begin
       inc(port);
       if port > 3 then port := 0;
       disp_port;
     end;

      while b <> 0 do
       begin
         m_stat(x,y,b);
       end;

   end; { >50 }


 end; { if button pressed }

end;



procedure keyboard;
const   up = $48;
      down = $50;
      left = $4B;
     right = $4D;
      pgup = $49;
      pgdn = $51;
     cpgup = $84;
     cpgdn = $76;
      eend = $4F;
        CR = $0D;
       ESC = $1B;


var speed,a:byte;
    c:char;

begin
  a := ord(readkey);

  if a <> 0 then
  begin
   case a of

     CR  : dobutton;
     esc : done := true;

     ord('P'),ord('p') : begin
                           inc(port);
                           if port > 3 then port := 0;
                           disp_port;
                         end;

   end; { case }
  end
  else
  begin
    a := ord(readkey);

    case a of

    cpgup : begin
             if top > 1       then dec(top);
             fixslc;
             disp_list;
            end;

    cpgdn : begin
             if top < sli - 1 then inc(top);
             fixslc;
             disp_list;
            end;

    pgup  : begin
             if top > 22 then
               top := top - 22
             else
               begin
                 if top = 1 then slect := 1;
                 top := 1;
               end;

             fixslc;
             disp_list;
            end;

    pgdn  : begin
             if top < sli - 44 then
               top := top + 22
             else
              begin
               if top >= sli - 23 then slect := sli - 1;

               if sli - 23 >= 1 then top := sli - 23;

              end;

             fixslc;
             disp_list;
            end;

    up    : begin
             if slect > 1    then dec(slect);
             fixtop;
             disp_list;
            end;

    down  : begin
             if slect < sli - 1 then inc(slect);
             fixtop;
             disp_list;
            end;

    right : begin
              speed := sl[slect].speed;
              if speed < 9 then inc(speed);
              if speed = vunk then speed := defspeed;
              sl[slect].speed := speed ;
              disp_list;
              schange := true;
            end;

    left  : begin
              speed := sl[slect].speed;
              if (speed < 10) and (speed > 0) then dec(speed);
              if speed = vunk then speed := defspeed;
              sl[slect].speed := speed ;
              disp_list;
              schange := true;
            end;



    eend  : done := true;

   end; { case }
 end;

  while keypressed do  { wipe buffer }
    c := readkey;

end; { keyboard }




procedure menu;
begin

  mslect := 0;
  slect := 1;
  top := 1;

  TextBackground(3);
  TextColor(9);

  gotoxy(20,1);
  write('Zebra Reasearch Point and Shoot sound player');

  TextBackground(1);
  TextColor(14);

  gotoxy(1,2);
  write('File name   | speed   | Size');

  TextBackground(1);
  TextColor(7);

  if mmouse then
  begin
    gotoxy(50,20);
    write('Click here to END');

  end;


  loaddir;
  disp_port;
  disp_list;

  while not done do
   begin
    if keypressed then keyboard;
    if mmouse then chkmouse;
   end;

end;




begin { MAIN }

done := false;
port := 0;

textmode(CO80);
TextBackground(0);
TextColor(7);
clrscr;

writeln('Searching Directory');

find_splay;

TextBackground(1);
TextColor(7);
clrscr;

{
writeln(sli -1 ,' Identified');
repeat until keypressed;
  }

m_int; { initialize mouse driver and detect mouse existance }

if mmouse then m_on;

menu;

if mmouse then m_off;

if schange then savespeedfile;

TextBackground(0);
TextColor(7);
clrscr;

end.