home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / gam / square.200 < prev    next >
Text File  |  2006-10-19  |  7KB  |  263 lines
  1. 0 'SQUARE.BA - Author unknown              Modified for M200 by Steve St.Laurent
  2. 1 'Club 100 Library - 415/939-1246 BBS,    937-5039 NEWSLETTER, 932-8856 VOICE
  3. 100 DEFINTA-Z
  4. 110 DIMD(52),P(25),S(25),G$(2),H$(2,5)
  5. 120 FORN=1TOVAL(RIGHT$(TIME$,2))
  6. 130 W=RND(1)
  7. 140 NEXT
  8. 150 CLS
  9. 160 FORN=0TO2
  10. 170 G$(N)=STRING$(25,48)
  11. 180 NEXT
  12. 190 FORX=14TO98STEP21
  13. 200 FORY=0TO52STEP13
  14. 210 LINE(X,Y)-(X+19,Y+11),1,B
  15. 220 NEXT
  16. 230 NEXT
  17. 240 IFF=0THENFORN=1TO52:D(N)=N-1:NEXT:D=53
  18. 250 PRINT@62,"PLEASE PLAY
  19. 260 PRINT@103,"THIS CARD
  20. 270 LINE(153,27)-(176,40),1,B
  21. 280 LINE(154,28)-(175,39),1,B
  22. 290 FORN=1TO25
  23. 300 X=157
  24. 310 Y=30
  25. 320 IFF<>0THEN380
  26. 330 D=D-1
  27. 340 M=D*RND(1)+1
  28. 350 P(N)=1+(D(M)MOD13)
  29. 360 S(N)=D(M)/13
  30. 370 D(M)=D(D)
  31. 380 C$=CHR$(13*S(N)+P(N)+64)
  32. 390 GOSUB2570
  33. 400 GOSUB2590
  34. 410 Z=1
  35. 420 G=0
  36. 430 GOSUB2500
  37. 440 V=1
  38. 450 GOSUB2540
  39. 460 POKE64798,0
  40. 470 B=0
  41. 480 LINE(X,Y)-(X+15,Y+7),V,BF
  42. 490 B=B+1
  43. 500 IFB=12THENV=1-V:GOTO470ELSEK$=INKEY$:IFN=25THENK$=CHR$(13):GOTO510ELSEIFK$=""THENW=RND(1):GOTO490
  44. 510 IFK$=CHR$(13)THENGOSUB2540:GOSUB2570:GOSUB2590:MID$(G$(0),31-C-5*R)=C$:MID$(G$(1),C+5*R-5)=C$:MID$(G$(2),R+5*C-5)=C$:NEXT:GOTO710
  45. 520 IFINSTR(CHR$(28)+"dDlL",K$)=0THEN570
  46. 530 GOSUB2570
  47. 540 Z=1
  48. 550 GOSUB2500
  49. 560 IFG=0THENGOSUB2500:GOTO440ELSE440
  50. 570 IFINSTR(CHR$(29)+"sSkK",K$)=0THEN680
  51. 580 GOSUB2570
  52. 590 Z=0
  53. 600 G=26-G
  54. 610 GOSUB2500
  55. 620 IFG=0THENGOSUB2500
  56. 630 G=26-G
  57. 640 R=6-R
  58. 650 C=6-C
  59. 660 Z=1
  60. 670 GOTO440
  61. 680 IFINSTR(CHR$(30)+"eEoO",K$)THENG=G-(GMOD5)-(GMOD5<>0)+4*(GMOD5=0):GOTO580
  62. 690 IFINSTR(CHR$(31)+"xX,",K$)THENG=G-(GMOD5)-5*(GMOD5<>0):GOTO530
  63. 700 IFK$=CHR$(127)THEN1390ELSEBEEP:GOTO470
  64. 710 F=0
  65. 720 PRINT@61,SPACE$(12)
  66. 730 PRINT@102,"SCORING....
  67. 740 U=0
  68. 750 T=0
  69. 760 FORN=1TO21STEP5
  70. 770 FORL=1TO2
  71. 780 F$="
  72. 790 H$=STRING$(13,48)
  73. 800 S=0
  74. 810 J=0
  75. 820 FORK=0TO4
  76. 830 P=ASC(MID$(G$(L),N+K,1))-65
  77. 840 F$=F$+RIGHT$(STR$(INT(P/13)),1)
  78. 850 P=(P+1)MOD13
  79. 860 P=P-13*(P=0)
  80. 870 MID$(H$,P)=MID$(STR$(1+VAL(MID$(H$,P,1))),2,2)
  81. 880 NEXT
  82. 890 IFF$=STRING$(5,ASC(F$))THENJ=1
  83. 900 H=INSTR(H$,"1")
  84. 910 IFH>0ANDINSTR(H+1,H$,"1111")=H+1THENS=1
  85. 920 IFINSTR(10,H$,"1111")>0ANDASC(H$)=49THENS=2
  86. 930 IFJ=1ANDS>0THENE=30:A=75-25*(S=2):GOTO1020
  87. 940 IFJ=1ORS>0THENE=-5*(J=1)-12*(S>0):A=-20*(J=1)-15*(S>0):GOTO1020
  88. 950 IFINSTR(H$,"4")THENE=16:A=50:GOTO1020
  89. 960 IFINSTR(H$,"3")>0ANDINSTR(H$,"2")>0THENE=10:A=25:GOTO1020
  90. 970 IFINSTR(H$,"3")THENE=6:A=10:GOTO1020
  91. 980 P=INSTR(H$,"2")
  92. 990 IFP>0ANDINSTR(P+1,H$,"2")>0THENE=3:A=5:GOTO1020
  93. 1000 E=-(P>0)
  94. 1010 A=-2*(P>0)
  95. 1020 IFA<25THENQ=A/5+1-9*(A=0)ELSEQ=A/25+5
  96. 1030 H$(L,(N+4)/5)=MID$("PAIR    2 PAIRS 3/KIND  STRAIGHTFLUSH   FL/HOUSE4/KIND  ST/FLUSHROYAL/FLNOTHING",8*Q-7,8)
  97. 1040 U=U+E
  98. 1050 T=T+A
  99. 1060 NEXT
  100. 1070 NEXT
  101. 1080 GOSUB1440
  102. 1090 PRINT@66,"SCORES
  103. 1100 LINE(153,5)-(193,17),1,B
  104. 1110 LINE(152,4)-(194,18),1,B
  105. 1120 PRINT@143,"AMERICAN ="T
  106. 1130 PRINT@223,"ENGLISH ="U
  107. 1140 GOSUB2670
  108. 1150 GOSUB1440
  109. 1160 PRINT@22,"PRESS FOR
  110. 1170 PRINT@104,"1   NEW DEAL
  111. 1180 LINE(131,9)-(161,9)
  112. 1190 LINE(167,9)-(185,9)
  113. 1200 PRINT@144,"2   SAME DEAL
  114. 1210 PRINT@184,"3   SCORES
  115. 1220 PRINT@224,"4   HANDS
  116. 1230 PRINT@264,"DEL TO QUIT
  117. 1240 GOSUB2670
  118. 1250 IFK$<"1"ORK$>"4"THENBEEP:GOTO1240
  119. 1260 ONASC(K$)-48GOTO150,1270,1080,1290
  120. 1270 F=1
  121. 1280 GOTO150
  122. 1290 GOSUB1440
  123. 1300 PRINT@63,"ROW      COLUMN
  124. 1310 PRINT@101,"--------  --------
  125. 1320 FORN=1TO5
  126. 1330 PRINT@101+40*N,H$(1,N);
  127. 1340 PRINT@111+40*N,H$(2,N);
  128. 1350 NEXT
  129. 1360 GOSUB2670
  130. 1370 GOSUB1440
  131. 1380 GOTO1160
  132. 1390 CLS
  133. 1400 PRINT@135,"GAME  OVER
  134. 1410 PRINT
  135. 1420 PRINT
  136. 1430 MENU
  137. 1440 FORN=20TO300STEP40
  138. 1450 PRINT@N,SPACE$(19);
  139. 1460 NEXT
  140. 1470 RETURN
  141. 1480 LINE(X,Y+7)-(X,Y+3)
  142. 1490 LINE-(X+2,Y+1)
  143. 1500 LINE-(X+4,Y+3)
  144. 1510 LINE-(X+4,Y+7)
  145. 1520 LINE(X+1,Y+5)-(X+3,Y+5)
  146. 1530 RETURN
  147. 1540 GOSUB2410
  148. 1550 LINE-(X+2,Y+5)
  149. 1560 LINE-(X+1,Y+5)
  150. 1570 LINE-(X,Y+6)
  151. 1580 LINE-(X,Y+7)
  152. 1590 LINE-(X+4,Y+7)
  153. 1600 RETURN
  154. 1610 GOSUB2410
  155. 1620 LINE(X+2,Y+4)-(X+3,Y+4)
  156. 1630 LINE-(X+4,Y+5)
  157. 1640 LINE-(X+4,Y+6)
  158. 1650 LINE-(X+3,Y+7)
  159. 1660 LINE-(X+1,Y+7)
  160. 1670 PSET(X,Y+6)
  161. 1680 RETURN
  162. 1690 LINE(X+3,Y+7)-(X+3,Y+1)
  163. 1700 LINE-(X,Y+4)
  164. 1710 LINE-(X,Y+5)
  165. 1720 LINE-(X+4,Y+5)
  166. 1730 RETURN
  167. 1740 LINE(X+4,Y+1)-(X,Y+1)
  168. 1750 LINE-(X,Y+3)
  169. 1760 LINE-(X+3,Y+3)
  170. 1770 LINE-(X+4,Y+4)
  171. 1780 LINE-(X+4,Y+6)
  172. 1790 LINE-(X+3,Y+7)
  173. 1800 LINE-(X+1,Y+7)
  174. 1810 PSET(X,Y+6)
  175. 1820 RETURN
  176. 1830 LINE(X+3,Y+1)-(X+2,Y+1)
  177. 1840 LINE-(X,Y+3)
  178. 1850 LINE-(X,Y+6)
  179. 1860 LINE-(X+1,Y+7)
  180. 1870 LINE-(X+3,Y+7)
  181. 1880 LINE-(X+4,Y+6)
  182. 1890 LINE-(X+4,Y+5)
  183. 1900 LINE-(X+3,Y+4)
  184. 1910 LINE-(X+1,Y+4)
  185. 1920 RETURN
  186. 1930 PSET(X,Y+2)
  187. 1940 LINE(X,Y+1)-(X+4,Y+1)
  188. 1950 LINE-(X+4,Y+2)
  189. 1960 LINE-(X+2,Y+4)
  190. 1970 LINE-(X+2,Y+7)
  191. 1980 RETURN
  192. 1990 PSET(X,Y+3)
  193. 2000 GOSUB2410
  194. 2010 LINE-(X+3,Y+4)
  195. 2020 LINE-(X+1,Y+4)
  196. 2030 LINE-(X,Y+5)
  197. 2040 LINE-(X,Y+6)
  198. 2050 LINE-(X+1,Y+7)
  199. 2060 LINE-(X+3,Y+7)
  200. 2070 LINE-(X+4,Y+6)
  201. 2080 PSET(X+4,Y+5)
  202. 2090 RETURN
  203. 2100 LINE(X+1,Y+4)-(X+3,Y+4)
  204. 2110 PSET(X,Y+3)
  205. 2120 GOSUB2410
  206. 2130 LINE-(X+4,Y+5)
  207. 2140 LINE-(X+2,Y+7)
  208. 2150 PSET(X+1,Y+7)
  209. 2160 RETURN
  210. 2170 FORXA=0TO4STEP2
  211. 2180 LINE(X+XA,Y+1)-(X+XA,Y+7)
  212. 2190 NEXT
  213. 2200 PSET(X+3,Y+1)
  214. 2210 PSET(X+3,Y+7)
  215. 2220 RETURN
  216. 2230 LINE(X+2,Y+1)-(X+4,Y+1)
  217. 2240 LINE(X+3,Y+2)-(X+3,Y+6)
  218. 2250 LINE-(X+2,Y+7)
  219. 2260 LINE-(X+1,Y+7)
  220. 2270 LINE(X,Y+6)-(X,Y+5)
  221. 2280 RETURN
  222. 2290 GOSUB2410
  223. 2300 LINE-(X+4,Y+5)
  224. 2310 LINE-(X+2,Y+7)
  225. 2320 LINE-(X+1,Y+7)
  226. 2330 LINE-(X,Y+6)
  227. 2340 LINE-(X,Y+3)
  228. 2350 LINE(X+2,Y+5)-(X+4,Y+7)
  229. 2360 RETURN
  230. 2370 LINE(X,Y+1)-(X,Y+7)
  231. 2380 LINE(X+4,Y+1)-(X+1,Y+4)
  232. 2390 LINE-(X+4,Y+7)
  233. 2400 RETURN
  234. 2410 LINE(X,Y+2)-(X+1,Y+1)
  235. 2420 LINE-(X+3,Y+1)
  236. 2430 LINE-(X+4,Y+2)
  237. 2440 LINE-(X+4,Y+3)
  238. 2450 RETURN
  239. 2460 DATA 4,5,3,6,2,6,1,5,0,7,1,5,2,6,3,6,4,5
  240. 2470 DATA 1,3,0,4,0,5,1,6,2,7,1,6,0,5,0,4,1,3
  241. 2480 DATA -2,-2,4,4,3,5,2,6,1,7,2,6,3,5,4,4,-2,-2
  242. 2490 DATA 4,5,3,6,1,6,0,5,0,7,0,5,1,6,3,6,4,5
  243. 2500 G=INSTR(G+1,G$(Z),"0")
  244. 2510 C=((G-1)MOD5)+1
  245. 2520 R=(G-1)/5+1
  246. 2530 RETURN
  247. 2540 X=21*C-5
  248. 2550 Y=13*R-11
  249. 2560 RETURN
  250. 2570 LINE(X,Y)-(X+15,Y+7),0,BF
  251. 2580 RETURN
  252. 2590 ONP(N)GOSUB1480,1540,1610,1690,1740,1830,1930,1990,2100,2170,2230,2290,2370
  253. 2600 IFS(N)=0THENRESTORE2460ELSEIFS(N)=1THENRESTORE2470ELSEIFS(N)=2THENRESTORE2480ELSERESTORE2490
  254. 2610 FORXA=7TO15
  255. 2620 READYA,YB
  256. 2630 LINE(X+XA,Y+YA)-(X+XA,Y+YB)
  257. 2640 NEXT
  258. 2650 IFS(N)=3THENPRESET(X+9,Y+2):PRESET(X+10,Y+3):PRESET(X+12,Y+3):PRESET(X+13,Y+2)
  259. 2660 RETURN
  260. 2670 POKE64798,0
  261. 2680 K$=INKEY$
  262. 2690 IFK$=""THEN2680ELSEIFK$=CHR$(127)THEN1390ELSERETURN
  263.