home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 07 / tricks / music.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-04-06  |  6.9 KB  |  185 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   MUSIC.PAS                            *)
  3. (*        (c) 1990 Alexander Sunder & TOOLBOX             *)
  4. (* ------------------------------------------------------ *)
  5. UNIT Music;
  6.  
  7. INTERFACE
  8.  
  9. USES Crt;
  10.  
  11. TYPE
  12.   TSpielArt = (Stakkato, Normal, Legato);
  13.  
  14. VAR
  15.   SpielArt  : TSpielArt;
  16.   Oktave    : 0..6;
  17.   Tempo     : 32..255;
  18.   NotenLg   : 1..64;
  19.  
  20.   PROCEDURE Play(Noten : STRING);
  21.  
  22. IMPLEMENTATION
  23.  
  24.   PROCEDURE Play(Noten : STRING);
  25.   CONST
  26.     Freq : ARRAY[1..84] OF INTEGER = { 7 Oktaven }
  27.              (    65,   69,   73,   78,   82,   87,   92,
  28.                   98,  104,  110,  117,  123,  131,  139,
  29.                  147,  156,  165,  175,  185,  196,  208,
  30.                  220,  233,  247,  262,  277,  294,  311,
  31.                  330,  349,  370,  392,  414,  440,  466,
  32.                  494,  523,  554,  587,  622,  659,  698,
  33.                  740,  784,  831,  880,  932,  988, 1047,
  34.                 1109, 1175, 1245, 1319, 1397, 1480, 1568,
  35.                 1661, 1760, 1865, 1976, 2093, 2217, 2349,
  36.                 2489, 2637, 2794, 2960, 3136, 3322, 3520,
  37.                 3729, 3951, 4186, 4434, 4698, 4978, 5274,
  38.                 5588, 5920, 6272, 6644, 7040, 7458, 7902);
  39.  
  40.   VAR
  41.     i, j, N   : BYTE;
  42.     L, BT, Lg : INTEGER;
  43.     StdLg, P  : REAL;
  44.  
  45.     PROCEDURE Umwandlung(VAR i : BYTE; VAR L : INTEGER);
  46.     VAR
  47.       j : BYTE;
  48.     BEGIN
  49.       L := 0;  j := 1;
  50.       WHILE (i + j <= Length(Noten)) AND
  51.             (Noten[i+j] IN ['0'..'9']) DO BEGIN
  52.         L := L * 10 + Ord(Noten[i+j]) - 48;
  53.         Inc(j);
  54.       END;
  55.       i := i + j - 1;
  56.     END;
  57.     BEGIN
  58.       StdLg := 60000.0 / Tempo * 4;
  59.       i := 0;
  60.       WHILE i < Length(Noten) DO BEGIN
  61.         Inc(i);
  62.         CASE UpCase(Noten[i]) OF
  63.           'A'..'G': BEGIN
  64.                       N := Oktave * 12;
  65.                       CASE UpCase(Noten[i]) OF
  66.                         'C' : N := N +  1;
  67.                         'D' : N := N +  3;
  68.                         'E' : N := N +  5;
  69.                         'F' : N := N +  6;
  70.                         'G' : N := N +  8;
  71.                         'A' : N := N + 10;
  72.                         'B' : N := N + 12;
  73.                       END;
  74.                       IF (i < Length(Noten)) AND
  75.                          (Noten[i+1] IN ['+', '#', '-'])
  76.                          THEN BEGIN
  77.                         Inc(i);
  78.                         IF Noten[i] = '-' THEN
  79.                           IF N > 1 THEN Dec(N)
  80.                         ELSE
  81.                           IF N < 84 THEN Inc(N);
  82.                       END;
  83.                       Sound(Freq[N]);
  84.                       Lg := Round(StdLg / NotenLg);
  85.                       IF (i < Length(Noten)) AND
  86.                          (Noten[i+1] IN ['0'..'9'])
  87.                          THEN BEGIN
  88.                         Umwandlung(i, L);
  89.                         IF L IN [1..64] THEN
  90.                           Lg := Round(StdLg / L);
  91.                       END;
  92.                       IF (i < Length(Noten)) AND
  93.                          (Noten[i+1] = '.') THEN BEGIN
  94.                         j := 1;
  95.                         P := Lg / 2;
  96.                         WHILE (i + j <= Length(Noten)) AND
  97.                               (Noten[i+j] = '.') DO BEGIN
  98.                           Inc(j);
  99.                           Lg := Round(Lg + P);
  100.                           P  := P / 2;
  101.                         END;
  102.                         i := i + j - 1;
  103.                       END;
  104.                       CASE SpielArt OF
  105.                         Stakkato : BEGIN
  106.                                      BT := Round(LG / 4);
  107.                                      Delay(3 * BT);
  108.                                      NoSound;
  109.                                      Delay(BT);
  110.                                    END;
  111.                         Normal   : BEGIN
  112.                                      BT := Round(LG / 8);
  113.                                      Delay(7 * BT);
  114.                                      NoSound;
  115.                                      Delay(BT);
  116.                                    END;
  117.                         Legato   : Delay(Lg);
  118.                       END;
  119.                     END;
  120.           'O'     : IF (i < Length(Noten)) AND
  121.                        (Noten[i+1] in ['0'..'6']) THEN BEGIN
  122.                       Oktave := Ord(Noten[i+1]) - 48;
  123.                       Inc(i);
  124.                     END;
  125.           '>'     : IF Oktave < 6 THEN Oktave := Oktave + 1;
  126.           '<'     : IF Oktave > 0 THEN Oktave := Oktave - 1;
  127.           'M'     : IF (i < Length(Noten)) AND
  128.                        (UpCase(Noten[i+1]) IN ['S','N','L'])
  129.                        THEN BEGIN
  130.                       CASE UpCase(Noten[i+1]) OF
  131.                         'S' : SpielArt := Stakkato;
  132.                         'N' : SpielArt := Normal;
  133.                         'L' : SpielArt := Legato;
  134.                       END;
  135.                       i := i + 1;
  136.                     END;
  137.           'P'     : BEGIN
  138.                       Lg := Round(StdLg / NotenLg);
  139.                       IF (i < Length(Noten)) AND
  140.                          (Noten[i+1] IN ['0'..'9'])
  141.                          THEN BEGIN
  142.                         Umwandlung(i, L);
  143.                         IF L IN [1..64] THEN
  144.                           Lg := Round(StdLg / L)
  145.                         ELSE
  146.                           IF L = 0 THEN Lg := 0;
  147.                       END;
  148.                       IF (i < Length(Noten)) AND
  149.                          (Noten[i+1] = '.') THEN BEGIN
  150.                         j := 1;
  151.                         P := Lg / 2;
  152.                         WHILE (i + j <= Length(Noten)) AND
  153.                               (Noten[i+j] = '.') DO BEGIN
  154.                           Inc(j);
  155.                           Lg := Round(Lg + P);
  156.                           P := P / 2;
  157.                         END;
  158.                         i := i + j - 1
  159.                       END;
  160.                       NoSound;
  161.                       Delay(Lg);
  162.                     END;
  163.           'L'     : IF (i < Length(Noten)) AND
  164.                        (Noten[i+1] in ['0'..'9']) THEN BEGIN
  165.                       Umwandlung(i, L);
  166.                       IF L IN [1..64] THEN NotenLg := L;
  167.                     END;
  168.           'T'     : IF (i < Length(Noten)) AND
  169.                        (Noten[i+1] IN ['0'..'9']) THEN BEGIN
  170.                       Umwandlung(i, L);
  171.                       IF L IN [32..255] THEN BEGIN
  172.                         Tempo := L;
  173.                         StdLg := 60000.0 / Tempo * 4;
  174.                       END;
  175.                     END;
  176.         END;
  177.       END;
  178.     END;
  179.  
  180.  BEGIN
  181.    Oktave  := 4;  Tempo    := 120;
  182.    NotenLg := 4;  SpielArt := Normal;
  183.  END.
  184.  (* ----------------------------------------------------- *)
  185.  (*                Ende von MUSIC.PAS                     *)