Happy New Year

[Dimster]

Looking forward to getting this damn virus behind us. It did hit our home ending a lot of beautiful meals and a hook ups with some very funny relatives. But on the positive side ( if that word still carries a happy meaning) my Christmas turned into an adult Halloween. Tons  of chocolates, tarts and treats you couldn't stop eating. At the moment I'm trying to write some code while consuming a coffee with chocolates filled with brandy. I suspect its' the chocolates that have inspired me to pass along this season greeting. I'm very thankful for all the help this community has provided to me. Going for a couple more chocolates, they could actually be a cure for the virus.

[bplus]

Code: QB64: [Select]

1. _Title "Happy Trails 2022" 'from Happy Trails 2018
2. ' 2017-12-29 another redesign of fireworks
3. ' 2017-12-28 redesign fireworks
4. ' now with lake refelction 2017-12-27 forget the bouncing sparks
5. ' combine Welcome Plasma Font with landscape
6. '_title "Fireworks 3 translation to QB64 2017-12-26 bplus"
7. 'fireworks 3.bas SmallBASIC 0.12.2 [B+=MGA] 2015-05-09
8. 'fireworks 2.bas 2016-05-05 now with Gravity, Newtonian bounce, smoke debris
9. 'fireworks 3.bas try with map variables make bursts around a central point
10.  
11.  
12. Randomize Timer
13. Const xmax = 1200
14. Const ymax = 720
15. Const waterline = 600 ' 600 = ratio 5 to 1 sky to water
16. '                       raise and lower waterline as desired  highest about 400?
17. Const lTail = 15
18. Const bluey = 5 * 256 ^ 2 + 256 * 5 + 5
19. Const debrisMax = 28000
20.  
21. Screen _NewImage(xmax, ymax, 32)
22. _ScreenMove 120, 20
23.  
24. Type fireWorkType
25.     x As Integer
26.     y As Integer
27.     seed As Integer
28.     age As Integer
29.     life As Integer
30. End Type
31.  
32.  
33. Type debrisType
34.     x As Single
35.     y As Single
36.     c As Long
37. End Type
38.  
39. Common Shared fw() As fireWorkType
40. Common Shared debris() As debrisType
41. Common Shared cN, pR!, pG!, pB!
42.  
43. Screen _NewImage(xmax, ymax, 32)
44.  
45. 'prepare message font
46. mess$ = " Happy New Year 2022"
47. Print mess$
48. w = 8 * Len(mess$): h = 16
49. Dim p(w, h)
50. black&& = Point(0, 10)
51. For y = 0 To h
52.     For x = 0 To w
53.         If Point(x, y) <> black&& Then
54.             p(x, y) = 1
55.         End If
56.     Next
57. Next
58. xo = 0: yo = 15: m = 7.2
59. resetPlasma
60.  
61. 'prepare landscape
62. Cls
63. land& = _NewImage(xmax, ymax, 32)
64. _Dest land&
65. drawLandscape
66. _Dest 0
67.  
68. 'prepare fire works
69. nFW = 3
70. Dim fw(1 To 10) As fireWorkType
71. For i = 1 To nFW
72.     initFireWork (i)
73. Next
74.  
75. ''debris feild
76. 'DIM debris(debrisMax) AS debrisType
77.  
78. 'OK start the show
79. While 1
80.     'cls screen with land image
81.     _PutImage , land&, 0
82.  
83.     'draw fireworks
84.     For f = 1 To nFW
85.         If fw(f).age <= fw(f).life Then drawfw (f) Else initFireWork f
86.     Next
87.  
88.     ''debris
89.     'FOR i = 0 TO debrisStack
90.     '    PSET (debris(i).x, debris(i).y), debris(i).c
91.     '    debris(i).x = debris(i).x + RND * 3 - 1.5
92.     '    debris(i).y = debris(i).y + RND * 3.5 - 1.5
93.     '    IF debris(i).x < 0 OR debris(i).y < 0 OR debris(i).x > xmax OR debris(i).y > waterline + RND * 20 THEN NewDebris (i)
94.     'NEXT
95.  
96.     'text message in plasma
97.     For y = 0 To h - 1
98.         For x = 0 To w - 1
99.             If p(x, y) Then
100.                 changePlasma
101.             Else
102.                 Color 0
103.             End If
104.             Line (xo + x * m, yo + y * m)-(xo + x * m + m, yo + y * m + m), , BF
105.         Next
106.     Next
107.     lc = lc + 1
108.     If lc Mod 200 = 0 Then resetPlasma
109.  
110.     'reflect sky
111.     skyWaterRatio = waterline / (ymax - waterline) - .05
112.     For y = waterline To ymax
113.         For x = 0 To xmax
114.             c&& = Point(x, waterline - ((y - waterline - 1) * skyWaterRatio) + Rnd * 5)
115.             PSet (x, y + 1), c&& + bluey
116.         Next
117.     Next
118.  
119.     _Display
120.     _Limit 200 'no limit needed on my system!
121.  
122.     ''accumulate debris
123.     'IF lc MOD 2000 THEN
124.     '    IF debrisStack < debrisMax THEN
125.     '        FOR i = 1 TO 2
126.     '            NewDebris i + debrisStack
127.     '        NEXT
128.     '        debrisStack = debrisStack + 2
129.     '    END IF
130.     'END IF
131. Wend
132.  
133. 'SUB NewDebris (i)
134. '    debris(i).x = RND * xmax
135. '    debris(i).y = RND * ymax
136. '    c = RND * 155
137. '    debris(i).c = _RGB32(c, c, c)
138. 'END SUB
139.  
140. Sub changePlasma ()
141.     cN = cN + .01
142.     Color _RGB(127 + 127 * Sin(pR! * .3 * cN), 127 + 127 * Sin(pG! * .3 * cN), 127 + 127 * Sin(pB! * .3 * cN))
143. End Sub
144.  
145. Sub resetPlasma ()
146.     pR! = Rnd ^ 2: pG! = Rnd ^ 2: pB! = Rnd ^ 2
147. End Sub
148.  
149. Sub drawLandscape
150.     'the sky
151.     For i = 0 To ymax
152.         midInk 0, 0, 0, 78, 28, 68, i / ymax
153.         Line (0, i)-(xmax, i)
154.     Next
155.     'the land
156.     startH = waterline - 80
157.     rr = 10: gg = 20: bb = 15
158.     For mountain = 1 To 6
159.         Xright = 0
160.         y = startH
161.         While Xright < xmax
162.             ' upDown = local up / down over range, change along Y
163.             ' range = how far up / down, along X
164.             upDown = (Rnd * .8 - .35) * (1 / (1 * mountain))
165.             range = Xright + rand&&(5, 35) * 2.5 / mountain
166.             lastx = Xright - 1
167.             For X = Xright To range
168.                 y = y + upDown
169.                 Color _RGB32(rr, gg, bb)
170.                 Line (lastx, y)-(X, ymax), , BF 'just lines weren't filling right
171.                 lastx = X
172.             Next
173.             Xright = range
174.         Wend
175.         rr = rand&&(rr + 5, rr): gg = rand&&(gg + 5, gg): bb = rand&&(bb + 4, bb)
176.         If rr < 0 Then rr = 0
177.         If gg < 0 Then gg = 0
178.         If bb < 0 Then bb = 0
179.         startH = startH + rand&&(1, 10)
180.     Next
181.     'LINE (0, waterline)-(xmax, ymax), _RGB32(0, 0, 0), BF
182. End Sub
183.  
184. Sub midInk (r1, g1, b1, r2, g2, b2, fr)
185.     Color _RGB(r1 + (r2 - r1) * fr, g1 + (g2 - g1) * fr, b1 + (b2 - b1) * fr)
186. End Sub
187.  
188. Function rand&& (lo&&, hi&&)
189.     rand&& = Int(Rnd * (hi&& - lo&& + 1)) + lo&&
190. End Function
191.  
192. Sub drawfw (i)
193.     'here's how to "save" a bunch of random numbers without data and arrays but tons of redundant calculations
194.     Randomize Using fw(i).seed 'this repeats all random numbers generated by seed in same sequence
195.     'recreate our firework from scratch!
196.     red = rand&&(200, 255)
197.     green = rand&&(200, 255)
198.     blue = rand&&(200, 255)
199.     x = rand&&(1, 4)
200.     If x = 1 Then
201.         red = 0
202.     ElseIf x = 2 Then
203.         green = 0
204.     ElseIf x = 3 Then
205.         blue = 0
206.     Else
207.         x = rand&&(1, 4)
208.         If x = 1 Then
209.             red = 0: green = 0
210.         ElseIf x = 2 Then
211.             green = 0: blue = 0
212.         ElseIf x = 3 Then
213.             blue = 0: red = 0
214.         End If
215.     End If
216.     ne = rand&&(80, 300)
217.     Dim embers(ne, 1)
218.     For e = 0 To ne
219.         r = Rnd * 3
220.         embers(e, 0) = r * Cos(e * _Pi(2) / 101)
221.         embers(e, 1) = r * Sin(e * _Pi(2) / 101)
222.     Next
223.     start = fw(i).age - lTail ' don't let tails get longer than lTail const
224.     If start < 1 Then start = 1
225.     For e = 0 To ne
226.         cx = fw(i).x: cy = fw(i).y: dx = embers(e, 0): dy = embers(e, 1)
227.         For t = 1 To fw(i).age
228.             cx = cx + dx
229.             cy = cy + dy
230.             If t >= start Then
231.                 'too much like a flower?
232.                 midInk 60, 60, 60, red, green, blue, (t - start) / lTail
233.                 'midInk 60, 60, 60, 128, 160, 150, (t - start) / lTail
234.                 fcirc cx, cy, (t - start) / lTail
235.             End If
236.  
237.             dx = dx * .99 'air resitance
238.             dy = dy + .01 'gravity
239.         Next
240.         Color _RGB32(255, 255, 255)
241.         'COLOR _RGB32(red, green, blue)
242.         cx = cx + dx: cy = cy + dy
243.         fcirc cx, cy, (t - start) / lTail
244.     Next
245.     fw(i).age = fw(i).age + 1
246. End Sub
247.  
248. Sub initFireWork (i)
249.     fw(i).x = rand&&(.1 * xmax, .9 * xmax)
250.     fw(i).y = rand&&(.1 * ymax, .5 * ymax)
251.     fw(i).seed = rand&&(0, 32000)
252.     fw(i).age = 0
253.     fw(i).life = rand&&(20, 120)
254. End Sub
255.  
256. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
257. Sub fcirc (CX As Long, CY As Long, R As Long)
258.     Dim subRadius As Long, RadiusError As Long
259.     Dim X As Long, Y As Long
260.  
261.     subRadius = Abs(R)
262.     RadiusError = -subRadius
263.     X = subRadius
264.     Y = 0
265.  
266.     If subRadius = 0 Then PSet (CX, CY): Exit Sub
267.  
268.     ' Draw the middle span here so we don't draw it twice in the main loop,
269.     ' which would be a problem with blending turned on.
270.     Line (CX - X, CY)-(CX + X, CY), , BF
271.  
272.     While X > Y
273.         RadiusError = RadiusError + Y * 2 + 1
274.         If RadiusError >= 0 Then
275.             If X <> Y + 1 Then
276.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), , BF
277.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
278.             End If
279.             X = X - 1
280.             RadiusError = RadiusError - X * 2
281.         End If
282.         Y = Y + 1
283.         Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
284.         Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
285.     Wend
286. End Sub
287.  

[johnno56]

Gotta love those particle demos!!

Have a great new year, guys!!

[Dimster]

Beautiful bplus...the reflection must have taken a lot of thought.

[madscijr]

Code: QB64: [Select]

1. _Title "Happy Trails 2022" 'from Happy Trails 2018
2.  

i'm amazed how little code you guys need to get so much done.
my programs are always huge!
anyway this is very nice. happy new year!

[bplus]

Hi @madscijr

I will give one tip that saved allot of saving of points for Fireworks:
I saved seed to randomly draw one firework. From that seed I reset Randomize and always got the exact same set of "randomly" chosen points, colors, dx, dy... the whole works are determined from one seed. That way I didn't have to track where each trail of flames goes for each frame the fireworks is "alive".

I too have always admired how some function can be done with as few lines as possible, perhaps with practice and a few years it becomes a skill. :) SMcNeill is a master of it IMHO :) others too of course, he had to learn from others as well!