home *** CD-ROM | disk | FTP | other *** search
/ Audio 4.94 - Over 11,000 Files / audio-11000.iso / msdos / cdrom / cdplay.exe / ROMPLAY3.BAS < prev   
Encoding:
BASIC Source File  |  1989-07-15  |  17.9 KB  |  349 lines
  1. 1 REM SAVE"romplay3.bas",A
  2. 10 GOSUB 10000:GOTO 9000
  3. 1000 ACK=INP(PRTB) AND 3:IF ACK=2 THEN RETURN ELSE L=L+1:IF L<1400 THEN 1000 ELSE 8070
  4. 1050 ACK=INP(PRTB) AND 3:IF ACK=2 THEN OUT PRTC,NOCMD:RETURN
  5. 1060 L=L+1:IF L<1025 THEN 1050 ELSE 8070
  6. 2000 OUT DIRPRT,OTCMD:RETURN :' \ OutDir
  7. 2999 ' \ ClrCmdC
  8. 3000 L=0:OUT PRTC,NOCMD:OUT PRTA,255:OUT PRTC,CMD:GOSUB 1050:RETURN
  9. 3010 GOSUB 3500:BUSY=CSTAT AND 1:IF BUSY<1 THEN RETURN ELSE 3010
  10. 3199 ' \ TracPlay
  11. 3200 GOSUB 3000:OUT PRTA,232 OR CHANNELS:OUT PRTC,CMD:GOSUB 1050
  12. 3210 OUT PRTA,STRAC:OUT PRTC,CMD:GOSUB 1050
  13. 3220 OUT PRTA,ETRAC:OUT PRTC,CMD:GOSUB 1050:GOSUB 3010:RETURN
  14. 3299 ' \ TimePlay
  15. 3300 GOSUB 3000:OUT PRTA,224 OR CHANNELS:OUT PRTC,CMD:GOSUB 1050:FOR X=1 TO 6
  16. 3310 OUT PRTA,PTIM(X):OUT PRTC,CMD:GOSUB 1050:NEXT X:GOSUB 3010:RETURN
  17. 3399 ' \ DStat
  18. 3400 GOSUB 3000:OUT PRTA,96:OUT PRTC,CMD:GOSUB 1050:OUT DIRPRT,NCMD
  19. 3410 OUT PRTC,DMC:GOSUB 1000:DSTAT=INP(PRTA):OUT PRTC,NOCMD:GOSUB 2000:RETURN
  20. 3499 ' \ CStat
  21. 3500 GOSUB 3000:OUT PRTA,112:OUT PRTC,CMD:GOSUB 1050:OUT DIRPRT,NCMD
  22. 3510 OUT PRTC,DMC:GOSUB 1000:CSTAT=INP(PRTA):OUT PRTC,NOCMD:GOSUB 2000:RETURN
  23. 3549 ' \ LStat
  24. 3550 GOSUB 3000:OUT PRTA,160:OUT PRTC,CMD:GOSUB 1050:OUT DIRPRT,NCMD
  25. 3560 OUT PRTC,DMC:GOSUB 1000:LSTAT=INP(PRTA):OUT PRTC,NOCMD:GOSUB 2000:RETURN
  26. 3599 ' \ Q@
  27. 3600 GOSUB 3000:OUT PRTA,80:OUT PRTC,CMD:GOSUB 1050:OUT DIRPRT,NCMD
  28. 3650 FOR Q=1 TO 10:OUT PRTC,DMC:GOSUB 1000:QCODE(Q)=INP(PRTA):OUT PRTC,NODMC:NEXT Q:GOSUB 2000:RETURN
  29. 3699 ' \ ID@
  30. 3700 GOSUB 3000:OUT PRTA,48:OUT PRTC,CMD:GOSUB 1050
  31. 3710 OUT PRTA,144:OUT PRTC,CMD:GOSUB 1050:OUT PRTA,144:OUT PRTC,CMD:GOSUB 1050
  32. 3720 OUT PRTA,133:OUT PRTC,CMD:GOSUB 1050:OUT DIRPRT,NCMD:FOR Q=1 TO 52
  33. 3730 OUT PRTC,DMC:GOSUB 1000:ID(Q)=INP(PRTA):OUT PRTC,NODMC:NEXT Q:GOSUB 2000:RETURN
  34. 3800 GOSUB 3000:OUT PRTA,24:OUT PRTC,CMD:GOSUB 1050:GOSUB 3010:RETURN:' \ Paws
  35. 3810 GOSUB 3000:OUT PRTA,16:OUT PRTC,CMD:GOSUB 1050:' \ Seek
  36. 3820 FOR X=1 TO 3:OUT PRTA,PTIM(X):OUT PRTC,CMD:GOSUB 1050:NEXT X:GOSUB 3010:RETURN
  37. 3900 GOSUB 3000:OUT PRTA,0:OUT PRTC,CMD:GOSUB 1050:RETURN:' \ Reset
  38. 3910 GOSUB 3000:OUT PRTA,169:OUT PRTC,CMD:GOSUB 1050:RETURN:' Lock
  39. 3920 GOSUB 3000:OUT PRTA,48:OUT PRTC,CMD:GOSUB 1050:' \ Eat
  40. 3930 OUT PRTA,129:OUT PRTC,CMD:GOSUB 1050:GOSUB 3010:RETURN
  41. 3950 GOSUB 3000:OUT PRTA,168:OUT PRTC,CMD:GOSUB 1050:RETURN:' \ Kcol
  42. 3960 GOSUB 3000:OUT PRTA,48:OUT PRTC,CMD:GOSUB 1050:' \ Eject
  43. 3970 OUT PRTA,128:OUT PRTC,CMD:GOSUB 1050:GOSUB 3010:RETURN
  44. 4000 GOSUB 3400:K$=INKEY$:IF K$<>"" OR DSTAT>7 THEN RETURN
  45. 4100 GOSUB 3600:NQ=QCODE(9):IF NQ=TQ THEN 4000
  46. 4110 QMODE=QCODE(1) AND 15:IF QMODE=1 THEN TQ=NQ:GOSUB 4200
  47. 4120 GOTO 4000
  48. 4200 QCTL=QCODE(1) AND 240:IF QCTL<64 THEN TINK=INK ELSE TINK=YELLOW
  49. 4210 COLOR TINK,HOLE:BCD=QCODE(2):GOSUB 5050:NHPOS=19:GOSUB 4420
  50. 4220 BCD=QCODE(3):GOSUB 5050:NHPOS=30:GOSUB 4420
  51. 4240 BCD=QCODE(8):GOSUB 5050:NHPOS=41:GOSUB 4420:NPOS=DEC
  52. 4250 IF NPOS>MPOS THEN NPOS=MPOS
  53. 4260 BCD=QCODE(9):GOSUB 5050:NHPOS=52:GOSUB 4420
  54. 4400 COLOR WHITE,HOLE:IF NPOS<>OPOS THEN LOCATE SPOS,OPOS+1:PRINT SCALE$;
  55. 4410 COLOR TIP:LOCATE SPOS,NPOS+1:PRINT TIP$;:OPOS=NPOS:COLOR TINK,PAPER:RETURN
  56. 4420 IF D1=0 THEN GOSUB 5300 ELSE ON D1 GOSUB 5310,5320,5330,5340,5350,5360,5370,5380,5390
  57. 4440 NHPOS=NHPOS+4:IF D2=0 THEN GOSUB 5300:RETURN
  58. 4450 ON D2 GOSUB 5310,5320,5330,5340,5350,5360,5370,5380,5390
  59. 4452 RETURN
  60. 4999 ' \ >BCD
  61. 5000 D1=INT(DEC/10):D1=D1*16:D2=DEC MOD 10:BCD=D1 OR D2:RETURN
  62. 5049 ' \ <BCD  Mask 240=11110000 15=00001111
  63. 5050 D1=BCD AND 240:D1=D1/16:D3=D1*10:D2=BCD AND 15:DEC=D2+D3:RETURN
  64. 5100 FOR X=1 TO 6:PTIM(X)=MTIM(X):NEXT:RETURN
  65. 5200 GOSUB 3600:QMODE=QCODE(1) AND 15:IF QMODE>1 THEN 5200:' \ Gtime
  66. 5210 RETURN
  67. 5300 LOCATE NVPOS,NHPOS:PRINT "┌─┐"
  68. 5302 LOCATE ,NHPOS:PRINT "│ │"
  69. 5304 LOCATE ,NHPOS:PRINT "└─┘":RETURN
  70. 5310 LOCATE NVPOS,NHPOS:PRINT " ┐ "
  71. 5312 LOCATE ,NHPOS:PRINT " │ "
  72. 5314 LOCATE ,NHPOS:PRINT " ┴ ":RETURN
  73. 5320 LOCATE NVPOS,NHPOS:PRINT "┌─┐"
  74. 5322 LOCATE ,NHPOS:PRINT "┌─┘"
  75. 5324 LOCATE ,NHPOS:PRINT "└──":RETURN
  76. 5330 LOCATE NVPOS,NHPOS:PRINT "┌─┐"
  77. 5332 LOCATE ,NHPOS:PRINT " ─┤"
  78. 5333 LOCATE ,NHPOS:PRINT "└─┘":RETURN
  79. 5340 LOCATE NVPOS,NHPOS:PRINT "┬ ┌"
  80. 5342 LOCATE ,NHPOS:PRINT "└─┼"
  81. 5344 LOCATE ,NHPOS:PRINT "  ┴":RETURN
  82. 5350 LOCATE NVPOS,NHPOS:PRINT "┌─ "
  83. 5352 LOCATE ,NHPOS:PRINT "└─┐"
  84. 5354 LOCATE ,NHPOS:PRINT "──┘":RETURN
  85. 5360 LOCATE NVPOS,NHPOS:PRINT "┌─ "
  86. 5362 LOCATE ,NHPOS:PRINT "├─┐"
  87. 5364 LOCATE ,NHPOS:PRINT "└─┘":RETURN
  88. 5370 LOCATE NVPOS,NHPOS:PRINT "┌─┐"
  89. 5372 LOCATE ,NHPOS:PRINT "  │"
  90. 5374 LOCATE ,NHPOS:PRINT "  ┴":RETURN
  91. 5380 LOCATE NVPOS,NHPOS:PRINT "┌─┐"
  92. 5382 LOCATE ,NHPOS:PRINT "├─┤"
  93. 5384 LOCATE ,NHPOS:PRINT "└─┘":RETURN
  94. 5390 LOCATE NVPOS,NHPOS:PRINT "┌─┐"
  95. 5392 LOCATE ,NHPOS:PRINT "└─┤"
  96. 5394 LOCATE ,NHPOS:PRINT " ─┘":RETURN
  97. 5500 GOSUB 9600:IF OLDDISC=1 THEN RETURN: ' \ >MaxMin
  98. 5502 GOSUB 9860:GOSUB 3910:GOSUB 5100:GOSUB 9460:MQUE=1:QUE(1)=0:QFLAG=0:OPOS=0
  99. 5510 GOSUB 9740:CHANNELS=3:MAXM=0:C=94:INC=-5:COLOR INK,HOLE
  100. 5520 DEC=C:GOSUB 5000:PTIM(1)=BCD:GOSUB 5550:IF INC=1 AND DSTAT=8 THEN 5570
  101. 5530 LOCATE 13,62:PRINT C;" ";:C=C+INC:IF C<0 THEN C=0:INC=1
  102. 5532 IF C>99 THEN RETURN
  103. 5540 GOTO 5520
  104. 5550 GOSUB 3300:GOSUB 3400:IF DSTAT=4 THEN INC=1:' ?Play
  105. 5560 RETURN
  106. 5570 IF C>1 THEN MAXM=C-1
  107. 5580 DEC=MAXM:GOSUB 5000:PTIM(1)=BCD:MPOS=MAXM:IF MAXM>79 THEN MPOS=79
  108. 5590 COLOR WHITE,HOLE:FOR X=0 TO MPOS:LOCATE SPOS,X+1:PRINT SCALE$;:NEXT:COLOR INK
  109. 5600 INC=-3:C=56:MAXS=0:' >MaxSec
  110. 5610 DEC=C:GOSUB 5000:PTIM(2)=BCD:LOCATE 14,62:PRINT C;" ";
  111. 5620 GOSUB 5550:IF INC=1 AND DSTAT=8 THEN 5650
  112. 5630 C=C+INC:IF C<0 THEN C=0:INC=1
  113. 5632 IF C>60 THEN RETURN
  114. 5640 GOTO 5610
  115. 5650 IF C>1 THEN MAXS=C-1
  116. 5660 ASEC=C-2:IF ASEC<0 THEN ASEC=ASEC+59:DEC=MAXM-1:GOSUB 5000:PTIM(1)=BCD
  117. 5670 DEC=ASEC:GOSUB 5000:PTIM(2)=BCD:GOSUB 3300
  118. 5680 GOSUB 5200:BCD=QCODE(2):GOSUB 5050:MAXTRAC=DEC
  119. 5690 LOCATE 12,62:PRINT MAXTRAC;:CHANNELS=0:OLDDISC=1
  120. 5692 IF HTIM(1)>0 THEN FOR X=1 TO 3:PTIM(X)=HTIM(X):NEXT:GOSUB 3300
  121. 5694 COLOR INK,PAPER:RETURN
  122. 6000 K$=INKEY$:IF K$="" THEN 6000
  123. 6010 K=ASC(K$):RETURN
  124. 6200 IF K>47 AND K<58 THEN WK$=K$ ELSE WK$=""
  125. 6210 LOCATE 23,48:PRINT WK$;"  ";
  126. 6220 GOSUB 6000:IF K=8 THEN WK$="" ELSE IF K=13 THEN RETURN
  127. 6230 IF K>47 AND K<58 THEN WK$=WK$+K$:IF LEN(WK$)>2 THEN 6200
  128. 6240 IF K=32 THEN K$="":RETURN
  129. 6250 GOTO 6210
  130. 6300 GOSUB 7060:' \ SlideCue
  131. 6310 IF LEN(K$)<2 THEN GOSUB 6400:RETURN
  132. 6320 K$=RIGHT$(K$,1):IF K$="M" THEN NPOS=OPOS+1:IF NPOS>MPOS THEN NPOS=0
  133. 6330 IF K$="K" THEN NPOS=OPOS-1:IF NPOS<0 THEN NPOS=MPOS
  134. 6350 DEC=NPOS:GOSUB 4400
  135. 6360 IF K$="P" THEN GOSUB 6400:RETURN
  136. 6370 IF K$="H" THEN GOSUB 6390
  137. 6380 GOSUB 6000:GOTO 6310
  138. 6390 GOSUB 5000:GOSUB 5100:PTIM(1)=BCD:PTIM(2)=1:GOSUB 3810:GOSUB 7050:GOSUB 5200:T=NPOS:GOSUB 4200::NPOS=T:GOSUB 9990:RETURN
  139. 6400 K$="":GOSUB 5000:GOSUB 5100:PTIM(1)=BCD:PTIM(2)=0:GOSUB 3300:GOSUB 5200:GOSUB 7060:GOSUB 9990:RETURN
  140. 7050 WF=1:LOCATE 23,37:PRINT "PAUSED":RETURN
  141. 7060 IF QFLAG=1 THEN GOSUB 8700:RETURN
  142. 7070 TIP=GREEN:GOSUB 4400:FINFLAG=0:RFLAG=0:WF=0:GOSUB 9560:RETURN
  143. 7100 GOSUB 5200:BCD=QCODE(2):GOSUB 5050:DEC=DEC+SKIPDIR:' \ Skip
  144. 7110 IF DEC>MAXTRAC THEN DEC=1 ELSE IF DEC<1 THEN DEC=MAXTRAC
  145. 7120 GOSUB 5000:STRAC=BCD:ETRAC=153:GOSUB 3200:GOSUB 7060:GOSUB 9990:RETURN
  146. 7300 QMODE=QCODE(1) AND 15:IF QMODE>1 THEN GOSUB 5200:' \ SectionPlayBegin
  147. 7310 FOR Q=1 TO 3:RTIM(Q)=QCODE(Q+7):NEXT Q:RETURN
  148. 7400 QMODE=QCODE(1) AND 15:IF QMODE>1 THEN GOSUB 5200:' \ Finish
  149. 7410 FOR Q=4 TO 6:RTIM(Q)=QCODE(Q+4):NEXT Q:FINFLAG=1
  150. 7420 IF RTIM(1)>RTIM(4) THEN GOSUB 7060:RETURN
  151. 7430 IF RTIM(1)=RTIM(4) THEN IF RTIM(2)>=RTIM(5) THEN GOSUB 7060:RETURN
  152. 7440 TIP=LCYAN:GOSUB 4400:FOR Q=1 TO 6:PTIM(Q)=RTIM(Q):NEXT Q:RETURN
  153. 7710 IF WF=1 THEN GOTO 7750:' \ Pause
  154. 7720 GOSUB 5200:GOSUB 3800:GOSUB 7050:GOSUB 5100
  155. 7730 PTIM(1)=QCODE(8):PTIM(2)=QCODE(9):PTIM(3)=QCODE(10):RETURN
  156. 7750 GOSUB 3300:GOSUB 7060:RETURN
  157. 7760 IF AFRAME<0 THEN AFRAME=AFRAME+74:ASEC=ASEC-1
  158. 7770 IF ASEC<0 THEN ASEC=ASEC+59:AMIN=AMIN-1
  159. 7780 IF AMIN<0 THEN AMIN=0
  160. 7790 RETURN
  161. 7800 IF WF=1 THEN 7750:' \ Cue
  162. 7810 GOSUB 5200:BCD=QCODE(8):GOSUB 5050:AMIN=DEC:BCD=QCODE(9):GOSUB 5050
  163. 7820 ASEC=DEC:BCD=QCODE(10):GOSUB 5050:AFRAME=DEC
  164. 7830 BCD=QCODE(4):GOSUB 5050:CMIN=DEC:BCD=QCODE(5):GOSUB 5050:CSEC=DEC
  165. 7840 BCD=QCODE(6):GOSUB 5050:CFRAME=DEC
  166. 7850 AMIN=AMIN-CMIN:ASEC=ASEC-CSEC:AFRAME=AFRAME-CFRAME:GOSUB 7760
  167. 7860 GOSUB 5100:DEC=AMIN:GOSUB 5000:PTIM(1)=BCD:DEC=ASEC:GOSUB 5000:PTIM(2)=BCD
  168. 7870 DEC=AFRAME:GOSUB 5000:PTIM(3)=BCD
  169. 7880 GOSUB 3810:GOSUB 7050:GOSUB 4100:RETURN
  170. 7900 GOSUB 5100:GOSUB 5200:BCD=QCODE(8):GOSUB 5050:CMIN=DEC:BCD=QCODE(9):GOSUB 5050:' >>
  171. 7910 DEC=DEC+INC:IF DEC<0 THEN DEC=DEC+59:CMIN=CMIN-1:IF CMIN<0 THEN CMIN=MAXM:IF DEC>MAXS THEN DEC=MAXS-10:IF DEC<0 THEN DEC=DEC+59:CMIN=CMIN-1
  172. 7920 IF DEC>59 THEN DEC=DEC-59:CMIN=CMIN+1
  173. 7922 IF CMIN>MAXM OR CMIN<0 THEN CMIN=0
  174. 7930 GOSUB 5000:PTIM(2)=BCD:DEC=CMIN:GOSUB 5000:PTIM(1)=BCD
  175. 7940 GOSUB 3300:GOSUB 7060:GOSUB 9990:RETURN
  176. 7950 GOSUB 5100:GOSUB 5200:BCD=QCODE(8):GOSUB 5050:AMIN=DEC+INC:IF AMIN<0 THEN AMIN=MAXM:BCD=QCODE(9):GOSUB 5050:IF DEC>MAXS+1 THEN AMIN=AMIN-1:' >>>
  177. 7970 IF AMIN>MAXM OR AMIN<0 THEN AMIN=0
  178. 7980 DEC=AMIN:GOSUB 5000:PTIM(1)=BCD:PTIM(2)=QCODE(9):GOSUB 3300:GOSUB 7060:GOSUB 9990:RETURN
  179. 8000 L=0:ACK=INP(PRTB) AND 3:IF ACK>0 THEN 8100:' \ Drive?
  180. 8002 OUT PRTC,NOCMD:OUT PRTA,255
  181. 8010 L=L+1:IF L=2 THEN GOSUB 8080
  182. 8020 OUT PRTC,CMD
  183. 8030 ACK=INP(PRTB) AND 3:IF ACK=2 THEN GOSUB 8090:RETURN
  184. 8050 IF L<200 THEN 8010
  185. 8060 IF DF=0 THEN DRIVE=DRIVE+1:GOSUB 9890:IF DRIVE<8 THEN 8000 ELSE IF DRIVE=8 THEN DRIVE=0:DF=1:GOTO 8000
  186. 8070 LOCATE 23,25:PRINT "Power On Drive & Press a Key":GOSUB 6000:IF K=27 THEN 9682 ELSE RUN
  187. 8080 COLOR INK+FLASH:LOCATE 23,30:PRINT "Checking for Drive! ";DRIVE:RETURN
  188. 8090 OUT PRTC,NOCMD:GOSUB 9560:GOSUB 9850:RETURN
  189. 8100 LOCATE 20:PRINT "Address Mismatch I/F Card-Program":LIST 10010:END
  190. 8200 GOSUB 8839:LOCATE 22,8:PRINT "< > StepQue  Fill  Clear  Shuffle  Insert  Delete  ToggleMode"
  191. 8210 GOSUB 6000:IF K=13 OR K=32 THEN GOSUB 8250:RETURN
  192. 8220 IF K$<>"" THEN GOSUB 9350:GOSUB 8839
  193. 8230 GOTO 8210
  194. 8250 LOCATE 22,8:FOR X=1 TO 70:PRINT " ";:NEXT X:IF QFLAG=1 THEN RETURN
  195. 8260 LOCATE 13,5:PRINT "       ";:RETURN
  196. 8300 IF MQUE>98 THEN RETURN ELSE GOSUB 9560:PRINT"Add what Track?";
  197. 8302 GOSUB 6200:TUNE=VAL(WK$):IF TUNE>MAXTRAC THEN 8302 ELSE IF TUNE=0 THEN GOSUB 9560:RETURN
  198. 8304 IF QUE(1)=0 THEN QUE(1)=TUNE:GOSUB 8840:GOSUB 9560:RETURN
  199. 8310 MQUE=MQUE+1:QUE(MQUE)=QUE(1):QUE(1)=TUNE:GOSUB 8840:GOSUB 9560:RETURN
  200. 8400 IF MQUE<2 THEN RETURN ELSE GOSUB 9560:PRINT "Num. to Delete?";
  201. 8402 GOSUB 6200:TUNE=VAL(WK$):IF TUNE>MAXTRAC THEN 8402 ELSE IF TUNE=0 THEN GOSUB 9560:RETURN
  202. 8410 TMQUE=MQUE:FOR X=1 TO MQUE:IF QUE(X)=TUNE THEN GOSUB 8450
  203. 8420 NEXT X:MQUE=TMQUE
  204. 8440 GOSUB 8840:GOSUB 9560:RETURN
  205. 8450 IF QUE(X)=TUNE THEN GOSUB 8480:IF TMQUE<X THEN RETURN
  206. 8452 IF QUE(X)=TUNE THEN 8450
  207. 8460 RETURN
  208. 8480 FOR X1=X TO MQUE:QUE(X1)=QUE(X1+1):NEXT X1:TMQUE=TMQUE-1:RETURN
  209. 8500 IF SKIPDIR=1 THEN GOSUB 8820 ELSE GOSUB 8830
  210. 8510 GOSUB 8840:K$="~":RETURN
  211. 8700 LOCATE 13,5:IF QFLAG=1 THEN PRINT "      ";:QFLAG=0:GOSUB 7070:RETURN:' \ Qoff
  212. 8710 IF QFLAG=0 THEN GOSUB 8839:QFLAG=1:FINFLAG=0:RFLAG=0:TIP=LRED:GOSUB 4400
  213. 8712 IF K$<>"/" THEN RETURN:' Rndplay
  214. 8714 MQUE=MAXTRAC:GOSUB 8720:GOSUB 8730:GOSUB 9400:RETURN
  215. 8720 FOR X=1 TO MQUE:QUE(X)=(MQUE+1)-X:NEXT X:RETURN:' Fillque
  216. 8730 FOR X=1 TO MQUE:TRAN=1+INT(RND(1)*MQUE):TQUE=QUE(TRAN):' Shuffle
  217. 8740 QUE(TRAN)=QUE(X):QUE(X)=TQUE:NEXT X:RETURN
  218. 8800 TUNE=QUE(1):IF TUNE=0 THEN GOSUB 8700:STRAC=1:ETRAC=53:RETURN:' @Que
  219. 8810 DEC=TUNE:GOSUB 5000:STRAC=BCD:ETRAC=BCD:GOSUB 8820:GOSUB 8840:RETURN
  220. 8820 TUNE=QUE(1):FOR X=1 TO MQUE-1:QUE(X)=QUE(X+1):NEXT X:QUE(MQUE)=TUNE:RETURN
  221. 8830 TUNE=QUE(MQUE):FOR X=MQUE TO 2 STEP -1:QUE(X)=QUE(X-1):NEXT X:QUE(1)=TUNE:RETURN
  222. 8839 LOCATE 13,5:PRINT "Que";
  223. 8840 LOCATE 13,8:PRINT QUE(1);" ";:RETURN
  224. 9000 GOSUB 2000:GOSUB 10900:GOSUB 8000:GOSUB 5500
  225. 9100 GOSUB 4000:IF DSTAT>31 THEN GOSUB 9600
  226. 9110 IF WF=0 THEN IF DSTAT=8 THEN K$="P"
  227. 9116 IF LEN(K$)>1 THEN GOSUB 6300
  228. 9120 IF K$<>"" THEN GOSUB 9200
  229. 9130 IF OLDDISC=0 THEN GOSUB 5500
  230. 9199 GOTO 9100
  231. 9200 IF K$="{" THEN INC=-1:GOSUB 7950
  232. 9210 IF K$="}" THEN INC=1:GOSUB 7950
  233. 9220 IF K$="[" THEN INC=-10:GOSUB 7900:RETURN
  234. 9230 IF K$="]" THEN INC=10:GOSUB 7900:RETURN
  235. 9240 IF K$=" " THEN GOSUB 7710
  236. 9242 IF QFLAG=1 THEN GOSUB 9330
  237. 9250 IF K$=";" OR K$=">" OR K$="." THEN SKIPDIR=1:GOSUB 7100
  238. 9260 IF K$=":" OR K$="<" OR K$="," THEN SKIPDIR=-1:GOSUB 7100
  239. 9270 GOSUB 9660:IF K$="C" THEN GOSUB 7800
  240. 9280 IF K$="B" THEN GOSUB 7300
  241. 9290 IF K$="F" THEN GOSUB 7400
  242. 9300 IF K$="/" THEN GOSUB 8700
  243. 9304 IF K$="S" THEN GOSUB 9900:GOSUB 7060:IF K$="" THEN GOSUB 9400
  244. 9306 IF K$="P" THEN GOSUB 9560:WF=0:GOSUB 9400
  245. 9308 IF K$="R" THEN GOSUB 7060:TIP=LMAGENTA:RFLAG=1:GOSUB 9500:GOSUB 4400
  246. 9310 IF K$="N" OR K>47 AND K<58 THEN GOSUB 7060:GOSUB 9500
  247. 9312 IF K$="M" THEN GOSUB 8200
  248. 9314 IF K$="T" THEN GOSUB 8700
  249. 9318 IF K$="I" THEN GOSUB 9970
  250. 9320 IF K$="D" THEN GOSUB 9800
  251. 9322 IF K$="Q" THEN GOSUB 3950:GOSUB 10600:COLOR INK,BLACK:CLS:SYSTEM
  252. 9326 FOR X=0 TO 6:J$=INKEY$:NEXT X:X=RND(1)
  253. 9329 RETURN
  254. 9330 IF K$="," OR K$="<" THEN SKIPDIR=-1:GOSUB 8500
  255. 9340 IF K$="." OR K$=">" THEN SKIPDIR=1:GOSUB 8500
  256. 9342 RETURN
  257. 9350 GOSUB 9660:GOSUB 9330
  258. 9352 IF K$="D" THEN GOSUB 8400
  259. 9354 IF K$="I" OR K>47 AND K<58 THEN GOSUB 8300
  260. 9356 IF K$="F" THEN MQUE=MAXTRAC:GOSUB 8720
  261. 9358 IF K$="S" THEN IF MQUE>2 THEN GOSUB 8730
  262. 9360 IF K$="C" THEN MQUE=1:QUE(1)=0:QFLAG=0
  263. 9362 IF K$="T" THEN GOSUB 8700
  264. 9399 GOSUB 9326:K$="M":RETURN
  265. 9400 IF OLDDISC=0 THEN GOSUB 5500:' \ Play
  266. 9410 IF RFLAG=1 THEN GOSUB 3200:RETURN
  267. 9420 IF FINFLAG=1 THEN GOSUB 3300:RETURN
  268. 9430 IF QFLAG=1 THEN GOSUB 8800:GOSUB 3200:RETURN
  269. 9450 GOSUB 5100:GOSUB 3300:RETURN
  270. 9460 FOR X=1 TO 6:HTIM(X)=0:NEXT:HTIM(4)=99:GOSUB 3400:IF DSTAT=4 THEN GOSUB 5200:FOR X=1 TO 3:HTIM(X)=QCODE(X+7):NEXT
  271. 9470 RETURN
  272. 9500 GOSUB 9560:PRINT "Starting Track: ";:GOSUB 6200:STRAC=VAL(WK$):' #Play
  273. 9510 IF STRAC<1 THEN STRAC=1 ELSE IF STRAC>MAXTRAC THEN 9500
  274. 9520 GOSUB 9560:PRINT "  Ending Track: ";:GOSUB 6200:ETRAC=VAL(WK$)
  275. 9530 IF ETRAC<1 THEN ETRAC=99
  276. 9532 IF ETRAC<STRAC THEN T=STRAC:STRAC=ETRAC:ETRAC=T
  277. 9540 DEC=STRAC:GOSUB 5000:STRAC=BCD:DEC=ETRAC:GOSUB 5000:ETRAC=BCD
  278. 9550 GOSUB 9560:GOSUB 3200:RETURN
  279. 9560 LOCATE 23,30:COLOR INK:PRINT BLK$;:LOCATE 23,30:RETURN
  280. 9600 K$=INKEY$:IF K$<>"" THEN GOSUB 9660:' \ Error?
  281. 9610 GOSUB 3010:GOSUB 3400:IF DSTAT=8 THEN RETURN:' Pause
  282. 9620 IF DSTAT>127 THEN GOSUB 9760:GOTO 9600
  283. 9630 IF DSTAT>63 THEN GOSUB 9700
  284. 9640 IF DSTAT=4 THEN RETURN:' Play
  285. 9650 GOTO 9600
  286. 9660 K=ASC(K$):IF K>96 AND K<123 THEN K=K-32:K$=CHR$(K)
  287. 9670 IF K$="A" AND DT=51 THEN GOSUB 3400:IF DSTAT>63 THEN GOSUB 3920:' Eat
  288. 9680 IF K$="E" THEN GOSUB 7060:GOSUB 9880:' Eject
  289. 9682 IF K=27 THEN LOCATE 20:GOSUB 10600:STOP
  290. 9690 RETURN
  291. 9700 GOSUB 9560:OLDDISC=0:CDRST=0:PRINT " Insert Disc!":GOSUB 9740:GOSUB 9860
  292. 9710 FOR T=1 TO 400:NEXT T:GOSUB 9720:RETURN
  293. 9720 GOSUB 9560:FOR T=1 TO 100:NEXT T:RETURN
  294. 9730 GOSUB 9560:PRINT" Bad Disc? Dirty?":BEEP:FOR X=0 TO 4500:NEXT:RETURN
  295. 9740 COLOR INK,HOLE:LOCATE 12,13:PRINT BLK$;BLK$;:LOCATE 13,13:PRINT BLK$;BLK$:LOCATE 14,13:PRINT BLK$;BLK$
  296. 9750 COLOR GREY,HOLE:FOR X=1 TO 80:LOCATE SPOS,X:PRINT SCALE$;:NEXT:COLOR INK,PAPER:RETURN
  297. 9760 IF CDRST<1 THEN GOSUB 3900:CDRST=1:RETURN
  298. 9770 GOSUB 9880:GOSUB 9730:RETURN
  299. 9800 GOSUB 9560:PRINT "Drive Number? ";:GOSUB 6000:IF K>47 AND K<56 THEN T=VAL(K$) ELSE GOTO 9800
  300. 9810 GOSUB 9560:IF T=DRIVE THEN RETURN
  301. 9820 DF=0:DRIVE=T:OLDDISC=0:GOSUB 9890:GOSUB 8000:GOSUB 9850:RETURN
  302. 9850 GOSUB 3700:DT=ID(52):RETURN
  303. 9860 IF DT=67 THEN RETURN
  304. 9862 GOSUB 3400:CHUCK=DSTAT AND 64:COLOR INK,HOLE:LOCATE 17,3:IF CHUCK=64 THEN PRINT "Accept":KEY 1,"A"
  305. 9864 IF CHUCK=0 THEN PRINT "Eject ":KEY 1,"E"
  306. 9870 COLOR INK,PAPER:RETURN
  307. 9880 GOSUB 3950:GOSUB 3960:RETURN
  308. 9890 DVAR=DRIVE*8:DVAR=DVAR XOR 32:CMD=129 OR DVAR:DMC=131 OR DVAR:NOCMD=128 OR DVAR:NODMC=130 OR DVAR:RETURN
  309. 9900 GOSUB 7060:TIP=LBLUE:GOSUB 4400:Z=1:STIM=17:' Sample
  310. 9910 DEC=Z:GOSUB 5000:STRAC=BCD:ETRAC=153:GOSUB 3200
  311. 9920 GOSUB 9940:IF K$<>"" THEN RETURN
  312. 9930 Z=Z+1:IF Z>MAXTRAC THEN RETURN ELSE 9910:' Exit
  313. 9940 GOSUB 5200:GOSUB 4200:K$=INKEY$:IF K$<>"" THEN RETURN
  314. 9950 BCD=QCODE(5):GOSUB 5050:IF DEC<STIM THEN 9940
  315. 9960 RETURN
  316. 9970 ID$="":FOR Q=1 TO 52:ID$=ID$+CHR$(ID(Q)):NEXT :LOCATE 23,14:PRINT ID$
  317. 9980 FOR X=0 TO 9999:NEXT:LOCATE 23,14:PRINT BLK$;BLK$:RETURN
  318. 9990 FOR X=0 TO 100:J$=INKEY$:NEXT:RETURN
  319. 10000 KEY OFF:' \ Setup
  320. 10010 PRTA=&H300:' Program Card-Address
  321. 10020 PRTB=PRTA+1:PRTC=PRTA+2:DIRPRT=PRTA+3:NCMD=&H92:OTCMD=&H82:DRIVE=0
  322. 10030 GOSUB 9890:DIM QCODE(10),PTIM(6),HTIM(6),MTIM(6),RTIM(6),ID(52),QUE(100)
  323. 10040 NVPOS=12:CHANNELS=0:DF=0:SPOS=9:TIP$=CHR$(4):SCALE$=CHR$(254)
  324. 10060 BLUE=1:GREEN=2:CYAN=3:RED=4:MAGENTA=5:BROWN=6:WHITE=7:FLASH=16
  325. 10070 LBLUE=9:LGREEN=10:LCYAN=11:LRED=12:LMAGENTA=13:YELLOW=14:LWHITE=15:GREY=8
  326. 10080 PAPER=BLUE:INK=LWHITE:HOLE=BLACK:TIP=GREEN
  327. 10100 TOP$=CHR$(218):FOR X=2 TO 79:TOP$=TOP$+CHR$(196):NEXT X:TOP$=TOP$+CHR$(191)
  328. 10110 BOT$=TOP$:MID$(BOT$,1,1)=CHR$(192):MID$(BOT$,80,1)=CHR$(217)
  329. 10120 CET$=CHR$(179):FOR X=2 TO 79:CET$=CET$+" ":NEXT X:CET$=CET$+CHR$(179)
  330. 10200 KEY 1,"E":KEY 2,"S":KEY 3,"P":KEY 4,":":KEY 5,"{":KEY 6,"[":KEY 7,"]":KEY  8,"}":KEY 9,";":KEY 10,"N"
  331. 10210 FCN$="Eject  Sample  Play   <   <<<  <<  >>  >>>   >   Number   Pause   Cue   Quit"
  332. 10220 KFN$="  F1     F2     F3    F4   F5  F6  F7  F8   F9    F10     -----    C     Q"
  333. 10250 BLK$="                           "
  334. 10260 MTIM(1)=0:MTIM(2)=0:MTIM(3)=0:MTIM(4)=153:MTIM(5)=89:MTIM(6)=116
  335. 10280 TITLE$="RomPlay - Ver. 0.75e"
  336. 10500 RETURN
  337. 10600 OUT PRTA,255:OUT PRTC,223:RETURN
  338. 10900 COLOR INK,PAPER:CLS:PRINT TOP$;CET$;BOT$;
  339. 10910 LOCATE 2,30:PRINT TITLE$;
  340. 10912 LOCATE 4,1:COLOR HOLE,HOLE:PRINT CET$;CET$;CET$;CET$;:COLOR INK,PAPER
  341. 10920 GOSUB 9740:LOCATE 12,68:PRINT "Tracks"
  342. 10930 LOCATE 13,68:PRINT "Minutes":LOCATE 14,68:PRINT"Seconds";
  343. 10940 LOCATE 11,20:PRINT "TRACK      INDEX       MIN        SEC"
  344. 10960 COLOR ,HOLE:LOCATE 16:PRINT TOP$;CET$;CET$;BOT$;
  345. 10970 LOCATE 17,3:PRINT FCN$;:LOCATE 18,3:PRINT KFN$;:COLOR INK,PAPER:RETURN
  346. 32000 ' \ Romplay by Roscoe 71777,2564
  347. 32001 ' \ Hardware Direct - Hitachi CDR1503S/3500 CD-ROM Drives/PC bus
  348. 32002 ' \ twr15Jul89
  349.