home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.whtech.com
/
ftp.whtech.com.tar
/
ftp.whtech.com
/
club100
/
gam
/
square.100
< prev
next >
Wrap
Text File
|
2006-10-19
|
6KB
|
263 lines
0 'SQUARE.BA - Author unknown
1 'Club 100 Library - 415/939-1246 BBS, 937-5039 NEWSLETTER, 932-8856 VOICE
100 DEFINTA-Z
110 DIMD(52),P(25),S(25),G$(2),H$(2,5)
120 FORN=1TOVAL(RIGHT$(TIME$,2))
130 W=RND(1)
140 NEXT
150 CLS
160 FORN=0TO2
170 G$(N)=STRING$(25,48)
180 NEXT
190 FORX=14TO98STEP21
200 FORY=0TO52STEP13
210 LINE(X,Y)-(X+19,Y+11),1,B
220 NEXT
230 NEXT
240 IFF=0THENFORN=1TO52:D(N)=N-1:NEXT:D=53
250 PRINT@62,"PLEASE PLAY
260 PRINT@103,"THIS CARD
270 LINE(153,27)-(176,40),1,B
280 LINE(154,28)-(175,39),1,B
290 FORN=1TO25
300 X=157
310 Y=30
320 IFF<>0THEN380
330 D=D-1
340 M=D*RND(1)+1
350 P(N)=1+(D(M)MOD13)
360 S(N)=D(M)/13
370 D(M)=D(D)
380 C$=CHR$(13*S(N)+P(N)+64)
390 GOSUB2570
400 GOSUB2590
410 Z=1
420 G=0
430 GOSUB2500
440 V=1
450 GOSUB2540
460 POKE65450,0
470 B=0
480 LINE(X,Y)-(X+15,Y+7),V,BF
490 B=B+1
500 IFB=12THENV=1-V:GOTO470ELSEK$=INKEY$:IFN=25THENK$=CHR$(13):GOTO510ELSEIFK$=""THENW=RND(1):GOTO490
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
520 IFINSTR(CHR$(28)+"dDlL",K$)=0THEN570
530 GOSUB2570
540 Z=1
550 GOSUB2500
560 IFG=0THENGOSUB2500:GOTO440ELSE440
570 IFINSTR(CHR$(29)+"sSkK",K$)=0THEN680
580 GOSUB2570
590 Z=0
600 G=26-G
610 GOSUB2500
620 IFG=0THENGOSUB2500
630 G=26-G
640 R=6-R
650 C=6-C
660 Z=1
670 GOTO440
680 IFINSTR(CHR$(30)+"eEoO",K$)THENG=G-(GMOD5)-(GMOD5<>0)+4*(GMOD5=0):GOTO580
690 IFINSTR(CHR$(31)+"xX,",K$)THENG=G-(GMOD5)-5*(GMOD5<>0):GOTO530
700 IFK$=CHR$(127)THEN1390ELSEBEEP:GOTO470
710 F=0
720 PRINT@61,SPACE$(12)
730 PRINT@102,"SCORING....
740 U=0
750 T=0
760 FORN=1TO21STEP5
770 FORL=1TO2
780 F$="
790 H$=STRING$(13,48)
800 S=0
810 J=0
820 FORK=0TO4
830 P=ASC(MID$(G$(L),N+K,1))-65
840 F$=F$+RIGHT$(STR$(INT(P/13)),1)
850 P=(P+1)MOD13
860 P=P-13*(P=0)
870 MID$(H$,P)=MID$(STR$(1+VAL(MID$(H$,P,1))),2,2)
880 NEXT
890 IFF$=STRING$(5,ASC(F$))THENJ=1
900 H=INSTR(H$,"1")
910 IFH>0ANDINSTR(H+1,H$,"1111")=H+1THENS=1
920 IFINSTR(10,H$,"1111")>0ANDASC(H$)=49THENS=2
930 IFJ=1ANDS>0THENE=30:A=75-25*(S=2):GOTO1020
940 IFJ=1ORS>0THENE=-5*(J=1)-12*(S>0):A=-20*(J=1)-15*(S>0):GOTO1020
950 IFINSTR(H$,"4")THENE=16:A=50:GOTO1020
960 IFINSTR(H$,"3")>0ANDINSTR(H$,"2")>0THENE=10:A=25:GOTO1020
970 IFINSTR(H$,"3")THENE=6:A=10:GOTO1020
980 P=INSTR(H$,"2")
990 IFP>0ANDINSTR(P+1,H$,"2")>0THENE=3:A=5:GOTO1020
1000 E=-(P>0)
1010 A=-2*(P>0)
1020 IFA<25THENQ=A/5+1-9*(A=0)ELSEQ=A/25+5
1030 H$(L,(N+4)/5)=MID$("PAIR 2 PAIRS 3/KIND STRAIGHTFLUSH FL/HOUSE4/KIND ST/FLUSHROYAL/FLNOTHING",8*Q-7,8)
1040 U=U+E
1050 T=T+A
1060 NEXT
1070 NEXT
1080 GOSUB1440
1090 PRINT@66,"SCORES
1100 LINE(153,5)-(193,17),1,B
1110 LINE(152,4)-(194,18),1,B
1120 PRINT@143,"AMERICAN ="T
1130 PRINT@223,"ENGLISH ="U
1140 GOSUB2670
1150 GOSUB1440
1160 PRINT@22,"PRESS FOR
1170 PRINT@104,"1 NEW DEAL
1180 LINE(131,9)-(161,9)
1190 LINE(167,9)-(185,9)
1200 PRINT@144,"2 SAME DEAL
1210 PRINT@184,"3 SCORES
1220 PRINT@224,"4 HANDS
1230 PRINT@264,"DEL TO QUIT
1240 GOSUB2670
1250 IFK$<"1"ORK$>"4"THENBEEP:GOTO1240
1260 ONASC(K$)-48GOTO150,1270,1080,1290
1270 F=1
1280 GOTO150
1290 GOSUB1440
1300 PRINT@63,"ROW COLUMN
1310 PRINT@101,"-------- --------
1320 FORN=1TO5
1330 PRINT@101+40*N,H$(1,N);
1340 PRINT@111+40*N,H$(2,N);
1350 NEXT
1360 GOSUB2670
1370 GOSUB1440
1380 GOTO1160
1390 CLS
1400 PRINT@135,"GAME OVER
1410 PRINT
1420 PRINT
1430 MENU
1440 FORN=20TO300STEP40
1450 PRINT@N,SPACE$(19);
1460 NEXT
1470 RETURN
1480 LINE(X,Y+7)-(X,Y+3)
1490 LINE-(X+2,Y+1)
1500 LINE-(X+4,Y+3)
1510 LINE-(X+4,Y+7)
1520 LINE(X+1,Y+5)-(X+3,Y+5)
1530 RETURN
1540 GOSUB2410
1550 LINE-(X+2,Y+5)
1560 LINE-(X+1,Y+5)
1570 LINE-(X,Y+6)
1580 LINE-(X,Y+7)
1590 LINE-(X+4,Y+7)
1600 RETURN
1610 GOSUB2410
1620 LINE(X+2,Y+4)-(X+3,Y+4)
1630 LINE-(X+4,Y+5)
1640 LINE-(X+4,Y+6)
1650 LINE-(X+3,Y+7)
1660 LINE-(X+1,Y+7)
1670 PSET(X,Y+6)
1680 RETURN
1690 LINE(X+3,Y+7)-(X+3,Y+1)
1700 LINE-(X,Y+4)
1710 LINE-(X,Y+5)
1720 LINE-(X+4,Y+5)
1730 RETURN
1740 LINE(X+4,Y+1)-(X,Y+1)
1750 LINE-(X,Y+3)
1760 LINE-(X+3,Y+3)
1770 LINE-(X+4,Y+4)
1780 LINE-(X+4,Y+6)
1790 LINE-(X+3,Y+7)
1800 LINE-(X+1,Y+7)
1810 PSET(X,Y+6)
1820 RETURN
1830 LINE(X+3,Y+1)-(X+2,Y+1)
1840 LINE-(X,Y+3)
1850 LINE-(X,Y+6)
1860 LINE-(X+1,Y+7)
1870 LINE-(X+3,Y+7)
1880 LINE-(X+4,Y+6)
1890 LINE-(X+4,Y+5)
1900 LINE-(X+3,Y+4)
1910 LINE-(X+1,Y+4)
1920 RETURN
1930 PSET(X,Y+2)
1940 LINE(X,Y+1)-(X+4,Y+1)
1950 LINE-(X+4,Y+2)
1960 LINE-(X+2,Y+4)
1970 LINE-(X+2,Y+7)
1980 RETURN
1990 PSET(X,Y+3)
2000 GOSUB2410
2010 LINE-(X+3,Y+4)
2020 LINE-(X+1,Y+4)
2030 LINE-(X,Y+5)
2040 LINE-(X,Y+6)
2050 LINE-(X+1,Y+7)
2060 LINE-(X+3,Y+7)
2070 LINE-(X+4,Y+6)
2080 PSET(X+4,Y+5)
2090 RETURN
2100 LINE(X+1,Y+4)-(X+3,Y+4)
2110 PSET(X,Y+3)
2120 GOSUB2410
2130 LINE-(X+4,Y+5)
2140 LINE-(X+2,Y+7)
2150 PSET(X+1,Y+7)
2160 RETURN
2170 FORXA=0TO4STEP2
2180 LINE(X+XA,Y+1)-(X+XA,Y+7)
2190 NEXT
2200 PSET(X+3,Y+1)
2210 PSET(X+3,Y+7)
2220 RETURN
2230 LINE(X+2,Y+1)-(X+4,Y+1)
2240 LINE(X+3,Y+2)-(X+3,Y+6)
2250 LINE-(X+2,Y+7)
2260 LINE-(X+1,Y+7)
2270 LINE(X,Y+6)-(X,Y+5)
2280 RETURN
2290 GOSUB2410
2300 LINE-(X+4,Y+5)
2310 LINE-(X+2,Y+7)
2320 LINE-(X+1,Y+7)
2330 LINE-(X,Y+6)
2340 LINE-(X,Y+3)
2350 LINE(X+2,Y+5)-(X+4,Y+7)
2360 RETURN
2370 LINE(X,Y+1)-(X,Y+7)
2380 LINE(X+4,Y+1)-(X+1,Y+4)
2390 LINE-(X+4,Y+7)
2400 RETURN
2410 LINE(X,Y+2)-(X+1,Y+1)
2420 LINE-(X+3,Y+1)
2430 LINE-(X+4,Y+2)
2440 LINE-(X+4,Y+3)
2450 RETURN
2460 DATA 4,5,3,6,2,6,1,5,0,7,1,5,2,6,3,6,4,5
2470 DATA 1,3,0,4,0,5,1,6,2,7,1,6,0,5,0,4,1,3
2480 DATA -2,-2,4,4,3,5,2,6,1,7,2,6,3,5,4,4,-2,-2
2490 DATA 4,5,3,6,1,6,0,5,0,7,0,5,1,6,3,6,4,5
2500 G=INSTR(G+1,G$(Z),"0")
2510 C=((G-1)MOD5)+1
2520 R=(G-1)/5+1
2530 RETURN
2540 X=21*C-5
2550 Y=13*R-11
2560 RETURN
2570 LINE(X,Y)-(X+15,Y+7),0,BF
2580 RETURN
2590 ONP(N)GOSUB1480,1540,1610,1690,1740,1830,1930,1990,2100,2170,2230,2290,2370
2600 IFS(N)=0THENRESTORE2460ELSEIFS(N)=1THENRESTORE2470ELSEIFS(N)=2THENRESTORE2480ELSERESTORE2490
2610 FORXA=7TO15
2620 READYA,YB
2630 LINE(X+XA,Y+YA)-(X+XA,Y+YB)
2640 NEXT
2650 IFS(N)=3THENPRESET(X+9,Y+2):PRESET(X+10,Y+3):PRESET(X+12,Y+3):PRESET(X+13,Y+2)
2660 RETURN
2670 POKE65450,0
2680 K$=INKEY$
2690 IFK$=""THEN2680ELSEIFK$=CHR$(127)THEN1390ELSERETURN