home *** CD-ROM | disk | FTP | other *** search
/ Generous Efforts of Many / gemcd.zip / GEM.CD.A.po / FEATURES:BEAGLE / SHAPE.MECH1.SHK / SHAPE.MECHANIC / SONG.SUBROUTINE.bas < prev    next >
BASIC Source File  |  2000-01-01  |  9KB  |  158 lines
  1. 100  GOSUB 60000: REM MUSIC POKES
  2. 150  GOTO 700: REM GOTO MENU
  3. 200  IF REST  THEN  HTAB 12: PRINT "<REST=";REST;">": FOR X = 1 TO REST: NEXT :REST = 0: RETURN 
  4. 300  PRINT "PITCH:";PI;",";: HTAB 12: PRINT "LENGTH:";LE
  5. 399  REM <CTRL-M><CTRL-M><CTRL-M><CTRL-M><CTRL-M><CTRL-M><CTRL-M>PLAY A NOTE<CTRL-M>===========
  6. 400  POKE 0,255 -PI: REM PITCH
  7. 401  POKE 1,LE: REM NOTE LENGTH
  8. 402  CALL 771: REM PLAY THE NOTE
  9. 403  RETURN 
  10. 499  REM   <CTRL-M><CTRL-M><CTRL-M><CTRL-M><CTRL-M><CTRL-M><CTRL-M>MENU<CTRL-M>====
  11. 500  PRINT :A$ = "--------": PRINT A$: PRINT "ANY KEY:": PRINT A$;: VTAB  PEEK(37): GET A$
  12. 700  SPEED= 255: NOTRACE : TEXT : PRINT  CHR$(21): NORMAL :DOT$ = "........................................": FOR I = 1 TO 23: VTAB I: HTAB 1: PRINT DOT$;: NEXT : PRINT  LEFT$(DOT$,39);: POKE 2039, ASC(".") +128
  13. 800  POKE 32,5: POKE 33,35: VTAB 3: HTAB 5: INVERSE : PRINT " SONG SUBROUTINES ": NORMAL : PRINT : PRINT "<1> CHARGE": PRINT "<2> SHAVE AND A HAIRCUT": PRINT "<3> HERE COMES THE BRIDE": PRINT "<4> BUGLE CALL"
  14. 900  PRINT "<5> ": PRINT "<6> C?-SCALE": PRINT "<7> MUSICAL TYPEWRITER": PRINT "<8> RANDOM NOTES": PRINT "<9> SLIDE WHISTLE": PRINT : PRINT "<I> INSTRUCTIONS": PRINT : PRINT "<Q> QUIT"
  15. 1000  VTAB 22: HTAB 5: PRINT "SELECT:";: FLASH : PRINT " ": NORMAL :HT = 1:A$ = " MYSTERY SONG."
  16. 1100  FOR I = 1 TO 3:PI =  INT( RND(1) *200) +25:LE = 20: GOSUB 400: NEXT 
  17. 1200 HT = HT +1 -12 *(HT = 12): VTAB 9: HTAB HT +4: PRINT "G";: HTAB HT +3: PRINT  MID$ (A$,HT,1):K =  PEEK( -16384): IF K <128  THEN 1200
  18. 1300  POKE  -16368,0:K = K -32 *(K >223): IF (K <177  OR K >185)  AND K < >209  AND K < >201  THEN 1000
  19. 1400  VTAB 9: HTAB 5: PRINT "MYSTERY SONG"
  20. 1500  VTAB 22: HTAB 12: PRINT  CHR$(K): TEXT : IF K = 209  THEN 13600
  21. 1505  IF K = 201  THEN 50010
  22. 1600  ON K -176 GOTO 1800,2700,3800,9900,5700,11800,9500,5100,5300: GOTO 700
  23. 1700  REM <CTRL-M><CTRL-M>CHARGE SONG<CTRL-M>===========
  24. 1800  HOME :PI = 63:LE = 40: GOSUB 200
  25. 1900 PI = 111: GOSUB 200
  26. 2000 PI = 141: GOSUB 200
  27. 2100 PI = 159:LE = 50: GOSUB 200
  28. 2200 REST = 100: GOSUB 200
  29. 2300 PI = 141:LE = 60: GOSUB 200
  30. 2400 PI = 159:LE = 255: GOSUB 200
  31. 2500  GOTO 500
  32. 2600  REM  <CTRL-M><CTRL-M>SHAVE & HAIRCUT<CTRL-M>===============
  33. 2700  HOME :PI = 103:LE = 100: GOSUB 200: REM SHAVE
  34. 2800 PI = 63:LE = 50: GOSUB 200 REM AND
  35. 2900  GOSUB 200: REM A
  36. 3000 PI = 84:LE = 90: GOSUB 200: REM HAIR-
  37. 3100 PI = 63:LE = 60: GOSUB 200: REM CUT,
  38. 3200 REST = 300: GOSUB 200
  39. 3300 PI = 103:LE = 80: GOSUB 200: REM SIX
  40. 3400 REST = 22: GOSUB 200
  41. 3500 PI = 111: GOSUB 200: REM BITS!
  42. 3600  GOTO 500
  43. 3700  REM <CTRL-M><CTRL-M>HERE COMES THE BRIDE<CTRL-M>====================
  44. 3800  HOME :PI = 63:LE = 255: GOSUB 200: REM HERE
  45. 3900 PI = 111:LE = 180: GOSUB 200: REM COMES
  46. 4000 REST = 20: GOSUB 200
  47. 4100 LE = 80: GOSUB 200: REM THE
  48. 4200 LE = 255: GOSUB 200: REM BRIDE;
  49. 4300 REST = 350: GOSUB 200
  50. 4400 PI = 63:LE = 255: GOSUB 200: REM ALL
  51. 4500 PI = 127:LE = 180: GOSUB 200: REM FAT
  52. 4600 REST = 3: GOSUB 200
  53. 4700 PI = 103:LE = 80: GOSUB 200: REM AND
  54. 4800 PI = 111:LE = 255: GOSUB 200: REM WIDE!
  55. 4900  GOTO 500
  56. 5000  REM <CTRL-M><CTRL-M>RANDOM<CTRL-M>======
  57. 5100  FLASH : FOR I = 1 TO 20:PI =  INT( RND(1) *255) +1:LE =  INT( RND(1) *30) +10: POKE 0,PI: POKE 1,LE: CALL 771: VTAB  INT( RND(1) *24) +1: HTAB  INT( RND(1) *39) +1: PRINT  CHR$( INT( RND(1) *64) +32);: NEXT :LE = 255: POKE 0,PI: POKE 1,LE: CALL 771: NORMAL : GOTO 700
  58. 5200  REM <CTRL-M><CTRL-M>SLIDE WHISTLE<CTRL-M>=============
  59. 5300 COL$ = "::::::::::::::::::::::::::::::::::::::::": FOR I = 1 TO 23: VTAB I: HTAB 1: PRINT COL$;: NEXT : PRINT  LEFT$(COL$,39);: POKE 2039, ASC(":") +128
  60. 5400 LE = 4: FOR PI = 254 TO 1  STEP  -2: POKE 0,255 -PI: POKE 1,LE: CALL 771: NEXT 
  61. 5500  FOR PI = 1 TO 50: POKE 0,255 -PI *5: POKE 1,LE: CALL 771: NEXT : GOTO 700
  62. 5600  REM <CTRL-M><CTRL-M>MYSTERY SONG<CTRL-M>============
  63. 5700  HOME : PRINT "MYSTERY SONG!": PRINT "------------": PRINT : PRINT "THIS SONG HAS BEEN COMPRESSED. EACH TIMEIT IS PLAYED, THE NOTES GET LONGER.     SEE HOW FAST YOU CAN NAME THE SONG."
  64. 5800  FOR LX = 2 TO 80  STEP 2
  65. 5900  VTAB 10: HTAB 1: CALL  -958: PRINT "NOTE LENGTH: ";LX/2;" (NORMAL IS 40)"
  66. 6000 PI = 111:LE = LX: GOSUB 400: REM YAN-
  67. 6100  GOSUB 400: REM KEE
  68. 6200 PI = 127: GOSUB 400: REM DOO-
  69. 6300 PI = 141: GOSUB 400: REM DLE
  70. 6400 PI = 111: GOSUB 400: REM CAME
  71. 6500 PI = 141: GOSUB 400: REM TO
  72. 6600 PI = 127: GOSUB 400: REM TOWN
  73. 6700 PI = 63: GOSUB 400: REM A-
  74. 6800 PI = 111: GOSUB 400: REM RID-
  75. 6900  GOSUB 400: REM ING
  76. 7000 PI = 127: GOSUB 400: REM ON
  77. 7100 PI = 141: GOSUB 400: REM A
  78. 7200 PI = 111:LE = LX *2: GOSUB 400: REM PO-
  79. 7300 PI = 103:LE = LX: GOSUB 400: REM NY.
  80. 7400 PI = 63: GOSUB 400: REM HE
  81. 7500 PI = 111: GOSUB 400: REM STUCK
  82. 7600  GOSUB 400: REM A
  83. 7700 PI = 127: GOSUB 400: REM FEA-
  84. 7800 PI = 141: GOSUB 400: REM THER
  85. 7900 PI = 147: GOSUB 400: REM IN
  86. 8000 PI = 141: GOSUB 400: REM HIS
  87. 8100 PI = 127: GOSUB 400: REM HAT
  88. 8200 PI = 111: GOSUB 400: REM AND
  89. 8300 PI = 103: GOSUB 400: REM CALLED
  90. 8400 PI = 63: GOSUB 400: REM IT
  91. 8500 PI = 84: GOSUB 400: REM RICE-
  92. 8600 PI = 103: GOSUB 400: REM A-
  93. 8700 PI = 111:LE = 2 *LX: GOSUB 400: REM RO-
  94. 8800 LE = LX: GOSUB 400: REM NI!
  95. 8900  IF LX = 80  THEN 700
  96. 9000  VTAB 12: PRINT "<P> PLAY AGAIN WITH LONGER NOTES.": PRINT "<G> GIVE UP; PLAY AT NORMAL SPEED.": PRINT "<Q> QUIT PLAYING THAT SONG... NOW!": PRINT 
  97. 9010  PRINT "   SELECT:";: GET A$:A$ =  CHR$( ASC(A$) -32 *(A$ >"_")): PRINT A$: IF A$ < >"Q"  AND A$ < >"P"  AND A$ < >"G"  THEN 9000
  98. 9100  IF A$ = "P"  THEN  NEXT 
  99. 9200  IF A$ = "G"  THEN LX = 80: GOTO 5900
  100. 9300  GOTO 700
  101. 9400  REM <CTRL-M><CTRL-M>MUSICAL TYPEWRITER<CTRL-M>==================
  102. 9500  HOME : PRINT "    EACH KEY TYPES A DIFFERENT NOTE.": HTAB 13: PRINT "<CTRL-Q> TO QUIT.": PRINT "----------------------------------------"
  103. 9600  GET A$: PRINT A$;:PI =  ASC(A$): POKE 0,PI *2: POKE 1,20: CALL 771: IF A$ < > CHR$(17)  THEN 9600
  104. 9700  GOTO 700
  105. 9800  REM  <CTRL-M><CTRL-M>BUGLE CALL<CTRL-M>==========
  106. 9900  HOME : VTAB 24:BT = 72: FOR I = 1 TO 2
  107. 10000 REST = 50: GOSUB 200
  108. 10100 PI = 63:LE = BT/3: GOSUB 200
  109. 10200  FOR J = 1 TO 3
  110. 10300 PI = 111:LE = BT/3: GOSUB 200
  111. 10400 REST = 5: GOSUB 200
  112. 10500 PI = 141:LE = BT/4: GOSUB 200
  113. 10600 PI = 111:LE = BT/4: GOSUB 200
  114. 10700 PI = 63:LE = BT/4: GOSUB 200
  115. 10800 REST = 1: GOSUB 200
  116. 10900  IF I = 2  AND J = 3  THEN  GOSUB 200:REST = 15: GOSUB 200:PI = 111:LE = 2 *BT: GOSUB 200: GOTO 11500
  117. 11000  IF J = 3  THEN PI = 111:LE = BT/2: GOSUB 200
  118. 11100 PI = 141:LE = BT/3 +BT *(J = 3): GOSUB 200
  119. 11200  IF J <3  THEN REST = 15: GOSUB 200
  120. 11300  NEXT J
  121. 11400 PI = 111:LE = BT/2: GOSUB 200
  122. 11500  NEXT I
  123. 11600  GOTO 500
  124. 11700  REM <CTRL-M><CTRL-M>C-SCALE<CTRL-M>=======
  125. 11800  HOME :A$ = "CDEFGABCBAGFEDC": FOR I = 1 TO  LEN(A$): VTAB I: HTAB 23: PRINT "("; MID$ (A$,I,1);")": NEXT : VTAB 1
  126. 11900 PI = 63:LE = 80: GOSUB 200
  127. 12000 PI = 84: GOSUB 200
  128. 12100 PI = 103: GOSUB 200
  129. 12200 PI = 111: GOSUB 200
  130. 12300 PI = 127: GOSUB 200
  131. 12400 PI = 141: GOSUB 200
  132. 12500 PI = 153: GOSUB 200
  133. 12600 PI = 159: GOSUB 200
  134. 12700 PI = 153: GOSUB 200
  135. 12800 PI = 141: GOSUB 200
  136. 12900 PI = 127: GOSUB 200
  137. 13000 PI = 111: GOSUB 200
  138. 13100 PI = 103: GOSUB 200
  139. 13200 PI = 84: GOSUB 200
  140. 13300 PI = 63:LE = 150: GOSUB 200
  141. 13400  GOTO 500
  142. 13500  REM <CTRL-M><CTRL-M>QUIT<CTRL-M>====
  143. 13600  FOR V = 1 TO 23:H = 25 -V:A = 128 *V +H -(984 * INT((V -1)/8)) +895:B = A +1:PA =  PEEK(A):PB =  PEEK(B): POKE A,221: POKE B,96: POKE 0,10 *V: POKE 1,9: CALL 771: FOR J = 1 TO 25: NEXT : POKE A,PA: POKE B,PB: NEXT : VTAB 23: END 
  144. 50000  REM <CTRL-M><CTRL-M>INSTRUCTIONS<CTRL-M>============
  145. 50010  HOME : PRINT "  C    D    E    F    G    A    B    C": INVERSE : FOR I = 1 TO 40: PRINT "@@@@@     ";: NEXT 
  146. 50020  NORMAL : FOR I = 1 TO 6: FOR J = 5 TO 30  STEP 5: VTAB I +1: HTAB J: IF J < >15  THEN  PRINT "  ";
  147. 50030  NEXT : HTAB 40: PRINT " ";: NEXT 
  148. 50040  VTAB 4:A$ = "  X111X1": GOSUB 50080:A$ = "79X134X6": GOSUB 50080:A$ = "34X947X9": GOSUB 50080
  149. 50050 I = 0:A$ = " 63": GOSUB 50060:A$ = " 84": GOSUB 50060:A$ = "103": GOSUB 50060:A$ = "111": GOSUB 50060:A$ = "127": GOSUB 50060:A$ = "141": GOSUB 50060:A$ = "153": GOSUB 50060:A$ = "159": GOSUB 50060: GOTO 50100
  150. 50060  INVERSE :I = I +1: VTAB 10: HTAB I *5 -3: PRINT A$: POKE 0,255 - VAL(A$): POKE 1,80: CALL 771: RETURN 
  151. 50070  FOR I = 1 TO 8: HTAB I *5 -2: POKE 50,63 +192 *( PEEK(37) >55): PRINT  MID$ (A$,I,1);: NEXT : PRINT : RETURN 
  152. 50080  FOR I = 1 TO 8: HTAB I *5: IF  MID$ (A$,I,1) < >"X"  THEN  PRINT  MID$ (A$,I,1);
  153. 50090  NEXT : RETURN 
  154. 50100  NORMAL : VTAB 13: PRINT "TO MAKE MUSIC, ADD LINE 60000 TO YOUR   PROGRAM AND MAKE YOUR FIRST LINE BE--": PRINT : PRINT "  10  GOSUB 60000": PRINT 
  155. 50110  PRINT "FOR EACH NOTE, DO TWO POKES AND A CALL--                  ---------       ----"
  156. 50120  PRINT "  POKE 0,255-PI (PI=PITCH, SEE ABOVE)     POKE 1,LE     (LE=LENGTH, 0-255)        CALL 771      (PLAYS THE NOTE)";: VTAB 24: HTAB 1: PRINT "ANY KEY:";: GET A$: GOTO 700
  157. 59999  REM <CTRL-M><CTRL-M>MUSIC POKES<CTRL-M>===========
  158. 60000  POKE 771,173: POKE 772,48: POKE 773,192: POKE 774,136: POKE 775,208: POKE 776,4: POKE 777,198: POKE 778,1: POKE 779,240: POKE 780,8: POKE 781,202: POKE 782,208: POKE 783,246: POKE 784,166: POKE 785,0: POKE 786,76: POKE 787,3: POKE 788,3: POKE 789,96: RETURN