{ KLAVIRUS.PAS 1.0                                                  }
{ Program pre tvorbu melodii                                        }
{ -------------------------------------------                       }
{ | pato1 studio @ Patrik Benyak            |                       }
{ | http://pato1.ic.cz/                     |                       }
{ -------------------------------------------                       }
{ | Tento program je sireny pod licenciu    |                       }
{ | P1PL OS (http://pato1.ic.cz/p1plos.txt) |                       }
{ -------------------------------------------                       }
{ | Copyrights (C) pato1 2009/10            |                       }
{                                                                   }
{ Datum:19.04.2009                             http://www.trsek.com }
 
program klavirus;
uses crt, JwaWinBase;
var
 a, b, c, d, e: integer;
 znak: char;
 f: TextFile;
 meno, songname: string;
begin
 d:=50;
 ClrScr;
 writeln('Vitaj v klaviruse: n stroji na skladanie mel˘diĄ pre pascal');
 writeln;
 write('N hodn  pripoŸĄtan  hodnota [1/0]: ');
 readln(e);
 if e=0 then
 begin
  write('PripoŸĄtan  hodnota:  ');
  readln(d);
 end;
 write('Zadaj poŸet MILISEKéND d’§ky ka§d‚ho t˘nu: ');
 readln(b);
 write('Zadaj meno sŁboru: ');
 readln(meno);
 write('Zadaj meno melodie: ');
 readln(songname);
 writeln;
 writeln('1.riadok v subore je "TONERATE". 2.riadok v subore je "SONGNAMA" a zviçok sŁ t˘ny');
 writeln;
 Assign(f, meno);
 ReWrite(f);
 writeln(f, b);
 writeln(f, songname);
 writeln('Hraj !!! [ESC]koniec');
 repeat
  if e=1 then d:=Random(100)+30;
  znak:=ReadKey;
  Beep(Ord(znak)+d, b);
  writeln(f, Ord(znak)+d);
 until znak=#27;
 Close(f);
 ClrScr;
end.
 
{ rutiny na spustanie melodie (neodskusana (iba teoria)):(treba vymazat posledny riadok)
program run;
uses crt, SysUtils, pato1asvk; //pre spustaciu rutinu je potrebn  moja kniznica pato1asvk v 1.3 (http://pato1.ic.cz/pato1asvk/13.rar)
var
 a: integer;
 f: TextFile;
 meno, songname, buffer: string;
begin
  Write('Zadaj meno suboru: ';)
 readln(meno);
 Assign(f, meno);
 readln(f, buffer);
 a:=StrToInt(buffer);
 readln(f, songname);
 ClrScr;
 writeln(songname, '  TONERATE: ', a, ' : PLAYING:');
 while not Eof(f) do
 begin
  readln(f, buffer);
  pip(StrtoInt(buffer), a);
 end;
end.     }