home *** CD-ROM | disk | FTP | other *** search
/ The Glitch Apple Disk Collection / 2014.glitch.apple.collection.zip / indexed / COMPKARA.DSK / P19.bas < prev    next >
BASIC Source File  |  2014-09-09  |  13KB  |  175 lines
  1. 10  REM  (C) 1984 EDWARD BADASOV
  2. 11  REM  COMPETITION KARATE
  3. 70  ONERR  GOTO 19000
  4. 80  GOSUB 1002:E = 1:CU$ = "]":ES$ =  CHR$(27)
  5. 90  GOSUB 20020: GOSUB 21010: GOSUB 21210: GOTO 21920
  6. 503 C$ = "": GOSUB 1000: PRINT "["CU$;
  7. 506  IF  PEEK(PE%) <128  THEN 506
  8. 509  GET A$: IF A$ =  CHR$(13)  THEN  PRINT : GOSUB 600:E =  RND( -( PEEK(78) + PEEK(79) *256)):E = 1: RETURN 
  9. 510  IF A$ = ES$  THEN C$ = ES$: PRINT : RETURN 
  10. 512  IF  LEN(C$) = 1  AND A$ = BS$  THEN  PRINT A$SP$A$A$CU$;
  11. 515  IF (A$ <SP$  AND A$ < >BS$)  OR A$ = ","  OR ( LEN(C$) <1  AND A$ = SP$)  THEN  PRINT S1$;: GOTO 506
  12. 518  IF  LEN(C$) <2  AND A$ = BS$  THEN C$ = "": GOTO 506
  13. 521  IF A$ < >BS$  AND  LEN(C$) = 15  THEN  PRINT S1$;: GOTO 506
  14. 524 C$ = C$ +A$
  15. 527  IF A$ = BS$  THEN  PRINT A$SP$A$A$CU$;:C$ =  LEFT$(C$, LEN(C$) -2): GOTO 506
  16. 530  PRINT BS$A$CU$;: GOTO 506
  17. 600  IF  RIGHT$(C$,1) = SP$  THEN C$ =  LEFT$(C$, LEN(C$) -1): GOTO 600
  18. 601  RETURN 
  19. 1000  POKE PK%,0: POKE 6,46: POKE 7,3: CALL 768: RETURN 
  20. 1002 SP$ = " ":BS$ =  CHR$(8):D$ =  CHR$(4): GOSUB 1100:HR$ = "STRIKE KEY WHEN READY":SC$ = "  ":L1$ = "========================================":R1% = 16:R2% = 3:R% = 0:CNT% = 0:PK% =  -16368:PE% =  -16384:DF% = 0: DIM PNA$(30):PF% = 0:NS$ = ""
  21. 1020 K1$ = "STRIKE ANY KEY TO STOP THE":K2$ = "KARMIC NUMBERS OF FATE": FOR I = 1 TO 9: READ ABIL$(I): NEXT :US% = 0:WI% = 0:LO% = 0:EX% = 1:T1% = 0:T2% = 0:T3% = 0:PNTS% = 0:REDY% = 0:S1$ =  CHR$(7):S$ = S1$ +S1$:RO$ = ".ROSTER": RETURN 
  22. 1100  GOSUB 2100: ONERR  GOTO 19000
  23. 1105  PRINT D$"OPEN UL.4,D1"
  24. 1110  PRINT D$"READ UL.4"
  25. 1115  FOR I = 1 TO 5: INPUT INST$(I): FOR J = 1 TO 4: INPUT IAB%(I,J): NEXT J,I
  26. 1120  PRINT D$"CLOSE"
  27. 1130  RETURN 
  28. 2000  ONERR  GOTO 2010
  29. 2005 SS% = 786: IF  PEEK(798) = 2  OR DF%  THEN 2020
  30. 2010  CALL SS%: VTAB 24: PRINT "INSERT DATA DISK IN DRIVE "; PEEK(798);" AND HIT KEY";: GOSUB 1000: GET A$: VTAB 23: CALL  -958: PRINT 
  31. 2015  IF A$ = ES$  THEN  HOME : HTAB 15: FLASH : PRINT " NOT SAVED ": NORMAL : POP : POP : VTAB 24: GOTO 22075
  32. 2020 SS% = 787: PRINT D$"VERIFY STUDENTS & ROSTERS,D" PEEK(798)
  33. 2030 DF% = 1: RETURN 
  34. 2100  ONERR  GOTO 2110
  35. 2105 SS% = 786: IF  PEEK(798) = 2  OR   NOT DF%  THEN 2120
  36. 2110  CALL SS%: VTAB 24: HTAB 1: PRINT "INSERT GAME DISK IN DRIVE 1 AND HIT KEY";: GOSUB 1000: GET A$: VTAB 23: CALL  -958: PRINT 
  37. 2120 SS% = 787: PRINT D$"VERIFY P20,D1"
  38. 2130 DF% = 0: RETURN 
  39. 10000  HOME : FLASH : HTAB 12: PRINT " CREATE DATA DISK ": NORMAL : POKE 34,7
  40. 10010  VTAB 10: FLASH : PRINT S$" WARNING ";: NORMAL : PRINT " CREATION OF DATA DISK DESTROYS  ANY EXISTING DATA ON THE TARGET DISK."
  41. 10020  PRINT : PRINT "STRIKE [!] TO PROCEED, [ANY KEY] ABORTS";: GET A$: PRINT : IF A$ < >"!"  THEN  RETURN 
  42. 10030  POKE KB%,0: POKE 34,13: VTAB 13: CALL  -958
  43. 10040  PRINT : PRINT "INSERT TARGET DISK IN DRIVE " PEEK(798): PRINT : PRINT "STRIKE [ANY KEY] TO CONTINUE ";: GOSUB 1000: GET A$: PRINT : IF A$ = ES$  THEN  RETURN 
  44. 10050  ONERR  GOTO 10080
  45. 10060  PRINT : PRINT D$"VERIFY P20,D" PEEK(798)
  46. 10061  ONERR  GOTO 19000
  47. 10070  PRINT : FLASH : PRINT S$S$" REMOVE GAME DISK FROM DRIVE!! ": NORMAL : PRINT : PRINT "STRIKE [ANY KEY] TO CONTINUE ";: GET A$: PRINT : GOTO 10030
  48. 10080  CALL 787: ONERR  GOTO 19000
  49. 10090  PRINT : VTAB 20: HTAB 15: FLASH : PRINT " CREATING ": NORMAL : POKE 34,23: VTAB 23
  50. 10100  PRINT : POKE 214,0: PRINT D$"INITCKH,D" PEEK(798)
  51. 10101  POKE 214,128
  52. 10110  PRINT D$"DELETECKH,D" PEEK(798)
  53. 10120  PRINT D$"BSAVE STUDENTS & ROSTERS,A768,L1,D" PEEK(798)
  54. 10130  PRINT D$"LOCK STUDENTS & ROSTERS,D" PEEK(798)
  55. 10140  INVERSE : VTAB 20: HTAB 15: GOSUB 1000: PRINT " COMPLETED ": NORMAL : FOR I = 1 TO 2000: NEXT :DF% = 1: RETURN 
  56. 19000  CALL 787: POKE PK%,0: IF  PEEK(222) = 255  THEN  CALL 803
  57. 19002  IF  PEEK(222) < >9  THEN 19010
  58. 19005  FLASH : PRINT : PRINT S$"DATA DISK IS FULL": NORMAL : PRINT : PRINT "INSERT A PREPARED DATA DISK WITH FREE   SPACE AND STRIKE [ANY KEY] TO CONTINUE": PRINT "OR [ESC] TO ABORT ";: GET A$: PRINT : IF A$ < >ES$  THEN  ON FL% GOTO 22340,22551
  59. 19006  ON FL% GOTO 19065,19022
  60. 19010  IF  PEEK(222) < >6  THEN 19050
  61. 19015  IF  PEEK(222) = 6  THEN  FLASH : HOME : PRINT S$"TEAM ROSTER NOT FOUND": NORMAL : IF P$ = "C"  THEN 19025
  62. 19020  PRINT : PRINT "[C]REATE ROSTER USING EXISTING NAME     [E]NTER ANOTHER ROSTER NAME ? [C]";: HTAB  PEEK(36) -1: GET A$: IF A$ = "E"  THEN  PRINT A$: GOTO 19035
  63. 19022  PRINT : IF A$ = ES$  OR PNA$ = ""  THEN  POP : HOME : FLASH : HTAB 15: PRINT " NOT ADDED ": NORMAL : VTAB 23: GOTO 22075
  64. 19025  IF   NOT EF%  THEN  HOME : RETURN 
  65. 19026  IF EF%  THEN  HOME : GOTO 22550
  66. 19034  IF P$ = "C"  THEN  POKE 800,1 + PEEK(800):PNA$ = "COMPUTER-" + STR$( PEEK(800)):PF% = 1: GOTO 19042
  67. 19035  PRINT : PRINT "[NEW ROSTER]  [C]ATALOG  [ESC]=ABORT": PRINT "=> ";: GOSUB 503:PNA$ = C$: IF PNA$ = "C"  THEN  POKE 44452,7: POKE 44605,6: GOSUB 22710: GOTO 19035
  68. 19036  IF PNA$ = ES$  THEN 19022
  69. 19040  IF PNA$ = ""  THEN  HOME : GOTO 19035
  70. 19042  HOME : GOTO 22500
  71. 19050  IF  PEEK(222) < >10  THEN 19070
  72. 19055  IF  PEEK(222) = 10  THEN  FLASH : PRINT : PRINT S$"THERE IS ALREADY A STUDENT BY THIS NAME": NORMAL 
  73. 19060  PRINT : PRINT "[NEW NAME]  [C]ATALOG  [ESC]=ABORT": PRINT "=> ";: GOSUB 503:NA$ = C$: IF C$ = ""  THEN  HOME : GOTO 19060
  74. 19061  IF NA$ = "C"  THEN  POKE 44452,11: POKE 44605,10: GOSUB 22710: GOTO 19060
  75. 19063  PRINT : IF NA$ < >ES$  THEN 22340
  76. 19065  HOME : HTAB 15: FLASH : PRINT " NOT SAVED ": NORMAL : POP : VTAB 23: GOTO 22075
  77. 19070  FLASH : PRINT S$" DISK ERROR ";: NORMAL : PRINT " CHECK SETUP AND STRIKE KEY";: GET A$: HTAB 1: CALL  -868: VTAB  PEEK(37): PRINT : RESUME 
  78. 20020  HOME : POKE 34,6: INVERSE : HTAB 14: PRINT " NEW STUDENT ": NORMAL : IF R%  THEN 20110
  79. 20021  HOME : PRINT : HTAB 7: PRINT "WELCOME TO STUDENT CREATION!!": VTAB 14: HTAB 10: PRINT "PRESS [Y] IF YOU NEED": PRINT : HTAB 10: PRINT "TO CREATE A DATA DISK"
  80. 20080  GOSUB 21510: IF A$ = ES$  THEN  POP : GOTO 22440
  81. 20085  IF A$ = "Y"  THEN  GOSUB 10000: POKE 34,6
  82. 20110  HOME : PRINT : PRINT "FOR SOLITAIRE PLAY, THE COMPUTER CAN    GENERATE IT'S OWN STUDENTS.": PRINT 
  83. 20112  PRINT : PRINT "STUDENT TO BE CREATED BY:": PRINT : PRINT "[P]LAYER OR [C]OMPUTER ? [P]";: HTAB  PEEK(36) -1: GOSUB 1000: GET P$: IF P$ = ES$  THEN 20021
  84. 20115  POKE 34,4: RETURN 
  85. 21010  HOME : PRINT "BELOW ARE THE AVAILABLE MARTIAL ARTS    INSTRUCTORS.  BY THEIR NAMES ARE LISTED ABILITIES WHICH THEIR STYLES EXCEL IN.": PRINT 
  86. 21030  FOR I = 1 TO 5: PRINT "[";I;"]  ";: INVERSE : PRINT INST$(I);: NORMAL : PRINT " -": HTAB 7: FOR J = 1 TO 3: PRINT ABIL$(IAB%(I,J));: IF J < >3  THEN  PRINT ", ";
  87. 21035  NEXT J: PRINT : PRINT : NEXT I: PRINT  TAB( 7);"SELECT ONE -> [ ]";: IF P$ = "C"  THEN  FOR I = 1 TO 500: NEXT :IN% =  RND(E) *5 +1: GOTO 21060
  88. 21050  HTAB 22: VTAB 24: PRINT SP$;: HTAB 22: GOSUB 1000: GET A$: IF A$ = ES$  THEN  POP : GOTO 90
  89. 21051  IF A$ <"1"  OR A$ >"5"  THEN 21050
  90. 21052 IN% =  VAL(A$)
  91. 21060  HTAB 22: VTAB 24: PRINT IN%;: GOSUB 21610: FOR I = 1 TO 700: NEXT : RETURN 
  92. 21100  INVERSE : HTAB 8: PRINT K1$: PRINT : HTAB 10: PRINT K2$: NORMAL : RETURN 
  93. 21210  HOME : FOR I = 1 TO 9: VTAB I +5: HTAB 7: PRINT ABIL$(I): NEXT : PRINT : PRINT "OVERALL AVERAGE : 0";: HTAB 25: PRINT "HT:      WT:": VTAB 18: PRINT L1$: POKE 34,19: IF P$ < >"C"  THEN  GOSUB 21100: GOSUB 1000
  94. 21227 AVG% = 0:H% = 19: FOR I = 1 TO 9: POKE PK%,0:V% = I +5: VTAB V%: HTAB H% -1: PRINT "[  ]";: HTAB 7: INVERSE : PRINT ABIL$(I);
  95. 21228  IF P$ = "C"  THEN  FOR J = 1 TO 15: NEXT :R% =  RND(E) *16 +3: GOTO 21285
  96. 21280 R% =  RND(E) *R1% +R2%: HTAB H%: PRINT SC$;: HTAB H%: PRINT R%;: IF  PEEK(PE%) <128  THEN 21280
  97. 21285  NORMAL : POKE 6,120 -8 *I: POKE 7,15: CALL 768: HTAB 6: CALL  -868: PRINT " "ABIL$(I);:AB%(I) = R%: HTAB H%: PRINT AB%(I);: HTAB 25: GOSUB 22250:AVG% = AVG% +AB%(I): VTAB 16: HTAB H%: PRINT SC$;: HTAB H%: PRINT  INT(AVG%/I +.5): NEXT 
  98. 21290  FOR I = 1 TO 300: NEXT : VTAB 19: CALL  -958: FOR I = 1 TO 9: FOR J = 1 TO 3: IF I = IAB%(IN%,J)  THEN  POKE 6,12: POKE 7,30: CALL 768: VTAB I +5: HTAB 5: PRINT "*":J = 3
  99. 21291  NEXT J,I: IF P$ = "C"  THEN  RETURN 
  100. 21292  HOME : PRINT "ASTERISKS (*) INDICATE THOSE ABILITIES  WHICH ";INST$(IN%)"'";: IF  RIGHT$(INST$(IN%),1) < >"S"  THEN  PRINT "S";
  101. 21295  PRINT " STYLE EMPHASIZES": VTAB 22: HTAB 1: PRINT "AND WILL BE THE EASIEST TO IMPROVE.": GOSUB 21510: RETURN 
  102. 21510  INVERSE : HTAB 10: VTAB 24: PRINT HR$;: GOSUB 1000: GET A$: VTAB 23: PRINT : NORMAL : POKE PK%,0: RETURN 
  103. 21610  POKE 6,40: POKE 7,15: CALL 768: POKE 6,21: POKE 7,15: CALL 768: RETURN 
  104. 21920  HOME :V% = 16:H% = 28: GOSUB 21100: GOSUB 1000: VTAB V%: HTAB H% +2: PRINT  CHR$(34);: POKE PK%,0: INVERSE : IF P$ = "C"  THEN  HOME :HT% =  RND(E) *12 +63: GOTO 21924
  105. 21922  VTAB V%: HTAB H%: PRINT  INT( RND(E) *12) +63;: IF  PEEK(PE%) <128  THEN 21922
  106. 21924 HT% =  RND(0) *5 +68: VTAB V%: HTAB H%: NORMAL : PRINT SC$SC$;: HTAB H%: PRINT  INT(HT%/12);"'";HT% - INT(HT%/12) *12; CHR$(34): GOSUB 21610
  107. 21950 H% = 37:HW% = 140 +4 *(HT% -64):MI% = HW% -(HW% *.05):MA% = (HW% +(HW% *.1)) -MI% +1: POKE PK%,0: INVERSE : IF P$ = "C"  THEN WE% =  RND(E) *MA% +MI%: GOTO 21954
  108. 21952  VTAB V%: HTAB H%: PRINT  INT( RND(E) *MA%) +MI%;: IF  PEEK(PE%) <128  THEN 21952
  109. 21954 WE% =  RND(0) *MA% +MI%: VTAB V%: HTAB H%: NORMAL : PRINT WE%: GOSUB 21610: POKE PK%,0: SPEED= 190
  110. 21960  HOME : PRINT "PLEASE ENTER THE STUDENT'S [NAME]": PRINT "[C]ATALOG => ";: SPEED= 255: GOSUB 503:NA$ = C$: IF NA$ = ""  OR NA$ = ES$  OR NA$ = "R"  THEN 21960
  111. 21962  GOSUB 22700: IF C$ = ""  THEN  PRINT S$;: GOTO 21960
  112. 21964  IF NA$ = "C"  THEN  POKE 34,18: POKE 44452,5: POKE 44605,4: GOSUB 22710: POKE 34,19: GOTO 21960
  113. 21965  INVERSE : VTAB 4: HTAB 1: PRINT SP$NA$SP$: NORMAL : GOSUB 21610:RA% = 1: POKE PK%,0: SPEED= 190
  114. 21970  IF P$ = "C"  THEN PNA$ = "COMPUTER-" + STR$( PEEK(800)): GOTO 22050
  115. 22040  HOME : PRINT "ADMIT THIS STUDENT INTO THE WORLD OF    COMPETITION KARATE [YES/NO] ? ";: SPEED= 255: GOSUB 503: IF C$ < >"NO"  AND C$ < >"YES"  THEN  VTAB 22: CALL  -958: GOTO 22040
  116. 22041  IF C$ = "NO"  THEN  VTAB 4: CALL  -868: HOME : PRINT : GOTO 22075
  117. 22042  SPEED= 190
  118. 22045  HOME : PRINT "ADD THIS STUDENT TO WHICH [TEAM ROSTER] [C]ATALOG   [RETURN] FOR NONE": PRINT "=> ";: SPEED= 255: GOSUB 503:PNA$ = C$: IF PNA$ = ES$  THEN PNA$ = ""
  119. 22046  IF PNA$ = "C"  THEN  POKE 34,18: POKE 44452,5: POKE 44605,4: GOSUB 22710: POKE 34,19: GOTO 22045
  120. 22048  IF PNA$ < >""  THEN  IF  LEFT$(PNA$,1) <"A"  OR  LEFT$(PNA$,1) >"Z"  THEN  PRINT S$;: GOTO 22045
  121. 22050  SPEED= 255: VTAB 23: GOSUB 22340: GOSUB 22500: GOSUB 22600: GOSUB 22550: VTAB 23
  122. 22075  POKE 34,4: SPEED= 190: PRINT "CREATE ANOTHER STUDENT [Y/N] ? [N]";: SPEED= 255: HTAB  PEEK(36) -1: GOSUB 1000: GET A$: IF A$ = "Y"  THEN 90
  123. 22080  GOTO 22440
  124. 22250  IF R% = 3  THEN  PRINT "TERRIBLE": RETURN 
  125. 22260  IF R% <7  THEN  PRINT "PRETTY BAD": RETURN 
  126. 22270  IF R% <11  THEN  PRINT "SO SO": RETURN 
  127. 22280  IF R% <15  THEN  PRINT "GOOD": RETURN 
  128. 22290  IF R% = 18  THEN  PRINT "EXCELENT": RETURN 
  129. 22300  PRINT "VERY GOOD"
  130. 22310  RETURN 
  131. 22340  SPEED= 255: POKE 34,3: HOME : POKE 34,4: VTAB 7: PRINT "SAVING NEW STUDENT ON DISK.  SAVING AS:": PRINT : PRINT : INVERSE : HTAB  INT((40 - LEN(NA$))/2) +1: PRINT NA$: NORMAL : POKE 34,12:FL% = 1
  132. 22355  PRINT : GOSUB 2000: HOME : ONERR  GOTO 19000
  133. 22370  PRINT D$"OPEN^"NA$",D" PEEK(798)
  134. 22380  PRINT D$"WRITE^"NA$
  135. 22390  FOR I = 1 TO 9: PRINT AB%(I): NEXT : PRINT US%: PRINT  INT(AVG%/9 +.5)
  136. 22400  PRINT IN%: PRINT WE%: PRINT HT%: PRINT RA%
  137. 22405  PRINT WI%: PRINT LO%: PRINT EX%: PRINT T1%: PRINT T2%: PRINT T3%: PRINT PNTS%: PRINT REDY%: PRINT NS$
  138. 22410  PRINT D$"CLOSE^"NA$
  139. 22420  PRINT D$"LOCK^"NA$
  140. 22430  RETURN 
  141. 22440  POKE 34,4: HOME : VTAB 12: HTAB 8: PRINT "ONE ETERNAL MOMENT PLEASE"
  142. 22445  SPEED= 255: GOSUB 2100: ONERR  GOTO 19000
  143. 22446  IF   NOT PF%  THEN 22450
  144. 22447  PRINT D$"UNLOCK UL.2,D1"
  145. 22448  PRINT D$"BSAVE UL.2,A768,L33,D1"
  146. 22449  PRINT D$"LOCK UL.2,D1"
  147. 22450  PRINT D$"RUN P20,D1"
  148. 22500 RCNT% = 0: IF PNA$ = ""  THEN  RETURN 
  149. 22505  POKE 34,12: HOME : HTAB 10: PRINT ":::ADDING TO ROSTER:::": PRINT : FLASH : HTAB  INT((40 - LEN(PNA$))/2) +1: PRINT PNA$: NORMAL : POKE 34,16:FL% = 2
  150. 22509  GOSUB 2000: HOME :EF% = 0: ONERR  GOTO 19000
  151. 22512  PRINT D$"VERIFY"PNA$ +RO$",D" PEEK(798)
  152. 22515  PRINT D$"OPEN"PNA$ +RO$
  153. 22518  PRINT D$"READ"PNA$ +RO$
  154. 22521  INPUT RCNT%: IF   NOT RCNT%  OR RCNT% >29  THEN 22530
  155. 22527  FOR P = 1 TO RCNT%: INPUT PNA$(P): NEXT 
  156. 22530  PRINT D$"CLOSE"
  157. 22531  IF RCNT% <30  THEN  RETURN 
  158. 22532  HOME : PRINT : FLASH : PRINT S$"THIS ROSTER IS FULL": NORMAL : GOTO 19034
  159. 22534  GOTO 22500
  160. 22550  IF PNA$ = ""  THEN  RETURN 
  161. 22551  GOSUB 2000: HOME :EF% = 1: ONERR  GOTO 19000
  162. 22556  PRINT D$"OPEN"PNA$ +RO$",D" PEEK(798)
  163. 22559  PRINT D$"UNLOCK"PNA$ +RO$
  164. 22562  PRINT D$"DELETE"PNA$ +RO$
  165. 22565  PRINT D$"OPEN"PNA$ +RO$
  166. 22568  PRINT D$"WRITE"PNA$ +RO$
  167. 22571  PRINT RCNT%: FOR P = 1 TO RCNT%: PRINT PNA$(P): NEXT 
  168. 22574  PRINT D$"CLOSE"
  169. 22577  PRINT D$"LOCK"PNA$ +RO$
  170. 22580  RETURN 
  171. 22600 RCNT% = RCNT% +1:PNA$(RCNT%) = NA$: RETURN 
  172. 22700  FOR I = 1 TO 5: IF C$ = INST$(I)  THEN C$ = "": RETURN 
  173. 22702  NEXT : RETURN 
  174. 22710  HOME : PRINT D$"CAT,D" PEEK(798): GET A$: HOME : PRINT : RETURN 
  175. 23040  DATA  STRENGTH,AGILITY,QUICKNESS,STAMINA,PERCEPTION,COURAGE,ARMS,LEGS,BODY