| в Бане
Сообщения: 527
Регистрация: 30.12.2009 | 
4 января 2010, 17:13
| | |
#288 (ПС)
| uses crt, speaker, dos, mouse, graph, graphs;
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;
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, "Quit");
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
init_frequency;
reset_mouse(mouse_OK, button);
if not mouse_OK then
halt;
open_graph;
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;
close_graph;
end. |
Похожие темы на: Что у Вас сейчас в буфере обмена?