The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 

 Return to Index  

Version that interrupts music

April 20 2007 at 4:08 PM
  (Premier Login iorr5t)
Forum Owner


Response to Some music by Ahn

 
DECLARE FUNCTION GotIt% (w$)
DECLARE SUB INTRODUCTION ()
DIM i AS INTEGER, j AS INTEGER, k AS INTEGER

DIM d(6, 3) AS STRING: GOSUB BuildD
DIM q(6) AS INTEGER

ON ERROR GOTO Ignore

ON PLAY(1) GOSUB MusicBOX
DIM SHARED Music AS STRING
DIM SHARED Interrupt AS STRING
DIM SHARED Work1 AS STRING

DIM Song AS INTEGER
DO
  GOSUB BuildQ
  FOR Song = 1 TO 6
    CALL INTRODUCTION
    GOSUB PlaySong
    PRINT R$: PRINT
    INPUT "Will now play a different song. Proceed"; z$
    IF NOT LEFT$(UCASE$(z$), 1) = "Y" THEN EXIT DO
  NEXT Song
LOOP
SYSTEM

Ignore:
Interrupt = CHR$(0)
RESUME NEXT

MusicBOX:
Interrupt = INKEY$: IF Interrupt <> "" THEN RETURN
GOSUB GetP: IF p$ = "" THEN Interrupt = CHR$(0): RETURN
Work1 = p$
DO WHILE INSTR(p$, "L") = 0
  GOSUB GetP
  Work1 = Work1 + p$
  IF p$ = "" THEN p$ = "L"
LOOP
PLAY Work1
RETURN

GetP:
SELECT CASE LEN(Music)
CASE IS < 15: p$ = Music: Music = ""
CASE ELSE:
  y = INSTR(5, Music, "L")
  IF y = 0 THEN
     p$ = Music: Music = ""
  ELSE
    p$ = LEFT$(Music, y - 1)
    Music = RIGHT$(Music, LEN(Music) - y + 1)
  END IF
END SELECT
RETURN

PlaySong:
R$ = "**You Are Correct**"
Music = d(q(Song), 2): GOSUB DoIt
IF GotIt(d(q(Song), 1)) THEN RETURN
PRINT "**Sorry Try Again**": PRINT
Music = d(q(Song), 2) + d(q(Song), 3): GOSUB DoIt
IF GotIt(d(q(Song), 1)) THEN RETURN
R$ = "**You Are Incorrect**"
RETURN

DoIt:
Music = UCASE$(Music)
y = INSTR(Music, "LL")
WHILE y > 0: MID$(Music, y, 1) = "lL": y = INSTR(Music, "LL"): WEND

PLAY ON
LOCATE , , 1: PRINT "Press key when ready to answer: ";
Interrupt = "": GOSUB MusicBOX: WHILE Interrupt = "": WEND
PLAY OFF
RETURN

BuildQ:
FOR i = 1 TO 6: q(i) = i: NEXT i
RANDOMIZE TIMER
DO
  FOR i = 1 TO 6
    j = 1 + INT(RND * 6)
    IF i <> j THEN SWAP q(i), q(j): k = k + 1
  NEXT i
LOOP WHILE k < 20
RETURN

BuildD:
d(1, 1) = "FUNERAL MARCH"
d(1, 2) = "MNT100L4O1AL8A.L16AL4AL8>C.L16<BL8"
d(1, 3) = "B.L16AL8A.L16AL2AL4>CL8C.L16CL4CL8E.L16DL8D.L16CL8C.L16CL2C"
d(2, 1) = "WEDDING MARCH"
d(2, 2) = "t100o2mnl4g> l8cp16l16c l2c<l4g> l8d<p16l16b> "
d(2, 3) = "l2c <l4g> l8cp16l16f l4fl8ep16l16d l4c<l8bp16l16>cl2d<l4g>l8cp16l16cl2c<l4g>l8dp16l16<b>l2c<l4g>l8cp16l16e l4gl8ep16l16c<l4a> l8dp16l16el2c"
d(3, 1) = "YANKEE DOODLE"
d(3, 2) = "MNT255L4O2GGABGBAD"
d(3, 3) = "GGABL2GF+L4GGAB>C<BAGF+DEF+L2GL4G P4L4EF+EDEF+L2GL4DEDC<L2B>L2DL4EF+EDEF+GEDGF+AL2GL4G"
d(4, 1) = "JINGLE BELLS"
d(4, 2) = "t200l4o2mn eel2el4eel2el4eg"
d(4, 3) = " l3cl8dl1e l4ffl3fl8fl4fel2el8eel4eddel2dgl4eel2el4eel2el4egl3cl8dl1el4ffl3fl8fl4fel2el8efl4ggfdl2c"
d(5, 1) = "MACARENA"
d(5, 2) = "MNT180L4O2CL8CCL4CL8CCCCCCCE<GGL4>C"
d(5, 3) = "L8CCL4CL8CCCCCCL4<A G>CL8CCL4CL8CCCCCCL4EGL2GL8EP8GEP4L2C"
d(6, 1) = "TAKE ME OUT TO THE BALL GAME"
d(6, 2) = "mnt200l4o1cp4>c<agemll2gl4gmnmll2dl4d"
d(6, 3) = "mnl4cp4>c<agemll2gggmnl4ag+aefgl2al4fmll2dl4dmnl2al4aab>cd<bagedcp4>c<agemll2gl4gmnl2dl4dl2cl4defgmll2aamnl4ab>cp4p4cp4p4c<bagf+gmll2al4al2bl4b>l2cc"
RETURN

FUNCTION GotIt% (w$)
LOCATE , , 1: PRINT SPACE$(70);
WHILE INKEY$ <> "": WEND
PRINT : LINE INPUT "Name That Tune: "; c$: c$ = UCASE$(c$)
FOR i = 1 TO LEN(c$)
  j = INSTR(w$, MID$(c$, i, 1))
  IF j = 0 THEN
    cntb = cntb + 1
  ELSE
    MID$(c$, i, 1) = CHR$(0)
    cntg = cntg + 1
  END IF
NEXT i
IF cntb > 2 OR cntg + 3 < LEN(w$) THEN EXIT FUNCTION
GotIt% = -1
END FUNCTION

SUB INTRODUCTION
CLS
PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
PRINT " º NAME THAT TUNE º"
PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
PRINT
PRINT
PRINT "TRY GUESSING THE TUNE THAT IS PLAYING."
PRINT "YOU GET ONLY 2 GUESSES. GOOD LUCK!"
PRINT
END SUB


 
 Respond to this message   
Response TitleAuthor and Date
*First rate job, Mac! (View Thread) on Apr 20
   Cleaner Version on Apr 21
      Notes on interrupting PLAY on Apr 21
         Better still... on Apr 21
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums