home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / APOG / CDROM.ZIP / ROMPLAY.BAS < prev    next >
Encoding:
BASIC Source File  |  1988-10-18  |  16.1 KB  |  314 lines
  1. 1 REM SAVE"ROMPLAY.bas",A
  2. 10 GOSUB 10000:GOTO 9000
  3. 1000 ACK=INP(PRTB):IF ACK=2 THEN RETURN ELSE L=L+1:IF L<1400 THEN 1000 ELSE RUN
  4. 1050 ACK=INP(PRTB):IF ACK=2 THEN OUT PRTC,NOCMD:RETURN
  5. 1060 L=L+1:IF L<1025 THEN 1050 ELSE RUN
  6. 2000 OUT DIRPRT,OTCMD:RETURN :' \ OutDir
  7. 2999 ' \ CCC
  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>0 THEN 3010 ELSE RETURN:' ?busy
  10. 3199 ' \ TrackPlay
  11. 3200 GOSUB 3000:OUT PRTA,232 OR CHANNELS:OUT PRTC,CMD:GOSUB 1050
  12. 3210 OUT PRTA,STRACK:OUT PRTC,CMD:GOSUB 1050
  13. 3220 OUT PRTA,ETRACK: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
  16. 3310 FOR X=1 TO 6: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
  33. 3730 FOR Q=1 TO 52: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 K$=INKEY$:GOSUB 3400:IF DSTAT>7 OR K$<>"" THEN RETURN
  45. 4100 GOSUB 3600:NQ=QCODE(9):IF NQ=TQ THEN 4000 ELSE TQ=NQ
  46. 4110 QMODE=QCODE(1) AND 15:IF QMODE=1 THEN GOSUB 4200
  47. 4120 GOTO 4000
  48. 4200 QCTL=QCODE(1) AND 240:IF QCTL>63 THEN TINK=LRED ELSE TINK=INK
  49. 4210 COLOR TINK:LOCATE 9,41:BCD=QCODE(2):GOSUB 5050:PRINT DEC;"  ";
  50. 4220 LOCATE 10,41:BCD=QCODE(3):IF BCD>9 THEN GOSUB 5050 ELSE DEC=BCD
  51. 4230 PRINT DEC;"  ";:TMQ=QCODE(8):IF LMQ<>TMQ THEN GOSUB 4300
  52. 4240 LOCATE 12,41:BCD=QCODE(9):GOSUB 5050:PRINT DEC;" ";:RETURN
  53. 4300 BCD=TMQ:GOSUB 5050:NPOS=DEC:IF NPOS>MPOS THEN NPOS=MPOS
  54. 4310 GOSUB 4400:LMQ=TMQ:RETURN
  55. 4400 COLOR WHITE,HOLE:LOCATE SPOS,OPOS+1:PRINT SCALE$;
  56. 4410 COLOR TIP:LOCATE SPOS,NPOS+1:PRINT TIP$;
  57. 4420 OPOS=NPOS:LOCATE 11,41:COLOR TINK,PAPER:PRINT DEC;"  ";:RETURN
  58. 4999 ' \ >BCD
  59. 5000 BT1=INT(DEC/10):BT1=BT1*16
  60. 5010 BT2=DEC MOD 10:BCD=BT1 OR BT2:RETURN
  61. 5049 ' \ <BCD  Mask 240=11110000 15=00001111
  62. 5050 DT1=BCD AND 240:DT1=DT1/16:DT1=DT1*10
  63. 5060 DT2=BCD AND 15:DEC=DT2+DT1:RETURN
  64. 6000 K$=INKEY$:IF K$="" THEN 6000
  65. 6010 K=ASC(K$):RETURN
  66. 6200 IF K>47 AND K<58 THEN WK$=K$  ELSE WK$=""
  67. 6210 LOCATE 23,48:PRINT  WK$;"  ";
  68. 6220 GOSUB 6000:IF K=8 THEN  WK$="" ELSE IF K=13 THEN RETURN
  69. 6230 IF K>47 AND K<58 THEN WK$=WK$+K$:IF LEN(WK$)>2 THEN 6200
  70. 6240 IF K=32 THEN K$="":RETURN
  71. 6250 GOTO 6210
  72. 6300 GOSUB 7060:' \ CursorCue
  73. 6310 IF LEN(K$)<2 THEN GOSUB 6400:RETURN
  74. 6320 K$=RIGHT$(K$,1)
  75. 6330 IF K$="M" THEN NPOS=OPOS+1:IF NPOS>MPOS THEN NPOS=0
  76. 6340 IF K$="K" THEN NPOS=OPOS-1:IF NPOS<0 THEN NPOS=MPOS
  77. 6350 DEC=NPOS:GOSUB 4400
  78. 6360 IF K$="P" THEN GOSUB 6400:RETURN
  79. 6370 IF K$="H" THEN GOSUB 6390
  80. 6380 GOSUB 6000:GOTO 6310
  81. 6390 GOSUB 5000:GOSUB 10400:PTIM(1)=BCD:GOSUB 3810:GOSUB 7050:GOSUB 7000:T=NPOS:GOSUB 4200::NPOS=T:RETURN
  82. 6400 K$="":DEC=NPOS:GOSUB 5000:GOSUB 10400:PTIM(1)=BCD:GOSUB 3300:GOSUB 7060:RETURN
  83. 6500 GOSUB 8839:LOCATE 22,8:PRINT "< > StepQue  Fill  Clear  Shuffle  Insert  Delete  ToggleMode"
  84. 6510 GOSUB 6000:IF K=13 OR K=32 THEN GOSUB 6550:RETURN
  85. 6520 IF K$<>"" THEN GOSUB 9350:GOSUB 8839
  86. 6530 GOTO 6510
  87. 6550 LOCATE 22,8:FOR X=1 TO 70:PRINT " ";:NEXT X:IF QFLAG=1 THEN RETURN
  88. 6560 LOCATE 14,38:PRINT BLK$:RETURN
  89. 6600 IF MQUE>98 THEN RETURN ELSE GOSUB 9560:PRINT "Add what Track?";
  90. 6602 GOSUB 6200:TUNE=VAL(WK$):IF TUNE>MAXTRACK THEN 6602 ELSE IF TUNE=0 THEN GOSUB 9560:RETURN
  91. 6604 IF QUE(1)=0 THEN QUE(1)=TUNE:GOSUB 8840:GOSUB 9560:RETURN
  92. 6610 MQUE=MQUE+1:QUE(MQUE)=QUE(1):QUE(1)=TUNE:GOSUB 8840:GOSUB 9560:RETURN
  93. 6700 IF MQUE<2 THEN RETURN ELSE GOSUB 9560:PRINT "Num. to Delete?";
  94. 6702 GOSUB 6200:TUNE=VAL(WK$):IF TUNE>MAXTRACK THEN 6702 ELSE IF TUNE=0 THEN GOSUB 9560:RETURN
  95. 6710 TMQUE=MQUE:FOR X=1 TO MQUE:IF QUE(X)=TUNE THEN GOSUB 6750
  96. 6720 NEXT X:MQUE=TMQUE
  97. 6740 GOSUB 8840:GOSUB 9560:RETURN
  98. 6750 IF QUE(X)=TUNE THEN GOSUB 6780:IF TMQUE<X THEN RETURN
  99. 6752 IF QUE(X)=TUNE THEN 6750
  100. 6760 RETURN
  101. 6780 FOR X1=X TO MQUE:QUE(X1)=QUE(X1+1):NEXT X1:TMQUE=TMQUE-1:RETURN
  102. 6800 IF SKIPDIR=1 THEN GOSUB 8820 ELSE GOSUB 8830
  103. 6810 GOSUB 8840:K$="~":RETURN
  104. 7000 GOSUB 3600:QMODE=QCODE(1) AND 15:IF QMODE>1 THEN 7000:' \ Gtime
  105. 7010 RETURN
  106. 7050 WF=1:LOCATE 23,37:PRINT "PAUSED":RETURN
  107. 7060 IF QFLAG=1 THEN GOSUB 8700
  108. 7070 TIP=GREEN:GOSUB 4400:FINFLAG=0:RFLAG=0:WF=0:GOSUB 9560:RETURN
  109. 7100 GOSUB 7000:BCD=QCODE(2):GOSUB 5050:DEC=DEC+SKIPDIR:' \ Skip
  110. 7110 IF DEC>MAXTRACK THEN DEC=1 ELSE IF DEC<1 THEN DEC=MAXTRACK
  111. 7120 GOSUB 5000:STRACK=BCD:ETRACK=153:GOSUB 3200:GOSUB 7060:RETURN
  112. 7300 QMODE=QCODE(1) AND 15:IF QMODE>1 THEN GOSUB 7000:' \ Begin
  113. 7310 FOR Q=1 TO 3:RTIM(Q)=QCODE(Q+7):NEXT Q:RETURN
  114. 7400 QMODE=QCODE(1) AND 15:IF QMODE>1 THEN GOSUB 7000:' \ Finish
  115. 7410 FOR Q=4 TO 6:RTIM(Q)=QCODE(Q+4):NEXT Q:FINFLAG=1
  116. 7420 IF RTIM(1)>RTIM(4) THEN GOSUB 7060:RETURN
  117. 7430 IF RTIM(1)=RTIM(4) THEN IF RTIM(2)>=RTIM(5) THEN GOSUB 7060:RETURN
  118. 7440 TIP=LCYAN:GOSUB 4400:FOR Q=1 TO 6:PTIM(Q)=RTIM(Q):NEXT Q:RETURN
  119. 7500 GOSUB 9600:IF OLDDISC=1 THEN RETURN: ' \ Maxtimes?
  120. 7502 GOSUB 3400:IF DSTAT=4 THEN GOSUB 7000:FOR X=1 TO 3:HTIM(X)=QCODE(X+7):NEXT
  121. 7504 MQUE=1:QUE(1)=0:QFLAG=0
  122. 7510 GOSUB 10400:OPOS=0:LMQ=154:MAXM=0:GOSUB 3910:GOSUB 9740:CHANNELS=3:C=94:INC=-5:COLOR INK
  123. 7520 DEC=C:GOSUB 5000:PTIM(1)=BCD:GOSUB 7550:IF INC=1 AND DSTAT=8 THEN 7570
  124. 7530 LOCATE 6,41:PRINT C;:C=C+INC:IF C<0 THEN C=0:INC=1
  125. 7540 GOTO 7520
  126. 7550 GOSUB 3300:GOSUB 3400:IF DSTAT=4 THEN INC=1:' Play?
  127. 7560 RETURN
  128. 7570 IF C>1 THEN MAXM=C-1
  129. 7580 DEC=MAXM:GOSUB 5000:PTIM(1)=BCD:MPOS=MAXM:IF MAXM>79 THEN MPOS=79
  130. 7590 COLOR WHITE,HOLE:FOR X=0 TO MPOS:LOCATE SPOS,X+1:PRINT SCALE$;:NEXT:COLOR INK,PAPER
  131. 7600 INC=-3:C=56:MAXS=0:' Maxsec?
  132. 7610 DEC=C:GOSUB 5000:PTIM(2)=BCD:GOSUB 7550:IF INC=1 AND DSTAT=8 THEN 7660
  133. 7620 GOSUB 3600:QMODE=QCODE(1) AND 15:IF QMODE>1 THEN 7620
  134. 7630 LOCATE 7,41:PRINT C;:C=C+INC:IF C<0 THEN C=0:INC=1
  135. 7640 GOTO 7610
  136. 7660 IF C>1 THEN MAXS=C-1
  137. 7670 DEC=MAXS:GOSUB 5000:PTIM(2)=BCD:BCD=QCODE(2):GOSUB 5050:MAXTRACK=DEC
  138. 7680 LOCATE 5,41:PRINT MAXTRACK;"  ";:CHANNELS=0:OLDDISC=1:HTIM(4)=PTIM(1)
  139. 7690 HTIM(5)=PTIM(2):HTIM(6)=PTIM(3)
  140. 7692 IF HTIM(1)>0 THEN FOR X=1 TO 3:PTIM(X)=HTIM(X):NEXT:GOSUB 3300
  141. 7694 RETURN
  142. 7710 IF WF=1 THEN GOTO 7750:' \ Pause
  143. 7720 GOSUB 7000:GOSUB 3800:GOSUB 7050:GOSUB 10400
  144. 7730 PTIM(1)=QCODE(8):PTIM(2)=QCODE(9):PTIM(3)=QCODE(10):RETURN
  145. 7750 GOSUB 3300:GOSUB 7060:RETURN
  146. 7760 IF AFRAME<0 THEN AFRAME=AFRAME+74:ASEC=ASEC-1
  147. 7770 IF ASEC<0 THEN ASEC=ASEC+59:AMIN=AMIN-1
  148. 7780 IF AMIN<0 THEN AMIN=0
  149. 7790 RETURN
  150. 7800 IF WF=1 THEN 7750:' \ Cue
  151. 7810 GOSUB 7000:BCD=QCODE(8):GOSUB 5050:AMIN=DEC:BCD=QCODE(9):GOSUB 5050
  152. 7820 ASEC=DEC:BCD=QCODE(10):GOSUB 5050:AFRAME=DEC
  153. 7830 BCD=QCODE(4):GOSUB 5050:CMIN=DEC:BCD=QCODE(5):GOSUB 5050:CSEC=DEC
  154. 7840 BCD=QCODE(6):GOSUB 5050:CFRAME=DEC
  155. 7850 AMIN=AMIN-CMIN:ASEC=ASEC-CSEC:AFRAME=AFRAME-CFRAME:GOSUB 7760
  156. 7860 GOSUB 10400:DEC=AMIN:GOSUB 5000:PTIM(1)=BCD:DEC=ASEC:GOSUB 5000:PTIM(2)=BCD
  157. 7870 DEC=AFRAME:GOSUB 5000:PTIM(3)=BCD
  158. 7880 GOSUB 3810:GOSUB 7050:GOSUB 4100:RETURN
  159. 7900 GOSUB 10400:GOSUB 7000:BCD=QCODE(8):GOSUB 5050:CMIN=DEC:BCD=QCODE(9):GOSUB 5050:' >>
  160. 7910 DEC=DEC+INC:IF DEC<0 THEN DEC=DEC+59:CMIN=CMIN-1:IF CMIN<0 THEN CMIN=0:DEC=0
  161. 7920 IF DEC>59 THEN DEC=DEC-59:CMIN=CMIN+1:IF CMIN>MAXM THEN CMIN=MAXM-1
  162. 7930 GOSUB 5000:PTIM(2)=BCD:DEC=CMIN:GOSUB 5000:PTIM(1)=BCD
  163. 7940 GOSUB 7060:GOSUB 3300:RETURN
  164. 7950 GOSUB 10400:GOSUB 7000:BCD=QCODE(8):GOSUB 5050:DEC=DEC+INC:IF DEC<0 THEN DEC=0:QCODE(9)=0:' >>>
  165. 7970 IF DEC>MAXM THEN DEC=MAXM
  166. 7980 GOSUB 5000:PTIM(1)=BCD:PTIM(2)=QCODE(9):GOSUB 7060:GOSUB 3300:RETURN
  167. 8000 L=0:ACK=INP(PRTB):IF ACK>3 GOTO 8100:' \ ?Drive
  168. 8010 L=L+1:IF L=2 THEN GOSUB 8080
  169. 8020 OUT PRTC,NOCMD:OUT PRTA,255:OUT PRTC,CMD
  170. 8030 ACK=INP(PRTB):IF ACK=2 THEN GOSUB 8090:RETURN
  171. 8050 IF L<200 THEN 8010
  172. 8060 DRIVE=DRIVE+1:GOSUB 8600:IF DRIVE<4 THEN 8000
  173. 8070 LOCATE 23,25:PRINT "Power On Drive & Press a Key":GOSUB 6000:RUN
  174. 8080 COLOR INK+FLASH:LOCATE 23,30:PRINT "Checking for Drive! ";DRIVE:RETURN
  175. 8090 OUT PRTC,NOCMD:GOSUB 9560:GOSUB 8200:RETURN
  176. 8100 LOCATE 20:PRINT "Address Mismatch I/F Card-Program":LIST 10010:END
  177. 8200 GOSUB 3700:DT=ID(52)
  178. 8210 IF DT=67 THEN COLOR ,HOLE:LOCATE 16,10:PRINT"Sample":COLOR ,PAPER
  179. 8220 RETURN
  180. 8300 GOSUB 9560:PRINT "Drive Number? ";:GOSUB 6000:IF K>47 AND K<52 THEN DRIVE=VAL(K$) ELSE GOTO 8300
  181. 8310 PRINT K$;:OLDDISC=0:GOSUB 9560:GOSUB 8600:GOSUB 8000:GOSUB 8200:RETURN
  182. 8400 CHANNELS=0:GOSUB 3950:GOSUB 3960:RETURN
  183. 8600 IF DRIVE=0 THEN DVAR=0 ELSE IF DRIVE=1 THEN DVAR=8
  184. 8610 IF DRIVE=2 THEN DVAR=16 ELSE IF DRIVE=3 THEN DVAR=24
  185. 8650 CMD=129 OR DVAR:DMC=131 OR DVAR:NOCMD=128 OR DVAR:NODMC=130 OR DVAR:RETURN
  186. 8700 LOCATE 14,38:IF QFLAG=1 THEN PRINT BLK$;:QFLAG=0:TIP=GREEN:GOSUB 4400:RETURN:' \ Qoff
  187. 8710 IF QFLAG=0 THEN GOSUB 8839:QFLAG=1:FINFLAG=0:RFLAG=0:TIP=LRED:GOSUB 4400
  188. 8712 IF K$<>"/" THEN RETURN:' Rndplay
  189. 8714 MQUE=MAXTRACK:GOSUB 8720:GOSUB 8730:GOSUB 9400:RETURN
  190. 8720 FOR X=1 TO MQUE:QUE(X)=(MQUE+1)-X:NEXT X:RETURN:' Fillque
  191. 8730 FOR X=1 TO MQUE:TRAN=1+INT(RND(1)*MQUE):TQUE=QUE(TRAN):' Shuffle
  192. 8740 QUE(TRAN)=QUE(X):QUE(X)=TQUE:NEXT X:RETURN
  193. 8800 TUNE=QUE(1):IF TUNE=0 THEN GOSUB 8700:STRACK=1:ETRACK=53:RETURN:' @Que
  194. 8810 DEC=TUNE:GOSUB 5000:STRACK=BCD:ETRACK=BCD:GOSUB 8820:GOSUB 8840:RETURN
  195. 8820 TUNE=QUE(1):FOR X=1 TO MQUE-1:QUE(X)=QUE(X+1):NEXT X:QUE(MQUE)=TUNE:RETURN
  196. 8830 TUNE=QUE(MQUE):FOR X=MQUE TO 2 STEP -1:QUE(X)=QUE(X-1):NEXT X:QUE(1)=TUNE:RETURN
  197. 8839 LOCATE 14,38:PRINT "Que";
  198. 8840 LOCATE 14,41:PRINT QUE(1);"  ";:RETURN
  199. 8900 GOSUB 2000:COLOR INK,PAPER:CLS
  200. 8910 PRINT TOP$;CET$;BOT$:LOCATE 2,30:PRINT TITLE$;
  201. 8920 LOCATE 5,34:PRINT "Tracks"
  202. 8930 LOCATE 6,34:PRINT "Minutes":LOCATE 7,34:PRINT"Seconds";
  203. 8940 LOCATE 9,35:PRINT "Track":LOCATE 10,35:PRINT"Index"
  204. 8950 LOCATE 11,35:PRINT "Minute":LOCATE 12,35:PRINT "Second"
  205. 8960 COLOR ,HOLE:LOCATE 15:PRINT TOP$;CET$;CET$;BOT$;
  206. 8970 LOCATE 16,3:PRINT FCN$;:LOCATE 17,3:PRINT KFN$;:COLOR INK,PAPER:RETURN
  207. 9000 GOSUB 8900:GOSUB 8000:GOSUB 7500
  208. 9100 GOSUB 4000:IF DSTAT>31 THEN GOSUB 9600
  209. 9110 IF WF=0 THEN IF DSTAT=8 THEN K$="P"
  210. 9116 IF LEN(K$)>1 THEN GOSUB 6300
  211. 9120 IF K$<>"" THEN GOSUB 9200
  212. 9130 IF OLDDISC=0 THEN GOSUB 7500
  213. 9199 GOTO 9100
  214. 9200 IF K$="{" THEN INC=-1:GOSUB 7950
  215. 9210 IF K$="}" THEN INC=1:GOSUB 7950
  216. 9220 IF K$="[" THEN INC=-10:GOSUB 7900
  217. 9230 IF K$="]" THEN INC=10:GOSUB 7900:RETURN
  218. 9240 IF K$=" " THEN GOSUB 7710
  219. 9242 IF QFLAG=1 THEN GOSUB 9330
  220. 9250 IF K$="." OR K$=">" THEN SKIPDIR=1:GOSUB 7100
  221. 9260 IF K$="," OR K$="<" THEN SKIPDIR=-1:GOSUB 7100
  222. 9270 GOSUB 9660:IF K$="C" THEN GOSUB 7800
  223. 9280 IF K$="B" THEN GOSUB 7300
  224. 9290 IF K$="F" THEN GOSUB 7400
  225. 9300 IF K$="/" THEN GOSUB 8700
  226. 9302 IF K$="A" AND DT=67 THEN K$="S"
  227. 9304 IF K$="S" THEN GOSUB 9900
  228. 9306 IF K$="P" THEN GOSUB 9560:WF=0:GOSUB 9400
  229. 9308 IF K$="R" THEN GOSUB 7060:GOSUB 9500:RFLAG=1:TIP=LMAGENTA:GOSUB 4400
  230. 9310 IF K$="N" OR K>47 AND K<58 THEN GOSUB 7060:GOSUB 9500
  231. 9312 IF K$="M" THEN GOSUB 6500
  232. 9314 IF K$="T" THEN GOSUB 8700
  233. 9318 IF K$="I" THEN GOSUB 9970
  234. 9320 IF K$="D" THEN GOSUB 8300
  235. 9322 IF K$="Q" THEN GOSUB 3950:GOSUB 10600:COLOR INK,BLACK:CLS:SYSTEM
  236. 9326 FOR X=0 TO 6:J$=INKEY$:NEXT X:X=RND(1)
  237. 9329 RETURN
  238. 9330 IF K$="," OR K$="<" THEN SKIPDIR=-1:GOSUB 6800
  239. 9340 IF K$="." OR K$=">" THEN SKIPDIR=1:GOSUB 6800
  240. 9342 RETURN
  241. 9350 GOSUB 9660:GOSUB 9330
  242. 9352 IF K$="D" THEN GOSUB 6700
  243. 9354 IF K$="I" OR K>47 AND K<58 THEN GOSUB 6600
  244. 9356 IF K$="F" THEN MQUE=MAXTRACK:GOSUB 8720
  245. 9358 IF K$="S" THEN IF MQUE>2 THEN GOSUB 8730
  246. 9360 IF K$="C" THEN MQUE=1:QUE(1)=0:QFLAG=0
  247. 9362 IF K$="T" THEN GOSUB 8700
  248. 9399 GOSUB 9326:K$="M":RETURN
  249. 9400 IF OLDDISC=0 THEN GOSUB 7500:' \ Play
  250. 9410 IF RFLAG=1 THEN GOSUB 3200:RETURN
  251. 9420 IF FINFLAG=1 THEN GOSUB 3300:RETURN
  252. 9430 IF QFLAG=1 THEN GOSUB 8800:GOSUB 3200:RETURN
  253. 9450 GOSUB 10400:GOSUB 3300:RETURN
  254. 9500 GOSUB 9560:PRINT "Starting Track: ";:GOSUB 6200:STRACK=VAL(WK$):' #Play
  255. 9510 IF STRACK<1 THEN STRACK=1 ELSE IF STRACK>MAXTRACK THEN STRACK=MAXTRACK
  256. 9520 DEC=STRACK:GOSUB 5000:STRACK=BCD:GOSUB 9560
  257. 9530 GOSUB 9560:PRINT "  Ending Track: ";:GOSUB 6200:ETRACK=VAL(WK$)
  258. 9540 IF ETRACK<1 OR ETRACK<STRACK THEN ETRACK=99
  259. 9550 GOSUB 9560:DEC=ETRACK:GOSUB 5000:ETRACK=BCD:GOSUB 3200:RETURN
  260. 9560 LOCATE 23,30:COLOR INK:PRINT BLK$;:LOCATE 23,30:RETURN
  261. 9600 K$=INKEY$:IF K$<>"" THEN GOSUB 9660:' \ Error?
  262. 9610 GOSUB 3010:GOSUB 3400:IF DSTAT=8 THEN RETURN:' Pause
  263. 9620 IF DSTAT>127 THEN GOSUB 9760:GOTO 9600
  264. 9630 IF DSTAT>63 THEN GOSUB 9700
  265. 9640 IF DSTAT=4 THEN RETURN:' Play
  266. 9650 GOTO 9600
  267. 9660 K=ASC(K$):IF K>96 AND K<123 THEN K=K-32:K$=CHR$(K)
  268. 9670 IF K$="A" AND DT=51 THEN GOSUB 3400:IF DSTAT>63 THEN GOSUB 3920:' Eat
  269. 9680 IF K$="E" THEN GOSUB 7060:GOSUB 8400:' Eject
  270. 9682 IF K=27 THEN LOCATE 19:STOP
  271. 9690 RETURN
  272. 9700 GOSUB 9560:OLDDISC=0:CDRST=0:PRINT " Insert Disc!":GOSUB 9740
  273. 9710 FOR T=1 TO 400:NEXT T:GOSUB 9720:RETURN
  274. 9720 GOSUB 9560:FOR T=1 TO 100:NEXT T:RETURN
  275. 9730 GOSUB 9560:PRINT" Dirty Lens? Disc?":BEEP:FOR X=0 TO 4500:NEXT:RETURN
  276. 9740 FOR X=5 TO 12:LOCATE X,42:PRINT "   ";:NEXT X
  277. 9750 COLOR GREY,HOLE:FOR X=1 TO 80:LOCATE SPOS,X:PRINT SCALE$;:NEXT:COLOR INK,PAPER:RETURN
  278. 9760 IF CDRST<1 THEN GOSUB 3900:CDRST=1:RETURN
  279. 9770 GOSUB 8400:GOSUB 9730:RETURN
  280. 9900 GOSUB 7060:TIP=LBLUE:GOSUB 4400:Z=1:STIM=17:' Sample
  281. 9910 DEC=Z:GOSUB 5000:STRACK=BCD:ETRACK=153:GOSUB 3200
  282. 9920 GOSUB 9940:IF K$<>"" THEN RETURN
  283. 9930 Z=Z+1:IF Z>MAXTRACK THEN RETURN ELSE 9910
  284. 9940 GOSUB 7000:GOSUB 4200:K$=INKEY$:IF K$<>"" THEN RETURN
  285. 9950 BCD=QCODE(5):GOSUB 5050:IF DEC<STIM THEN 9940
  286. 9960 RETURN
  287. 9970 GOSUB 3700:ID$="":FOR Q=1 TO 52:ID$=ID$+CHR$(ID(Q)):NEXT Q
  288. 9980 LOCATE 23,14:PRINT ID$:FOR X=1 TO 9000:NEXT:LOCATE 23,14:PRINT BLK$;BLK$
  289. 9999 RETURN
  290. 10000 KEY OFF:' \ Setup
  291. 10010 PRTA=&H300:' Program Card-Address
  292. 10020 PRTB=PRTA+1:PRTC=PRTA+2:DIRPRT=PRTA+3:NCMD=&H92:OTCMD=&H82:GOSUB 2000
  293. 10030 DRIVE=0:GOSUB 8600:DIM QCODE(10),PTIM(6),HTIM(6),MTIM(6),ID(52),QUE(100)
  294. 10040 CHANNELS=0:SPOS=20:TIP$=CHR$(4):SCALE$=CHR$(254)
  295. 10060 BLUE=1:GREEN=2:CYAN=3:RED=4:MAGENTA=5:BROWN=6:WHITE=7:FLASH=16
  296. 10070 LBLUE=9:LGREEN=10:LCYAN=11:LRED=12:LMAGENTA=13:YELLOW=14:LWHITE=15:GREY=8
  297. 10080 PAPER=BLUE:INK=LWHITE:HOLE=BLACK:TIP=GREEN
  298. 10100 TOP$=CHR$(218):FOR X=2 TO 79:TOP$=TOP$+CHR$(196):NEXT X:TOP$=TOP$+CHR$(191)
  299. 10110 BOT$=TOP$:MID$(BOT$,1,1)=CHR$(192):MID$(BOT$,80,1)=CHR$(217)
  300. 10120 CET$=CHR$(179):FOR X=2 TO 79:CET$=CET$+" ":NEXT X:CET$=CET$+CHR$(179)
  301. 10200 KEY 1,"E":KEY 2,"A":KEY 3,"P":KEY 4,"<":KEY 5,"{":KEY 6,"[":KEY 7,"]":KEY  8,"}":KEY 9,">":KEY 10,"N"
  302. 10210 FCN$="Eject  Accept  Play   <   <<<  <<  >>  >>>   >   Number   Pause   Cue   Quit"
  303. 10220 KFN$="  F1     F2     F3    F4   F5  F6  F7  F8   F9    F10     -----    C     Q"
  304. 10250 BLK$="                           "
  305. 10260 TITLE$="Romplay - Ver. 0.75"
  306. 10300 FOR X=1 TO 3:MTIM(X)=0:NEXT
  307. 10310 MTIM(4)=153:MTIM(5)=89:MTIM(6)=116:RETURN:' 99,59,74
  308. 10400 FOR X=1 TO 6:PTIM(X)=MTIM(X):NEXT
  309. 10500 RETURN
  310. 10600 OUT PRTA,255:OUT PRTC,223:RETURN:' Clear I/F
  311. 32000 ' \ Romplay - by Roscoe 71777,2564
  312. 32001 ' \ Hitachi CDR1503S/CDR3500 CD-ROM Drive
  313. 32002 ' \ Hardware Direct PC bus - twr18Oct88
  314.