home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / misc / baseball.lbr / BASEBALL.BZS / BASEBALL.BAS
Encoding:
BASIC Source File  |  1993-10-25  |  20.0 KB  |  467 lines

  1. 10 '    ------------------------------------------------------
  2.  
  3.     |         KAYPRO 10 BASEBALL             |
  4.  
  5.     |         by  Richard Altman             |
  6. 12 '    |        4/20/90    Revised:  9/25/91         |
  7.  
  8.     |  (c) 1991 by Richard Altman.  All Rights Reserved. |
  9.  
  10.     ------------------------------------------------------
  11. 15 '
  12. 16 '     USER SUPPORTED
  13. 17 '
  14. 18 '     This program is user-supported software.  It is copyrighted and cannot
  15. 19 ' be sold for profit (without the author's express written permission),  but
  16. 20 ' it may be copied and distributed for free.
  17. 21 '
  18. 22 '     The  SHAREWARE  concept is a  distribution method  that dispenses with
  19. 23 ' heavy  marketing/advertising costs and gives the user the  opportunity  to
  20. 24 ' try a software program before buying.   Its continued existence depends on
  21. 26 '
  22. 27 '     If you find this program [BASEBALL] enjoyable, please send the $20 (or
  23. 28 ' more) registration fee directly to the author:
  24. 29 '
  25. 30 '        Richard S. Altman -- P.O. Box 4388 -- Clearlake, CA 95422
  26. 31 '
  27. 32 '      Upon registration,  you will receive a floppy diskette containing the
  28. 33 ' latest version of this program,  as well as a printed manual detailing its
  29. 34 ' uses and specifications.   You will also receive a FREE  calendar printing
  30. 35 ' program and other programs by the same author.
  31. 36 '
  32. 37 '      WHEN ORDERING,  please be sure to indicate  single or double  density
  33. 38 ' disk drive,  and the name of the program [BASEBALL.BAS].  Comments on pro-
  34. 39 ' grams are also most welcome!
  35. 40 '
  36. 41 '     Due to  possible unforeseen circumstances,  the above offer is subject
  37. 42 ' to change without notice.
  38. 43 '
  39. 44 '     Set Up Variables
  40. 45 DEFINT B-Z:DEFSTR A,C-D,F,N:WIDTH 255:CLS=CHR$(26):CLR=CHR$(24):CX=CHR$(23)
  41. 46 DIM F(24),NT(24),V(11),ID(11),DA(9),DB(9),L1(9),L2(9):ESC$=CHR$(27):N=" "
  42. 47 FE=ESC$+"=":FOR X=1 TO 24:F(X)=FE+CHR$(X+31)+N:NEXT:C7=CHR$(7):NN=" *"
  43. 48 DEF FNF(X,Y)=FE+CHR$(X+31)+CHR$(Y+31):DEF FNRN(X)=INT(RND*X)+1:F="   "
  44. 49 DEF FNTITLE$(X,M$)=FNF(X,1)+STRING$((80-LEN(M$))/2,12)+M$:Q=1000:C="  "
  45. 50 FD=STRING$(79,45):CS=STRING$(25,32):A=F+C:FS=STRING$(79,143):FX=A:D=F+F
  46. 51 DEF FNAL(W,X,Y,Z)=ESC$+"L"+CHR$(W)+CHR$(X)+CHR$(Y)+CHR$(Z):CO=ESC$+"B4"
  47. 52 DK="Press <ANY KEY> to continue":DE="."+F:CF=ESC$+"C4":PRINT CLS;CO:P=100
  48. 53 AO=ESC$+"B3":AF=ESC$+"C3":FO=ESC$+"B0":FF=ESC$+"C0":DF=CHR$(8)+DE:GOTO 100
  49. 54 '
  50. 55 PRINT F(5)"R:"HR;FNF(5,10)"H:"HT;FNF(5,19)"Outs:"OU:IF OU=3 THEN RETURN
  51. 56 PRINT FNF(5,63)"On Base: "HB:RETURN
  52. 60 IF G0=0 THEN H1=H1+1 ELSE H2=H2+1
  53. 61 IF G0=0 THEN T1(IG)=HR ELSE T2(IG)=HR
  54. 62 T1=0:T2=0:FOR X=1 TO 9:T1=T1+T1(X):T2=T2+T2(X):NEXT
  55. 63 IF GS=0 THEN RETURN
  56. 65 PRINT CLS;CF:FOR X=2 TO 24 STEP 2
  57. 66 L$=FNTITLE$(X,F+"G R A N D   S L A M  !!"+F):GOSUB 5065:PRINT C7;
  58. 67 FOR T=1 TO 85+(25-X)*25:NEXT:IF X<24 THEN PRINT L$
  59. 68 NEXT:BB=9:DN=F:GOSUB 75:GOSUB 2500:GOSUB 85:GOTO 3000
  60. 70 R4=R4+1:R3=0:HR=R4:HB=HB-1:RETURN
  61. 72 Z=Z+1:IF Z>12 OR Z=3 THEN Z=12
  62. 73 RETURN
  63. 75 FOR T=1 TO 1350:IF INKEY$="" THEN NEXT:RETURN ELSE RETURN
  64. 80 FOR T=1 TO 675:NEXT:RETURN
  65. 81 FOR T=1 TO 270:NEXT:RETURN
  66. 82 FOR T=1 TO  67:NEXT:RETURN
  67. 84 IF BB>1 OR ER>1 THEN FOR T=1 TO 415:NEXT:RETURN ELSE 81 
  68. 85 PRINT FNF(12,59)D1;FNF(3,41)D2;FNF(12,23)D3:RETURN
  69. 90 PRINT FF"> to "AO"make the change"AF"."
  70. 92 PRINT F(23)F"or Press <"FO" RETURN "FF"> "C7;AC;:RETURN
  71. 95 R1=0:R2=0:R3=0:R4=0:BK=0:HB=0:HR=0:HT=0:OU=0:IJ=0:RETURN
  72.  
  73.  
  74. 100 '    Start Program
  75. 105 PRINT CLS:PRINT FD:L$=FNTITLE$(4,F+"B A S E B A L L"+F):GOSUB 5065
  76. 110 PRINT FNTITLE$(7,"for the KAYPRO 10 Computer");F(9)FD
  77. 115 PRINT FNF(23,10)"Copyright (c) 1991 by Richard Altman"DE"All Rights ";
  78. 120 PRINT"Reserved"DE;:D1=CHR$(149)+CHR$(190):D2=CHR$(191)+CHR$(170)
  79. 125 D3=CHR$(189)+CHR$(170):RESTORE:FOR X=1 TO 24:READ NT(X):NEXT
  80. 130 FOR X=1 TO 9:READ DA(X),DB(X),L2(X):L1(X)=0:DQ(X)=DB(X):NEXT
  81. 135 GOSUB 6500:L1(9)=9: U$=".###":V$="###":NU="Player ":NP="Pitcher "
  82. 140 X=FNRN(14):Y=FNRN(24):IF X=Y THEN 140 ELSE NA=NT(X):NB=NT(Y)
  83. 145 IF NA="" OR NB="" THEN 135
  84. 150 FOR X=1 TO 8
  85. 155 Y=FNRN(8):IF L1(Y)=0 THEN L1(Y)=X:NEXT ELSE 155
  86. 160 DATA GIANTS,RED SOX,EXPOS,WHITE SOX,BLUE JAYS,PIRATES,CARDINALS
  87. 165 DATA ORIOLES,ROYALS,PHILLIES,PADRES,BRAVES,ASTROS,TIGERS,RANGERS
  88. 170 DATA BREWERS,DODGERS,METS,CUBS,YANKEES,INDIANS,REDS,TWINS,ANGELS
  89. 175 DATA 1st Baseman,1B,1,2nd Baseman,2B,5,3rd Baseman,3B,4
  90. 180 DATA Short Stop,SS,8,Right Fielder,RF,2,Center Fielder,CF,7
  91. 185 DATA Left Fielder,LF,3,Catcher,"C ",6,Pitcher,"P ",9
  92. 190 ' B1,B2=Regular Players    L1,L2=Team Lineup
  93. 192 ' U1,U2=Utility Players    P1,P2=Pitchers
  94. 195 FOR X=1 TO 8:B1(X)=FNRN(140)+260:U1(X)=FNRN(170)+275:NEXT
  95. 200 FOR X=1 TO 8:B2(X)=FNRN(150)+245:U2(X)=FNRN(190)+250:NEXT:XX=FNRN(5)
  96. 205 FOR X=1 TO 7:P1(X)=FNRN(70) +210:P2(X)=FNRN(75) +200:NEXT:YY=FNRN(5)
  97. 210 B1(XX+FNRN(3))=FNRN(P)+385:B1(XX)=FNRN(P)+388:B2(YY)=FNRN(P)+385
  98. 215 B2(YY+FNRN(3))=FNRN(P)+380:FOR X=1 TO 8:BV=BV+B1(X):NEXT
  99. 220 FOR X=1 TO 6:IF P1(X)<P1(X+1) THEN SWAP P1(X),P1(X+1):GOTO 220
  100. 225 NEXT:B1(9)=P1(6)+20:B2(9)=P2(6):J1=1:J2=1:BV=BV/8:BW=BV-20
  101. 230 IF B1(9)<B2(9) THEN SWAP B1(9),B2(9)
  102. 235 U1=FNRN(3)+4:U2=FNRN(5)+3:P1=FNRN(3)+4:P2=FNRN(4)+3:U0=U1:P0=P1
  103. 240 L$=FNTITLE$(13,F+NA+NN+D+"vs"+D+NB+F)+CX:GOSUB 5065
  104. 245 PRINT FNF(16,13)"*  The "NA" are the Visiting Team and are up "AO"first";
  105. 250 PRINT AF;DE:PRINT FNF(17,13)"*  You are the Manager of the "NA;DE
  106. 255 PRINT FNF(19,13)"*  The "NB" are the Home Team -- managed by the Kaypro ";
  107. 260 PRINT"10."FNF(23,27)DK;DE;C7;:GOSUB 6600:GOSUB 7000
  108. 265 EN=0:GOSUB 2500:IG=IG+1:UP=1:G0=0:GOSUB 95
  109. 270 BB=0:GOSUB 3000:Y=FNRN(1400):IF Y>999 THEN GOSUB 5500
  110. 275 PRINT F(24)" <1> to PITCH BALL"D"<2> Display SCOREBOARD"D;
  111. 280 PRINT"<3> Display PLAYER STATS"F;CO;:GS=0
  112. 285 GOSUB 6000:IF AK="Q" THEN 6050
  113. 290 IF AK="3" THEN GOSUB 7000:GOSUB 2500:GOTO 270
  114. 292 'IF AK="5" THEN HB=3:R1=1:R2=1:R3=1:OU=OU-1:AK="1":GOSUB 3000:IF OU<1 THEN OU=1
  115. 295 IF AK="2" THEN 4010 ELSE IF AK<>"1" THEN 285
  116.  
  117.  
  118. 300 '    Pitch Ball
  119. 305 PRINT F(23)CX:IF UP=1 THEN BX=B1(9) ELSE BX=B2(9)
  120. 310 RX=BX*FNRN(7):X=FNRN(6):Y=FNRN(6):Z=X+Y:IF X=Y THEN G2=1
  121. 315 IF RX>725  THEN Z=Z-1:G2=0
  122. 320 IF RX>1450 THEN Z=Z-1
  123. 325 IF Z<2 THEN Z=2
  124. 330 IF NOT(Z=2 OR Z=12) THEN 340
  125. 335 Y=FNRN(5):IF Y<4 THEN G2=0:GOTO 450
  126. 340 Y=FNRN(7):IF UP=1 THEN H=B1(J1)*Y ELSE H=B2(J2)*Y
  127. 345 IF H>1560 THEN GOSUB 72
  128. 350 IF H>2900 AND UP=1 THEN GOSUB 72
  129. 355 K0=0:ON Z GOTO 600,820,820,800,800,840,900,400,500,550,600
  130.  
  131.  
  132. 400 '    Single
  133. 410 R=FNRN(4):IF FNRN(5)=4 THEN 450
  134. 412 IF FNRN(7)=4 THEN 830
  135. 414 GOSUB 1200:R3=R2:R2=R1:R1=1:HT=HT+1:HB=1:K0=1:IF BK=0 THEN 434
  136. 416 ON BK GOTO 434,418,420,432,424,426,428
  137. 418 IF R<4 THEN 434 ELSE R3=0:R2=1:GOTO 434
  138. 420 IF R<3 THEN R3=1:GOTO 434 ELSE 424
  139. 422 IF R<3 THEN 432 ELSE R4=R4+1:GOTO 434
  140. 424 GOSUB 70:GOTO 434
  141. 426 IF R=4 THEN 432 ELSE R4=R4+1:GOTO 434
  142. 428 IF R=4 THEN R4=R4+2:R3=0:GOTO 434
  143. 430 R4=R4+1
  144. 432 R3=1:R2=1:R1=1
  145. 434 B$="SINGLE":IF R<3 AND (BK=2 OR BK=3 OR BK=4 OR BK=6) THEN B$="BUNT SINGLE"
  146. 436 IF R2=1 THEN HB=HB+1
  147. 438 IF R3=1 THEN HB=HB+1
  148. 440 IF UP=1 THEN K1=K1+1 ELSE M1=M1+1
  149. 442 GOTO 650
  150.  
  151.  
  152. 450 '    Walk
  153. 460 B$=" WALK ":IF UP=2 THEN W1=W1+1 ELSE W2=W2+1
  154. 462 GOSUB 1200:QK=BK:IF BK=7 THEN R4=R4+1
  155. 464 R1=1:IF BK=1 OR BK=5 THEN R2=1
  156. 466 K0=1:IF BK=4 THEN R3=1
  157. 468 HB=1:IF R2=1 THEN HB=HB+1
  158. 470 IF R3=1 THEN HB=HB+1
  159. 472 HR=R4:GOSUB 61:GOTO 1000
  160.  
  161.  
  162. 475 '    Stolen Base
  163. 480 IF FNRN(11)<3 THEN 450
  164. 485 IB=9:GOSUB 1200:B$="STOLEN BASE  !!":SB=9:GOTO 915
  165.  
  166.  
  167. 500 '    Double
  168. 505 IF G2=1 THEN G2=0:GOTO 450
  169. 510 GOSUB 1200:IF BK=1 OR BK=2 THEN 475
  170. 515 QK=BK:R4=R4+R3+R2:R3=R1:R2=1:R1=0:HT=HT+1:HB=1:K0=2
  171. 520 B$="DOUBLE":IF R3=1 THEN HB=2
  172. 525 IF UP=1 THEN K2=K2+1 ELSE M2=M2+1
  173. 530 GOTO 650
  174.  
  175.  
  176. 550 '    Triple
  177. 555 IF R3=1 THEN 750
  178. 560 R=FNRN(11):IF R>7 THEN G2=0:GOTO 700
  179. 565 IF UP=1 THEN K3=K3+1 ELSE M3=M3+1
  180. 570 GOSUB 1200:QK=BK:R4=R4+R3+R2+R1:R3=1:R2=0:R1=0:HT=HT+1:HB=1:K0=3
  181. 575 B$="TRIPLE":GOTO 650
  182.  
  183.  
  184. 600 '    Home Run
  185. 610 X=FNRN(30):IF X<6 THEN 550 ELSE IF X>25 THEN 450
  186. 620 GOSUB 1200:R4=R4+R3+R2+R1+1:GS=0:IF BK=7 THEN GS=9
  187. 630 HT=HT+1:HB=0:K0=4:BB=8:B$="***  HOME RUN  ***"
  188. 640 IF UP=1 THEN K4=K4+1 ELSE M4=M4+1
  189. 650 HR=R4:GOSUB 60:GOTO 1000
  190.  
  191.  
  192. 700 '    Error
  193. 705 GOSUB 1200:IF ER1=1 OR (IG=9 AND UP=2) THEN 400
  194. 710 B$="== ERROR !! ==":ER=9:R=FNRN(7)
  195. 715 PRINT F(18)DB(R)" Dropped the ball.  Batter safe at 1st."
  196. 720 IF BK=1 THEN 740
  197. 725 IF BK=2 OR BK=4 THEN R3=1:GOTO 740
  198. 730 IF BK=5 THEN GOSUB 70:GOTO 740
  199. 735 IF BK=3 OR BK>5 THEN GOSUB 70:R3=R2
  200. 740 R2=R1:R1=1:HB=HB+1:GOTO 780
  201.  
  202.  
  203. 750 '    Passed Ball
  204. 755 IF FNRN(9)>6 OR ER1=1 THEN 400
  205. 760 IF IG=9 AND UP=2 THEN 510
  206. 765 GOSUB 70:IF FNRN(5)=3 THEN R3=R2:R2=0
  207. 770 B$="BALL GETS BY CATCHER.":GOSUB 61:ER=8
  208. 775 PRINT FNF(12,23)"3 "F(18)C"Runner steals Home !!"
  209. 780 IB=9:IF UP=1 THEN E2=E2+1 ELSE E1=E1+1
  210. 785 GOTO 1000
  211.  
  212.  
  213. 800 '    Fly Out
  214. 805 IF OU<=1 AND R3=1 THEN 915
  215. 810 O$="FLY":G2=0:IF OU<2 THEN 950
  216.  
  217.  
  218. 820 '    Strike Out
  219. 825 IF G2=1 THEN 850
  220. 830 IF UP=2 THEN S1=S1+1 ELSE S2=S2+1
  221. 835 O$="STRIKE":GOTO 950
  222.  
  223.  
  224. 840 '    Ground Out
  225. 845 IF G2=0 THEN O$="GROUND":GOTO 950
  226.  
  227.  
  228. 850 '    Double Play
  229. 855 G2=0:IF OU<2 AND HB>0 THEN 860 ELSE 800
  230. 860 OU=OU+2:B$="== DOUBLE PLAY =="+C7:BB=5:GOSUB 1200
  231. 865 HB=0:R3=0:R2=0:R1=0:IF BK<4 OR OU=3 THEN 960
  232. 870 IF BK=4 THEN R3=1:HB=1:GOTO 960
  233. 875 IF BK=7 THEN R3=1:HB=1
  234. 880 R4=R4+1:HR=R4:GOTO 960
  235.  
  236.  
  237. 900 '    Sacrifice Out
  238. 905 IF G2=1 THEN G2=0:GOTO 450
  239. 910 IF OU<2 AND HB>0 THEN 915 ELSE 800
  240. 915 IF R3=1 THEN GOSUB 70:R3=R2:R2=0:GOTO 930
  241. 920 IF R2=1 THEN R3=1:R2=0:GOTO 930
  242. 925 R2=1:R1=0:IF SB=0 THEN BB=4:B$="=== LONG FLY BALL ===":PRINT F(18)"Runner tags & goes to 2nd!!"
  243. 930 IF SB=9 THEN 1000
  244. 935 IF UP=1 THEN K5=K5+1 ELSE L5=L5+1
  245. 940 IF BB<>4 THEN B$="== SACRIFICE OUT ==":GOSUB 61
  246. 945 OU=OU+1:GOTO 960
  247.  
  248.  
  249. 950 B$="== "+O$+" OUT ==":OU=OU+1
  250. 960 GOSUB 82
  251.  
  252.  
  253. 1000 '    Complete Batter's Turn
  254. 1005 PRINT CF;:BK=0:IF IG=9 AND UP=2 AND T2>T1 THEN GOSUB 1100:GOTO 4000
  255. 1010 GOSUB 1200:SB=0:IF BB>7 THEN R3=0:R2=0:R1=0
  256. 1015 G1=0:G2=0:GOSUB 1030:IF G1=0 THEN 1100
  257. 1020 UP=2:GOSUB 95:IF G0=1 THEN 4000
  258. 1025 G0=1:DN=F:K0=0:GOSUB 2500:GOTO 270
  259. 1030 IF IB=9 THEN IB=0:GOTO 1045
  260. 1035 IF UP=1 THEN J1=J1+1:IF J1>9 THEN J1=1
  261. 1040 IF UP=2 THEN J2=J2+1:IF J2>9 THEN J2=1
  262. 1045 IF OU<3 THEN RETURN
  263. 1050 L$=F(17)+C+B$+C:GOSUB 5065:IF BB=5 THEN B5=5:GOSUB 1115:B5=0
  264. 1055 G1=1:IF IG=9 AND UP=1 AND T2>T1 THEN GOSUB 1060:GOTO 4000
  265. 1060 GOSUB 55:L$=F(18)+A+"THREE OUTS":FOR X=1 TO 7:PRINT L$
  266. 1065 GOSUB 82:PRINT F(18)CS:GOSUB 82:NEXT X:PRINT L$
  267. 1070 GOSUB 80:PRINT F(18)CS:HB(UP)=HB(UP)+HB:RETURN
  268.  
  269.  
  270. 1100 '    Display Results of this Play
  271. 1105 GOSUB 55:L$=F(17)+C+B$+C
  272. 1110 IF BB=9 THEN L$=L$+F(18)+F+"(( GRAND SLAM ))"+F+C7
  273. 1115 Y=3:IF BB>1 OR ER>1 THEN Y=5
  274. 1120 FOR X=1 TO Y:GOSUB 5065:GOSUB 84:PRINT F(17)CS:GOSUB 82:NEXT X
  275. 1125 GOSUB 5065:IF B5=5 THEN RETURN
  276. 1130 ER1=0:IF ER>1 THEN ER1=1:GOSUB 81:IF ER=9 THEN GOSUB 2490
  277. 1135 ER=0:GOSUB 1500:IF BB=9 THEN 1145
  278. 1140 IF BB=5 THEN GOSUB 80:GOTO 270
  279. 1145 IF IG=9 AND UP=2 AND T2>T1 THEN 1150 ELSE 270
  280. 1150 L$=F(19)+"  === WINNING HIT !! ===  "+C7:PRINT F(17)F;B$;F:FOR X=1 TO 7
  281. 1155 GOSUB 5065:GOSUB 81:PRINT F(19)CS;F:GOSUB 81:NEXT X
  282. 1160 GOSUB 5065:GOTO 75
  283.  
  284.  
  285. 1200 IF R1=0 AND R2=0 AND R3=0 THEN RETURN
  286. 1210 IF R1=1 AND R2=0 AND R3=0 THEN BK=1:RETURN
  287. 1220 IF R1=0 AND R2=1 AND R3=0 THEN BK=2:RETURN
  288. 1230 IF R1=0 AND R2=0 AND R3=1 THEN BK=3:RETURN
  289. 1240 IF R1=1 AND R2=1 AND R3=0 THEN BK=4:RETURN
  290. 1250 IF R1=1 AND R2=0 AND R3=1 THEN BK=5:RETURN
  291. 1260 IF R1=0 AND R2=1 AND R3=1 THEN BK=6:RETURN
  292. 1270 IF R1=1 AND R2=1 AND R3=1 THEN BK=7:RETURN
  293.  
  294.  
  295. 1500 '    Run the Bases!
  296. 1505 IF K0=0 THEN RETURN
  297. 1510 IF K0=2 OR K0=3 OR K0=5 THEN BK=QK
  298. 1515 ON K0 GOTO 1525,1550,1575,1600
  299.  
  300.  
  301. 1525 '    Single
  302. 1530 ON BK GOTO 1700,1710,1720,1730,1740,1750,1760
  303. 1550 '    Double
  304. 1552 IF BK=0 OR BK=3 THEN BK=2:GOSUB 1700:GOTO 1710
  305. 1554 IF BK=1 OR BK=5 THEN BK=6:GOSUB 1730:GOTO 1750
  306. 1556 IF BK=2 OR BK=6 THEN BK=2:GOSUB 1740:GOTO 1710
  307. 1558 BK=6:GOSUB 1760:GOTO 1750
  308. 1575 '    Triple
  309. 1580 IF BK=0 OR BK=3 THEN GOSUB 1700:GOSUB 1710:GOTO 1720
  310. 1585 IF BK=1 OR BK=5 THEN GOSUB 1730:GOSUB 1750:GOTO 1720
  311. 1590 IF BK=2 OR BK=6 THEN GOSUB 1740:GOSUB 1710:GOTO 1720
  312. 1595 GOSUB 1760:GOSUB 1750:GOTO 1720
  313.  
  314.  
  315. 1600 '    Home Run
  316. 1610 IF BK=0 OR BK=3 THEN GOSUB 1700:GOSUB 1710:GOTO 1650
  317. 1620 IF BK=1 OR BK=5 THEN GOSUB 1730:GOSUB 1750:GOTO 1650
  318. 1630 IF BK=2 OR BK=6 THEN GOSUB 1740:GOSUB 1710:GOTO 1650
  319. 1640 GOSUB 1760:GOSUB 1750
  320. 1650 GOSUB 1720:BB=0:BK=0:GOSUB 80:PRINT FNF(12,23)"3 "
  321. 1660 L$=FNF(20,39)+" HOME ":FOR X=1 TO 9:PRINT FNF(20,39)D
  322. 1670 GOSUB 82:GOSUB 5065:GOSUB 82:NEXT X
  323. 1675 PRINT L$:GOSUB 81:GOSUB 82:GOTO 1780
  324.  
  325.  
  326. 1700 GOSUB 1770:PRINT FNF(12,59)D1:RETURN
  327. 1710 GOSUB 1770:PRINT FNF(3,41) D2:RETURN
  328. 1720 GOSUB 1770:PRINT FNF(12,23)D3:RETURN
  329. 1730 GOSUB 1770:PRINT FNF(12,59)D1;FNF(3,41) D2:RETURN
  330. 1740 GOSUB 1770:PRINT FNF(12,59)D1;FNF(12,23)D3:RETURN
  331. 1750 GOSUB 1770:PRINT FNF(3,41) D2;FNF(12,23)D3:RETURN
  332. 1760 GOSUB 1770:GOTO 85
  333. 1770 GOSUB 80
  334. 1780 PRINT FNF(12,59)" 1"FNF(3,41)"2 "FNF(12,23)"3 ":RETURN
  335. 2490 GOSUB 84:PRINT F(18)STRING$(41,32);:GOTO 2510
  336.  
  337.  
  338. 2500 '    Display Field
  339. 2505 PRINT CLS;CF
  340. 2510 PRINT FNAL(78,73,37,114)  FNAL(37,112,78,154)
  341. 2520 PRINT FNAL(78,73,119,114) FNAL(119,114,78,154)
  342. 2530 PRINT FNAL(78,72,37,113)  FNAL(37,113,78,155)
  343. 2540 PRINT FNAL(78,72,119,113) FNAL(119,113,78,155)
  344. 2550 PRINT FNAL(78,71,37,112)  FNAL(37,114,78,156)
  345. 2560 PRINT FNAL(78,71,119,112) FNAL(119,114,78,156) FNF(20,40)"HOME"CO:RETURN
  346.  
  347.  
  348. 3000 '    Fill In Box Score
  349. 3005 IF K0=0 THEN GOSUB 1780
  350. 3010 IF K0=0 AND R3=1 THEN PRINT FNF(12,23)D3
  351. 3015 IF K0=0 AND R2=1 THEN PRINT FNF(3,41) D2
  352. 3020 IF K0=0 AND R1=1 THEN PRINT FNF(12,59)D1
  353. 3025 IF IG=1 THEN AI="st":GOTO 3040
  354. 3030 IF IG=2 THEN AI="nd":GOTO 3040
  355. 3035 IF IG=3 THEN AI="rd":GOTO 3040 ELSE AI="th"
  356. 3040 PRINT FNF(1,5)CF;:L$=STRING$(16,32):PRINT AO;L$;FNF(1,60)L$;AF;
  357. 3045 PRINT FNF(2,4)"(";:L$=C+STR$(IG)+AI+" Inning"+F:GOSUB 5050
  358. 3050 J$="":K$=NN:M$=NA:IF UP=2 THEN J$=N:K$=N:M$=NB
  359. 3055 LN=LEN(M$):L$=F:L=11:IF LN=6 OR LN=7 THEN L$=C+C:L=10:GOTO 3065
  360. 3060 IF LN<6 THEN L$=F+C:L=9
  361. 3065 L$=L$+J$+M$+K$+STRING$(L-LN,32):IF UP=2 THEN 3075
  362. 3070 J=J1:DM=DA(L1(J)):BU=B1(J):GOTO 3080
  363. 3075 J=J2:DM=DA(L2(J)):BU=B2(J)
  364. 3080 PRINT")"FNF(2,59)"(";:GOSUB 5050:PRINT")":GOSUB 55
  365. 3085 PRINT F(17)CS;F(18)CS;C:IF DN=DM THEN RETURN
  366. 3090 DN=DM:PRINT F(8)"Batter #"USING"#";J
  367. 3095 PRINT CS;F(9)DM" -- ";USING U$;BU/Q:RETURN
  368.  
  369.  
  370. 4000 '    Display Scoreboard
  371. 4005 EN=1
  372. 4010 PRINT CLS:PRINT STRING$(79,188);F(12)FS:DN=F:K0=0
  373. 4015 PRINT FNAL(38,32,120,32) FNAL(38,34,120,34) FNAL(38,187,120,187)
  374. 4020 PRINT FNAL(38,189,120,189) F(23)FS; FNF(6,5)NA FNF(9,5)NB
  375. 4025 FOR X=1 TO 9-(9-IG):PRINT FNF(6,X*4+16)T1(X);FNF(9,X*4+16)T2(X):NEXT
  376. 4030 PRINT FNF(4,21)"1   2   3   4   5   6   7   8   9"FNF(4,63)"R    H    E"
  377. 4035 PRINT FNF(6,62)T1;FNF(6,67)H1;FNF(6,72)E1
  378. 4040 PRINT FNF(9,62)T2;FNF(9,67)H2;FNF(9,72)E2
  379. 4045 L$=FNF(13,46)+NA+F+NB:GOSUB 5050:LN=LEN(NA)+LEN(NB):AG=STRING$(LN/2,32)
  380. 4050 PRINT FNF(14,21)"Hits:   Singles ----->"
  381. 4055 PRINT FNF(14,47)USING V$;K1;:PRINT AG;USING V$;M1
  382. 4060 PRINT FNF(15,21)"Hits:   Doubles ----->"
  383. 4065 PRINT FNF(15,47)USING V$;K2;:PRINT AG;USING V$;M2
  384. 4070 PRINT FNF(16,21)"Hits:   Triples ----->"
  385. 4075 PRINT FNF(16,47)USING V$;K3;:PRINT AG;USING V$;M3
  386. 4080 PRINT FNF(17,21)"Hits:   Home Runs --->"
  387. 4085 PRINT FNF(17,47)USING V$;K4;:PRINT AG;USING V$;M4
  388. 4090 PRINT FNF(18,21)"Walks by your Team -->"
  389. 4095 PRINT FNF(18,47)USING V$;W2;:PRINT AG;USING V$;W1
  390. 4100 PRINT FNF(19,21)"Strikeouts by your Team:"
  391. 4105 PRINT FNF(19,47)USING V$;S2;:PRINT AG;USING V$;S1
  392. 4110 PRINT FNF(20,21)"Sacrifice Outs  by Team:"
  393. 4115 PRINT FNF(20,47)USING V$;K5;:PRINT AG;USING V$;L5
  394. 4120 PRINT FNF(21,21)"-- Men stranded on base:"
  395. 4125 PRINT FNF(21,47)USING V$;HB(1);:PRINT AG;USING V$;HB(2)
  396. 4130 L$=F(11)+STRING$(79,32):IF EN=1 AND IG=9 THEN 4145
  397. 4135 PRINT FNF(24,24)DK;DE;CO;:GOSUB 6600
  398. 4140 IF EN=1 THEN 265 ELSE GOSUB 2500:GOTO 270
  399. 4145 GOSUB 5065:PRINT FNF(11,14);FO;
  400. 4150 IF T1=T2 THEN PRINT A;F"The game is over"DE" It ended in a TIE.":GOTO 4170
  401. 4155 T$=NA:U$=NB:T=T1:TT=T2:IF T2>T1 THEN T$=NB:U$=NA:T=T2:TT=T1
  402. 4160 IF TT=0 THEN PRINT"The "T$" shut out the "U$" by a score of"T"to"TT;DF
  403. 4165 IF TT>0 THEN PRINT"The "T$" won by a score of"T"to"TT"over the "U$;DE
  404. 4170 PRINT FF;FNF(24,20)" Do you want to play another game?   (Y/N) ";
  405. 4175 PRINT F;CO;CX;C7;
  406. 4180 GOSUB 6000:IF AK="Y" THEN 4500
  407. 4185 IF AK="N" OR AK=CHR$(3) OR AK=ESC$ THEN PRINT F(23)FS;CX;F(22);:END:GOTO 4500 ELSE 4180
  408.  
  409.  
  410. 4500 FX=A:BK=0:BB=0:E1=0:E2=0:G0=0:G1=0:G2=0:S1=0:S2=0:W1=0:W2=0:S9=0
  411. 4510 EN=0:H1=0:H2=0:HB(1)=0:HB(2)=0:U1=0:U2=0:BG=0:IG=0:FOR X=1 TO 9
  412. 4520 T1(X)=0:T2(X)=0:U1(X)=0:U2(X)=0:P1(X)=0:P2(X)=0:NEXT:K1=0:K2=0
  413. 4530 K3=0:K4=0:M1=0:M2=0:M3=0:M4=0:BV=0:GOTO 100
  414.  
  415.  
  416. 5000 '    Misc. Subroutines
  417. 5050 PRINT AO;L$;AF;:RETURN:'    Underline L$
  418. 5065 PRINT FO;L$;FF;:RETURN:'    BRIGHT Video L$
  419.  
  420.  
  421. 5500 '    Change Computer's Players
  422. 5510 IF UP=2 THEN 5540
  423. 5520 IF P2(1)=0 OR P2<0 THEN RETURN
  424. 5530 B2(9)=P2(P2):P2(P2)=0:P2=P2-1:RETURN
  425. 5540 IF U2(1)=0 OR U2<0 THEN RETURN
  426. 5550 IF U2(U2)<BW THEN U2(U2)=BW+FNRN(6)
  427. 5560 X=FNRN(8):B2(X)=U2(U2):U2(U2)=0:U2=U2-1:RETURN
  428.  
  429.  
  430. 5700 L$=FNF(19,4)+"There are no RELIEF PITCHERS":GOTO 5900
  431. 5800 L$=FNF(19,4)+"There are no UTILITY PLAYERS"
  432. 5900 L$=L$+" left to substitute":GOSUB 5050:PRINT"."F(23)F;DK" the game"DE;
  433.  
  434.  
  435. 6000 '    INKEY$ Subroutines
  436. 6010 K$=INKEY$:AK=""
  437. 6020 AK=INKEY$:IF AK="" THEN 6020
  438. 6030 IF ASC(AK)>96 THEN AK=CHR$(ASC(AK)-32)
  439. 6040 IF (AK=CHR$(3) OR AK=ESC$) AND EN=0 THEN 6050 ELSE RETURN
  440. 6050 PRINT CLS;F(4)AO"Game called on account of rain!!"AF:PRINT:END:RETURN
  441.  
  442.  
  443. 6500 '    Random Number #1
  444. 6510 PORTA=32:PORTB=36:RESTORE 6540:FOR X=1 TO 11:READ ID(X):NEXT
  445. 6520 FOR Y=1 TO 11:ID=ID(Y):GOSUB 6550:V(Y)=SZ:NEXT
  446. 6530 TX=V(3)+V(5)*V(6):TX=TX+V(9)+V(10)*V(11)*3.58:RANDOMIZE TX:RETURN
  447. 6540 DATA 7,15,9,11,7,6,10,5,4,3,2
  448. 6550 OUT PORTA,ID:B=INP(PORTB):SX=INT(B/16):SY=B-16*SX:SZ=10*SX+SY:RETURN
  449. 6600 '    Random Number #2
  450. 6610 K$=INKEY$:AK=""
  451. 6620 AK=INKEY$:IF AK<>"" THEN RANDOMIZE TX:GOTO 6030
  452. 6630 TX=TX+1:IF TX>32222 THEN TX=P:GOTO 6620 ELSE 6620
  453.  
  454.  
  455. 7000 '    Display Players & Stats
  456. 7005 PRINT CLS:DN=F:K0=0:X1=29-LEN(NA):X2=24-LEN(NB)
  457. 7010 PRINT CF;FX"======= "NA" "STRING$(X1,61)" "NB" "STRING$(X2,61)
  458. 7015 FOR X=1 TO 9:PRINT F(X+4)"      "FX;X"--- "DB(L1(X))D;
  459. 7020 PRINT USING U$;B1(X)/Q;:PRINT STRING$(12,32);X"--- "DQ(L2(X))D;
  460. 7025 PRINT USING U$;B2(X)/Q:NEXT:IF BG=9 THEN 7100
  461. 7030 BG=9:L$=FNF(15,14)+"  <<< STARTING LINE-UP and BATTING AVERAGES >>>  "
  462. 7035 GOSUB 5065:PRINT F(18)FX;STRING$(64,61):FX=""
  463. 7040 AU="Utility Player":AP="Relief Pitcher":S$="starting"
  464. 7045 L$=FNF(23,22)+LEFT$(DK,19)+"start the game":GOSUB 5050
  465. 7050 AC="to continue the game"+DE:PRINT DE;CO;:GOTO 6600
  466. 7100 '    (Utility)
  467. 7105 PRINT F(16)STRING$(64,61)CO:IF UP=2 THEN 7200
  468. 7110 X=U1:IF U1(1)=0 THEN 5800
  469. 7115 IF IJ>1 THEN 7300
  470. 7120 IF U1(X)<=BV THEN U1(X)=BV+FNRN(IG/1.8+4.8)+2
  471. 7125 PRINT F(18)F;AU" --- ";USING U$;U1(X)/Q;
  472. 7130 PRINT" --- #"U0-X+1"of"U0;FNF(18,54)NA" *"FNF(19,54)"Batter ="J1
  473. 7135 PRINT F(21)F"Press <1> to bring in "AU"."F(23)F"Press <2> "AC;
  474. 7140 GOSUB 6600:IF AK="1" THEN 7150
  475. 7145 IF AK="2" OR AK=CHR$(13) THEN RETURN ELSE 7140
  476. 7150 PRINT F(18)CX;F;AU;N;USING U$;U1(X)/Q;:PRINT" to replace "NU"1-8 ??"
  477. 7155 PRINT F(21)A" Press <"FO" 1-8 ";:GOSUB 90
  478. 7160 GOSUB 6000:IF AK=CHR$(13) THEN RETURN
  479. 7165 VK=VAL(AK):IF VK=0 OR VK=9 THEN 7160
  480. 7170 PRINT F(18)CX:PRINT"A ";AO;AU;AF" has taken over for ";
  481. 7175 PRINT NU"#"AK" --- "DB(L1(VK))A;
  482. 7180 GOSUB 75:B1(VK)=U1(X):U1(X)=0:U1=U1-1:IJ=IJ+1:RETURN
  483. 7200 '    (Pitcher)
  484. 7205 X=P1:IF P1(1)=0 THEN 5700
  485. 7210 IF IJ>1 THEN 7300
  486. 7215 IF P1(X)<=B1(9) THEN P1(X)=B1(9)+FNRN(IG/1.8+1.8)+1
  487. 7220 PRINT F(18)F;AP" --- ";USING U$;P1(X)/Q;:PRINT" --- #"P0-X+1"of"P0
  488. 7225 PRINT FNF(18,54)NB;FNF(19,54)"Batter ="J2
  489. 7230 PRINT F(21)F"Press <1> to bring in "AP"."F(23)F"Press <2> "AC;
  490. 7235 GOSUB 6600:IF AK="1" THEN 7245
  491. 7240 IF AK="2" OR AK=CHR$(13) THEN RETURN ELSE 7235
  492. 7245 PRINT F(18)CX;F;AP;N;USING U$;P1(X)/Q;:PRINT" to replace the ";
  493. 7250 PRINT"current "NP"??"F(21)A" Press <"FO" 1 ";:GOSUB 90
  494. 7255 GOSUB 6000:IF AK=CHR$(13) THEN RETURN
  495. 7260 IF AK<>"1" THEN 7255
  496. 7265 PRINT F(18)CX:PRINT F"A ";AO;AP;AF;:IJ=IJ+1
  497. 7270 PRINT" has taken over for the "S$" "NP;DF;:S$="last"
  498. 7275 GOSUB 75:B1(9)=P1(X):P1(X)=0:P1=P1-1:RETURN
  499. 7300 L$=AU:IF UP=2 THEN L$=AP
  500. 7305 PRINT F(18)F"Only two "AO;L$;AF" changes allowed per inning!!"
  501. 7310 PRINT F(21)F"Press <"FO" ANY KEY "FF"> "AC;:GOTO 6600
  502. 7315 '
  503.  F(18)F"Only two "AO;L$;AF" changes allowed per inning!!"
  504. 7310 PRINT F(21)F"Press <"F