home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / util / cdro / 001 / romplay2.bas < prev    next >
BASIC Source File  |  1989-07-15  |  17KB  |  316 lines
  1. 1 REM SAVE"ROMPLAY2.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:LOCATE 9,41:BCD=QCODE(2):GOSUB 5050:PRINT DEC;"  ";
  50. 4220 LOCATE 10,41:BCD=QCODE(3):GOSUB 5050
  51. 4230 PRINT DEC;"  ";
  52. 4240 BCD=QCODE(8):GOSUB 5050:NPOS=DEC:IF NPOS>MPOS THEN NPOS=MPOS
  53. 4250 LOCATE 11,41:PRINT DEC;"  ";
  54. 4260 LOCATE 12,41:BCD=QCODE(9):GOSUB 5050:PRINT DEC;" ";
  55. 4400 COLOR WHITE,HOLE:IF NPOS<>OPOS THEN LOCATE SPOS,OPOS+1:PRINT SCALE$;
  56. 4410 COLOR TIP:LOCATE SPOS,NPOS+1:PRINT TIP$;:OPOS=NPOS:COLOR TINK,PAPER:RETURN
  57. 4999 ' \ >BCD
  58. 5000 D1=INT(DEC/10):D1=D1*16:D2=DEC MOD 10:BCD=D1 OR D2:RETURN
  59. 5049 ' \ <BCD  Mask 240=11110000 15=00001111
  60. 5050 D1=BCD AND 240:D1=D1/16:D1=D1*10:D2=BCD AND 15:DEC=D2+D1:RETURN
  61. 5100 FOR X=1 TO 6:PTIM(X)=MTIM(X):NEXT:RETURN
  62. 5200 GOSUB 3600:QMODE=QCODE(1) AND 15:IF QMODE>1 THEN 5200:' \ Gtime
  63. 5210 RETURN
  64. 5500 GOSUB 9600:IF OLDDISC=1 THEN RETURN: ' \ >MaxMin
  65. 5502 GOSUB 9860:GOSUB 3910:GOSUB 5100:GOSUB 9460:MQUE=1:QUE(1)=0:QFLAG=0:OPOS=0
  66. 5510 GOSUB 9740:CHANNELS=3:MAXM=0:C=94:INC=-5:COLOR INK
  67. 5520 DEC=C:GOSUB 5000:PTIM(1)=BCD:GOSUB 5550:IF INC=1 AND DSTAT=8 THEN 5570
  68. 5530 LOCATE 6,41:PRINT C;:C=C+INC:IF C<0 THEN C=0:INC=1
  69. 5532 IF C>99 THEN RETURN
  70. 5540 GOTO 5520
  71. 5550 GOSUB 3300:GOSUB 3400:IF DSTAT=4 THEN INC=1:' ?Play
  72. 5560 RETURN
  73. 5570 IF C>1 THEN MAXM=C-1
  74. 5580 DEC=MAXM:GOSUB 5000:PTIM(1)=BCD:MPOS=MAXM:IF MAXM>79 THEN MPOS=79
  75. 5590 COLOR WHITE,HOLE:FOR X=0 TO MPOS:LOCATE SPOS,X+1:PRINT SCALE$;:NEXT:COLOR INK,PAPER
  76. 5600 INC=-3:C=56:MAXS=0:' >MaxSec
  77. 5610 DEC=C:GOSUB 5000:PTIM(2)=BCD:LOCATE 7,41:PRINT C;"  ";
  78. 5620 GOSUB 5550:IF INC=1 AND DSTAT=8 THEN 5650
  79. 5630 C=C+INC:IF C<0 THEN C=0:INC=1
  80. 5632 IF C>60 THEN RETURN
  81. 5640 GOTO 5610
  82. 5650 IF C>1 THEN MAXS=C-1
  83. 5660 ASEC=C-2:IF ASEC<0 THEN ASEC=ASEC+59:DEC=MAXM-1:GOSUB 5000:PTIM(1)=BCD
  84. 5670 DEC=ASEC:GOSUB 5000:PTIM(2)=BCD:GOSUB 3300
  85. 5680 GOSUB 5200:BCD=QCODE(2):GOSUB 5050:MAXTRAC=DEC
  86. 5690 LOCATE 5,41:PRINT MAXTRAC;"  ";:CHANNELS=0:OLDDISC=1
  87. 5692 IF HTIM(1)>0 THEN FOR X=1 TO 3:PTIM(X)=HTIM(X):NEXT:GOSUB 3300
  88. 5694 RETURN
  89. 6000 K$=INKEY$:IF K$="" THEN 6000
  90. 6010 K=ASC(K$):RETURN
  91. 6200 IF K>47 AND K<58 THEN WK$=K$ ELSE WK$=""
  92. 6210 LOCATE 23,48:PRINT WK$;"  ";
  93. 6220 GOSUB 6000:IF K=8 THEN WK$="" ELSE IF K=13 THEN RETURN
  94. 6230 IF K>47 AND K<58 THEN WK$=WK$+K$:IF LEN(WK$)>2 THEN 6200
  95. 6240 IF K=32 THEN K$="":RETURN
  96. 6250 GOTO 6210
  97. 6300 GOSUB 7060:' \ SlideCue
  98. 6310 IF LEN(K$)<2 THEN GOSUB 6400:RETURN
  99. 6320 K$=RIGHT$(K$,1):IF K$="M" THEN NPOS=OPOS+1:IF NPOS>MPOS THEN NPOS=0
  100. 6330 IF K$="K" THEN NPOS=OPOS-1:IF NPOS<0 THEN NPOS=MPOS
  101. 6350 DEC=NPOS:GOSUB 4400:LOCATE 11,41:PRINT NPOS;"  ";
  102. 6360 IF K$="P" THEN GOSUB 6400:RETURN
  103. 6370 IF K$="H" THEN GOSUB 6390
  104. 6380 GOSUB 6000:GOTO 6310
  105. 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
  106. 6400 K$="":GOSUB 5000:GOSUB 5100:PTIM(1)=BCD:PTIM(2)=0:GOSUB 3300:GOSUB 5200:GOSUB 7060:GOSUB 9990:RETURN
  107. 7050 WF=1:LOCATE 23,37:PRINT "PAUSED":RETURN
  108. 7060 IF QFLAG=1 THEN GOSUB 8700:RETURN
  109. 7070 TIP=YELLOW:GOSUB 4400:FINFLAG=0:RFLAG=0:WF=0:GOSUB 9560:RETURN
  110. 7100 GOSUB 5200:BCD=QCODE(2):GOSUB 5050:DEC=DEC+SKIPDIR:' \ Skip
  111. 7110 IF DEC>MAXTRAC THEN DEC=1 ELSE IF DEC<1 THEN DEC=MAXTRAC
  112. 7120 GOSUB 5000:STRAC=BCD:ETRAC=153:GOSUB 3200:GOSUB 7060:GOSUB 9990:RETURN
  113. 7300 QMODE=QCODE(1) AND 15:IF QMODE>1 THEN GOSUB 5200:' \ SectionPlayBegin
  114. 7310 FOR Q=1 TO 3:RTIM(Q)=QCODE(Q+7):NEXT Q:RETURN
  115. 7400 QMODE=QCODE(1) AND 15:IF QMODE>1 THEN GOSUB 5200:' \ Finish
  116. 7410 FOR Q=4 TO 6:RTIM(Q)=QCODE(Q+4):NEXT Q:FINFLAG=1
  117. 7420 IF RTIM(1)>RTIM(4) THEN GOSUB 7060:RETURN
  118. 7430 IF RTIM(1)=RTIM(4) THEN IF RTIM(2)>=RTIM(5) THEN GOSUB 7060:RETURN
  119. 7440 TIP=LCYAN:GOSUB 4400:FOR Q=1 TO 6:PTIM(Q)=RTIM(Q):NEXT Q:RETURN
  120. 7710 IF WF=1 THEN GOTO 7750:' \ Pause
  121. 7720 GOSUB 5200:GOSUB 3800:GOSUB 7050:GOSUB 5100
  122. 7730 PTIM(1)=QCODE(8):PTIM(2)=QCODE(9):PTIM(3)=QCODE(10):RETURN
  123. 7750 GOSUB 3300:GOSUB 7060:RETURN
  124. 7760 IF AFRAME<0 THEN AFRAME=AFRAME+74:ASEC=ASEC-1
  125. 7770 IF ASEC<0 THEN ASEC=ASEC+59:AMIN=AMIN-1
  126. 7780 IF AMIN<0 THEN AMIN=0
  127. 7790 RETURN
  128. 7800 IF WF=1 THEN 7750:' \ Cue
  129. 7810 GOSUB 5200:BCD=QCODE(8):GOSUB 5050:AMIN=DEC:BCD=QCODE(9):GOSUB 5050
  130. 7820 ASEC=DEC:BCD=QCODE(10):GOSUB 5050:AFRAME=DEC
  131. 7830 BCD=QCODE(4):GOSUB 5050:CMIN=DEC:BCD=QCODE(5):GOSUB 5050:CSEC=DEC
  132. 7840 BCD=QCODE(6):GOSUB 5050:CFRAME=DEC
  133. 7850 AMIN=AMIN-CMIN:ASEC=ASEC-CSEC:AFRAME=AFRAME-CFRAME:GOSUB 7760
  134. 7860 GOSUB 5100:DEC=AMIN:GOSUB 5000:PTIM(1)=BCD:DEC=ASEC:GOSUB 5000:PTIM(2)=BCD
  135. 7870 DEC=AFRAME:GOSUB 5000:PTIM(3)=BCD
  136. 7880 GOSUB 3810:GOSUB 7050:GOSUB 4100:RETURN
  137. 7900 GOSUB 5100:GOSUB 5200:BCD=QCODE(8):GOSUB 5050:CMIN=DEC:BCD=QCODE(9):GOSUB 5050:' >>
  138. 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
  139. 7920 IF DEC>59 THEN DEC=DEC-59:CMIN=CMIN+1
  140. 7922 IF CMIN>MAXM OR CMIN<0 THEN CMIN=0
  141. 7930 GOSUB 5000:PTIM(2)=BCD:DEC=CMIN:GOSUB 5000:PTIM(1)=BCD
  142. 7940 GOSUB 3300:GOSUB 7060:GOSUB 9990:RETURN
  143. 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:' >>>
  144. 7970 IF AMIN>MAXM OR AMIN<0 THEN AMIN=0
  145. 7980 DEC=AMIN:GOSUB 5000:PTIM(1)=BCD:PTIM(2)=QCODE(9):GOSUB 3300:GOSUB 7060:GOSUB 9990:RETURN
  146. 8000 L=0:ACK=INP(PRTB) AND 3:IF ACK>0 THEN 8100:' \ Drive?
  147. 8002 OUT PRTC,NOCMD:OUT PRTA,255
  148. 8010 L=L+1:IF L=2 THEN GOSUB 8080
  149. 8020 OUT PRTC,CMD
  150. 8030 ACK=INP(PRTB) AND 3:IF ACK=2 THEN GOSUB 8090:RETURN
  151. 8050 IF L<200 THEN 8010
  152. 8060 IF DF=