David H. Ahl BULLSEYE (Dart Game) Revisited :-)

[xra7en]

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]

1. Option _Explicit
2. Randomize (-Timer)
3.  
4.  
5. Type tPlayer
6.     score As Long
7.  
8. End Type
9.  
10.  
11. Dim As Integer i, j, k ' loop vars
12.  
13. Dim Shared throwId As Integer
14. Dim score As Integer
15. Dim Shared calcThrow As Double
16. Dim Shared oppScore As Integer
17. Dim Shared miss 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
29. Do
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"
87. Else
88.     Print "Aww too bad. house wins!!"
89. End If
90.  
91. End
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
100. End Sub
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.  
112. End Sub
113.  
114. '// shorthand numbergen
115. Function r (num As Integer)
116.     r = Int(Rnd * num) + 1
117. End Function

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.  
24. End Sub
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)
31. End Function
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.  
44. End Function
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.  
56. End Function
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.  
97. End Function
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$
123. End Function
124.  
125.  
126. Function DEC (X As Integer)
127.     '============================================================================
128.     '--- PASCAL FUNCTION: DECREASES X BY 1)
129.     '============================================================================
130.     X = X - 1
131.     DEC = X
132. End Function
133.  
134. Function INC (X As Integer)
135.     '============================================================================
136.     '--- PASCAL FUNCTION: INCREASE X BY 1)
137.     '============================================================================
138.     X = X + 1
139.     INC = X
140. End Function
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)
148. End Function
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.  
169. End Function
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.  
189. End Function
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.  
217. End Sub
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 ;
255. End Sub
256.  
257. Sub LWRITELN (TXT As String)
258.     LWRITE (TXT$)
259.     Print
260. End Sub
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.  
284. End Sub
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
307. End Sub
308.  
309. Sub HR '                                        HR
310.     LWRITELN ("`8 -  --`3------------------=`!=`%*`!=`3------------------`8--  - ")
311. End Sub
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 > ""
345. End Sub
346.  
347.  

[johnno56]

I still have the original book... So cool...

[xra7en]

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!!

[johnno56]

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...

[Cobalt]

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!

[bplus]

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.  
12. Do
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$ <> ""
55. Print: Print
56. cp "AI's Score is " + ts$(Scores(0))
57. cp "Your Score is " + ts$(Scores(1))
58. Print
59. cp "Game goes to " + winner$ + "."
60. Sleep
61.  
62. Sub cp (s$)
63.     Print Spc((80 - Len(s$)) / 2); s$
64. End Sub
65.  
66. Function ts$ (num)
67.     ts$ = _Trim$(Str$(num))
68. End Function
69.  

I do like the little gizmo thing going on in xra7en's bottom line.

[johnno56]

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

[bplus]

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.

[bplus]

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
14. _PrintMode _KeepBackground
15. rounds = 1
16. Do
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$ <> ""
62. Print
63. cp "AI's Score is " + ts$(Scores(0))
64. cp "Your Score is " + ts$(Scores(1))
65. Print
66. cp "Game goes to " + winner$ + "."
67. Sleep
68.  
69. Sub cp (s$)
70.     Locate , (80 - Len(s$)) / 2: Print s$
71. End Sub
72.  
73. Function ts$ (num)
74.     ts$ = _Trim$(Str$(num))
75. End Function
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
99. End Sub
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
117. End Sub
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
126. End Sub
127.  

 

[johnno56]

Cool...

[johnno56]

Bplus,

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

 

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

[bplus]

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.

[johnno56]

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

[bplus]

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.

[johnno56]

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...