program virtual_piano;

uses crt, speaker,  mouse, graph, dos;

const
     masks : array[0..1, 0..15] of word = (
     ($E1FF, $EDFF, $EDFF, $EDFF,
      $EDFF, $EC00, $EDB6, $EDB6,
      $0DB6, $6FFE, $6FFE, $6FFE,
      $7FFE, $7FFE, $7FFE, $0000),
     ($1E00, $1200, $1200, $1200,
      $1200, $13FF, $1249, $1249,
      $F249, $9001, $9001, $9001,
      $8001, $8001, $8001, $FFFF));

const
     width = 18;
     x1 = 35 * width;
     y1 = 160;
     black_key_low = 100;
     half_black_width = width div 3;
     quit_x = 500;
     quit_y = 400;
var
   frequency : array[0..4,0..11] of real ;
   white_freq : array[0..4,0..6] of real;
   black_freq : array[0..4,0..6] of real;
   mouse_OK : boolean;
   x, y : word;
   button : byte;
   gd, gm : integer;

procedure init_frequency;
const
     white_map : array[0..6] of word = (0, 2, 4, 5, 7, 9, 11);
     black_map : array[0..6] of word = (0, 1, 3, 0, 6, 8, 10);
var
   x, semitone_ratio : real;
   i, j : word;
begin
   semitone_ratio := exp(ln(2.0) / 12.0);
   frequency[1, 9] := 440.0;
   x := 440.0;
   for j := 8 downto 0 do
   begin
        x := x / semitone_ratio;
        frequency[1, j] := x;
   end;
   x := 440.0;
   for j := 10 to 11 do
   begin
        x := x * semitone_ratio;
        frequency[1, j] := x;
   end;
   for j := 0 to 11 do
   begin
        frequency[0,j] := 0.5 * frequency[1,j];
        frequency[2,j] := 2.0 * frequency[1,j];
        frequency[3,j] := 4.0 * frequency[1,j];
        frequency[4,j] := 8.0 * frequency[1,j];
   end;
   for i := 0 to 4 do
   begin
        for j := 0 to 6 do
        begin
             white_freq[i,j] := frequency[i, white_map[j]];
             black_freq[i,j] := frequency[i, black_map[j]];
        end;
   end;
end;
procedure draw_keyboard;
const
     black : array[1..5] of integer = (-3, 16, 52, 70, 87);
var
   pp, z, p : integer;
begin
     x := 0;
     y := 10;
     for pp := 1 to 5 do
     begin
          for p := 1 to 8 do
          begin
          setcolor(11);
          for z := y to y + 150 do line(x, z, x + 15, z);
          putpixel(x, y + 150, 0);
          putpixel(x + 15, y + 150, 0);
          inc(x, 18);
     end;
     dec(x, 131);
     for p := 1 to 5 do
     begin
          setcolor(8);
          for z := y to y + 80 do
              line(x + black[p], z, x + black[p]+ 11, z);
              setcolor(0);
              rectangle(x + black[p] + 1, y, x+ black[p]+12, y + 80);
              setcolor(7);
              for z := y + 77 to y + 79 do
                  line(x+ black[p] + 2, z, x + black[p] + 11, z);
          end;
          inc(x,114);
     end;
     rectangle(quit_x, quit_y, 639, 479);
     outtextxy(quit_x+40, quit_y+35, 'Qoit');
end;

procedure poll;
begin
     repeat
           get_mouse_status(button, x, y);
           if button and $01 <> 0 then
              exit
           else
           no_sound;
     until false;
end;

procedure play;
var
   key, octave: word;
   z, w: integer;
begin
     key:= x div width;
     octave := key div 7;
     z := x mod (7* width);
     w := round(z/width);
     if (y <= black_key_low) and
        (abs(width * w - z)<=half_black_width) and
        (w in [1, 2, 4..6]) then
           sound(black_freq[octave, w])
     else
         sound(white_freq[octave, key mod 7]);
     repeat
           get_mouse_status(button, x, y);
     until button and $01 = $00;
     no_sound;
end;

begin
     clrscr;
     init_frequency;
     reset_mouse(mouse_OK, button);
     if not mouse_OK then Halt;
     gd := VGA; gm := VGAHi;
     initgraph(gd, gm, '');
     reset_mouse(mouse_OK, button);
     set_graph_cursor_shape(7, 0, @masks);
     show_cursor;
     mouse_gotoXY(320,300);
     draw_keyboard;
     repeat
           poll;
           if (x=0) or (y=0) then
           begin
                no_sound;
                poll;
           end;
           if (x <= x1) and (y <= y1) then
              play
           else
               if (x >= quit_x) and (y >= quit_y) then break;
           no_sound;
     until false;
     closegraph;
end.