home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / misc2 / pmusic12.lzh / LOOPPOLY.PAS < prev    next >
Pascal/Delphi Source File  |  1989-07-11  |  2KB  |  74 lines
  1. program loopply;
  2.  
  3. {$L ppoly_s}
  4. uses crt;
  5.  
  6. const
  7.         DEFTEMP = 1024;
  8.     FILENAMEEXT = '.ply';
  9.  
  10. var
  11.     tempval, badchar : integer;
  12.     infile : file;
  13.  
  14. procedure poly(s,o:word); external;
  15.  
  16. procedure looppoly(filename:string; defaulttempo:word);
  17. var
  18.     tune : pointer;
  19.     fsize : longint;
  20.     p : ^word;
  21.     infilename : string;
  22. begin
  23.     infilename := filename;
  24.     if pos('.', filename) = 0 then
  25.         infilename := infilename+FILENAMEEXT;
  26.     assign(infile, infilename);
  27.     reset(infile,1);
  28.     fsize := filesize(infile);
  29.     getmem( p, word(fsize)+1 );
  30.     p^ := defaulttempo;
  31.     tune := p;
  32.     p := ptr(seg(p^),ofs(p^)+2);
  33.     blockread(infile,p^,word(fsize));
  34.     close(infile);
  35.           while not (keypressed) do
  36.             poly(seg(tune^),ofs(tune^));
  37.     freemem(tune,word(fsize));
  38. end;
  39.  
  40. procedure message;
  41. begin
  42.     writeln('Usage: LoopPoly <plyfile> [tval]');
  43.     writeln;
  44.     writeln('where:');
  45.     writeln('   <plyfile> = the name of the file to play.');
  46.     writeln('   [tval]    = [optional] starting tempo value, 1 (fast) - 65535 (slow)');
  47.     writeln;
  48.     writeln('LoopPoly.EXE and its original source code is Copyright (c) 1989 - ');
  49.     writeln('GrigaSoft Productions. PlayPoly may not be included in any commercial');
  50.     writeln('software package without explicit written permission from the author.');
  51.     writeln('This package is an unregistered evaluation copy for demo use only.');
  52.     writeln('Register your copy today!');
  53. end;
  54.  
  55. begin
  56.     if paramcount > 0 then begin
  57.         if paramcount > 1 then begin
  58.             val(paramstr(2),tempval,badchar);
  59.             if badchar = 0 then
  60.                 looppoly( paramstr(1), tempval )
  61.             else begin
  62.                 message;
  63.                 halt(2);
  64.             end;
  65.         end else
  66.             looppoly(paramstr(1),DEFTEMP);
  67.     end else begin
  68.         message;
  69.         halt(1);
  70.     end;
  71. end.
  72.  
  73.  
  74.