home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib41b.dsk / EAR.TRAINING.bas < prev    next >
BASIC Source File  |  2023-02-26  |  8KB  |  181 lines
  1. 10  REM  *************************
  2. 20  REM  * INTERVAL EAR TRAINING *
  3. 30  REM  *  by Douglas Florzak   *
  4. 40  REM  *                       *
  5. 50  REM  *  Copyright (C) 1991   *
  6. 60  REM  * MindCraft Publ. Corp. *
  7. 70  REM  *  Lincoln, MA  01773   *
  8. 80  REM  *************************
  9. 90  REM  Modified by Stavros Karatsoridis, December 1991
  10. 100  ONERR  GOTO 1760
  11. 110 SL% = 13:MI% = 5: PRINT  CHR$(21)
  12. 120  DIM T1(12),T3$(12),X$(1),SL(SL%),MITEMS(MI%)
  13. 130  HOME : VTAB 7: HTAB 10: INVERSE : PRINT "INTERVAL EAR TRAINING": NORMAL : VTAB 9: HTAB 11: PRINT "by: Douglas Florzak": VTAB 15: HTAB 10: PRINT "Copyright (C) 1991 by": HTAB 8: PRINT "MindCraft Publishing Corp."
  14. 140  PRINT  CHR$(4);"BLOAD NOTEPLAY": GOSUB 910
  15. 150 X$(0) = "   ":X$(1) = "-->"
  16. 160  GOSUB 1190
  17. 170  REM 
  18. 180  REM  ** MAIN MENU IS HANDLED HERE **
  19. 190  REM 
  20. 200 TL = 1:DD = 2: GOSUB 1260
  21. 210 PX = 38:SX = 4:SL(TL) = SL(TL) +(SL(TL) = 0):MX = MITEMS(TL): GOSUB 1530: IF Z = 20  THEN  PRINT  CHR$(7);: GOTO 210
  22. 220  ON SL(TL) GOSUB 470,320,270
  23. 230  GOTO 200
  24. 240  REM 
  25. 250  REM  ** QUIT SCREEN **
  26. 260  REM 
  27. 270  HOME : VTAB 8: INPUT "Are you sure you want to quit? (Y/N): ";YN$: ON YN$ = "Y"  OR YN$ =  CHR$(121) GOTO 280: RETURN 
  28. 280  END 
  29. 290  REM 
  30. 300  REM  ** TEST MENU IS HANDLED HERE **
  31. 310  REM 
  32. 320 EV = 10:R = 0:W = 0
  33. 330  FOR K = 1 TO EV
  34. 340 TL = 2:HM = 1:DD = 1: GOSUB 1260: GOSUB 920
  35. 350  IF Z$ =  CHR$(27)  THEN  RETURN 
  36. 360 A1 =  INT( RND(1) *12 +1)
  37. 370  GOSUB 970:PI = T1(A1): GOSUB 1010: VTAB 24: HTAB 1: CALL  -868: GOSUB 1320
  38. 380 PX = 38:SX = 4:SL(TL) = SL(TL) +(SL(TL) = 0):MX = MITEMS(TL): GOSUB 1360: IF Z = 20  THEN  RETURN 
  39. 390  IF SL(TL) = 13  THEN  GOTO 370
  40. 400  GOSUB 600
  41. 410  NEXT K
  42. 420  GOSUB 1080
  43. 430  RETURN 
  44. 440  REM 
  45. 450  REM  ** PRACTICE MENU IS HANDLED HERE **
  46. 460  REM 
  47. 470 TL = 3:HM = 1:DD = 2: GOSUB 1260
  48. 480  FOR K = 1 TO 12
  49. 490  GOSUB 1320:PX = 38:SX = 4:SL(TL) = SL(TL) +(SL(TL) = 0):MX = MITEMS(TL): GOSUB 1530: IF Z = 20  THEN  RETURN 
  50. 500  VTAB 24: HTAB 1: CALL  -868
  51. 510  IF SL(TL) = 2  AND K = 1  THEN  GOSUB 810: GOTO 490
  52. 520  IF SL(TL) = 2  THEN K = K -1: GOSUB 810:K = K +1: GOTO 490
  53. 530  GOSUB 810
  54. 540  NEXT K
  55. 550  GOSUB 910
  56. 560  RETURN 
  57. 570  REM 
  58. 580  REM  ** FEEDBACK SCREEN **
  59. 590  REM 
  60. 600  HOME 
  61. 610  IF A1 = SL(TL)  THEN R = R +1: GOTO 720
  62. 620 W = W +1
  63. 630  VTAB 2: HTAB 15: INVERSE : PRINT "INCORRECT!": NORMAL : GOSUB 970
  64. 640  PRINT : PRINT : HTAB 11: PRINT "The correct answer was:": GOSUB 970
  65. 650 PI = T1(A1): GOSUB 1010
  66. 660  PRINT : HTAB 11: PRINT "<";A1;">"; SPC( 2);MENU$(TL,A1)
  67. 670  GOSUB 970
  68. 680  PRINT : PRINT : HTAB 16: PRINT "You chose:": GOSUB 970
  69. 690 PI = T1(SL(TL)): GOSUB 1010
  70. 700  PRINT : HTAB 11: PRINT "<";SL(TL);">"; SPC( 2);MENU$(TL,SL(TL))
  71. 710  GOTO 760
  72. 720  VTAB 2: HTAB 15: INVERSE : PRINT "CORRECT!": NORMAL : GOSUB 970
  73. 730  PRINT : PRINT : HTAB 11: PRINT "The answer was:": GOSUB 970
  74. 740 PI = T1(SL(TL)): GOSUB 1010
  75. 750  PRINT : HTAB 11: PRINT "<";A1;">"; SPC( 2);MENU$(TL,A1)
  76. 760  GOSUB 910
  77. 770  RETURN 
  78. 780  REM 
  79. 790  REM  ** PRACTICE ROUTINE **
  80. 800  REM 
  81. 810 VM = 11: VTAB VM: HTAB 1: PRINT "---------------------------------------"
  82. 820  VTAB VM +2: CALL  -868: PRINT "Interval #";K;": ";
  83. 830  CALL  -868: PRINT MENU$(2,K)
  84. 840  VTAB VM +6: PRINT "Sounds": PRINT "Like: ";
  85. 850 PI = T1(K): GOSUB 1010
  86. 860  CALL  -868: PRINT T3$(K)
  87. 870  RETURN 
  88. 880  REM 
  89. 890  REM  ** 'PRESS RETURN' MESSAGE **
  90. 900  REM 
  91. 910  VTAB 24: HTAB 8: PRINT "Press <Return> to Continue ";: GET Z$: RETURN 
  92. 920  VTAB 24: HTAB 1: PRINT "Press <Return> to Play Random Interval ";: GET Z$: RETURN 
  93. 930  VTAB 24: HTAB 1: PRINT " Enter 2nd digit or press <Return>:  ";: RETURN 
  94. 940  REM 
  95. 950  REM  ** TIME DELAY ROUTINE **
  96. 960  REM 
  97. 970  FOR I = 1 TO 1500: NEXT : RETURN 
  98. 980  REM 
  99. 990  REM  ** CALL NOTEPLAY ROUTINE **
  100. 1000  REM 
  101. 1010  POKE 817,195: CALL 768: REM  PLAY 1ST NOTE
  102. 1020  POKE 817,00: CALL 768: REM  PLAY REST
  103. 1030  POKE 817,PI: CALL 768: REM  PLAY INTERVAL NOTE
  104. 1040  RETURN 
  105. 1050  REM 
  106. 1060  REM  ** STATISTICS SCREEN **
  107. 1070  REM 
  108. 1080  HOME :RP = (R/EV) *100:WP = (W/EV) *100
  109. 1090 LM = 10
  110. 1100  VTAB 2: HTAB 10: PRINT "Interval Ear Training"
  111. 1110  VTAB 4: HTAB 15: PRINT "Test Score"
  112. 1120  VTAB 7: HTAB LM: PRINT "Correct: ";R; SPC( 5); INT(RP);"%"
  113. 1130  VTAB 9: HTAB LM: PRINT "Wrong:   ";W; SPC( 5); INT(WP);"%"
  114. 1140  GOSUB 910
  115. 1150  RETURN 
  116. 1160  REM 
  117. 1170  REM  ** LOAD TONE VALUES, SONG NAMES AND MENU TABLES **
  118. 1180  REM 
  119. 1190  RESTORE : FOR I = 1 TO 12: READ T1(I): NEXT 
  120. 1200  FOR I = 1 TO 12: READ T3$(I): NEXT 
  121. 1210  READ NMENUS: DIM MENU$(NMENUS,SL%): FOR I = 1 TO NMENUS: READ MITEMS(I): FOR J = 0 TO MITEMS(I): READ MENU$(I,J): NEXT J,I
  122. 1220  RETURN 
  123. 1230  REM 
  124. 1240  REM  ** DISPLAY MENU ROUTINE **
  125. 1250  REM 
  126. 1260  HOME : IF TL < >1  THEN  PRINT "<";: INVERSE : PRINT "ESC";: NORMAL : PRINT "> - "MENU$(HM,0)
  127. 1270 TL$ = MENU$(TL,0): VTAB 3: HTAB  INT((40 - LEN(TL$))/2)
  128. 1280  INVERSE : PRINT TL$: NORMAL 
  129. 1290  FOR I = 1 TO MITEMS(TL): VTAB 4 +DD *I: HTAB 8: PRINT I". ";
  130. 1300  IF I <10  THEN  PRINT " ";
  131. 1310  PRINT MENU$(TL,I): NEXT 
  132. 1320  VTAB 24: HTAB 1: PRINT "Use number/arrows & press <Return>: ";: RETURN 
  133. 1330  REM 
  134. 1340  REM  ** MENU HANDLING ROUTINE FOR MENUS WITH > 9 ITEMS **
  135. 1350  REM 
  136. 1360 SL = SL(TL)
  137. 1370 N = SL:OS = SL: GOSUB 1580:Z = 0:ZZ = 0:ST = 1: VTAB 24: HTAB PX: CALL  -868: POKE  -16368,0
  138. 1380  VTAB 24: HTAB PX: PRINT SL;: WAIT  -16384,128:Z =  PEEK( -16384) -128
  139. 1390  IF Z <49  OR Z >MX +48  THEN  GOTO 1480
  140. 1400 ST = SL:SL = Z -48:N = OS: GOSUB 930
  141. 1410  VTAB 24: HTAB PX: PRINT SL;: CALL  -868: POKE  -16368,0: WAIT  -16384,128:ZZ =  PEEK( -16384) -128
  142. 1420  IF Z = 49  AND SL = 1  THEN SL = 0:N = OS: GOSUB 1580:SL = 1: GOTO 1440
  143. 1430  GOSUB 1580
  144. 1440  GOSUB 1320
  145. 1450  IF ZZ <48  OR ZZ >MX +48  THEN  GOTO 1370
  146. 1460  IF (ZZ -48) +((Z -48) *10) >MX  THEN SL = ST: GOTO 1370
  147. 1470 SL = (ZZ -48) +((Z -48) *10): GOTO 1370
  148. 1480 Z = (Z = 21  OR Z = 10) -(Z = 8  OR Z = 11) +10 *(Z = 13) +20 *(Z = 27)
  149. 1490  ON   NOT Z GOTO 1380:SL = SL +Z *(Z <10):SL = SL -MX *(SL >MX) +MX *(SL <1):N = OS: GOSUB 1580: ON Z <10 GOTO 1370:SL(TL) = SL: POKE  -16368,0: RETURN 
  150. 1500  REM 
  151. 1510  REM  ** MENU HANDLING ROUTINE FOR MENUS WITH < 10 ITEMS **
  152. 1520  REM 
  153. 1530 SL = SL(TL)
  154. 1540 N = SL:OS = SL: GOSUB 1580:Z = 0: VTAB 24: HTAB PX: CALL  -868: POKE  -16368,0
  155. 1550  VTAB 24: HTAB PX: PRINT SL;: WAIT  -16384,128:Z =  PEEK( -16384) -128: IF Z > = 49  AND Z < = MX +48  THEN SL = Z -48:N = OS: GOSUB 1580: GOTO 1540
  156. 1560 Z = (Z = 21  OR Z = 10) -(Z = 8  OR Z = 11) +10 *(Z = 13) +20 *(Z = 27)
  157. 1570  ON   NOT Z GOTO 1540:SL = SL +Z *(Z <10):SL = SL -MX *(SL >MX) +MX *(SL <1):N = OS: GOSUB 1580: ON Z <10 GOTO 1540:SL(TL) = SL: POKE  -16368,0: RETURN 
  158. 1580  VTAB 4 +DD *N: HTAB SX: PRINT X$(SL = OS);: RETURN 
  159. 1590  REM 
  160. 1600  REM  ** DATA STATEMENTS **
  161. 1610  REM 
  162. 1620  DATA  184,174,164,155,146,138,130,123,116,110,103,98
  163. 1630  DATA  <unknown>,"Do, Re, Me, Fa",Greensleeves,Michael Row the Boat
  164. 1640  DATA  Here Comes the Bride,Maria
  165. 1650  DATA  "Twinkle, Twinkle Little Star",Love Story,My Bonnie Lies Over the Ocean
  166. 1660  DATA  There's a Place for Us,<unknown>,Somewhere Over the Rainbow
  167. 1670  DATA  3,3,"INTERVAL EAR TRAINING: MAIN MENU",Practice,Test,Quit
  168. 1680  DATA  13,"INTERVAL EAR TRAINING: TEST"
  169. 1690  DATA  Minor 2nd, Major 2nd, Minor 3rd, Major 3rd
  170. 1700  DATA  Perfect 4th,"Dim. 5th, Aug. 4th, Tritone", Perfect 5th, Minor 6th
  171. 1710  DATA  Major 6th, Minor 7th, Major 7th, Octave, Repeat
  172. 1720  DATA  2,INTERVAL PRACTICE,Continue,Repeat
  173. 1730  REM 
  174. 1740  REM  ** ERROR HANDLING **
  175. 1750  REM 
  176. 1760 ER =  PEEK(222):LI =  PEEK(218) + PEEK(219) *256
  177. 1770  IF ER >10  THEN  GOTO 1800
  178. 1780  ON ER GOTO 1800,1800,1800,1800,1800,1790,1800,1800,1800,1800
  179. 1790  HOME : VTAB 12: HTAB 3: INVERSE : PRINT "BINARY FILE NOTEPLAY NOT FOUND ON DISK": NORMAL : GOSUB 910: VTAB 24: HTAB 1: CALL  -868: GOTO 1810
  180. 1800  VTAB 23: HTAB 05: PRINT "ERROR <";ER;"> OCCURED AT LINE <";LI;">"
  181. 1810  END