'===========================================================================
' Subject: PLAY MUSICAL HELPER                Date: 07-17-96 (20:51)       
'  Author: John Fischer                       Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: SOUND.ABC
'===========================================================================
'  > paid any attention to the PLAY syntax.  Now I've been looking around
'  > and I find an alarming paucity of available programs written to show
'  > off the PLAY function, so I'm contributing this one as a public
'  > service: 

'I agree, and although sound cards are much better, PLAY *IS* a part of QB
'(either flavor).  Here's a hastily written (and I mean HASTY) chuck of code
'that anyone is welcome to PLAY with.  BASICally, it will give you a very
'generic menu and let you input play commands into a buffer (sort of) and
'then play them back for you, save them, etc..  I have NOT put an editor
'into it, and probably won't, since I was just wanting to get more familiar
'with PLAY.  One last thing, I forgot that the . (period) after a note DOES
'make it a dotted note, even though that is NOT in the help section,
'therefore, I did not code for it.  IF anyone plays with this and makes
'something of it, all I ask is for a copy it to poke around in.  The
'following is original and by posting it here I release it to the public
'domain. 

DECLARE FUNCTION Music$ (A$)
CLEAR
ON ERROR GOTO Ooops
IF COMMAND$ = "" THEN
     FileName$ = "MUSIC.SND"
     ELSE FileName$ = COMMAND$
END IF
OPEN FileName$ FOR OUTPUT AS #1
CONST F1 = 59, F2 = 60, F3 = 61, F4 = 62, F10 = 68
Null$ = CHR$(0)
Temp$ = "O3 L4 T120 MN "
L = 4: O = 3: T = 120: T$ = " 7/8"
TopMenu:
CLS : COLOR 11
PRINT , "Input Keys to Play", "F10 = Help/Other Keys"
PRINT : COLOR 15
PRINT , "A - G)  Corresponding Note"
PRINT , "+ / -)  PREVIOUS Note SHARP or FLAT"
PRINT , "L)  Set Length of NEXT Notes (1-64)"
PRINT , "N)  Play a Note by it's Number (0-84)"
PRINT , "O)  Set Octave of NEXT Notes (0-6)"
PRINT , "P)  Pause for n ¬ Notes"
PRINT , "T)  Set # of ¬ Notes/Minute (32-255)"
PRINT , "< or > DOWN or UP 1 Octave"
PRINT , "1, 3, 7) Each Note FULL, 3/4, 7/8"
PRINT : COLOR 13
PRINT , "F1)  Play Your Tune", "F3) List Your Tune"
PRINT , "F2)  Start Over", "F4) PRINT Your Tune"
PRINT : COLOR 12
PRINT , "ESC)  Save and End Program"
COLOR 14
LOCATE 5, 53: PRINT L
LOCATE 7, 53: PRINT O
LOCATE 9, 53: PRINT T
LOCATE 11, 53: PRINT T$
COLOR 7
GetChoice: CHOICE$ = INKEY$
SELECT CASE UCASE$(CHOICE$)
     CASE IS = "/"
          CLS : SHELL: GOTO TopMenu
     CASE IS = "*"
          CLS : SHELL "LIST": GOTO TopMenu
     CASE IS = "`"
          CLS : SHELL "MUSIC.BAT": GOTO TopMenu
     CASE IS = "1"
          Temp$ = Music$("ML")
          T$ = " Full ML"
          GOTO TopMenu
     CASE IS = "3"
          Temp$ = Music$("MS")
          T$ = " 3/4 MS"
          GOTO TopMenu
     CASE IS = "7"
          Temp$ = Music$("MN")
          T$ = " 7/8 MN"
          GOTO TopMenu
     CASE IS = "A"
          Temp$ = Music$("A")
     CASE IS = "B"
          Temp$ = Music$("B")
     CASE IS = "C"
          Temp$ = Music$("C")
     CASE IS = "D"
          Temp$ = Music$("D")
     CASE IS = "E"
          Temp$ = Music$("E")
     CASE IS = "F"
          Temp$ = Music$("F")
     CASE IS = "G"
          Temp$ = Music$("G")
     CASE IS = "<"
          Temp$ = Music$("<")
          O = O - 1
          IF O < 0 THEN O = 0
          IF O > 6 THEN O = 6
          GOTO TopMenu
     CASE IS = ","
          Temp$ = Music$("<")
          O = O - 1
          IF O < 0 THEN O = 0
          IF O > 6 THEN O = 6
          GOTO TopMenu
     CASE IS = ">"
          Temp$ = Music$(">")
          O = O + 1
          IF O < 0 THEN O = 0
          IF O > 6 THEN O = 6
          GOTO TopMenu
     CASE IS = "."
          Temp$ = Music$(">")
          O = O + 1
          IF O < 0 THEN O = 0
          IF O > 6 THEN O = 6
          GOTO TopMenu
     CASE IS = "+"
          Temp$ = Music$("+")
     CASE IS = "-"
          Temp$ = Music$("-")
     CASE IS = "L"
          LOCATE 18, 20: PRINT "Range: 1 - 64"
          LOCATE 19, 20: INPUT "Length"; A
          IF A < 1 OR A > 64 THEN A = 4
          L = A
          Temp$ = Music$("L" + RTRIM$(LTRIM$(STR$(A))))
          GOTO TopMenu
     CASE IS = "N"
          LOCATE 18, 20: PRINT "Range: 0 - 84"
          LOCATE 19, 20: INPUT "Note"; A
          IF A < 0 OR A > 84 THEN A = 4
          Temp$ = Music$("N" + RTRIM$(LTRIM$(STR$(A))))
          GOTO TopMenu
     CASE IS = "O"
          LOCATE 18, 20: PRINT "Range: 0 - 6"
          LOCATE 19, 20: INPUT "Octave"; A
          IF A < 0 OR A > 6 THEN A = 0
          O = A
          Temp$ = Music$("O" + RTRIM$(LTRIM$(STR$(A))))
          GOTO TopMenu
     CASE IS = "P"
          LOCATE 18, 20: PRINT "Range: 1 - 64"
          LOCATE 19, 20: INPUT "Pause Time"; A
          IF A < 1 OR A > 64 THEN A = 4
          Temp$ = Music$("P" + RTRIM$(LTRIM$(STR$(A))))
          GOTO TopMenu
     CASE IS = "T"
          LOCATE 18, 20: PRINT "Range: 32 - 255"
          LOCATE 19, 20: INPUT "¬ Notes/Minute"; A
          IF A < 32 OR A > 255 THEN A = 120
          T = A
          Temp$ = Music$("T" + RTRIM$(LTRIM$(STR$(A))))
          GOTO TopMenu
     CASE IS = Null$ + CHR$(F1)
          IF LEN(Temp$) > 0 THEN PRINT #1, Temp$
          Temp$ = "": CLOSE #1
          OPEN FileName$ FOR INPUT AS #1
          LOCATE 18
          DO UNTIL EOF(1)
               LINE INPUT #1, X$
               PRINT X$
               'PLAY "MB" + X$
               PLAY X$
          LOOP
          CLOSE #1
          OPEN FileName$ FOR APPEND AS #1
          COLOR 15
          PRINT : PRINT "Press the SPACEBAR to resume"
          COLOR 7
          SLEEP
          DO UNTIL INKEY$ = "": LOOP
          GOTO TopMenu
     CASE IS = Null$ + CHR$(F2)
          Temp$ = "O3 L4 T120 MN "
          CLOSE #1
          OPEN FileName$ FOR OUTPUT AS #1
          LOCATE 18, 20
          COLOR 15
          PRINT "All Music Cleared"
          COLOR 7
          SLEEP 1
          L = 4: O = 3: T = 120: T$ = " 7/8"
          GOTO TopMenu
     CASE IS = Null$ + CHR$(F3)
          IF LEN(Temp$) > 0 THEN PRINT #1, Temp$
          Temp$ = ""
          CLOSE #1
          OPEN FileName$ FOR INPUT AS #1
          LOCATE 18
          DO UNTIL EOF(1)
               LINE INPUT #1, X$
               PRINT X$
          LOOP
          CLOSE #1
          OPEN FileName$ FOR APPEND AS #1
          COLOR 15
          PRINT : PRINT "Press the SPACEBAR to resume"
          COLOR 7
          SLEEP
          DO UNTIL INKEY$ = "": LOOP
          GOTO TopMenu
     CASE IS = Null$ + CHR$(F4)
          IF LEN(Temp$) > 0 THEN PRINT #1, Temp$
          Temp$ = ""
          CLOSE #1
          OPEN FileName$ FOR INPUT AS #1
          OPEN "PRN" FOR OUTPUT AS #2
          DO
               LINE INPUT #1, X$
               PRINT #2, X$
          LOOP UNTIL EOF(1)
          PRINT #2, ""
          CLOSE #2
          CLOSE #1
          OPEN FileName$ FOR APPEND AS #1
          GOTO TopMenu
     CASE IS = Null$ + CHR$(F10)
          CLS
          COLOR 14
          PRINT
          PRINT , "T20  = 1/2 time", "T40 = 2/2 time"
          PRINT , "T80  = 2/4 time", "T120 = 3/4 time"
          PRINT , "T160 = 4/4 time", "T240 = 6/8 time"
          PRINT
          PRINT , "L1 = Whole Note", "L2 = Half Note"
          PRINT , "L4 = Quarter Note", "L8 = Eighth Note"
          PRINT , "L16 = Sixteenth Note", "L32 = Thirty-Second Note"
          PRINT
          PRINT , "Octave: Higher the number, higher the pitch"
          PRINT
          COLOR 3
          PRINT , "Other MAIN MENU Commands Available"
          PRINT , "` Run file MUSIC.BAT if it exists"
          PRINT , "~ create MUSIC_QB.BAS (PLAYable)"
          PRINT , "* Run LIST"
          PRINT , "/ DOS Shell"
          COLOR 15
          PRINT : PRINT , "Press the SPACEBAR to continue"
          COLOR 7
          SLEEP
          DO UNTIL INKEY$ = "": LOOP
          CLS
          COLOR 14
          PRINT , "Central Octave Chart"
          COLOR 2
          PRINT
          PRINT , "                     B"
          PRINT , "                  ÄÄ A ÄÄ"
          PRINT , "                     G"
          PRINT , "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ F ÄÄÄÄÄÄÄ   Octave #4"
          PRINT , "                     E"
          PRINT , "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ D ÄÄÄÄÄÄÄ"
          PRINT , "                     C"
          COLOR 10
          PRINT , "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ B ÄÄÄÄÄÄÄÄÄÄÄÄ"
          PRINT , "                A"
          PRINT , "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ G ÄÄÄÄÄÄÄÄÄÄÄÄ"
          PRINT , "                F                Octave #3"
          PRINT , "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ E ÄÄÄÄÄÄÄÄÄÄÄÄ   (Default)"
          PRINT , "                D"
          PRINT , "             ÄÄ C ÄÄ"
          COLOR 15
          PRINT : PRINT , "You MUST shift octaves to use the entire scale"
          PRINT : PRINT , "Press the SPACEBAR to continue"
          COLOR 7
          SLEEP
          DO UNTIL INKEY$ = "": LOOP
          GOTO TopMenu
     CASE IS = CHR$(27)
          PRINT #1, Temp$
          CLOSE #1
          LOCATE 22
          END
     CASE IS = "~"
          PRINT #1, Temp$: Temp$ = ""
          CLOSE #1
          OPEN FileName$ FOR INPUT AS #1
          OPEN "MUSIC_QB.BAS" FOR OUTPUT AS #2
          PRINT #2, "CLS : CLEAR"
          PRINT #2, "PLAY " + CHR$(34) + "MB" + CHR$(34)
          PRINT #2, "'The Above line switches to BACKGROUND playing"
          DO UNTIL EOF(1)
               LINE INPUT #1, Bas$
               IF Bas$ <> "" THEN
                    Bas1$ = "PRINT " + CHR$(34) + Bas$ + CHR$(34)
                    Bas2$ = "PLAY " + CHR$(34) + Bas$ + CHR$(34)
                    PRINT #2, Bas1$
                    PRINT #2, Bas2$
               END IF
          LOOP
          PRINT #2, "PLAY " + CHR$(34) + "MF" + CHR$(34)
          PRINT #2, "'The Above line switches back to FOREGROUND playing"
          PRINT #2, "END"
          CLOSE #2
          CLOSE #1
          OPEN FileName$ FOR APPEND AS #1
     CASE ELSE
          GOTO GetChoice
END SELECT
GOTO GetChoice
LOCATE 22
END
Ooops:
COLOR 7
CLS
CLOSE
OPEN "MUSIC.ERR" FOR APPEND AS #1
PRINT #1, TIME$, DATE$, ERR
CLOSE #1
PRINT : PRINT "An error has occured: #"; ERR
PRINT "See file MUSIC.ERR for QB4.5 error number"
END

FUNCTION Music$ (Add$)
SHARED Temp$
Kill$ = "ABCDEFG"
IF INSTR(Kill$, Add$) > 0 THEN
     Temp$ = Temp$ + Add$
     ELSE Temp$ = Temp$ + Add$
          IF LEN(Temp$) >= 50 THEN PRINT #1, Temp$: Temp$ = ""
END IF
Music$ = Temp$
END FUNCTION