QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: bplus on February 10, 2021, 01:23:37 am

Title: Collide Circle and Box
Post by: bplus on February 10, 2021, 01:23:37 am

This is like the Game Operation get mouse from one side to other wo a squeak:

Code: QB64: [Select]

1. _Title "Collide Circle and Box" 'b+ 2021-02-09
2. ' Johnno submits ref:  https://www.qb64.org/forum/index.php?topic=3499.msg129726#msg129726
3. Randomize Timer
4. Const True = -1, False = Not True
5. Type box
6.     x As Single
7.     y As Single
8.     w As Single
9.     h As Single
10. End Type
11. Screen _NewImage(1024, 700, 32)
12. _Delay .25
13. _ScreenMove _Middle
14. 'Print True, False
15. ReDim b(1 To 50) As box
16. For i = 1 To 50
17.     b(i).x = Rnd * 1024
18.     b(i).y = Rnd * 700
19.     b(i).w = Rnd * 400 + 20
20.     b(i).h = Rnd * 50 + 5
21. Next
22. mr = 5
23. Do
24.     Cls
25.     While _MouseInput: Wend
26.     mx = _MouseX: my = _MouseY
27.     Circle (mx, my), mr, &HFF0000FF
28.     For i = 1 To 50
29.         Line (b(i).x, b(i).y)-Step(b(i).w, b(i).h), _RGB32(i * 5, -1 * (i < 25) + 128 + (i > 25), 255 - i * 5), B
30.         If collide(mx, my, mr, b(i).x, b(i).y, b(i).w, b(i).h) Then Beep
31.     Next
32.     _Display
33.     _Limit 60
34. Loop While _KeyDown(27) = 0
35.  
36. Function collide (cx, cy, radius, rx, ry, rw, rh)
37.     distX = Abs(cx - rx - rw / 2)
38.     distY = Abs(cy - ry - rh / 2)
39.  
40.     If distX > (rw / 2 + radius) Then
41.         collide = False: Exit Function
42.     End If
43.     If distY > (rh / 2 + radius) Then
44.         collide = False: Exit Function
45.     End If
46.  
47.     If distX <= rw / 2 Then
48.         collide = True: Exit Function
49.     End If
50.     If distY < rh / 2 Then
51.         collide = True: Exit Function
52.     End If
53.  
54.     'still here?
55.     dx = distX - rw / 2
56.     dy = distY - rh / 2
57.  
58.     collide = (dx * dx + dy * dy <= (radius * radius))
59. End Function
60.  
61.  

Title: Re: Collide Circle and Box
Post by: bplus on February 10, 2021, 01:26:39 am

Press spacebar to change scenery:

Code: QB64: [Select]

1. _Title "Collide Circle and Box" 'b+ 2021-02-09
2. ' Johnno submits ref:  https://www.qb64.org/forum/index.php?topic=3499.msg129726#msg129726
3. Randomize Timer
4. Const True = -1, False = Not True
5. Type box
6.     x As Single
7.     y As Single
8.     w As Single
9.     h As Single
10. End Type
11. Screen _NewImage(1024, 700, 32)
12. _Delay .25
13. _ScreenMove _Middle
14. 'Print True, False
15. ReDim b(1 To 50) As box
16. For i = 1 To 50
17.     b(i).x = Rnd * 1024
18.     b(i).y = Rnd * 700
19.     b(i).w = Rnd * 400 + 20
20.     b(i).h = Rnd * 50 + 5
21. Next
22. mr = 5
23. Do
24.     Cls
25.     While _MouseInput: Wend
26.     mx = _MouseX: my = _MouseY
27.     Circle (mx, my), mr, &HFF0000FF
28.     For i = 1 To 50
29.         Line (b(i).x, b(i).y)-Step(b(i).w, b(i).h), _RGB32(i * 5, -1 * (i < 25) + 128 + (i > 25), 255 - i * 5), B
30.         If collide(mx, my, mr, b(i).x, b(i).y, b(i).w, b(i).h) Then Beep
31.     Next
32.     If Len(InKey$) Then
33.         For i = 1 To 50
34.             b(i).x = Rnd * 1024
35.             b(i).y = Rnd * 700
36.             b(i).w = Rnd * 400 + 20
37.             b(i).h = Rnd * 50 + 5
38.         Next
39.     End If
40.     _Display
41.     _Limit 60
42. Loop While _KeyDown(27) = 0
43.  
44. Function collide (cx, cy, radius, rx, ry, rw, rh)
45.     distX = Abs(cx - rx - rw / 2)
46.     distY = Abs(cy - ry - rh / 2)
47.  
48.     If distX > (rw / 2 + radius) Then
49.         collide = False: Exit Function
50.     End If
51.     If distY > (rh / 2 + radius) Then
52.         collide = False: Exit Function
53.     End If
54.  
55.     If distX <= rw / 2 Then
56.         collide = True: Exit Function
57.     End If
58.     If distY < rh / 2 Then
59.         collide = True: Exit Function
60.     End If
61.  
62.     'still here?
63.     dx = distX - rw / 2
64.     dy = distY - rh / 2
65.  
66.     collide = (dx * dx + dy * dy <= (radius * radius))
67. End Function
68.  
69.  

Title: Re: Collide Circle and Box
Post by: bplus on February 10, 2021, 01:29:09 am

Fix colors

Code: QB64: [Select]

1. _Title "Collide Circle and Box" 'b+ 2021-02-09
2. ' Johnno submits ref:  https://www.qb64.org/forum/index.php?topic=3499.msg129726#msg129726
3. Randomize Timer
4. Const True = -1, False = Not True
5. Type box
6.     x As Single
7.     y As Single
8.     w As Single
9.     h As Single
10. End Type
11. Screen _NewImage(1024, 700, 32)
12. _Delay .25
13. _ScreenMove _Middle
14. 'Print True, False
15. ReDim b(1 To 50) As box
16. For i = 1 To 50
17.     b(i).x = Rnd * 1024
18.     b(i).y = Rnd * 700
19.     b(i).w = Rnd * 400 + 20
20.     b(i).h = Rnd * 50 + 5
21. Next
22. mr = 5
23. Do
24.     Cls
25.     While _MouseInput: Wend
26.     mx = _MouseX: my = _MouseY
27.     Circle (mx, my), mr, &HFF0000FF
28.     For i = 1 To 50
29.         Line (b(i).x, b(i).y)-Step(b(i).w, b(i).h), _RGB32(i * 5, -50 * (i < 25) + 128 + 50 * (i > 25), 255 - i * 5), B
30.         If collide(mx, my, mr, b(i).x, b(i).y, b(i).w, b(i).h) Then Beep
31.     Next
32.     If Len(InKey$) Then
33.         For i = 1 To 50
34.             b(i).x = Rnd * 1024
35.             b(i).y = Rnd * 700
36.             b(i).w = Rnd * 400 + 20
37.             b(i).h = Rnd * 50 + 5
38.         Next
39.     End If
40.     _Display
41.     _Limit 60
42. Loop While _KeyDown(27) = 0
43.  
44. Function collide (cx, cy, radius, rx, ry, rw, rh)
45.     distX = Abs(cx - rx - rw / 2)
46.     distY = Abs(cy - ry - rh / 2)
47.  
48.     If distX > (rw / 2 + radius) Then
49.         collide = False: Exit Function
50.     End If
51.     If distY > (rh / 2 + radius) Then
52.         collide = False: Exit Function
53.     End If
54.  
55.     If distX <= rw / 2 Then
56.         collide = True: Exit Function
57.     End If
58.     If distY < rh / 2 Then
59.         collide = True: Exit Function
60.     End If
61.  
62.     'still here?
63.     dx = distX - rw / 2
64.     dy = distY - rh / 2
65.  
66.     collide = (dx * dx + dy * dy <= (radius * radius))
67. End Function

Dang I thought I was in the Programs Board, sorry. :p

Title: Re: Collide Circle and Box
Post by: Dav on February 10, 2021, 12:35:22 pm

Nice little snippet for learning and building on to make a new game.  Easy to comprehend.  Thanks for sharing.

- Dav

Text Only | Text with Attachments