Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: xra7en on November 08, 2021, 06:02:57 pm

Title: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: xra7en on November 08, 2021, 06:02:57 pm
Got rid of some of the spaghetti code..
Mod it, enjoy it. have fun. Im working on a fantasy game that has an inn/bar I might include this as part of the games available there
the utils is for the pause,
you might have to make a inkey$ or look on the forum somewhere, I think my uttils.bi is here. if not I'll post it

original code
https://www.atariarchives.org/basicgames/showpage.php?page=34

Code: QB64: [Select]
  3.  
  4.  
  5. Type tPlayer
  6.     score As Long
  7.  
  9.  
  10.  
  11. Dim As Integer i, j, k ' loop vars
  12.  
  14. Dim score As Integer
  15. Dim Shared calcThrow As Double
  16. Dim Shared oppScore As Integer
  18. Dim Shared throw(3, 5) As Double '      3 types of throws 5 results
  19. Dim Shared player As tPlayer
  20.  
  21.  
  22. THROW_DATA:
  23. Data .65,.55,.5,.5
  24. Data .99,.77,.43,.01
  25. Data .95,.75,.45,.05
  26.  
  27.  
  28. initDartGame
  30.     For i = 1 To 2
  31.  
  32.         Cls
  33.         Print "Player Score    : "; player.score
  34.         Print "Opponent Score  : "; oppScore
  35.         Print
  36.  
  37.  
  38.         '// PLAYER TURN
  39.         If i = 1 Then
  40.             Print "Throw Type", "Description", , "Probable Score"
  41.             Print 1, "Fast Overarm", , "Bullseye or Complete Miss!"
  42.             Print 2, "Controlled Overarm", , "10, 20 or 30pts"
  43.             Print 3, "Frustration Throw", , "Anything! LOL"
  44.  
  45.             Print
  46.  
  47.             Input "Throw Type: "; throwId
  48.  
  49.         Else
  50.             j = r(3)
  51.             Select Case j
  52.                 Case 1: Print "Opponent does an Fast overarm!"
  53.                 Case 2: Print "Opponent tries a controlled overarm"
  54.                 Case 3: Print "Opponent just tosses the dart"
  55.             End Select
  56.         End If
  57.  
  58.         If i = 2 Then throwId = j
  59.  
  60.         Select Case throwId
  61.  
  62.             Case 1 TO 3
  63.                 calcThrow = Rnd(1)
  64.                 miss = 1
  65.                 If miss And calcThrow >= throw(throwId, 1) Then Print "BULLSEYE!!!  40 points": score = 40: miss = 0
  66.                 If miss And calcThrow >= throw(throwId, 2) Then Print "30 point zone": score = 30: miss = 0
  67.                 If miss And calcThrow >= throw(throwId, 3) Then Print "20 point zone": score = 20: miss = 0
  68.                 If miss And calcThrow >= throw(throwId, 4) Then Print "Whew 10 point zone": score = 10: miss = 0
  69.                 If miss Then Print "OOPS!! Wallshot!!! Zero Points!!!"
  70.  
  71.             Case Else
  72.                 Print "Wild throw - score 0"
  73.  
  74.         End Select
  75.  
  76.         Print
  77.         P_AUSE
  78.         If i = 1 Then player.score = player.score + score
  79.         If i = 2 Then oppScore = oppScore + score
  80.  
  81.     Next
  82.  
  83. Loop While player.score < 200 And oppScore < 200
  84.  
  85. If player.score >= 200 Then
  86.     Print "We have a winner"
  88.     Print "Aww too bad. house wins!!"
  90.  
  92.  
  93.  
  94. '$include: 'utils.bi'
  95.  
  96. Sub P_AUSE
  97.     'PAUSE (y, cntr As Integer, DARK As String, MED As String, LIGHT As String, HILITE As String)
  98.     PAUSE 24, 1, "8", "7", "!", "0"
  99.     Color 7
  101.  
  102.  
  103. Sub initDartGame
  104.     Dim i As Integer
  105.  
  106.     Restore THROW_DATA
  107.     For i = 1 To 3
  108.         Read throw(i, 1): Read throw(i, 2): Read throw(i, 3): Read throw(i, 4)
  109.     Next
  110.     player.score = 0
  111.  
  113.  
  114. '// shorthand numbergen
  116.     r = Int(Rnd * num) + 1


utils.bi

Code: QB64: [Select]
  1. Sub number_format (num As Double, flt As Integer)
  2.     Dim number As String '                                              stores whole number(w/o dec) minus "."
  3.     Dim convert As String '                                             stores the orginal number in string format
  4.     Dim I As Integer '                                                  i=loop counter delimeter counter
  5.     Dim tpl As String '                                                 .. using template
  6.  
  7.     convert = Str$(num) '                                               convert it all to a strig
  8.     If Right$(convert, 1) <> "." Then convert = convert + "." '         weird fix for lower numbers
  9.     number = Left$(convert, InStr(convert, ".") - 1) '                  store the integer
  10.     number = RTrim$(LTrim$(number)) '                                   trim it up
  11.  
  12.     tpl = "" '                                                          create a template string for USING
  13.  
  14.     For I = 1 To Len(number): tpl = tpl + "#": Next '                   add a hash per digit per integer digit
  15.     tpl = tpl + "," '                                                   set the comma tag
  16.     If flt > 0 Then '                                                   is the decimal count set?
  17.         tpl = tpl + "." '                                               add the decimal tag
  18.         For I = 1 To flt: tpl = tpl + "#": Next '                       how many places (as per dec)
  19.     End If
  20.     '    PRINT "tpl for "; num
  21.     '    PRINT tpl
  22.     Print Using tpl; num; '                                              now PRINT USING should look cleaner
  23.  
  25.  
  26.  
  27. '// MANY GRID GAME DIST CALCULATOR
  28. Function DIST (x1 As Integer, y1 As Integer, z1 As Integer, x2 As Integer, y2 As Integer, z2 As Integer)
  29.     '3D Distance Calc Pathag Theorym
  30.     DIST = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2 + (z1 - z2) ^ 2)
  32.  
  33.  
  34.  
  35.  
  36. '// DETERMINE IF STRING IS A INTEGER/DOUBLE OR NOT
  37. Function IS_NUMBER (NUM As String) ' returns 1 if string is an integer, 0 if not
  38.     If LTrim$(RTrim$(Str$(Val(NUM$)))) = LTrim$(RTrim$(NUM$)) Then
  39.         IS_NUMBER = 1
  40.     Else
  41.         IS_NUMBER = 0
  42.     End If
  43.  
  45.  
  46. Function GET_OPTION$ (OPTION_STR As String)
  47.     '@option_str = list of characters (can be separated by comma) as only option to seelect from
  48.  
  49.     Dim OPT As String
  50.     OPTION_STR = " " + OPTION_STR 'The space in the INSTR instruction and the > 1 are there as otherwise the loop would exit on the first pass.
  51.     Do
  52.         OPT = UCase$(InKey$)
  53.     Loop Until InStr(UCase$(OPTION_STR), OPT) > 1 And OPT <> ","
  54.     GET_OPTION = OPT
  55.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62. '//==========================================================================================================================
  63. '// --- THESE ARE LEGACY FUNCTIONS USE AT OWN DISCRECTION
  64. '//==========================================================================================================================
  65.  
  66. '// DEC(X) -1 TO X
  67. '// INC(X) +1 TO X
  68. '// DISTANCE: DISTANCE BETWEEN 2 X,Y COORDS
  69. '// yesNo (default AS STRING)
  70.  
  71.  
  72. Function TODAYS_DATE$
  73.     Dim month As String, day As String, year As String, moon As String
  74.     Dim m, d, y As Integer
  75.  
  76.  
  77.     month$ = Left$(Date$, 2): m = Val(month$)
  78.     day$ = Mid$(Date$, 4, 2): d = Val(day$)
  79.     day$ = Str$(d) ' eliminate any leading zeros
  80.     year$ = Right$(Date$, 4): y = Val(year$)
  81.     Select Case m
  82.         Case 1: moon$ = "January"
  83.         Case 2: moon$ = "February"
  84.         Case 3: moon$ = "March"
  85.         Case 4: moon$ = "April"
  86.         Case 5: moon$ = "May"
  87.         Case 6: moon$ = "June"
  88.         Case 7: moon$ = "July"
  89.         Case 8: moon$ = "August"
  90.         Case 9: moon$ = "September"
  91.         Case 10: moon$ = "October"
  92.         Case 11: moon$ = "November"
  93.         Case 12: moon$ = "December"
  94.     End Select
  95.     TODAYS_DATE = WeekDay$(m, d, y) + ", " + moon$ + day$ + ", " + year$ + Space$(10)
  96.  
  98.  
  99. Function WeekDay$ (M, D, Y)
  100.     Dim C, Y As Integer
  101.     Dim S1, S2, S3 As Integer
  102.     Dim WKDAY As Integer
  103.     Dim Day As String
  104.  
  105.  
  106.     If M < 3 Then M = M + 12: Y = Y - 1 'add 12 to Jan - Feb month, -1 year
  107.     C = Y \ 100: Y = Y Mod 100 'split century and year number
  108.     S1 = (C \ 4) - (2 * C) - 1 'century leap
  109.     S2 = (5 * Y) \ 4 '4 year leap
  110.     S3 = 26 * (M + 1) \ 10 'days in months
  111.     WKDAY = (S1 + S2 + S3 + D) Mod 7 'weekday total remainder
  112.     If WKDAY < 0 Then WKDAY = WKDAY + 7 'Adjust negative results to 0 to 6
  113.     Select Case WKDAY
  114.         Case 0: Day$ = "Sunday"
  115.         Case 1: Day$ = "Monday"
  116.         Case 2: Day$ = "Tuesday"
  117.         Case 3: Day$ = "Wednesday"
  118.         Case 4: Day$ = "Thursday"
  119.         Case 5: Day$ = "Friday"
  120.         Case 6: Day$ = "Saturday"
  121.     End Select
  122.     WeekDay$ = Day$
  124.  
  125.  
  127.     '============================================================================
  128.     '--- PASCAL FUNCTION: DECREASES X BY 1)
  129.     '============================================================================
  130.     X = X - 1
  131.     DEC = X
  133.  
  135.     '============================================================================
  136.     '--- PASCAL FUNCTION: INCREASE X BY 1)
  137.     '============================================================================
  138.     X = X + 1
  139.     INC = X
  141.  
  142.  
  143. Function DISTANCE (X1, Y1, X2, Y2 As Integer)
  144.     '============================================================================
  145.     '--- DIST BETWEEN 2 POINTS
  146.     '============================================================================
  147.     DISTANCE = Sqr((X1 - X2) ^ 2 + (Y1 - Y2) ^ 2)
  149.  
  150.  
  151. Function yesNo (default As String)
  152.     '// @default = when ENTER is pressed what will be the default answer
  153.  
  154.     Dim ans As String
  155.  
  156.     Do
  157.         ans = InKey$
  158.         ans = LCase$(ans)
  159.     Loop Until ans = "y" Or ans = "n" Or ans = Chr$(13) Or ans = ""
  160.  
  161.     If ans = Chr$(13) Or ans = "" Then ans = default
  162.  
  163.     If ans = "y" Then
  164.         yesNo = 1
  165.     Else
  166.         yesNo = 0
  167.     End If
  168.  
  170.  
  171. Function COUNT_TAGS (TEXT As String)
  172.     '//
  173.     '// RETURNS THE NUMBER OF LORD TAGS IN A STRING
  174.     '//
  175.     Dim I As Integer
  176.     If Len(TEXT) = 0 Then COUNT_TAGS = 0
  177.     Dim COUNT As Integer
  178.     Dim LENGTH As Integer
  179.     LENGTH = Len(TEXT)
  180.     COUNT = 0
  181.  
  182.     For I = 1 To LENGTH
  183.         If Mid$(TEXT, I, 1) = "`" Then COUNT = COUNT + 1
  184.  
  185.     Next
  186.     COUNT_TAGS = COUNT
  187.  
  188.  
  190.  
  191.  
  192. Sub CENTER (text As String, row As Integer)
  193.     '//
  194.     '// CENTER TEXT AS A SPECIFIED ROW
  195.     '//
  196.     Dim textLen, col As Integer
  197.     Dim TAGS As Integer
  198.  
  199.     If InStr(text, "`") >= 1 Then ' There is a tag
  200.  
  201.         TAGS = COUNT_TAGS(text) * 2
  202.         textLen = Int((Len(text) - TAGS) / 2)
  203.     Else
  204.         textLen = Int(Len(text) / 2)
  205.  
  206.     End If
  207.  
  208.     col = 40 - textLen
  209.     Locate row, col
  210.     If TAGS > 0 Then
  211.         LWRITE text
  212.     Else
  213.         Print text
  214.     End If
  215.  
  216.  
  218.  
  219. Sub LWRITE (TXT As String)
  220.     Dim i As Integer
  221.     '======================================================
  222.     '--- THIS IS A POPULAR COLOR ROUTINE BASED ON THE
  223.     '--- SETH ABLE L.O.R.D. BBS GAME COLOR FORMATTING
  224.     '=====================================================
  225.     Color 7 ' DEFAULT COLOR
  226.     For i = 1 To Len(TXT$)
  227.         ' CHECK FOR A COLOR CHANGE
  228.         If Mid$(TXT$, i, 1) = "`" Then
  229.             i = i + 1
  230.             Select Case Mid$(TXT, i, 1)
  231.                 Case "0": Color 10
  232.                 Case "1": Color 1
  233.                 Case "2": Color 2
  234.                 Case "3": Color 3
  235.                 Case "4": Color 4
  236.                 Case "5": Color 5
  237.                 Case "6": Color 6
  238.                 Case "7": Color 7
  239.                 Case "8": Color 8
  240.                 Case "9": Color 9
  241.                 Case "!": Color 11
  242.                 Case "@": Color 12
  243.                 Case "#": Color 13
  244.                 Case "$": Color 14
  245.                 Case "%": Color 15
  246.                 Case "n": Print '           new line
  247.                 Case "t": Print , ; '       TAB
  248.             End Select
  249.             i = i + 1
  250.  
  251.         End If
  252.         Print Mid$(TXT$, i, 1);
  253.     Next
  254.     Print ;
  256.  
  257. Sub LWRITELN (TXT As String)
  258.     LWRITE (TXT$)
  259.     Print
  261.  
  262. Sub EXPLODE (HAYSTACK As String, NEEDLE As String, EXPLODED_ARY() As String)
  263.     '//
  264.     '// speical thanks to SPRIGGYSPRIG for his inspiration to make this sub.
  265.     '// https://www.qb64.org/forum/index.php?topic=3721.0
  266.     '// USAGE
  267.     '//     EXPLODE DELIMITED STRING, DELIMETER, ARRAY TO RETURN
  268.     '//    EXAMPLE:  EXPLODE CONSOLE.Extentions, CHR$(32), SPLIT_EXT()
  269.     '//
  270.  
  271.     Dim CNT As Integer
  272.     Dim i As Integer
  273.     HAYSTACK = _Trim$(HAYSTACK)
  274.  
  275.     CNT = 1
  276.     For i = 1 To Len(HAYSTACK)
  277.         If Mid$(HAYSTACK, i, 1) <> NEEDLE Then
  278.             EXPLODED_ARY(CNT) = EXPLODED_ARY(CNT) + Mid$(HAYSTACK, i, 1)
  279.         Else
  280.             CNT = CNT + 1
  281.         End If
  282.     Next
  283.  
  285.  
  286. 'Sub EXPLODE (SplitMeString As String, delim As String, loadMeArray() As String)
  287. '        Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
  288. '        curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
  289. '        dpos = InStr(curpos, SplitMeString, delim)
  290. '        Do Until dpos = 0
  291. '                loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
  292. '                arrpos = arrpos + 1
  293. '                If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
  294. '                curpos = dpos + LD
  295. '                dpos = InStr(curpos, SplitMeString, delim)
  296. '        Loop
  297. '        loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
  298. '        ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
  299. 'End Sub
  300.  
  301.  
  302.  
  303.  
  304. Sub HEADER (TXT As String, Y As Integer)
  305.     CENTER "`8 --`2------------=`0=`%[ " + TXT + " `%]=`0= `2------------`8-- ", Y
  306.     Print
  308.  
  309. Sub HR '                                        HR
  310.     LWRITELN ("`8 -  --`3------------------=`!=`%*`!=`3------------------`8--  - ")
  312.  
  313. Sub PAUSE (y, cntr As Integer, DARK As String, MED As String, LIGHT As String, HILITE As String)
  314.     'y              = y coord to place it
  315.     'dark           = dark color
  316.     'med            = medium color
  317.     'light          = light color
  318.     'center pause?  = 1(yes), 0(mo)
  319.  
  320.     Dim SPIN(10) As String '    spiner tiles
  321.     Dim k As String '           dummy string to check for user input
  322.     Dim x As Integer '          spin array counter
  323.  
  324.     SPIN(1) = "*": SPIN(2) = "/": SPIN(3) = "-"
  325.     SPIN(4) = "\": SPIN(5) = "|": SPIN(6) = "/"
  326.     SPIN(7) = "-": SPIN(8) = "\": SPIN(9) = "|"
  327.  
  328.     x = 2
  329.     Do
  330.         '// IF NOT CENTERED
  331.         If cntr = 0 Then
  332.             Locate 24, 1
  333.             LWRITE "`" + DARK + "--`" + MED + "------------=`" + LIGHT + "=`" + HILITE + "[ " + SPIN(x) + " `" + HILITE + "]=`" + LIGHT + "= `" + MED + "------------`" + DARK + "-- "
  334.         Else
  335.  
  336.  
  337.             CENTER "`" + DARK + "--`" + MED + "------------=`" + LIGHT + "=`" + HILITE + "[ " + SPIN(x) + " `" + HILITE + "]=`" + LIGHT + "= `" + MED + "------------`" + DARK + "-- ", y
  338.         End If
  339.  
  340.         '// ANIMATE SPINNER
  341.         x = x + 1: If x > 9 Then x = 2
  342.         k = InKey$
  343.         _Delay (.10)
  344.     Loop Until k > ""
  346.  
  347.  

Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: johnno56 on November 09, 2021, 07:40:04 am
I still have the original book... So cool...
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: xra7en on November 09, 2021, 02:15:15 pm
keep in they're worth about $600+ LOL I know I got rid of all mine a long time ago (dumb i know LOL)
I did, however, buy all the Tim hartnell "Creating adventure games on your computer" LOL super rare

But I use these to practice a computer language, by converting the spaghetti code LOL!!
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: johnno56 on November 09, 2021, 06:18:03 pm
Ah. The dreaded line numbers and the 'gotos' that jump all around the program... Conversion for me was a nightmare... lol

My copy of "The Book" is not in very good condition... "Dog ears"; Pen doodles and notes... I basically (no pun intended) collect PDF's of Basic books. Hartnell is a favourite. I have tried scanning the pages and using OCR to convert to a text file was too labourious. Spent so much time correcting scan errors I coud have keyed in the listing... Gotta love those old programs...
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: Cobalt on November 09, 2021, 07:25:40 pm
So a wall shot for the computer is worth 30 points!?
cause that's what just happened, computer had 40points(2- 20 hits) then had a wall shot when I pressed space its points went to 70!
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: bplus on November 09, 2021, 09:11:55 pm
Yeah the game had some rough edges, so I gave it a shot:
Code: QB64: [Select]
  1. _Title "BULLSEYE!" 'b+ 2021-11-09
  2.  
  3. Dim tt_X_p(1 To 3, 1 To 4) ' Throw Type X Probability
  4. tt_X_p(1, 1) = .65: tt_X_p(1, 2) = .55: tt_X_p(1, 3) = .5: tt_X_p(1, 4) = .5 ' sum = 2.2
  5. '              35           10                  5                   0     50
  6. tt_X_p(2, 1) = .99: tt_X_p(2, 2) = .77: tt_X_p(2, 3) = .43: tt_X_p(2, 4) = .01 ' sum = 2.2
  7. '               1           27                 34                  42      1
  8. tt_X_p(3, 1) = .95: tt_X_p(3, 2) = .75: tt_X_p(3, 3) = .45: tt_X_p(3, 4) = .05 ' sum =  2.2
  9. '               5           20                 30                  40      5
  10. '       bulls 40pts        30pts             20pts                10pts     nada!
  11.  
  13.     Cls
  14.     Print: Print
  15.     cp "*** Bulls Eye! ***"
  16.     Print
  17.     cp "AI's Score is " + ts$(Scores(0))
  18.     cp "Your Score is " + ts$(Scores(1))
  19.     Print
  20.     cp "Throw Type:      Description:          Probable Score:      "
  21.     cp "      1          Fast Overarm     Bullseye or Complete Miss!"
  22.     cp "      2       Controlled Overarm       10, 20 or 30 pts     "
  23.     cp "      3        Frustration Throw        Anything! LOL       "
  24.     If turn Then
  25.         Print
  26.         cp "Human, press Throw Type number 1, 2 or 3"
  27.         t = 0
  28.         While t <> 1 And t <> 2 And t <> 3
  29.             k$ = InKey$
  30.             t = Val(k$)
  31.         Wend
  32.         cp ts$(t)
  33.     Else
  34.         t = Int(Rnd * 3) + 1
  35.         Print
  36.         cp "AI is choosing Throw Type: " + ts$(t)
  37.     End If
  38.     luck = Rnd: score = 0
  39.     If luck >= tt_X_p(t, 1) Then cp "BULLSEYE!!!  40 points": score = 40: GoTo 1
  40.     If luck >= tt_X_p(t, 2) Then cp "Hit 30 point zone": score = 30: GoTo 1
  41.     If luck >= tt_X_p(t, 3) Then cp "Hit 20 point zone": score = 20: GoTo 1
  42.     If luck >= tt_X_p(t, 4) Then cp "Whew, Hit 10 point zone": score = 10: GoTo 1
  43.     cp "OOPS!! Wallshot!!! Zero Points!!!"
  44.    1 Scores(turn) = Scores(turn) + score
  45.     Print: Print
  46.     cp "OK    press any... zzz"
  47.     Sleep
  48.     If turn Then 'both players shot their round
  49.         If Scores(0) > Scores(1) And Scores(0) >= 200 Then winner$ = "AI"
  50.         If Scores(1) > Scores(0) And Scores(1) >= 200 Then winner$ = "Human"
  51.         If Scores(0) = Scores(1) And Scores(0) >= 200 Then winner$ = "Tie"
  52.     End If
  53.     turn = (turn + 1) Mod 2
  54. Loop Until winner$ <> ""
  56. cp "AI's Score is " + ts$(Scores(0))
  57. cp "Your Score is " + ts$(Scores(1))
  59. cp "Game goes to " + winner$ + "."
  61.  
  62. Sub cp (s$)
  63.     Print Spc((80 - Len(s$)) / 2); s$
  65.  
  66. Function ts$ (num)
  67.     ts$ = _Trim$(Str$(num))
  69.  

I do like the little gizmo thing going on in xra7en's bottom line.
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: johnno56 on November 09, 2021, 11:00:07 pm
Cool game! Believe it or not, I actually won!

Hmm... Now that I think about it...  If "I" could win, you have obviously made the game too easy... lol

Perhaps with a little twisting of your arm, the next version, could possibly have some graphics... Nudge, nudge, wink, wink... Say no more... lol
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: bplus on November 09, 2021, 11:06:39 pm
Quote from: johnno56 on November 09, 2021, 11:00:07 pm
Cool game! Believe it or not, I actually won!

Hmm... Now that I think about it...  If "I" could win, you have obviously made the game too easy... lol

Perhaps with a little twisting of your arm, the next version, could possibly have some graphics... Nudge, nudge, wink, wink... Say no more... lol

Actually that's what got me started, imagining some simple graphics.
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: bplus on November 10, 2021, 01:08:57 am
Some graphics help
Code: QB64: [Select]
  1. _Title "BULLSEYE! v2" 'b+ 2021-11-09
  2. Const Xmax = 640, Ymax = 400
  3. Dim tt_X_p(1 To 3, 1 To 4) ' Throw Type X Probability
  4. tt_X_p(1, 1) = .65: tt_X_p(1, 2) = .55: tt_X_p(1, 3) = .5: tt_X_p(1, 4) = .5 ' sum = 2.2
  5. '              35           10                  5                   0     50
  6. tt_X_p(2, 1) = .99: tt_X_p(2, 2) = .77: tt_X_p(2, 3) = .43: tt_X_p(2, 4) = .01 ' sum = 2.2
  7. '               1           27                 34                  42      1
  8. tt_X_p(3, 1) = .95: tt_X_p(3, 2) = .75: tt_X_p(3, 3) = .45: tt_X_p(3, 4) = .05 ' sum =  2.2
  9. '               5           20                 30                  40      5
  10. '       bulls 40pts        30pts             20pts                10pts     nada!
  11. Dim Shared aix(1 To 100), aiy(1 To 100), hx(1 To 100), hy(1 To 100), rounds, turn
  12. Screen _NewImage(Xmax, Ymax, 12)
  13. _ScreenMove 200, 100
  15. rounds = 1
  17.     Cls
  18.     drawTargets
  19.     Print: Print
  20.     cp "*** Bulls Eye! ***"
  21.     Print
  22.     cp "AI's Score is " + ts$(Scores(0))
  23.     cp "Your Score is " + ts$(Scores(1))
  24.     Print
  25.     cp "Throw Type:      Description:          Probable Score:      "
  26.     cp "      1          Fast Overarm     Bullseye or Complete Miss!"
  27.     cp "      2       Controlled Overarm       10, 20 or 30 pts     "
  28.     cp "      3        Frustration Throw        Anything! LOL       "
  29.     If turn Then
  30.         Print
  31.         cp "Human, press Throw Type number 1, 2 or 3"
  32.         t = 0
  33.         While t <> 1 And t <> 2 And t <> 3
  34.             k$ = InKey$
  35.             t = Val(k$)
  36.         Wend
  37.         cp ts$(t)
  38.     Else
  39.         t = Int(Rnd * 3) + 1
  40.         Print
  41.         cp "AI is choosing Throw Type: " + ts$(t)
  42.     End If
  43.     luck = Rnd: score = 0
  44.     If luck >= tt_X_p(t, 1) Then cp "BULLSEYE!!!  40 points": score = 40: GoTo 1
  45.     If luck >= tt_X_p(t, 2) Then cp "Hit 30 point zone": score = 30: GoTo 1
  46.     If luck >= tt_X_p(t, 3) Then cp "Hit 20 point zone": score = 20: GoTo 1
  47.     If luck >= tt_X_p(t, 4) Then cp "Whew, Hit 10 point zone": score = 10: GoTo 1
  48.     cp "OOPS!! Wallshot!!! Zero Points!!!"
  49.    1 Scores(turn) = Scores(turn) + score
  50.     updateTarget score
  51.     Print: Print
  52.     cp "OK    press any... zzz"
  53.     Sleep
  54.     If turn Then 'both players shot their round
  55.         If Scores(0) > Scores(1) And Scores(0) >= 200 Then winner$ = "AI"
  56.         If Scores(1) > Scores(0) And Scores(1) >= 200 Then winner$ = "Human"
  57.         If Scores(0) = Scores(1) And Scores(0) >= 200 Then winner$ = "Tie"
  58.         rounds = rounds + 1
  59.     End If
  60.     turn = (turn + 1) Mod 2
  61. Loop Until winner$ <> ""
  63. cp "AI's Score is " + ts$(Scores(0))
  64. cp "Your Score is " + ts$(Scores(1))
  66. cp "Game goes to " + winner$ + "."
  68.  
  69. Sub cp (s$)
  70.     Locate , (80 - Len(s$)) / 2: Print s$
  72.  
  73. Function ts$ (num)
  74.     ts$ = _Trim$(Str$(num))
  76.  
  77. Sub drawTargets
  78.     cy = Ymax - 90
  79.     For r = 20 To 80 Step 20
  80.         Circle (90, cy), r, 15
  81.         Circle (Xmax - 90, cy), r, 15
  82.     Next
  83.     For y = Ymax - 85 To Ymax - 25 Step 20
  84.         If i Mod 2 Then c = 12 Else c = 15
  85.         Paint (90, y), c, 15
  86.         Paint (Xmax - 90, y), c, 15
  87.         i = i + 1
  88.     Next
  89.     For i = 1 To rounds
  90.         Circle (aix(i), aiy(i)), 2, 0
  91.         drawArrow aix(i), aiy(i)
  92.         Circle (hx(i), hy(i)), 2, 0
  93.         drawArrow hx(i), hy(i)
  94.     Next
  95.     If turn Then
  96.         Circle (aix(rounds + 1), aiy(rounds + 1)), 2, 0
  97.         drawArrow aix(rounds + 1), aiy(rounds + 1)
  98.     End If
  100.  
  101. Sub updateTarget (score)
  102.     If score Then
  103.         cy = Ymax - 90
  104.         dist = (40 - score) * 2 + 2 + Rnd * 16
  105.         angle = Rnd * _Pi * 2
  106.         If turn Then cx = Xmax - 90 Else cx = 90
  107.         x = cx + dist * Cos(angle)
  108.         y = cy + dist * Sin(angle)
  109.         Circle (x, y), 2, 0
  110.         drawArrow x, y
  111.         If turn Then ' save the place
  112.             hx(rounds + 1) = x: hy(rounds + 1) = y
  113.         Else
  114.             aix(rounds + 1) = x: aiy(rounds + 1) = y
  115.         End If
  116.     End If
  118.  
  119. Sub drawArrow (x, y)
  120.     Color 0
  121.     Line (x - 4, y)-(x + 4, y)
  122.     Line (x, y - 4)-(x, y + 4)
  123.     Circle (x, y), 2
  124.     Circle (x, y), 1
  125.     Color 15
  127.  

 
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: johnno56 on November 10, 2021, 06:59:30 am
Cool...
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: johnno56 on November 10, 2021, 02:25:09 pm
Bplus,

I have a simple dartboard program that I made with sdlbasic. Well... maybe not simple.

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Multiple shades of red, black, green and white. Rather than try to create a routine for a dart(s) to collide with odd shaped segments of a 'pie' I would just use a simple getpixel(x,y) - well that was my intention. Never did get beyond creating the dartboard. If you want the listing, let me know and I will post it. If you want to just use the image be my guest. No credit necessary.

J
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: bplus on November 10, 2021, 06:28:36 pm
Really nice dart board @johnno56 !!!

Instead of redrawing, we could just use the image.

PS Rotozoom might do wonders with a dart image or 2.
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: johnno56 on November 11, 2021, 01:38:33 am
As I mentioned earlier, odd shaped collision detection, for me anyway, was difficult. I figured that getpixel() (point()) would be easier. As a result, not all the black segments are black. Each scoring segment is a slight shade lighter. Same for the greens, reds and whites. I am not certain that a screen capture will pick up the differences. eg: if point(dartx,darty) = whatever then score is whichever... if point(dartx,darty) = grey (wire) then dart bounces off board. No score. Loss of dart.

If the screen capture works then cool. If not, let me know, and I will post the listing.

I like the idea of rotozoom. Couple of thoughts to increase difficulty. Slight gravity. Player will need to aim a little higher. Add slight aiming movement (like the effect of breathing when target shooting). Add a menu of difficulty to determine extent of aiming and moving... How about that? Ideas. Better write them down! This does not happen very often... I surprise myself at times... lol
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: bplus on November 11, 2021, 01:50:36 am
Great idea for collision detection, _putimage I don't think will blend so color should stay true, my opinion and guess, honestly don't know for sure.
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: johnno56 on November 11, 2021, 04:58:19 pm
This is where I got the idea for a dartboard. https://scratch.mit.edu/projects/2261044/
This was made by kids... Checkout how the board is put together. "See Inside".
Each segment of the board is 'patched' together. The dart scores when it hits a 'shape'

If you are up to it, play the game, just to see how it works. The system of aiming and firing are interesting.

In my opinion this could be a fun project to either inspire or duplicate... In my opinion...
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: _vince on November 13, 2021, 03:18:35 pm
I'll finish this on another computer in a bit (maybe never)

Code: [Select]
deflng a-z

const sw = 1000
const sh = 700

dim shared pi as double
pi = 4*atn(1)

dim shared mx, my, mbl, mbr, mw

dim shared aa(19)
aa( 0) = 6
aa( 1) = 10
aa( 2) = 15
aa( 3) = 2
aa( 4) = 17
aa( 5) = 3
aa( 6) = 19
aa( 7) = 7
aa( 8) = 16
aa( 9) = 8
aa(10) = 11
aa(11) = 14
aa(12) = 9
aa(13) = 12
aa(14) = 5
aa(15) = 20
aa(16) = 1
aa(17) = 18
aa(18) = 4
aa(19) = 13

'draw board once
screen _newimage(sw, sh, 32),, 1, 0

for y=-0.800*sh/2 to 0.800*sh/2
for x=-0.800*sh/2 to 0.800*sh/2
        dim a as double
        a = _atan2(y, x) + pi
        r = sqr(x*x + y*y)
        if r <= (0.800*sh/2) then
                am2 = (a*20/(2*pi)) mod 2
                if r >= 0.765*sh/2 or r >= 0.465*sh/2 and r <= 0.500*sh/2 then
                        if am2 = 0 then
                                c = _rgb(0,180,0)
                        else
                                c = _rgb(210,0,0)
                        end if
                else
                        if am2 = 0 then
                                c = _rgb(230,230,200)
                        else
                                c = _rgb(0,0,0)
                        end if
                end if
                if r<=0.060*sh/2 then
                        if r<=0.025*sh/2 then
                                c = _rgb(210,0,0)
                        else
                                c = _rgb(0,180,0)
                        end if
                end if
                pset (sw/2 + x, sh/2 + y), c
        end if
next
next

circle (sw/2, sh/2), sh/2 - 1, _rgb(50, 50, 50)

circle step(0,0), 0.800*sh/2
circle step(0,0), 0.765*sh/2

circle step(0,0), 0.500*sh/2
circle step(0,0), 0.465*sh/2

circle step(0,0), 0.060*sh/2
circle step(0,0), 0.025*sh/2


for i=0 to 19
        dim x as double, y as double
        x = cos(2*pi*(i/20) + 2*pi/40)
        y = sin(2*pi*(i/20) + 2*pi/40)
        pset  (sw/2 + (0.060*sh/2)*x, sh/2 + (0.060*sh/2)*y)
        line -(sw/2 + (0.800*sh/2)*x, sh/2 + (0.800*sh/2)*y)

        x = cos(2*pi*(i/20))
        y = sin(2*pi*(i/20))
        _printstring (sw/2 + (0.900*sh/2)*x - (8*len(ltrim$(str$(aa(i))))/2) - 8, sh/2 + (0.900*sh/2)*y - 8), str$(aa(i))
next

for i=0 to sh
        line (0, i)-step((sw - sh)/2 - 0.05*i*1000/sh, 0), _rgb(50 + 50*2*(atn(0.01*(sh/2 - i)))/pi,50 + 50*2*(atn(0.01*(i - sh/2)))/pi,0)

next

'main screen
screen ,, 0, 0

do
        t = timer*1000
        getmouse

        pcopy 1,0

        locate 1,1
        '? mx, my, mbl, mbr, mw
        ? t

        'for i=0 to 500+500*sin(2*pi*0.5*(t mod 10000)/1000)
                i = 500+500*sin(2*pi*0.5*(t mod 10000)/1000)
                line (0, i*sh/1000)-step((sw - sh)/2 - i*0.05, 0)
        'next

        _display
        '_limit 100
loop until _keyhit=27

sleep
system

sub getmouse()
        do
                mx = _mousex
                my = _mousey
                mbl = _mousebutton(1)
                mbr = _mousebutton(2)
                mw = mw - _mousewheel
        loop while _mouseinput
end sub

sub circlef (x, y, r, c as long)
        x0 = r
        y0 = 0
        e = 0
        do while y0<x0
                line(x-x0,y+y0)-(x+x0,y+y0),c,bf
                line(x-x0,y-y0)-(x+x0,y-y0),c,bf
                line(x-y0,y-x0)-(x+y0,y-x0),c,bf
                line(x-y0,y+x0)-(x+y0,y+x0),c,bf
                if e<=0 then
                        y0=y0+1
                        e=e+2*y0
                else
                        x0=x0-1
                        e=e-2*x0
                end if
        loop
end sub
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: xra7en on November 13, 2021, 03:36:05 pm
now thats cool bplus!

Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: bplus on November 13, 2021, 09:05:16 pm
Nice start @_vince

Fixed mouse to draw hit +- Rnd*10 of mx and my + Rnd*30, the mouse waits until you release the left button before it exits the GetMouse routine (meanwhile updating mx, my until button is released).

Need me to calc scores too?

Code: QB64: [Select]
  1. DefLng A-Z
  2.  
  3. Const sw = 1000
  4. Const sh = 700
  5.  
  7. pi = 4 * Atn(1)
  8.  
  9. Dim Shared mx, my, mbl, mbr, mw
  10.  
  11. Dim Shared aa(19)
  12. aa(0) = 6
  13. aa(1) = 10
  14. aa(2) = 15
  15. aa(3) = 2
  16. aa(4) = 17
  17. aa(5) = 3
  18. aa(6) = 19
  19. aa(7) = 7
  20. aa(8) = 16
  21. aa(9) = 8
  22. aa(10) = 11
  23. aa(11) = 14
  24. aa(12) = 9
  25. aa(13) = 12
  26. aa(14) = 5
  27. aa(15) = 20
  28. aa(16) = 1
  29. aa(17) = 18
  30. aa(18) = 4
  31. aa(19) = 13
  32.  
  33. 'draw board once
  34. Screen _NewImage(sw, sh, 32)
  35. _ScreenMove 100, 40
  36.  
  37. For y = -0.800 * sh / 2 To 0.800 * sh / 2
  38.     For x = -0.800 * sh / 2 To 0.800 * sh / 2
  39.         Dim a As Double
  40.         a = _Atan2(y, x) + pi
  41.         r = Sqr(x * x + y * y)
  42.         If r <= (0.800 * sh / 2) Then
  43.             am2 = (a * 20 / (2 * pi)) Mod 2
  44.             If r >= 0.765 * sh / 2 Or r >= 0.465 * sh / 2 And r <= 0.500 * sh / 2 Then
  45.                 If am2 = 0 Then
  46.                     c = _RGB(0, 180, 0)
  47.                 Else
  48.                     c = _RGB(210, 0, 0)
  49.                 End If
  50.             Else
  51.                 If am2 = 0 Then
  52.                     c = _RGB(230, 230, 200)
  53.                 Else
  54.                     c = _RGB(0, 0, 0)
  55.                 End If
  56.             End If
  57.             If r <= 0.060 * sh / 2 Then
  58.                 If r <= 0.025 * sh / 2 Then
  59.                     c = _RGB(210, 0, 0)
  60.                 Else
  61.                     c = _RGB(0, 180, 0)
  62.                 End If
  63.             End If
  64.             PSet (sw / 2 + x, sh / 2 + y), c
  65.         End If
  66.     Next
  68.  
  69. Circle (sw / 2, sh / 2), sh / 2 - 1, _RGB(50, 50, 50)
  70.  
  71. Circle Step(0, 0), 0.800 * sh / 2
  72. Circle Step(0, 0), 0.765 * sh / 2
  73.  
  74. Circle Step(0, 0), 0.500 * sh / 2
  75. Circle Step(0, 0), 0.465 * sh / 2
  76.  
  77. Circle Step(0, 0), 0.060 * sh / 2
  78. Circle Step(0, 0), 0.025 * sh / 2
  79.  
  80.  
  81. For i = 0 To 19
  82.     Dim x As Double, y As Double
  83.     x = Cos(2 * pi * (i / 20) + 2 * pi / 40)
  84.     y = Sin(2 * pi * (i / 20) + 2 * pi / 40)
  85.     PSet (sw / 2 + (0.060 * sh / 2) * x, sh / 2 + (0.060 * sh / 2) * y)
  86.     Line -(sw / 2 + (0.800 * sh / 2) * x, sh / 2 + (0.800 * sh / 2) * y)
  87.  
  88.     x = Cos(2 * pi * (i / 20))
  89.     y = Sin(2 * pi * (i / 20))
  90.     _PrintString (sw / 2 + (0.900 * sh / 2) * x - (8 * Len(LTrim$(Str$(aa(i)))) / 2) - 8, sh / 2 + (0.900 * sh / 2) * y - 8), Str$(aa(i))
  92.  
  93. For i = 0 To sh
  94.     Line (0, i)-Step((sw - sh) / 2 - 0.05 * i * 1000 / sh, 0), _RGB(50 + 50 * 2 * (Atn(0.01 * (sh / 2 - i))) / pi, 50 + 50 * 2 * (Atn(0.01 * (i - sh / 2))) / pi, 0)
  95.  
  97. board& = _NewImage(_Width - 1, _Height - 1, 32)
  98. _PutImage , 0, board&
  99.  
  100. 'main screen
  101.  
  102.  
  104.     t = Timer * 1000
  105.     getmouse
  106.  
  107.     _PutImage , board&, 0
  108.  
  109.     Locate 1, 1
  110.     '? mx, my, mbl, mbr, mw
  111.     If mbl Then
  112.         rx = Rnd * 20 - 10: ry = Rnd * 30
  113.         For i = 0 To 10 Step 2
  114.             Circle (mx + rx, my + ry), i, _RGB32((11 - i) * 25, (11 - i) * 25, 0)
  115.         Next
  116.         _PutImage , 0, board&
  117.     End If
  118.  
  119.     Print t
  120.  
  121.     'for i=0 to 500+500*sin(2*pi*0.5*(t mod 10000)/1000)
  122.     i = 500 + 500 * Sin(2 * pi * 0.5 * (t Mod 10000) / 1000)
  123.     Line (0, i * sh / 1000)-Step((sw - sh) / 2 - i * 0.05, 0)
  124.     'next
  125.  
  126.     _Display
  127.     _Limit 30
  129.  
  132.  
  133. Sub getmouse ()
  135.         mw = mw - _MouseWheel
  136.     Wend
  137.     mx = _MouseX
  138.     my = _MouseY
  139.     mbl = _MouseButton(1)
  140.     mbr = _MouseButton(2)
  141.     If mbl Then
  142.         Do 'wait for release of mousebutton before leaving this sub
  143.             While _MouseInput: Wend  'poll mouse
  144.             mx = _MouseX
  145.             my = _MouseY
  146.             mbl = _MouseButton(1)
  147.         Loop Until mbl = 0
  148.         mbl = -1
  149.     End If
  151.  
  152. Sub circlef (x, y, r, c As Long)
  153.     x0 = r
  154.     y0 = 0
  155.     e = 0
  156.     Do While y0 < x0
  157.         Line (x - x0, y + y0)-(x + x0, y + y0), c, BF
  158.         Line (x - x0, y - y0)-(x + x0, y - y0), c, BF
  159.         Line (x - y0, y - x0)-(x + y0, y - x0), c, BF
  160.         Line (x - y0, y + x0)-(x + y0, y + x0), c, BF
  161.         If e <= 0 Then
  162.             y0 = y0 + 1
  163.             e = e + 2 * y0
  164.         Else
  165.             x0 = x0 - 1
  166.             e = e - 2 * x0
  167.         End If
  168.     Loop
  170.  
  171.  
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: xra7en on November 13, 2021, 10:01:39 pm
Quote from: johnno56 on November 09, 2021, 11:00:07 pm
Cool game! Believe it or not, I actually won!

Hmm... Now that I think about it...  If "I" could win, you have obviously made the game too easy... lol

Perhaps with a little twisting of your arm, the next version, could possibly have some graphics... Nudge, nudge, wink, wink... Say no more... lol

well keep in mind this is just a direct rewrite of the original code - just cleaned up a bit and readable. I suppose if your hankerin for punishment you could tweak it, since the spaghetti is all cleaned up
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: johnno56 on November 14, 2021, 01:21:16 am
xra7en,

My comment was not intended to question your skills in converting one basic to another. If I caused offence, then I apologise. The comment that I made, "you have obviously made", was poorly and inaccurately chosen. Direct conversion of the game does not and should not imply that you are the direct cause of my winning or losing. If that implication left you with that conclusion, then for that, I also apologise.

J
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: _vince on November 14, 2021, 04:42:54 am
Scoring should be as easy as drawing the board itself.  I was planning to use this system https://en.wikipedia.org/wiki/Darts#/media/File:Dartboard_heatmap.svg (https://en.wikipedia.org/wiki/Darts#/media/File:Dartboard_heatmap.svg) and all those numbers can be generated just from the outside nums which I put in array aa(19).  I'm also going to stick all the radii in an array to make the game code entirely flexible.  But I don't care for all the formalities of an actual game, I won't go into that.

Mainly, I'm trying to think up of a good scheme for animating the darts and also the game/skill aspect.  The original game goes for the shaky hand and a deterministic power bar that over/underthrows.  There's also no physics or 3D rendering of any sort, it appears to be a single bitmap array animation of the dart in flight that just gets panned around.  This is what I wanted to play around with, not yet sure what I should go with there.
Title: Re: David H. Ahl BULLSEYE (Dart Game) Revisited :-)
Post by: xra7en on November 14, 2021, 05:02:42 am
Quote from: johnno56 on November 14, 2021, 01:21:16 am
xra7en,

My comment was not intended to question your skills in converting one basic to another. If I caused offence, then I apologise. The comment that I made, "you have obviously made", was poorly and inaccurately chosen. Direct conversion of the game does not and should not imply that you are the direct cause of my winning or losing. If that implication left you with that conclusion, then for that, I also apologise.

J

oooo nooo, no offense.I understood. after reading that I can see how that came out that way - sooooory!
your fine. :-P

Text Only | Text with Attachments