QB64.org Forum

Active Forums => Programs => Topic started by: FellippeHeitor on December 02, 2021, 12:08:53 pm

Title: 🐠 Curious Fish
Post by: FellippeHeitor on December 02, 2021, 12:08:53 pm

Code: QB64: [Select]

1. Randomize Timer
2. fishleft$ = "<*)))<{"
3. fishright$ = "}<(((*>"
4. Dim As Integer x, y
5. x = 1
6. y = Rnd * _Height
7. direction = 1
8. maxSpeed = 4
9. speed = maxSpeed
10.  
11. Do
12.     Color 2, 1
13.     Cls
14.  
15.     Select Case direction
16.         Case -1
17.             _PrintString (x, y), fishleft$
18.         Case 1
19.             _PrintString (x, y), fishright$
20.     End Select
21.  
22.     If speed > 0 Then
23.         x = x + direction * speed
24.         speed = speed - .2
25.         If speed <= 0 Then
26.             rest = Timer
27.             restFor = Rnd * 3
28.         End If
29.     Else
30.         If Timer - rest > restFor Then
31.             speed = maxSpeed
32.             bubbleX = Rnd * _Width
33.             bubbleY = _Height
34.             If Rnd < .5 Then
35.                 y = y + 1
36.             Else
37.                 y = y - 1
38.             End If
39.         End If
40.     End If
41.  
42.     If x < 1 Then x = 2: direction = direction * -1
43.     If x + Len(fishleft$) > _Width Then x = _Width - Len(fishleft$): direction = direction * -1
44.  
45.     If y > _Height Then y = _Height
46.     If y < 1 Then y = 1
47.  
48.     Color 7
49.     If bubbleY >= 1 Then
50.         _PrintString (bubbleX, Int(bubbleY)), "o"
51.         bubbleY = bubbleY - Rnd
52.     End If
53.     _Display
54.     _Limit 30
55. Loop
56.  

Title: Re: 🐠 Curious Fish
Post by: Petr on December 02, 2021, 02:05:52 pm

Nice :)

Title: Re: 🐠 Curious Fish
Post by: Richard Frost on December 02, 2021, 03:06:47 pm

Cute.  Should have Don Ho's "Tiny Bubbles" playing in the background.

Title: Re: 🐠 Curious Fish
Post by: bplus on December 03, 2021, 01:17:03 pm

This looks like fun!

Code: QB64: [Select]

1. Option _Explicit
2. _Title "     Fish:    press m for more,    l for less" 'b+ 2021-12-03
3. Const sw = 1024, sh = 700, LHead$ = "<*", LBody$ = ")", LTail$ = "<{", RHead$ = "*>", RBody$ = "(", RTail$ = "}<"
4. Type fish
5.     As Integer LFish, X, Y, DX
6.     As String fish
7.     As _Unsigned Long Colr
8. End Type
9.  
10. Screen _NewImage(sw, sh, 32)
11. _ScreenMove 180, 40
12.  
13.  
14. '_FullScreen ' <<<<<<<<<<<<<<<   goto full screen once you know instructions for more and less fish
15.  
16.  
17.  
18. Color _RGB32(220), _RGB32(0, 0, 60)
19. Cls
20. _PrintMode _KeepBackground
21. Dim As Integer i, nFish
22. Dim k$
23. nFish = 20
24.  
25. restart:
26. ReDim Shared school(1 To nFish) As fish, kelp(sw, sh) As _Unsigned Long
27. growKelp
28. For i = 1 To nFish
29.     NewFish i, -1
30. Next
31. Do
32.     Cls
33.     k$ = InKey$
34.     If k$ = "m" Then ' more fish
35.         nFish = nFish * 2
36.         If nFish > 300 Then Beep: nFish = 300
37.         GoTo restart
38.     End If
39.     If k$ = "l" Then ' less fish
40.         nFish = nFish / 2
41.         If nFish < 4 Then Beep: nFish = 4
42.         GoTo restart
43.     End If
44.     For i = 1 To nFish ' draw fish behind kelp
45.         If _Red32(school(i).Colr) < 160 Then
46.             Color school(i).Colr
47.             _PrintString (school(i).X, school(i).Y), school(i).fish 'draw fish
48.             school(i).X = school(i).X + school(i).DX
49.             If school(i).LFish Then
50.                 If school(i).X + Len(school(i).fish) * 8 < 0 Then NewFish i, 0
51.             Else
52.                 If school(i).X - Len(school(i).fish) * 8 > _Width Then NewFish i, 0
53.             End If
54.         End If
55.     Next
56.     showKelp
57.     For i = 1 To nFish ' draw fish in from of kelp
58.         If _Red32(school(i).Colr) >= 160 Then
59.             Color school(i).Colr
60.             _PrintString (school(i).X, school(i).Y), school(i).fish 'draw fish
61.             school(i).X = school(i).X + school(i).DX
62.             If school(i).LFish Then
63.                 If school(i).X + Len(school(i).fish) * 8 < 0 Then NewFish i, 0
64.             Else
65.                 If school(i).X - Len(school(i).fish) * 8 > _Width Then NewFish i, 0
66.             End If
67.         End If
68.     Next
69.  
70.     _Display
71.     _Limit 10
72. Loop Until _KeyDown(27)
73.  
74. Sub NewFish (i, initTF)
75.     Dim gray
76.     gray = Rnd * 200 + 55
77.     school(i).Colr = _RGB32(gray) ' color
78.     If Rnd > .5 Then
79.         school(i).LFish = -1
80.         school(i).fish = LHead$ + String$(Int(Rnd * 5) + -2 * (gray > 160) + 1, LBody$) + LTail$
81.     Else
82.         school(i).LFish = 0
83.         school(i).fish = RTail$ + String$(Int(Rnd * 5) + -2 * (gray > 160) + 1, RBody$) + RHead$
84.     End If
85.     If initTF Then
86.         school(i).X = _Width * Rnd
87.     Else
88.         If school(i).LFish Then school(i).X = _Width + Rnd * 35 Else school(i).X = -35 * Rnd - Len(school(i).fish) * 8
89.     End If
90.     If gray > 160 Then
91.         If school(i).LFish Then school(i).DX = -18 * Rnd - 3 Else school(i).DX = 18 * Rnd + 3
92.     Else
93.         If school(i).LFish Then school(i).DX = -6 * Rnd - 1 Else school(i).DX = 6 * Rnd + 1
94.     End If
95.     school(i).Y = _Height * Rnd
96. End Sub
97.  
98. Sub growKelp
99.     Dim kelps, x, y, r
100.     ReDim kelp(sw, sh) As _Unsigned Long
101.     kelps = Int(Rnd * 20) + 20
102.     For x = 1 To kelps
103.         kelp(Int(Rnd * sw / 8), (sh - 16) / 16) = _RGB32(0, Rnd * 128, 0)
104.     Next
105.     For y = sh / 16 To 0 Step -1
106.         For x = 0 To sw / 8
107.             If kelp(x, y + 1) Then
108.                 r = Int(Rnd * 23) + 1
109.                 Select Case r
110.                     Case 1, 2, 3, 18 '1 branch node
111.                         If x - 1 >= 0 Then kelp(x - 1, y) = kelp(x, y + 1)
112.                     Case 4, 5, 6, 7, 8, 9, 21 '1 branch node
113.                         kelp(x, y) = kelp(x, y + 1)
114.                     Case 10, 11, 12, 20 '1 branch node
115.                         If x + 1 <= sw Then kelp(x + 1, y) = kelp(x, y + 1)
116.                     Case 13, 14, 15, 16, 17, 19 '2 branch node
117.                         If x - 1 >= 0 Then kelp(x - 1, y) = kelp(x, y + 1)
118.                         If x + 1 <= sw Then kelp(x + 1, y) = kelp(x, y + 1)
119.                 End Select
120.             End If
121.         Next
122.     Next
123. End Sub
124.  
125. Sub showKelp
126.     Dim y, x
127.     For y = 0 To sh / 16
128.         For x = 0 To sw / 8
129.             If kelp(x, y) Then
130.                 Color kelp(x, y)
131.                 _PrintString (x * 8, y * 16), Mid$("kelp", Int(Rnd * 4) + 1, 1)
132.             End If
133.         Next
134.     Next
135. End Sub
136.  

EDIT: removed unused variables

Title: Re: 🐠 Curious Fish
Post by: FellippeHeitor on December 03, 2021, 07:29:26 pm

Whooooooa! Your mods never disappoint, bplus!

Title: Re: 🐠 Curious Fish
Post by: johnno56 on December 03, 2021, 07:41:27 pm

Now where have I seen this program before? It looks familiar. Can't quite put my finger on it... LOL
Text or not. It still looks impressive. Nicely done!

Title: Re: 🐠 Curious Fish
Post by: bplus on December 03, 2021, 11:26:15 pm

Thanks guys, yeah new use for old code. The random letters from "kelp" worked really nice for water effect.

Text Only | Text with Attachments