home *** CD-ROM | disk | FTP | other *** search
/ The Best of the Best / _.img / 02154 / muzak2.arc / MUZAK.BAS < prev    next >
BASIC Source File  |  1986-07-09  |  13KB  |  249 lines
  1. 1000 ' $MODULE:'OOPS!!!!' $DYNAMIC $LINESIZE:79
  2. 1010 ' ****************************************************************
  3. 1020 ' ************* MUZAK.BAS        By Aaron Ross Priven ************
  4. 1030 ' ****************************************************************
  5. 1040 ' ************* Version 2.3               9 July 1986 ************
  6. 1050 ' ****************************************************************
  7. 1060 ' This program is to be  in the public domain.  All rights waived.
  8. 1070 ' May be distributed in any form. You may even take my name off of
  9. 1080 ' it and not be legally in  any wrong, but  you will VERY  QUICKLY
  10. 1090 ' lose me as a friend!
  11. 1100 '
  12. 1110 ' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  13. 1120 ' @ This program is dedicated to Alfred Michael Yankovic,  whose @
  14. 1130 ' @ heartwarming and inspirational  music has  helped me  to get @
  15. 1140 ' @ through the hard times.                                      @
  16. 1150 ' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  17. 1160 '
  18. 1170 '
  19. 1180 '
  20. 1190 ' =Aaron Ross Priven=, 9 July 1986
  21. 1200 ' 540 Sylvan Ave., San Mateo, CA 94403-3214
  22. 1210 ' Data: (415) 349-2623 sometimes
  23. 1220 '
  24. 1230 '
  25. 1240 ' ******************************* SETUP
  26. 1250 DEFINT A-Z              ' set all values to integer unless specified
  27. 1260 OPTION BASE 1           ' I hate zero subscripts
  28. 1270 KEY OFF                 ' turn soft key display off
  29. 1280 IF INSTR(COMMAND$,"-D") OR INSTR(COMMAND$,"/D") THEN DEBUG=-1
  30. 1290                         ' set DEBUG level fm command line
  31. 1300 IF INSTR(COMMAND$,"-F") OR INSTR(COMMAND$,"/F") THEN FAST=-1
  32. 1310                         ' set FAST level fm command line
  33. 1320 LOCATE ,,0,1,13
  34. 1330 GOTO 2440               ' goto start of program
  35. 1340 '*********************************GET SONG TO PLAY*************
  36. 1350 COLOR 15,1,1            ' hiwhite on blue
  37. 1360 GOSUB 3240              ' set all colors, cls, and Stars
  38. 1370 RESTORE                 ' restore READ/DATA list to original values
  39. 1380 PLAY"MFT120MNO4L4"      ' set PLAY values to original values
  40. 1390 OPEN DEFINITION.FILE$ FOR INPUT AS #1
  41. 1400                         ' open the definition file
  42. 1410 INPUT#1,LAST.SONG,TOP.PROMPT$
  43. 1420                         ' number of songs,prompt for top of screen
  44. 1430 TOP.PROMPT$="MUZAK v2.3 by Aaron Ross Priven: "+TOP.PROMPT$
  45. 1440 COLOR 9,7               ' hiblue on white
  46. 1450 PRINT TAB(40-(LEN(TOP.PROMPT$))\2) TOP.PROMPT$ TAB(80)" "
  47. 1460                         ' print/center top line
  48. 1470 COLOR 15,1              ' back to hiwhite on blue
  49. 1480 DIM INK$(LAST.SONG),PROMPT$(LAST.SONG),WORDS(LAST.SONG),FILE$(LAST.SONG)
  50. 1490                         ' dimension keys to press, what to display,
  51. 1500                         '  whether song has words, filename of song
  52. 1510 FOR COUNT=1 TO LAST.SONG' input/count routine
  53. 1520 READ INK$(COUNT)        ' find the keys to press/input routine
  54. 1530 INPUT#1,WORDS(COUNT),FILE$(COUNT),PROMPT$(COUNT)
  55. 1540                         ' find whether song has words, filename of song,
  56. 1550                         ' & what to display
  57. 1560 NEXT                    ' end of input routine
  58. 1570 GOSUB 2790              ' print prompts (& close definition file)
  59. 1580 COLOR 9,7               ' hiblue on white
  60. 1590 PRINT TAB(30);"Enter Letter of Music";TAB(80)
  61. 1600                         ' center above line
  62. 1610 COLOR 15,1              ' hiwhite on blue
  63. 1620 LOCATE 25,1             ' go to the REALLY last line
  64. 1630 COLOR 9,7               ' hiblue on white
  65. 1640 PRINT TAB(27);"Escape/Return for Main Menu";TAB(80);
  66. 1650                         ' center above line
  67. 1660 COLOR 15,1              ' hiwhite on blue
  68. 1670 TEMP=1                  ' flag for the get character subroutine
  69. 1680 GOSUB 2960              ' get character &c
  70. 1690 '
  71. 1700 ' ********************************PRINT TITLE BOX
  72. 1710 OPEN FILE$(SONG.NO) FOR INPUT AS #1
  73. 1720                         ' open music file
  74. 1730 COLOR 15,2,2            ' hiwhite on green, border green
  75. 1740 GOSUB 3240                     ' clear screen, set above colors, stars!
  76. 1750 LOCATE 25               ' last line on screen
  77. 1760 PRINT "MUZAK v2.3 by Aaron Ross Priven" SPC(29) "Hit <ESC> To Return";
  78. 1770 LOCATE 1,2              ' go to positon 2
  79. 1780 PRINT CHR$(213)+STRING$(76,205)+CHR$(184)
  80. 1790                         ' top part of box
  81. 1800 LOCATE 5,2              ' top/middle of page
  82. 1810 PRINT CHR$(212)+STRING$(76,205)+CHR$(190)
  83. 1820                         ' bottom part of box
  84. 1830 FOR COUNT=1 TO 3        ' print middle part of box & titles
  85. 1840 INPUT #1,IKEY$          ' get title string
  86. 1850 LOCATE COUNT+1,2        ' get to part of box
  87. 1860 PRINT CHR$(179);        ' left part of box
  88. 1870 LOCATE ,(80-(LEN(IKEY$)))\2
  89. 1880                         ' number of spaces so that centering is possible
  90. 1890 PRINT IKEY$;            ' print title string
  91. 1900 LOCATE ,79              ' go to way out right
  92. 1910 PRINT CHR$(179)         ' right part of box
  93. 1920 NEXT                    ' end of printing scrolling boxes
  94. 1930 INPUT #1,FILE.LINES
  95. 1940 LOCATE 8,1              ' this moves cursor to a couple lines below box
  96. 1950 IF WORDS(SONG.NO)=0 THEN 2190   ' if song has words goto 460
  97. 1960 '
  98. 1970 '********************************************WITHOUT WORDS
  99. 1980 DIM FILE.LINE$(FILE.LINES)
  100. 1990                         ' dimension strings to PLAY
  101. 2000 ' +----------------------------------------+
  102. 2010 ' | This is done here to avoid the noise   |
  103. 2020 ' | of whirring disk drives while playing. |
  104. 2030 ' +----------------------------------------+
  105. 2040 FOR COUNT=1 TO FILE.LINES
  106. 2050                         ' input strings to play routine
  107. 2060 INPUT #1,FILE.LINE$(COUNT)' get the actual string
  108. 2070 NEXT                    ' end of input routine
  109. 2080 CLOSE                   ' close music file
  110. 2090 IF NOT DEBUG THEN PLAY "MB" ' set music background
  111. 2100 FOR COUNT=1 TO FILE.LINES
  112. 2110                         ' play music routine (yes, really!)
  113. 2120 IF DEBUG THEN PLAY"MF":PRINT FILE.LINE$(COUNT)' debugging routine
  114. 2130 PLAY FILE.LINE$(COUNT)  ' My God, actually play the music!!!!
  115. 2140 IF INKEY$=CHR$(27) THEN 3430 ' end if ESC struck
  116. 2150 NEXT                    ' end playing routine
  117. 2160 PLAY"mfp1"              ' play music foreground and pause for whole note
  118. 2170 ERASE INK$,PROMPT$,FILE$,WORDS,FILE.LINE$ ' kill dimensioned variables
  119. 2180 GOTO 1340               ' restart
  120. 2190 '******************************************** WITH WORDS
  121. 2200 CR$=CHR$(13)            ' set carriage return string
  122. 2210 FILE.LINES=FILE.LINES*2 ' count is only MUSIC codes
  123. 2220 DIM FILE.LINE$(FILE.LINES)
  124. 2230                         ' dimension strings
  125. 2240 FOR COUNT=1 TO FILE.LINES
  126. 2250                         ' input music/words routine
  127. 2260 INPUT #1,FILE.LINE$(COUNT)
  128. 2270                         ' input strings
  129. 2280 IF RIGHT$(FILE.LINE$(COUNT),1)<>"|" THEN 2310
  130. 2290 FILE.LINE$(COUNT)=LEFT$(FILE.LINE$(COUNT),LEN(FILE.LINE$(COUNT))-1)+CR$
  131. 2300                         ' if last character is | then change to CR
  132. 2310 NEXT                    ' end input routine
  133. 2320 CLOSE                   ' close file
  134. 2330 FOR COUNT=2 TO FILE.LINES STEP 2
  135. 2340                         ' play / print words routine
  136. 2350 PRINT FILE.LINE$(COUNT-1);' print the words
  137. 2360 IF DEBUG THEN PRINT FILE.LINE$(COUNT) ' Debug routine
  138. 2370 PLAY "MF"+FILE.LINE$(COUNT)'  play music + getting rid of 'MB's
  139. 2380 IF INKEY$=CHR$(27) THEN 3430 ' end if ESC struck
  140. 2390 NEXT                    ' end playing routine
  141. 2400 PLAY"mfp1"              ' quit playing and pause for a whole note
  142. 2410 '
  143. 2420 ERASE INK$,PROMPT$,FILE$,WORDS,FILE.LINE$ ' kill dimensioned variables
  144. 2430 GOTO 1340               ' restart
  145. 2440 '*******************************************SELECT BATCH OF SONGS
  146. 2450 RANDOMIZE TIMER
  147. 2460 RESTORE                 ' restore data for INK$
  148. 2470 COLOR 0,6,6             ' black on amber
  149. 2480 GOSUB 3240                     ' clear screen, set above colors active
  150. 2490 COLOR 6,0               ' amber on black
  151. 2500 PRINT TAB(12);"MUZAK v2.3 by Aaron Ross Priven:  Which Group of Songs";TAB(80)" "
  152. 2510                         ' print the title line
  153. 2520 COLOR 0,6               ' black on amber
  154. 2530 OPEN "DEFINTN.MUZ" FOR INPUT AS #1
  155. 2540                         ' open the master definition file
  156. 2550 INPUT#1,LAST.SONG       ' input the number of sets of songs
  157. 2560 DIM INK$(LAST.SONG),PROMPT$(LAST.SONG),FILE$(LAST.SONG)
  158. 2570                         ' dimension keys-to-press,prompt for each set,
  159. 2580                         '    filename of set
  160. 2590 FOR COUNT=1 TO LAST.SONG' input / get keys-to-press routine
  161. 2600 READ INK$(COUNT)        ' get key to press
  162. 2610 INPUT#1,FILE$(COUNT),PROMPT$(COUNT)
  163. 2620                         ' get filename and what to display for set
  164. 2630 NEXT                    ' end input/keys-to-press routine
  165. 2640 GOSUB 2790              ' print prompts (& close definition file)
  166. 2650 COLOR 6,0               ' amber on black
  167. 2660 PRINT TAB(29);"Escape Key - End Program";TAB(80)
  168. 2670                         ' print escape-to-end message
  169. 2680 COLOR 0,6               ' black on amber
  170. 2690 LOCATE 25,1             ' goto last line
  171. 2700 COLOR 6,0               ' amber on black
  172. 2710 PRINT TAB(30);"Enter Letter of Music";TAB(80);
  173. 2720 COLOR 0,6               ' black on amber
  174. 2730 TEMP=0                  ' flag for next subroutine
  175. 2740 GOSUB 2960              ' get character
  176. 2750 DEFINITION.FILE$=FILE$(SONG.NO)
  177. 2760                         ' save the filename
  178. 2770 ERASE INK$,PROMPT$,FILE$
  179. 2780 GOTO 1340
  180. 2790 '************************PRINT PROMPTS ROUTINE
  181. 2800 CLOSE#1                 ' close input file
  182. 2810 FOR COUNT=1 TO LAST.SONG-1 STEP 2
  183. 2820                         ' print prompt routine
  184. 2830 LOCATE COUNT\2+2,1      ' line to print prompt on
  185. 2840 PRINT INK$(COUNT);" - ";PROMPT$(COUNT);
  186. 2850                         ' print key to press, name of song (left side)
  187. 2860 LOCATE ,40              ' shift position to right side
  188. 2870 PRINT INK$(COUNT+1);" - ";PROMPT$(COUNT+1)
  189. 2880                         ' print key to press, name of song (right side)
  190. 2890 NEXT                    ' end of print songs routine
  191. 2900 IF LAST.SONG\2=LAST.SONG/2 THEN 2940
  192. 2910                         ' if # of songs is odd then -->
  193. 2920 PRINT INK$(LAST.SONG);" - ";PROMPT$(LAST.SONG)
  194. 2930                         ' print last song
  195. 2940 LOCATE 24,1             ' go to second to last line
  196. 2950 RETURN
  197. 2960 '**************************GET KEY FOR MENU
  198. 2970 IKEY$ = INPUT$(1)       ' one character
  199. 2980 IF NOT(TEMP=1 AND (IKEY$=CHR$(13) OR IKEY$=CHR$(27))) THEN 3010
  200. 2990 ERASE INK$,PROMPT$,FILE$,WORDS ' kill dimensioned variables
  201. 3000 RETURN 2440             ' if key is ESC/CR, go to 'pick a set' menu
  202. 3010 IF TEMP=0 AND IKEY$=CHR$(27) THEN 3150
  203. 3020                         ' if from main menu, key is ESC, then quit
  204. 3030 FLAG=0                  ' set flag for the following routine
  205. 3040 IF IKEY$<="z" AND IKEY$>="a" THEN IKEY$=CHR$(ASC(IKEY$)-32)
  206. 3050                         ' make lowercase capitals
  207. 3060 FOR A=1 TO LAST.SONG    ' identify song input routine
  208. 3070 IF IKEY$=INK$(A) THEN SONG.NO=A:FLAG=1
  209. 3080                         ' if the key input is this key then save
  210. 3090 NEXT                    ' end identify song-input routine
  211. 3100 IF FLAG=0 THEN 2960     ' if the key is not there then go get another
  212. 3110 RETURN
  213. 3120 '**************************DATA FOR INK$
  214. 3130 DATA A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z
  215. 3140 DATA 1,2,3,4,5,6,7,8,9,0,+,-,*,/
  216. 3150 '****************************QUIT
  217. 3160 LOCATE 24,1:PRINT SPC(79);:LOCATE 24,1
  218. 3170 PRINT "Are you Really Absolutely Sure?";' are you REALLY sure?
  219. 3180 LOCATE 25,1:PRINT SPC(79);:LOCATE 25,1,1' I don't want people
  220. 3190 PRINT"(Hit <Y> to exit, any other key to return)";' leaving MUZAK
  221. 3200 I$=INPUT$(1):IF I$><"y" AND I$><"Y" THEN LOCATE ,,0:RUN' accidentally.
  222. 3210 CLOSE                   ' just to be sure
  223. 3220 CLS
  224. 3230 SYSTEM
  225. 3240 '************************<< GALAXY >>********************
  226. 3250 CLS:IF FAST THEN RETURN
  227. 3260 A.GAL$="*":B.GAL$=".":C.GAL$="+":D.GAL$="*"
  228. 3270                         ' set up star characters
  229. 3280 FOR I.GAL=1 TO 25       ' # of star lines to print
  230. 3290 A.GAL=INT(RND(1)*28) : B.GAL=INT(RND(1)*25)+28 : C.GAL=INT(RND(1)*25)+55
  231. 3300 LOCATE I.GAL,1          ' both above & this: set up where to print it
  232. 3310 X.GAL!=RND(1)           ' random floating point number
  233. 3320 IF X.GAL!<.15 THEN SWAP A.GAL$,B.GAL$ : GOTO 3390
  234. 3330 IF X.GAL!<.3 THEN SWAP B.GAL$,C.GAL$ : GOTO 3390
  235. 3340 IF X.GAL!<.45 THEN SWAP A.GAL$,C.GAL$ : GOTO 3390
  236. 3350 IF X.GAL!<.6 THEN SWAP A.GAL$,D.GAL$ : GOTO 3390
  237. 3360 IF X.GAL!<.75 THEN SWAP B.GAL$,D.GAL$ : GOTO 3390
  238. 3370 IF X.GAL!<.9 THEN SWAP C.GAL$,D.GAL$
  239. 3380                         ' all those decide which char goes first
  240. 3390 PRINT TAB(A.GAL);A.GAL$;TAB(B.GAL);B.GAL$;TAB(C.GAL);C.GAL$;'  print lines
  241. 3400 NEXT                    ' we shall return...
  242. 3410 LOCATE 1,1
  243. 3420 RETURN
  244. 3430 ' *********************************ESC TRAPPING
  245. 3440 ERASE INK$,PROMPT$,FILE$,WORDS,FILE.LINE$ ' kill dimensioned variables
  246. 3450 PLAY "MF"               ' wait for music to be over if necessary
  247. 3460 GOTO 1340               ' restart
  248. oned variables
  249. 3450 PLAY "MF"               ' wait for music to be