program fortyone;
{$C-}
{ play music in 41-tone scale using computer keyboard as music keyboard}
{ adapted from TurboPascal 3.0 SOUND DEMONSTRATION PROGRAM  Version 1.00A}
{ keys in rows produce tones
	40 0 3 7 10 14 17 21 24 27 31 34 38 41
	   1 4 8 11 15 18 22 25 28 32 35 39
	   2 5 9 12 16 19 23 26 29 33 36 [40]
	   x 6 x 13  x 20 x  x  30 [x] 37
respectively (x = keys not producing sound). On my keyboard, the keys used
would be "1"-"=", "q"-"]", "a"-[ENTER], and "z"-[RSHIFT]. (Note substitution
from ideal: `~ for ENTER and /? for RSHIFT.) Use SPACE to end.
Use (left) SHIFT to go up an octave.

Future goals: 
Left CTRL to go up two octaves (allowing additive use to go up three) 
Left ALT to change these up-shifts to downshifts.
Simultaneous notes (chords)
}

var ch:char;

procedure Play(Octave, Note,Duration: integer);

{ Play Note in Octave Duration milliseconds
  Frequency computed by first computing C in
  Octave then increasing frequency by Note
  times the 41st root of 2. (1.0170497444)

  If Note is 99 nothing happens   }

var
  Frequency : real;
  I         : integer;
begin
  Frequency := 32.625;
  for I := 1 to Octave do                { Compute C in Octave             }
    Frequency := Frequency * 2;
  for I := 1 to Note do                  { Increase frequency Note-1 times }
    Frequency := Frequency * 1.0170497444;
  if Note <> 99 then
  begin
    Sound(Round(Frequency));
    Delay(Duration);
{    NoSound;}
  end
end;

procedure onenote;
var
  tone: integer;

begin
	read(kbd,ch);
	if ch='1' then tone:=0; if ch='!' then tone:=0+41;
	if ch='2' then tone:=3; if ch='@' then tone:=3+41;
	if ch='3' then tone:=7; if ch='#' then tone:=7+41;
	if ch='4' then tone:=10; if ch='$' then tone:=10+41;
	if ch='5' then tone:=14; if ch='%' then tone:=14+41;
	if ch='6' then tone:=17; if ch='^' then tone:=17+41;
	if ch='7' then tone:=21; if ch='&' then tone:=21+41;
	if ch='8' then tone:=24; if ch='*' then tone:=24+41;
	if ch='9' then tone:=27; if ch='(' then tone:=27+41;
	if ch='0' then tone:=31; if ch=')' then tone:=31+41;
	if ch='-' then tone:=34; if ch='_' then tone:=34+41;
	if ch='=' then tone:=38; if ch='+' then tone:=38+41;
	if ch='\' then tone:=41; if ch='|' then tone:=41+41;
	if ch='q' then tone:=1; if ch='Q' then tone:=1+41;
	if ch='w' then tone:=4; if ch='W' then tone:=4+41;
	if ch='e' then tone:=8; if ch='E' then tone:=8+41;
	if ch='r' then tone:=11; if ch='R' then tone:=11+41;
	if ch='t' then tone:=15; if ch='T' then tone:=15+41;
	if ch='y' then tone:=18; if ch='Y' then tone:=18+41;
	if ch='u' then tone:=22; if ch='U' then tone:=22+41;
	if ch='i' then tone:=25; if ch='I' then tone:=25+41;
	if ch='o' then tone:=28; if ch='O' then tone:=28+41;
	if ch='p' then tone:=32; if ch='P' then tone:=32+41;
	if ch='[' then tone:=35; if ch='{' then tone:=35+41;
	if ch=']' then tone:=39; if ch='}' then tone:=39+41;
	if ch='a' then tone:=2; if ch='A' then tone:=2+41;
	if ch='s' then tone:=5; if ch='S' then tone:=5+41;
	if ch='d' then tone:=9; if ch='D' then tone:=9+41;
	if ch='f' then tone:=12; if ch='F' then tone:=12+41;
	if ch='g' then tone:=16; if ch='G' then tone:=16+41;
	if ch='h' then tone:=19; if ch='H' then tone:=19+41;
	if ch='j' then tone:=23; if ch='J' then tone:=23+41;
	if ch='k' then tone:=26; if ch='K' then tone:=26+41;
	if ch='l' then tone:=29; if ch='L' then tone:=29+41;
	if ch=';' then tone:=33; if ch=':' then tone:=33+41;
	if ch=#44 then tone:=36; if ch='"' then tone:=36+41;
	if ch='`' then tone:=40; if ch='~' then tone:=40+41;
{should be ENTER key}
	if ch='z' then tone:=99; if ch='Z' then tone:=99;
	if ch='x' then tone:=6; if ch='X' then tone:=6+41;
	if ch='c' then tone:=99; if ch='C' then tone:=99;
	if ch='v' then tone:=13; if ch='V' then tone:=13+41;
	if ch='b' then tone:=99; if ch='B' then tone:=99;
	if ch='n' then tone:=20; if ch='N' then tone:=20+41;
	if ch='m' then tone:=99; if ch='M' then tone:=99;
	if ch=',' then tone:=99; if ch='<' then tone:=99;
	if ch='.' then tone:=30; if ch='>' then tone:=30+41;
	if ch='/' then tone:=37; if ch='?' then tone:=37+41;
{should be RSHIFT key}
	repeat play(4,tone,70) until KeyPressed; NoSound;
	if ch='m' then repeat begin play(4,0,10);play(4,24,10);end until KeyPressed;
end;

begin
ch:='1'; {in case user aborts without playing anything...}
while ch<> ' ' do onenote
end.
