home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / util / cdro / 001 / romplay3.bas < prev   
BASIC Source File  |  1989-07-15  |  18KB  |  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