Rosetta Code

War card game: Difference between revisions

Page Discussion

War card game (view source)

Revision as of 19:49, 2 March 2024

3,065 bytes added ,  3 months ago
Added FreeBASIC
(Applesoft BASIC)
(Added FreeBASIC)
 
(5 intermediate revisions by 3 users not shown)
Line 133:
=={{header|Applesoft BASIC}}==
{{trans|Python}}
* The Bicycle rules are set up by default, but other variations can be played by passing different parameters.
* When the winning player picks up cards, the cards are randomized when added to the bottom of the player's deck. see [[War_card_game#Raku|Raku]] for details.
* Other variations can be played by passing different parameters.
<syntaxhighlight lang="autohotkey"> 100 R = RND (0): REM SEED
110 W = 1: REM BICYCLE RULE: ONLY ONE EXTRA CARD GIVEN UP IN WAR
Line 142 ⟶ 144:
160 FACE$ = "23456789TJQKA"
170 M = LEN (SUIT$)
180 FOR I = 1 TO D: FOR S = 1 TO M: FOR F = 1 TO LEN (FACE$):DECKP$ = DECKP$ + CHR$ ((F - 1) * M + (S - 1)): NEXT F,S,I
190 TEXT : HOME : POKE 34,12
REM INITIALIZE
200 N = LEN (DECK$)
210 PRINT "SHUFFLING ..."
220 FOR I = 1 TO N
230 R = INT ( RND (1) * N + 1)
240 R$ = MID$ (DECK$,R,1)
250 C$ = MID$ (DECK$,I,1)
260 DECK$ = MID$ (DECK$,1,I - 1) + R$ + MID$ (DECK$,I + 1)
270 DECK$ = MID$ (DECK$,1,R - 1) + C$ + MID$ (DECK$,R + 1)
280 NEXT
REM DEAL TO PLAYERS
200 GOSUB 700"SHUFFLE
300 E = INT (N / P)
310210 FOR IE = 1 TOINT (N / P)
320220 FOR D$(I) = MID$ (DECK$,(I - 1) *TO E + 1,E)P
230 D$(I) = MID$ (P$,(I - 1) * E + 1,E)
330 NEXT
240 NEXT
340 P$ = MID$ (DECK$,(I - 1) * E + 1): REM WINNER OF THE FIRST PLAY KEEPS THESE REMAINING CARDS
250 P$ = MID$ (P$,(I - 1) * E + 1): REM WINNER OF THE FIRST PLAY KEEPS THESE REMAINING CARDS
350 P$ = "": REM REMOVE REMAINING CARDS FROM THE GAME
260 P$ = "": REM REMOVE REMAINING CARDS FROM THE GAME
REM PLAY
400300 FOR T = 0 TO 1E38
410310 GOSUB 500400"TURN
420320 IF Q = 0 THEN NEXT T
430330 PRINT TAB( 10)" IN "T" TURNS": TEXT : VTAB 11: PRINT : CALL - 868: PRINT "...": VTAB 23
440340 END
 
REM TURN
500400 PRINT : GOSUB 800900"IS GAME OVER?
510410 IF Q THEN RETURN
520420 U = 0: REM UTMOST CARD
530430 C = 0: REM COUNT THE PLAYERS WITH THE UTMOST CARD
540440 FOR I = 1 TO P
550450 C$(I) = "" : IF NOT L(I) THEN C$(I) = MID$ (D$(I),1,1)
560460 IF LEN (C$(I)) AND (R OR NOT L(I)) THEN GOSUB 700800"drawDRAW cardCARD
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.";
580 IF C = 1 THEN PRINT "PLAYER "A" TAKES THE CARDS.": FOR I = 1 TO P:L(I) = 0:D$(A) = D$(A) + C$(I): NEXT I:D$(A) = D$(A) + P$:P$ = "": RETURN
590 RETURN
590 FOR I = 1 TO P:L(I) = G(I) < > C: NEXT I
 
600 PRINT "TIE!"
REM WINNER TAKE CARDS
610 GOSUB 800"IS GAME OVER?
620600 IFFOR QI THEN= 1 RETURNTO P
630610 FOR I = 1 TO P:P$ = P$ + C$L(I): NEXT= I0
640620 FOR I = 1 TOP$ = P$ + C$(I)
630 NEXT I
REM DOES NOT APPLY TO 2 PLAYER GAMES (BICYCLE RULE): R MEANS IGNORE THE RULE THAT ONLY THE WINNERS PLACE CARD(S) FACE DOWN
640 PRINT "PLAYER "A" TAKES "LEN(P$);
650 IF R OR NOT L(I) THEN FOR J = 1 TO W:P$ = P$ + MID$ (D$(I),1,1):D$(I) = MID$ (D$(I),2): PRINT " ? ";: NEXT J
650 IF NOT Z THEN GOSUB 710"SHUFFLE
660 NEXT I
660 D$(A) = D$(A) + P$
670 PRINT "CARDS ARE FACE DOWN."
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
700800 G = ASC (C$(I))
710810 G(I) = INT (G / M) + 1
720820 PRINT MID$ (FACE$,G(I),1) MID$ (SUIT$,G - (G(I) - 1) * M + 1,1)" ";
730830 D$(I) = MID$ (D$(I),2)
740840 C = C + (G(I) = U)
750850 IF G(I) > U THEN U = G(I):C = 1:A = I
760860 RETURN
 
REM IS GAME OVER?
800900 C = 0
810910 FOR I = 1 TO P
820920 IF LEN (D$(I)) THEN A = I:C = C + 1
830930 NEXT I
840940 IF C > 1 THEN RETURN
REM GAME OVER - WHO WON MESSAGE
850950 Q = 1
860960 IF C THEN PRINT "PLAYER "A" WINS THE GAME.";: RETURN
870970 PRINT "GAME ENDS AS A TIE.";: RETURN</syntaxhighlight>
<syntaxhighlight lang="autohotkey">CLEAR : R = RND ( - 558) : GOTO 110</syntaxhighlight>
{{out}}
<pre>SHUFFLING .............
ADJD QD9H PLAYER 1 TAKES THE CARDS2.
4C 5C PLAYER 2 TAKES 2.
4D 4H TIE!
2D 8C PLAYER 2 TAKES 2.
? ? CARDS ARE FACE DOWN.
ACTH TDAS PLAYER 12 TAKES THE CARDS2.
9C7D 5CQS PLAYER 12 TAKES THE CARDS2.
3H 4S 8H PLAYER 2 TAKES THE CARDS2.
8DAD TH7C PLAYER 21 TAKES THE CARDS2.
JS 2S PLAYER 1 TAKES 2.
QS QC TIE!
?3C 3S ?WAR! 2 CARDS AREPLACED FACE DOWN.
5STD QHKH PLAYER 2 TAKES THE CARDS6..
...
8C8D 2D PLAYER 1 TAKES THE CARDS2.
8CTD 3S7C PLAYER 1 TAKES THE CARDS2.
2D7S AS6C PLAYER 21 TAKES THE CARDS2.
8C9H 7C8H PLAYER 1 TAKES THE CARDS2.
3S3D KH8C PLAYER 2 TAKES THE CARDS2.
8CAD 5H3C PLAYER 1 TAKES THE CARDS2.
7C4H JD4C PLAYERWAR! 2 TAKESCARDS THEPLACED CARDSFACE DOWN.
7D 7H WAR! 2 CARDS PLACED FACE DOWN.
8C 8D TIE!
JH 3D PLAYER 1 TAKES 10...
? ? CARDS ARE FACE DOWN.
9D 8C PLAYER 1 TAKES 2.
PLAYER 2 WINS THE GAME.
PLAYER 1 WINS THE GAME IN 959432 TURNS
</pre>
 
=={{header|AutoHotkey}}==
<syntaxhighlight lang="autohotkey">suits := ["♠", "♦", "♥", "♣"]
Line 472 ⟶ 490:
int main() {
war_game wargame;
srand((unsigned) time(NULL));
 
while ( ! wargame.game_over() ) {
wargame.next_turn();
Line 507 ⟶ 525:
Player A has won the game
</pre>
 
=={{header|FreeBASIC}}==
{{trans|XPLo}}
<syntaxhighlight lang="vbnet">Dim Shared As Integer stack(1, 51) ' each player's stack of cards (52 maximum)
Dim Shared As Integer inx(1) ' index to last card (+1) for each stack
Dim Shared As Integer carta
 
Sub MoveCard(hacia As Integer, desde As Integer) ' Move top card desde stack to bottom of To stack
Dim As Integer i
carta = stack(desde, 0) ' take top carta from desde stack
For i = 0 To inx(desde) - 2 ' shift remaining cards over
stack(desde, i) = stack(desde, i + 1)
Next i
If inx(desde) > 0 Then inx(desde) -= 1 ' remove desde card from its stack
stack(hacia, inx(hacia)) = carta ' add carta to bottom of To stack
If inx(hacia) < 52 Then inx(hacia) += 1 ' remove desde card from its stack
End Sub
 
Dim As String suit = "HDCS "
Dim As String rank = "23456789TJQKA "
Dim As Integer top ' index to compared cards, = stack top if not war
Dim As Integer deck(51) ' initial card deck (low 2 bits = suit)
For carta = 0 To 51 ' make a complete deck of cards
deck(carta) = carta
Next carta
Dim As Integer n, i, j, p, t
 
Randomize Timer
For n = 0 To 10000 ' shuffle the deck by swapping random locations
i = Int(Rnd * 52): j = Int(Rnd * 52)
Swap deck(i), deck(j)
Next n
For n = 0 To 51 ' deal deck into two stacks
carta = deck(n)
i = n \ 2
p = n Mod 2
stack(p, i) = carta
Next n
inx(0) = 52 \ 2: inx(1) = 52 \ 2 ' set indexes to last card +1
 
Do
For p = 0 To 1 ' show both stacks of cards
For i = 0 To inx(p) - 1
carta = stack(p, i)
Print Left(rank, carta Shr 2);
Next i
Print
For i = 0 To inx(p) - 1
carta = stack(p, i)
Print Mid(suit, (carta And 3) + 1, 1);
Next i
Print
Next p
If inx(0) = 0 Or inx(1) = 0 Then Exit Do ' game over
top = 0 ' compare card ranks (above 2-bit suits)
Do
If (stack(0, top) Shr 2) = (stack(1, top) Shr 2) Then
Color 3 : Print "War!" : Print : Color 7
top += 2 ' play a card down and a card up
Elseif (stack(0, top) Shr 2) > (stack(1, top) Shr 2) Then
For i = 0 To top ' move cards to stack 0
MoveCard(0, 0): MoveCard(0, 1)
Next i
Exit Do
Else
For i = 0 To top ' move cards to stack 1
MoveCard(1, 1): MoveCard(1, 0)
Next i
Exit Do
End If
Loop
Sleep 1000, 1
Print
Loop
 
End</syntaxhighlight>
 
=={{header|Go}}==
Line 1,767 ⟶ 1,862:
 
I've also assumed that if a player wins a round, his/her own cards (in the order played) are added back to the bottom of his/her hand before the other player's cards.
<syntaxhighlight lang="ecmascriptwren">import "random" for Random
import "./queue" for Deque
 
var rand = Random.new()
Jjuanhdez
2,167

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/346019...361082"