 {~ Plays tones given by keys; <Shift> makes them a halftone higher, <Ctrl> lower ~}

program Piano; {by Jan Hollan}

uses crt,
      un_str_m;
const
  cl=#13#10;
  F5: byte = 63; oct:integer = 0; 
var ht,ht2,ln2:real; ton:array [1..8] of real; ch:char; chb:byte absolute ch;
begin
ht:=exp(ln(2)/12); ht2:=ht*ht; ln2:=ln(2);
ton[1]:=440;
ton[2]:=440*ht;
ton[8]:=440*ht2;
ton[7]:=440/ht2;
ton[6]:=ton[7]/ht2;
ton[5]:=ton[6]/ht;
ton[4]:=ton[5]/ht2;
ton[3]:=ton[4]/ht2;

writeln(cl,
'Plays tones given by keys; <Shift> makes them a halftone higher, <Ctrl> lower'
,cl,
' (octaves can be changed by F-keys, default is <F5>).',cl);
highvideo;
writeln(
'Exit the programme by pressing <Enter>.',cl);
lowvideo;
writeln(
'( (C) Jan Hollan, N.Copernicus Observatory and Planetarium in Brno, 1999;'+cl+
' subject to the GNU General Public License, http://www.gnu.org/copyleft;'+cl+
' source code available at http://astro.sci.muni.cz/pub/hollan/programmes)'
);


ch:=readkey;
while (chb<>13) and (chb<>10) do
begin
 if chb=0 then
  begin
   ch:=readkey;
   oct:=chb-F5
  end
 else
  begin
    nosound; delay(30);
    case chb of
      1..  8: sound(round(exp((oct)*ln2)*ton[chb]/ht));
     65.. 72: sound(round(exp((oct)*ln2)*ton[chb-64]*ht));
     97..104: sound(round(exp((oct)*ln2)*ton[chb-96]));
     else     nosound
    end
  end;
 ch:=readkey
end;
nosound
end.
