RosettaCodeData/Task/War-card-game/Applesoft-BASIC/war-card-game-1.basic
2023-07-18 13:51:12 -07:00

90 lines
2.9 KiB
Text

100 R = RND (0): REM SEED
110 W = 1: REM BICYCLE RULE: ONLY ONE EXTRA CARD GIVEN UP IN WAR
120 P = 2: REM BICYCLE RULE: ONLY TWO PLAYERS
130 D = 1: REM BICYCLE RULE: ONLY ONE DECK OF CARDS
140 DIM D$(P),C$(P),G(P),L(P)
150 SUIT$ = "CDHS"
160 FACE$ = "23456789TJQKA"
170 M = LEN (SUIT$)
180 FOR I = 1 TO D: FOR S = 1 TO M: FOR F = 1 TO LEN (FACE$):P$ = P$ + CHR$ ((F - 1) * M + (S - 1)): NEXT F,S,I
190 TEXT : HOME : POKE 34,12
REM DEAL TO PLAYERS
200 GOSUB 700"SHUFFLE
210 E = INT (N / P)
220 FOR I = 1 TO P
230 D$(I) = MID$ (P$,(I - 1) * E + 1,E)
240 NEXT
250 P$ = MID$ (P$,(I - 1) * E + 1): REM WINNER OF THE FIRST PLAY KEEPS THESE REMAINING CARDS
260 P$ = "": REM REMOVE REMAINING CARDS FROM THE GAME
REM PLAY
300 FOR T = 0 TO 1E38
310 GOSUB 400"TURN
320 IF Q = 0 THEN NEXT T
330 PRINT " IN "T" TURNS": TEXT : VTAB 11: PRINT : CALL - 868: PRINT "...": VTAB 23
340 END
REM TURN
400 PRINT : GOSUB 900"IS GAME OVER?
410 IF Q THEN RETURN
420 U = 0: REM UTMOST CARD
430 C = 0: REM COUNT THE PLAYERS WITH THE UTMOST CARD
440 FOR I = 1 TO P
450 C$(I) = "" : IF NOT L(I) THEN C$(I) = MID$ (D$(I),1,1)
460 IF LEN (C$(I)) THEN GOSUB 800"DRAW CARD
470 NEXT I
480 IF C = 1 GOTO 600"WINNER TAKE CARDS
490 FOR I = 1 TO P:L(I) = G(I) < > U: NEXT I
500 PRINT "WAR! ";
510 GOSUB 900"IS GAME OVER?
520 IF Q THEN RETURN
530 C = 0
540 FOR I = 1 TO P:P$ = P$ + C$(I): NEXT I
550 FOR I = 1 TO P
REM DOES NOT APPLY TO 2 PLAYER GAMES (BICYCLE RULE): Y MEANS IGNORE THE RULE THAT ONLY THE WINNERS PLACE CARD(S) FACE DOWN
560 IF Y OR NOT L(I) THEN FOR J = 1 TO W:C$ = MID$ (D$(I),1,1) :C = C + LEN(C$) : P$ = P$ + C$ :D$(I) = MID$ (D$(I),2): NEXT J
570 NEXT I
580 PRINT C" CARDS PLACED FACE DOWN.";
590 RETURN
REM WINNER TAKE CARDS
600 FOR I = 1 TO P
610 L(I) = 0
620 P$ = P$ + C$(I)
630 NEXT I
640 PRINT "PLAYER "A" TAKES "LEN(P$);
650 IF NOT Z THEN GOSUB 710"SHUFFLE
660 D$(A) = D$(A) + P$
670 P$ = ""
680 RETURN
REM SHUFFLE
700 PRINT "SHUFFLING ";
710 N = LEN (P$)
720 FOR I = 1 TO N
730 IF I - INT (I / 4) * 4 = 1 THEN PRINT ".";
740 R = INT ( RND (1) * N + 1)
750 R$ = MID$ (P$,R,1) : C$ = MID$ (P$,I,1)
760 P$ = MID$ (P$,1,I - 1) + R$ + MID$ (P$,I + 1)
770 P$ = MID$ (P$,1,R - 1) + C$ + MID$ (P$,R + 1)
780 NEXT
790 RETURN
REM DRAW CARD
800 G = ASC (C$(I))
810 G(I) = INT (G / M) + 1
820 PRINT MID$ (FACE$,G(I),1) MID$ (SUIT$,G - (G(I) - 1) * M + 1,1)" ";
830 D$(I) = MID$ (D$(I),2)
840 C = C + (G(I) = U)
850 IF G(I) > U THEN U = G(I):C = 1:A = I
860 RETURN
REM IS GAME OVER?
900 C = 0
910 FOR I = 1 TO P
920 IF LEN (D$(I)) THEN A = I:C = C + 1
930 NEXT I
940 IF C > 1 THEN RETURN
REM GAME OVER - WHO WON MESSAGE
950 Q = 1
960 IF C THEN PRINT "PLAYER "A" WINS THE GAME";: RETURN
970 PRINT "GAME ENDS AS A TIE";: RETURN