Author Topic: 21 game text mode version (rosetta code)  (Read 3507 times)

0 Members and 1 Guest are viewing this topic.

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
21 game text mode version (rosetta code)
« 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

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. Dim TotalScore As Integer, NamePl1 As String, NamePl2 As String, ActivePlayer As String, Valchoose As Integer
  25. intro
  26. Initialize NamePl1, NamePl2, TotalScore
  27. ActivePlayer = NamePl1
  28. While TotalScore < 21
  29.     If ActivePlayer = "CPU" Then
  30.         TotalScore = TotalScore + ChooseCPU(TotalScore)
  31.     Else
  32.         Valchoose = ChooseHuman(ActivePlayer)
  33.         If Valchoose = 0 Then Valchoose = Quit(ActivePlayer)
  34.         TotalScore = TotalScore + Valchoose
  35.     End If
  36.     Locate 20, 10: Print Space$(40)
  37.     Locate 20, 10: Print ActivePlayer, TotalScore; "        ": _Delay 1
  38.     If TotalScore < 21 Then If ActivePlayer = NamePl1 Then ActivePlayer = NamePl2 Else ActivePlayer = NamePl1
  39. Winning ActivePlayer
  40.  
  41. Function Quit (who As String)
  42.     Quit = 0
  43.     Dim char As String
  44.     While char <> "Y" And char <> "N"
  45.         char = ""
  46.         box 10, 10, 12, 75
  47.         Locate 11, 11: Print who; " do you quit game?...Y,N?"
  48.         While char = "": char = UCase$(InKey$): Wend
  49.     Wend
  50.     If char = "Y" Then
  51.         End
  52.     Else
  53.         Quit = ChooseHuman(who)
  54.     End If
  55.  
  56.  
  57. Sub Winning (who As String)
  58.     Dim count As Integer
  59.     For count = 1 To 6
  60.         Color count
  61.         box 5 + count, 10 + count, 20 - count, 75 - count
  62.     Next count
  63.     Locate 5 + count, (34 - Int(Len(who) / 2))
  64.     Print "WINNER IS...." + who
  65.     Color 7, 0
  66.  
  67. Function ChooseHuman (who As String)
  68.     ChooseHuman = 0
  69.     Dim char As String
  70.     While char <> "0" And char <> "1" And char <> "2" And char <> "3"
  71.         char = ""
  72.         box 10, 10, 12, 75
  73.         Locate 11, 11: Print who; " Make your choice...1,2,3 or 0 to quit ";
  74.         While char = "": char = InKey$: Wend
  75.         Print char
  76.     Wend
  77.     ChooseHuman = Val(char)
  78.  
  79. Function ChooseCPU (Tscore As Integer)
  80.     If Tscore < 16 Then ChooseCPU = Int(Rnd * 2) + 1 Else If Tscore = 16 Then ChooseCPU = 1 Else ChooseCPU = 21 - Tscore
  81.  
  82. Sub Initialize (Pl1 As String, Pl2 As String, Tscore As Integer)
  83.     If ink = 1 Then
  84.         Pl1 = TakeName("player1")
  85.         Pl2 = TakeName("player2")
  86.     Else
  87.         Select Case whatTurn
  88.             Case 1
  89.                 Pl1 = TakeName("player1")
  90.                 Pl2 = "CPU"
  91.             Case 2
  92.                 Pl1 = "CPU"
  93.                 Pl2 = TakeName("player2")
  94.             Case 3
  95.                 If Int(Rnd * 1) + 1 = 2 Then
  96.                     Pl1 = "CPU"
  97.                     Pl2 = TakeName("player2")
  98.                 Else
  99.                     Pl1 = TakeName("player1")
  100.                     Pl2 = "CPU"
  101.                 End If
  102.         End Select
  103.     End If
  104.     Tscore = 0
  105.  
  106. Function TakeName$ (who As String)
  107.     Dim char As String, Name1 As String
  108.     TakeName$ = ""
  109.     Name1 = ""
  110.     Cancelbox 10, 10, 24, 75
  111.     box 10, 10, 12, 70
  112.     Locate 11, 11: Print "Enter name " + who + "...  "
  113.     While char <> Chr$(13)
  114.         char = InKey$
  115.         If char <> "" And InStr("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890", char) Then Name1 = Name1 + char
  116.         If Len(Name1) > 0 And char = Chr$(8) Then Name1 = Left$(Name1, Len(Name1) - 1)
  117.         Locate 11, 32: Print Name1 + " "
  118.     Wend
  119.     TakeName$ = Name1
  120.  
  121.  
  122. Function whatTurn
  123.     Dim choice As String
  124.     whatTurn = 0
  125.     While choice <> "F" And choice <> "S" And choice <> "R"
  126.         box Promtline - 1, 10, Promtline + 2, 75
  127.         Locate Promtline, 11: Print "Do you play as First (F) or Second (S) or at Random (R)? ";
  128.  
  129.         While choice = "": choice = UCase$(InKey$): Wend
  130.         Print choice: _Delay .5
  131.         box Errline - 1, 10, Errline + 2, 75
  132.  
  133.         While choice = "": choice = UCase$(InKey$): Wend
  134.         If choice <> "F" And choice <> "S" And choice <> "R" Then choice = "": Locate Errline, 11: Print "Please choose F, S or R "
  135.     Wend
  136.     If choice = "F" Then whatTurn = 1 Else If choice = "S" Then whatTurn = 2 Else If choice = "R" Then whatTurn = 3
  137.  
  138.     Dim Choice As String
  139.     ink = 0
  140.     While Choice <> "F" And Choice <> "C"
  141.         box Promtline - 1, 10, Promtline + 2, 75
  142.         Locate Promtline, 11: Print "Do you play against a friend (F) or CPU (C)? ";
  143.  
  144.         While Choice = "": Choice = UCase$(InKey$): Wend
  145.         Print Choice: _Delay .5
  146.         box Errline - 1, 10, Errline + 2, 75
  147.         If Choice <> "F" And Choice <> "C" Then Locate Errline, 11: Print "Please choose F or C": Choice = ""
  148.     Wend
  149.     If Choice = "F" Then ink = 1 Else If Choice = "C" Then ink = 2
  150.  
  151. Sub intro
  152.     Color 1, 0
  153.     box 9, 9, 18, 75
  154.     Locate 10, 31: Print "Welcome to 21 game"
  155.     Locate 12, 10: Print " This is the 21 game. Rules are easy, you must reach 21 score:"
  156.     Locate , 10: Print " 1. you can choose if you play against a friend (F) or CPU (C)"
  157.     Locate , 10: Print " 2. you can choose to start as First (F) or Second (S) player "
  158.     Locate , 10: Print "    or Random (R)."
  159.     Locate , 10: Print " 3. finally you can play choosing 1,2 or 3 and 0 to quit."
  160.     Locate , 30: Print " Press any key to continue..."
  161.     Sleep 4
  162.     For count = 1 To 13
  163.         Print
  164.         _Delay .2
  165.     Next count
  166.     Color 7, 0
  167.  
  168. Sub box (x1, y1, x2, y2)
  169.     Dim count As Integer
  170.     Locate x1, y1: Print "Ú" + String$(y2 - y1 - 2, "-") + "¿"
  171.     For count = 1 To (x2 - x1 - 1)
  172.         Locate x1 + count, y1: Print "³" + String$(y2 - y1 - 2, " ") + "³"
  173.     Next count
  174.     Locate x2, y1: Print "À" + String$(y2 - y1 - 2, "-") + "Ù"
  175.  
  176. Sub Cancelbox (x1, y1, x2, y2)
  177.     Dim count As Integer
  178.     For count = x1 To x2
  179.         Locate count, y1: Print String$(y2 - y1, " ");
  180.     Next count
  181.  
  182.  

Try to win AI to reach 21!
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: 21 game text mode version (rosetta code)
« Reply #1 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

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: 21 game text mode version (rosetta code)
« Reply #2 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?
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: 21 game text mode version (rosetta code)
« Reply #3 on: May 09, 2021, 12:55:27 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???
« Last Edit: May 09, 2021, 12:58:27 pm by bplus »