QB64.org Forum

Active Forums => Programs => Topic started by: TempodiBasic on May 07, 2021, 06:49:10 pm

Title: 21 game text mode version (rosetta code)
Post by: TempodiBasic on May 07, 2021, 06:49:10 pm

Hi guys and gals
I post here a text mode version of the 21 game
here the rosetta instructions http://rosettacode.org/wiki/21_game (http://rosettacode.org/wiki/21_game)

Code: QB64: [Select]

1. '21 is a two player game, the game is played by choosing a number
2. '(1, 2, or 3) to be added to the running total.
3.  
4. 'The game is won by the player whose chosen number causes
5. 'the running total to reach exactly 21.
6.  
7. 'The running total starts at zero. One player will be the computer.
8.  
9. 'Players alternate supplying a number to be added to the running total.
10.  
11.  
12. 'Task
13. 'Write a computer program that will:
14.  
15. 'do the prompting (or provide a button menu),
16. 'check for errors and display appropriate error messages,
17. 'do the additions (add a chosen number to the running total),
18. 'display the running total,
19. 'provide a mechanism for the player to quit/exit/halt/stop/close the program,
20. 'issue a notification when there is a winner, and
21. 'determine who goes first (maybe a random or user choice, or
22. 'can be specified when the game begins).
23. Const Errline = 18, Promtline = 14, Ends = 27
24. Screen 0
25. Dim TotalScore As Integer, NamePl1 As String, NamePl2 As String, ActivePlayer As String, Valchoose As Integer
26. intro
27. Initialize NamePl1, NamePl2, TotalScore
28. ActivePlayer = NamePl1
29. While TotalScore < 21
30.     If ActivePlayer = "CPU" Then
31.         TotalScore = TotalScore + ChooseCPU(TotalScore)
32.     Else
33.         Valchoose = ChooseHuman(ActivePlayer)
34.         If Valchoose = 0 Then Valchoose = Quit(ActivePlayer)
35.         TotalScore = TotalScore + Valchoose
36.     End If
37.     Locate 20, 10: Print Space$(40)
38.     Locate 20, 10: Print ActivePlayer, TotalScore; "        ": _Delay 1
39.     If TotalScore < 21 Then If ActivePlayer = NamePl1 Then ActivePlayer = NamePl2 Else ActivePlayer = NamePl1
40. Wend
41. Winning ActivePlayer
42. End
43.  
44. Function Quit (who As String)
45.     Quit = 0
46.     Dim char As String
47.     While char <> "Y" And char <> "N"
48.         char = ""
49.         box 10, 10, 12, 75
50.         Locate 11, 11: Print who; " do you quit game?...Y,N?"
51.         While char = "": char = UCase$(InKey$): Wend
52.     Wend
53.     If char = "Y" Then
54.         End
55.     Else
56.         Quit = ChooseHuman(who)
57.     End If
58. End Function
59.  
60.  
61. Sub Winning (who As String)
62.     Dim count As Integer
63.     For count = 1 To 6
64.         Color count
65.         box 5 + count, 10 + count, 20 - count, 75 - count
66.     Next count
67.     Locate 5 + count, (34 - Int(Len(who) / 2))
68.     Print "WINNER IS...." + who
69.     Color 7, 0
70. End Sub
71.  
72. Function ChooseHuman (who As String)
73.     ChooseHuman = 0
74.     Dim char As String
75.     While char <> "0" And char <> "1" And char <> "2" And char <> "3"
76.         char = ""
77.         box 10, 10, 12, 75
78.         Locate 11, 11: Print who; " Make your choice...1,2,3 or 0 to quit ";
79.         While char = "": char = InKey$: Wend
80.         Print char
81.     Wend
82.     ChooseHuman = Val(char)
83. End Function
84.  
85. Function ChooseCPU (Tscore As Integer)
86.     If Tscore < 16 Then ChooseCPU = Int(Rnd * 2) + 1 Else If Tscore = 16 Then ChooseCPU = 1 Else ChooseCPU = 21 - Tscore
87. End Function
88.  
89. Sub Initialize (Pl1 As String, Pl2 As String, Tscore As Integer)
90.     If ink = 1 Then
91.         Pl1 = TakeName("player1")
92.         Pl2 = TakeName("player2")
93.     Else
94.         Select Case whatTurn
95.             Case 1
96.                 Pl1 = TakeName("player1")
97.                 Pl2 = "CPU"
98.             Case 2
99.                 Pl1 = "CPU"
100.                 Pl2 = TakeName("player2")
101.             Case 3
102.                 If Int(Rnd * 1) + 1 = 2 Then
103.                     Pl1 = "CPU"
104.                     Pl2 = TakeName("player2")
105.                 Else
106.                     Pl1 = TakeName("player1")
107.                     Pl2 = "CPU"
108.                 End If
109.         End Select
110.     End If
111.     Tscore = 0
112. End Sub
113.  
114. Function TakeName$ (who As String)
115.     Dim char As String, Name1 As String
116.     TakeName$ = ""
117.     Name1 = ""
118.     Cancelbox 10, 10, 24, 75
119.     box 10, 10, 12, 70
120.     Locate 11, 11: Print "Enter name " + who + "...  "
121.     While char <> Chr$(13)
122.         char = InKey$
123.         If char <> "" And InStr("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890", char) Then Name1 = Name1 + char
124.         If Len(Name1) > 0 And char = Chr$(8) Then Name1 = Left$(Name1, Len(Name1) - 1)
125.         Locate 11, 32: Print Name1 + " "
126.     Wend
127.     TakeName$ = Name1
128. End Function
129.  
130.  
131. Function whatTurn
132.     Dim choice As String
133.     whatTurn = 0
134.     While choice <> "F" And choice <> "S" And choice <> "R"
135.         box Promtline - 1, 10, Promtline + 2, 75
136.         Locate Promtline, 11: Print "Do you play as First (F) or Second (S) or at Random (R)? ";
137.  
138.         While choice = "": choice = UCase$(InKey$): Wend
139.         Print choice: _Delay .5
140.         box Errline - 1, 10, Errline + 2, 75
141.  
142.         While choice = "": choice = UCase$(InKey$): Wend
143.         If choice <> "F" And choice <> "S" And choice <> "R" Then choice = "": Locate Errline, 11: Print "Please choose F, S or R "
144.     Wend
145.     If choice = "F" Then whatTurn = 1 Else If choice = "S" Then whatTurn = 2 Else If choice = "R" Then whatTurn = 3
146. End Function
147.  
148. Function ink
149.     Dim Choice As String
150.     ink = 0
151.     While Choice <> "F" And Choice <> "C"
152.         box Promtline - 1, 10, Promtline + 2, 75
153.         Locate Promtline, 11: Print "Do you play against a friend (F) or CPU (C)? ";
154.  
155.         While Choice = "": Choice = UCase$(InKey$): Wend
156.         Print Choice: _Delay .5
157.         box Errline - 1, 10, Errline + 2, 75
158.         If Choice <> "F" And Choice <> "C" Then Locate Errline, 11: Print "Please choose F or C": Choice = ""
159.     Wend
160.     If Choice = "F" Then ink = 1 Else If Choice = "C" Then ink = 2
161. End Function
162.  
163. Sub intro
164.     Color 1, 0
165.     box 9, 9, 18, 75
166.     Locate 10, 31: Print "Welcome to 21 game"
167.     Locate 12, 10: Print " This is the 21 game. Rules are easy, you must reach 21 score:"
168.     Locate , 10: Print " 1. you can choose if you play against a friend (F) or CPU (C)"
169.     Locate , 10: Print " 2. you can choose to start as First (F) or Second (S) player "
170.     Locate , 10: Print "    or Random (R)."
171.     Locate , 10: Print " 3. finally you can play choosing 1,2 or 3 and 0 to quit."
172.     Locate , 30: Print " Press any key to continue..."
173.     Sleep 4
174.     For count = 1 To 13
175.         Print
176.         _Delay .2
177.     Next count
178.     Color 7, 0
179. End Sub
180.  
181. Sub box (x1, y1, x2, y2)
182.     Dim count As Integer
183.     Locate x1, y1: Print "Ú" + String$(y2 - y1 - 2, "-") + "¿"
184.     For count = 1 To (x2 - x1 - 1)
185.         Locate x1 + count, y1: Print "³" + String$(y2 - y1 - 2, " ") + "³"
186.     Next count
187.     Locate x2, y1: Print "À" + String$(y2 - y1 - 2, "-") + "Ù"
188. End Sub
189.  
190. Sub Cancelbox (x1, y1, x2, y2)
191.     Dim count As Integer
192.     For count = x1 To x2
193.         Locate count, y1: Print String$(y2 - y1, " ");
194.     Next count
195. End Sub
196.  
197.  

Try to win AI to reach 21!

Title: Re: 21 game text mode version (rosetta code)
Post by: bplus on May 07, 2021, 06:57:57 pm

Here is my version from August, not much of a game, it's like NIM:
https://www.qb64.org/forum/index.php?topic=2902.msg121618#msg121618

Title: Re: 21 game text mode version (rosetta code)
Post by: TempodiBasic on May 09, 2021, 12:15:24 pm

Hi Bplus
I see it there! Ok I can see that your version  has just a more console style game aspect.

Please say me what is NIM?

Moreover please do you want publish your works on Rosetta Code?
You have done this task before me...
moreover in the string reverse task... there are so many versions... I like to got the right result to publish something... so what of these we (QB64community) want to publish on Rosetta Code?
What do you suggest to do?

Title: Re: 21 game text mode version (rosetta code)
Post by: bplus on May 09, 2021, 12:55:27 pm

Quote from: TempodiBasic on May 09, 2021, 12:15:24 pm

Hi Bplus
I see it there! Ok I can see that your version  has just a more console style game aspect.

Please say me what is NIM?

Moreover please do you want publish your works on Rosetta Code?
You have done this task before me...
moreover in the string reverse task... there are so many versions... I like to got the right result to publish something... so what of these we (QB64community) want to publish on Rosetta Code?
What do you suggest to do?

RE: NIM
I have a couple of old links haven't looked at for awhile, just check Game of NIM on Internet maybe you can find in your language?

Yeah I have coded the game but the AI always wins no fun at all!

RE: Rosetta Code posting by bplus
I love some of challenges but most seem either not very inventive or just plain crazy use of time IMHO, I don't have account and Word Search was the only thing I really really want to put up there. Thanks again to the guy that did that for me specially adding the zip for dictionary and additional codes.

So feel free to post any of mine if you want or we could set up a Rosetta Approval Committee that all these independent QB64 coders can ignore ;-)) My only concern is we post a really mediocre solution and miss a beautifully elegant one to show QB64 in best light.

RE: String Reverse task
I think the richness in variations deserves a post but who knows if they would like it over there???

Text Only | Text with Attachments