home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
1990
/
07
/
tricks
/
music.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-04-05
|
7KB
|
185 lines
(* ------------------------------------------------------ *)
(* MUSIC.PAS *)
(* (c) 1990 Alexander Sunder & TOOLBOX *)
(* ------------------------------------------------------ *)
UNIT Music;
INTERFACE
USES Crt;
TYPE
TSpielArt = (Stakkato, Normal, Legato);
VAR
SpielArt : TSpielArt;
Oktave : 0..6;
Tempo : 32..255;
NotenLg : 1..64;
PROCEDURE Play(Noten : STRING);
IMPLEMENTATION
PROCEDURE Play(Noten : STRING);
CONST
Freq : ARRAY[1..84] OF INTEGER = { 7 Oktaven }
( 65, 69, 73, 78, 82, 87, 92,
98, 104, 110, 117, 123, 131, 139,
147, 156, 165, 175, 185, 196, 208,
220, 233, 247, 262, 277, 294, 311,
330, 349, 370, 392, 414, 440, 466,
494, 523, 554, 587, 622, 659, 698,
740, 784, 831, 880, 932, 988, 1047,
1109, 1175, 1245, 1319, 1397, 1480, 1568,
1661, 1760, 1865, 1976, 2093, 2217, 2349,
2489, 2637, 2794, 2960, 3136, 3322, 3520,
3729, 3951, 4186, 4434, 4698, 4978, 5274,
5588, 5920, 6272, 6644, 7040, 7458, 7902);
VAR
i, j, N : BYTE;
L, BT, Lg : INTEGER;
StdLg, P : REAL;
PROCEDURE Umwandlung(VAR i : BYTE; VAR L : INTEGER);
VAR
j : BYTE;
BEGIN
L := 0; j := 1;
WHILE (i + j <= Length(Noten)) AND
(Noten[i+j] IN ['0'..'9']) DO BEGIN
L := L * 10 + Ord(Noten[i+j]) - 48;
Inc(j);
END;
i := i + j - 1;
END;
BEGIN
StdLg := 60000.0 / Tempo * 4;
i := 0;
WHILE i < Length(Noten) DO BEGIN
Inc(i);
CASE UpCase(Noten[i]) OF
'A'..'G': BEGIN
N := Oktave * 12;
CASE UpCase(Noten[i]) OF
'C' : N := N + 1;
'D' : N := N + 3;
'E' : N := N + 5;
'F' : N := N + 6;
'G' : N := N + 8;
'A' : N := N + 10;
'B' : N := N + 12;
END;
IF (i < Length(Noten)) AND
(Noten[i+1] IN ['+', '#', '-'])
THEN BEGIN
Inc(i);
IF Noten[i] = '-' THEN
IF N > 1 THEN Dec(N)
ELSE
IF N < 84 THEN Inc(N);
END;
Sound(Freq[N]);
Lg := Round(StdLg / NotenLg);
IF (i < Length(Noten)) AND
(Noten[i+1] IN ['0'..'9'])
THEN BEGIN
Umwandlung(i, L);
IF L IN [1..64] THEN
Lg := Round(StdLg / L);
END;
IF (i < Length(Noten)) AND
(Noten[i+1] = '.') THEN BEGIN
j := 1;
P := Lg / 2;
WHILE (i + j <= Length(Noten)) AND
(Noten[i+j] = '.') DO BEGIN
Inc(j);
Lg := Round(Lg + P);
P := P / 2;
END;
i := i + j - 1;
END;
CASE SpielArt OF
Stakkato : BEGIN
BT := Round(LG / 4);
Delay(3 * BT);
NoSound;
Delay(BT);
END;
Normal : BEGIN
BT := Round(LG / 8);
Delay(7 * BT);
NoSound;
Delay(BT);
END;
Legato : Delay(Lg);
END;
END;
'O' : IF (i < Length(Noten)) AND
(Noten[i+1] in ['0'..'6']) THEN BEGIN
Oktave := Ord(Noten[i+1]) - 48;
Inc(i);
END;
'>' : IF Oktave < 6 THEN Oktave := Oktave + 1;
'<' : IF Oktave > 0 THEN Oktave := Oktave - 1;
'M' : IF (i < Length(Noten)) AND
(UpCase(Noten[i+1]) IN ['S','N','L'])
THEN BEGIN
CASE UpCase(Noten[i+1]) OF
'S' : SpielArt := Stakkato;
'N' : SpielArt := Normal;
'L' : SpielArt := Legato;
END;
i := i + 1;
END;
'P' : BEGIN
Lg := Round(StdLg / NotenLg);
IF (i < Length(Noten)) AND
(Noten[i+1] IN ['0'..'9'])
THEN BEGIN
Umwandlung(i, L);
IF L IN [1..64] THEN
Lg := Round(StdLg / L)
ELSE
IF L = 0 THEN Lg := 0;
END;
IF (i < Length(Noten)) AND
(Noten[i+1] = '.') THEN BEGIN
j := 1;
P := Lg / 2;
WHILE (i + j <= Length(Noten)) AND
(Noten[i+j] = '.') DO BEGIN
Inc(j);
Lg := Round(Lg + P);
P := P / 2;
END;
i := i + j - 1
END;
NoSound;
Delay(Lg);
END;
'L' : IF (i < Length(Noten)) AND
(Noten[i+1] in ['0'..'9']) THEN BEGIN
Umwandlung(i, L);
IF L IN [1..64] THEN NotenLg := L;
END;
'T' : IF (i < Length(Noten)) AND
(Noten[i+1] IN ['0'..'9']) THEN BEGIN
Umwandlung(i, L);
IF L IN [32..255] THEN BEGIN
Tempo := L;
StdLg := 60000.0 / Tempo * 4;
END;
END;
END;
END;
END;
BEGIN
Oktave := 4; Tempo := 120;
NotenLg := 4; SpielArt := Normal;
END.
(* ----------------------------------------------------- *)
(* Ende von MUSIC.PAS *)