home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / basic / baswiz / bw$bas / qtplay.bas < prev    next >
Encoding:
BASIC Source File  |  1993-07-05  |  7.4 KB  |  205 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        BASWIZ  Copyright (c) 1990-1993  Thomas G. Hanlin III         |
  4. '   |                                                                      |
  5. '   |                      The BASIC Wizard's Library                      |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9.    '--- external routines from BasWiz
  10.    DECLARE FUNCTION SHRI% (BYVAL Value%, BYVAL Bits%)
  11.    DECLARE FUNCTION VALI% (St$)
  12.    DECLARE SUB QTSound (BYVAL Freq%, BYVAL Millisec%)
  13.  
  14.  
  15.    '--- internal routines to save/restore module-level globals
  16.    DECLARE SUB QTPlay00 (BYVAL Octave%, BYVAL NoteLen%, BYVAL Tempo%, BYVAL SoundLen%, BYVAL TmpNoteLen%, BaseTime&)
  17.    DECLARE SUB QTPlay01 (Octave%, NoteLen%, Tempo%, SoundLen%, TmpNoteLen%, BaseTime&)
  18.  
  19.  
  20.  
  21. SUB GetNum (St$, Nr%, ErrCode%)        ' grab a number from the music string
  22.    NumLen% = 0
  23.    FOR tmp% = 1 TO LEN(St$)
  24.       ch% = ASC(MID$(St$, tmp%, 1)) - 48
  25.       IF ch% >= 0 AND ch% <= 9 THEN
  26.          NumLen% = NumLen% + 1
  27.       ELSE
  28.          EXIT FOR
  29.       END IF
  30.    NEXT
  31.    IF NumLen% = 0 OR NumLen% > 3 THEN
  32.       ErrCode% = -1
  33.    ELSE
  34.       ErrCode% = 0
  35.       Nr% = VALI%(LEFT$(St$, NumLen%))
  36.    END IF
  37.    St$ = MID$(St$, NumLen% + 1)
  38. END SUB
  39.  
  40.  
  41.  
  42. SUB QTPlay (SoundSt$)                  ' play music in the foreground
  43.  
  44.    Sounds$ = UCASE$(SoundSt$)
  45.  
  46.    REDIM BaseOctave%(0 TO 11)
  47.    BaseOctave%(0)  = 18357        ' C
  48.    BaseOctave%(1)  = 17292        ' C# or D-
  49.    BaseOctave%(2)  = 16124        ' D
  50.    BaseOctave%(3)  = 15297        ' D# or E-
  51.    BaseOctave%(4)  = 14551        ' E
  52.    BaseOctave%(5)  = 13715        ' F
  53.    BaseOctave%(6)  = 12830        ' F# or G-
  54.    BaseOctave%(7)  = 12175        ' G
  55.    BaseOctave%(8)  = 11473        ' G#
  56.    BaseOctave%(9)  = 10847        ' A
  57.    BaseOctave%(10) = 10286        ' A# or B-
  58.    BaseOctave%(11) = 9623         ' B
  59.  
  60.    QTPlay01 Octave%, NoteLen%, Tempo%, SoundLen%, TmpNoteLen%, BaseTime&
  61.  
  62.    DO                                            ' remove spaces
  63.       Posn% = INSTR(Sounds$, " ")
  64.       IF Posn% > 0 THEN
  65.          Sounds$ = LEFT$(Sounds$, Posn% - 1) + MID$(Sounds$, Posn% + 1)
  66.       END IF
  67.    LOOP WHILE Posn%
  68.  
  69.    DO WHILE LEN(Sounds$)                         ' process music commands
  70.       Ch$ = LEFT$(Sounds$, 1)
  71.       Sounds$ = MID$(Sounds$, 2)
  72.       SELECT CASE Ch$
  73.          CASE "<"
  74.             IF Octave% > 1 THEN Octave% = Octave% - 1
  75.          CASE ">"
  76.             IF Octave% < 6 THEN Octave% = Octave% + 1
  77.          CASE "A" TO "G"
  78.             NotePos% = ASC(MID$("JLACEFH", ASC(Ch$) - 64, 1)) - 65
  79.             IF LEN(Sounds$) THEN
  80.                NoteInfo$ = ""
  81.                ch% = ASC(Sounds$)
  82.                Sounds$ = MID$(Sounds$, 2)
  83.                IF ch% = 45 THEN    ' -
  84.                   IF NotePos% = 2 OR NotePos% = 4 OR NotePos% = 7 OR NotePos% = 9 OR NotePos% = 11 THEN
  85.                      NotePos% = NotePos% - 1
  86.                   END IF
  87.                   IF LEN(Sounds$) THEN
  88.                      tch% = ASC(Sounds$)
  89.                      IF tch% = 46 OR tch% >= 48 AND tch% <= 57 THEN
  90.                         ch% = tch%
  91.                         Sounds$ = MID$(Sounds$, 2)
  92.                      END IF
  93.                   END IF
  94.                ELSEIF ch% = 43 OR ch% = 35 THEN   ' + or #
  95.                   IF NotePos% = 0 OR NotePos% = 2 OR NotePos% = 5 OR NotePos% = 7 OR NotePos% = 9 THEN
  96.                      NotePos% = NotePos% + 1
  97.                   END IF
  98.                   IF LEN(Sounds$) THEN
  99.                      tch% = ASC(Sounds$)
  100.                      IF tch% = 46 OR tch% >= 48 AND tch% <= 57 THEN
  101.                         ch% = tch%
  102.                         Sounds$ = MID$(Sounds$, 2)
  103.                      END IF
  104.                   END IF
  105.                ELSEIF ch% <> 43 AND (ch% < 48 OR ch% > 57) THEN
  106.                   Sounds$ = CHR$(ch%) + Sounds$
  107.                END IF
  108.                IF ch% = 43 OR ch% >= 48 AND ch% <= 57 THEN
  109.                   NoteInfo$ = NoteInfo$ + CHR$(ch%)
  110.                   DO WHILE LEN(Sounds$) > 0 AND INSTR("0123456789.", LEFT$(Sounds$, 1)) > 0
  111.                      NoteInfo$ = NoteInfo$ + LEFT$(Sounds$, 1)
  112.                      Sounds$ = MID$(Sounds$, 2)
  113.                   LOOP
  114.                   IF TmpNoteLen% = 0 THEN TmpNoteLen% = NoteLen%
  115.                   DotLen& = BaseTime&
  116.                   DO WHILE INSTR(NoteInfo$, ".")
  117.                      DotLen& = DotLen& \ 2&
  118.                      BaseTime& = BaseTime& + DotLen&
  119.                      tmp% = INSTR(NoteInfo$, ".")
  120.                      NoteInfo$ = LEFT$(NoteInfo$, tmp% - 1) + MID$(NoteInfo$, tmp% + 1)
  121.                   LOOP
  122.                   IF LEN(NoteInfo$) > 0 AND LEN(NoteInfo$) < 3 THEN
  123.                      SpecialLen% = VALI%(NoteInfo$)
  124.                      IF SpecialLen% > 0 AND SpecialLen% < 65 THEN
  125.                         TmpNoteLen% = SpecialLen%
  126.                      END IF
  127.                   END IF
  128.                END IF
  129.             END IF
  130.             Freq% = SHRI%(BaseOctave%(NotePos%), Octave%)
  131.             GOSUB PlayNote
  132.          CASE "L"
  133.             GetNum Sounds$, Nr%, ErrCode%
  134.             IF NOT ErrCode% AND (Nr% > 0 AND Nr% < 65) THEN NoteLen% = Nr%
  135.          CASE "M"
  136.             IF LEN(Sounds$) THEN
  137.                SELECT CASE LEFT$(Sounds$, 1)
  138.                   CASE "L": SoundLen% = 8   ' legato
  139.                   CASE "N": SoundLen% = 7   ' normal
  140.                   CASE "S": SoundLen% = 6   ' staccato
  141.                   CASE ELSE  ' either MF (default) or MB (not supported)
  142.                END SELECT
  143.                Sounds$ = MID$(Sounds$, 2)
  144.             END IF
  145.          CASE "N"
  146.             GetNum Sounds$, Nr%, ErrCode%
  147.             IF NOT ErrCode% AND (Nr% >= 0 AND Nr% <= 84) THEN
  148.                IF Nr% THEN
  149.                   Nr% = Nr% - 1
  150.                   Freq% = SHRI%(BaseOctave%(Nr% MOD 12), Nr% \ 12)
  151.                ELSE
  152.                   Freq% = Nr%
  153.                END IF
  154.                GOSUB PlayNote
  155.             END IF
  156.          CASE "O"
  157.             GetNum Sounds$, Nr%, ErrCode%
  158.             IF NOT ErrCode% AND (Nr% >= 0 AND Nr% <= 6) THEN Octave% = Nr%
  159.          CASE "P"
  160.             GetNum Sounds$, Nr%, ErrCode%
  161.             IF NOT ErrCode% AND (Nr% > 0 AND Nr% < 65) THEN
  162.                TmpNoteLen% = Nr%
  163.                Freq% = 0
  164.                GOSUB PlayNote
  165.             END IF
  166.          CASE "T"
  167.             GetNum Sounds$, Nr%, ErrCode%
  168.             IF NOT ErrCode% AND (Nr% >= 32 AND Nr% <= 255) THEN Tempo% = Nr%
  169.       END SELECT
  170.    LOOP
  171.  
  172.    QTPlay00 Octave%, NoteLen%, Tempo%, SoundLen%, TmpNoteLen%, BaseTime&
  173.  
  174.    EXIT SUB
  175.  
  176.  
  177.  
  178. PlayNote:          ' play the note defined by Freq%
  179.    IF TmpNoteLen% = 0 THEN TmpNoteLen% = NoteLen%
  180.    NoteTime% = BaseTime& \ CLNG(Tempo% * TmpNoteLen%)
  181.    IF Freq% > 0 THEN
  182.       QTSound CINT(1193180 \ CLNG(Freq%)), SoundLen% * NoteTime%
  183.    ELSE
  184.       QTSound 0, SoundLen% * NoteTime%
  185.    END IF
  186.    QTSound 0, (8 - SoundLen%) * NoteTime%
  187.    TmpNoteLen% = 0
  188.    BaseTime& = 30600
  189.    RETURN
  190.  
  191. END SUB
  192.  
  193.  
  194.  
  195.  
  196. SUB QTInitPlay               ' reset defaults to original values
  197.    Octave% = 4
  198.    NoteLen% = 4
  199.    Tempo% = 120
  200.    SoundLen% = 7
  201.    TmpNoteLen% = 0
  202.    BaseTime& = 30600
  203.    QTPlay00 Octave%, NoteLen%, Tempo%, SoundLen%, TmpNoteLen%, BaseTime&
  204. END SUB
  205.