🎄🎁✨ Holiday Season - are you ready to code?

[OldMoses]

@Petr that was completely amazing! Well done.

[SierraKen]

Thanks guys. Awesome ornaments Dav!

[Pete]

Anyone made Rudolf or Olive, yet?

Pete

[johnno56]

You finish off the bauble with a rectangle of the same rgb colour. I was thinking... stop laughing... What if the rectangles were 'center-gradient-based". The left-hand side of the rectangle starts off as pale grey; blends to a darker grey in the center; blends to a lighter grey towards the right-hand side. To give the "top" the illusion of being cylindrical... I don't know the correct way to explain it. I hope I am making sense? Just a thought...

[STxAxTIC]

Why invent something new when I can release a greatest hits album?

My (first?) holiday contribution comes as a FluidCraft level. Compile the code below to an EXE, and then drag+drop the attached file.

Code: QB64: [Select]

1. ' Version 2020-12-15
2.  
3. OPTION _EXPLICIT
4.  
5. DO UNTIL _SCREENEXISTS: LOOP
6. _TITLE "FluidCraft"
7.  
8. SCREEN _NEWIMAGE(1024, 768, 32)
9. '_FULLSCREEN , _SMOOTH
10.  
11. RANDOMIZE TIMER
12.  
13. TYPE Vector
14.     x AS DOUBLE
15.     y AS DOUBLE
16. END TYPE
17.  
18. TYPE ShadeVector
19.     shadered AS DOUBLE
20.     shadegreen AS DOUBLE
21.     shadeblue AS DOUBLE
22.     shadealpha AS DOUBLE
23. END TYPE
24.  
25. TYPE ShadeElement
26.     TheName AS STRING
27.     TheShade AS ShadeVector
28. END TYPE
29.  
30. TYPE Pixel
31.     position AS Vector
32.     velocity AS Vector
33.     acceleration AS Vector
34.     size AS DOUBLE
35.     TheShade AS ShadeVector
36. END TYPE
37.  
38. DIM SHARED ShadeData(8) AS ShadeElement
39. DIM SHARED ActiveShade AS ShadeVector
40. DIM SHARED PixelCloud(3000) AS Pixel
41. DIM SHARED ObjectSize AS DOUBLE
42. DIM SHARED GridSize AS Vector
43. ObjectSize = 6
44. GridSize.x = 1 + INT(_WIDTH / ObjectSize)
45. GridSize.y = 1 + INT(_HEIGHT / ObjectSize)
46. DIM SHARED Level(GridSize.x, GridSize.y) AS ShadeVector
47.  
48. CALL InitializeAll
49. CALL LoadFile
50. DO
51.     CALL UserInput
52.     CLS
53.     CALL DrawBorder
54.     CALL DrawPixels
55.     CALL DrawLevel
56.     CALL Dynamics
57.     CALL DrawOverlay
58.     _DISPLAY
59.     _LIMIT 30
60. LOOP
61.  
62. END
63.  
64. SUB DrawBorder
65.     DIM k AS INTEGER
66.     LINE (0, 0)-(_WIDTH, _HEIGHT), _RGB32(255, 0, 255, 255), BF
67.     FOR k = 6 TO _HEIGHT - 1 - 6
68.         LINE (6, k)-(_WIDTH - 6, k), _RGB32(255 * k / _HEIGHT, 0, 255 * (1 - k / _HEIGHT), 255)
69.     NEXT
70.     LINE (12, 12)-(_WIDTH - 12, _HEIGHT - 12), _RGB32(0, 0, 0, 255), BF
71.     LINE (12, 12)-(18 * (UBOUND(ShadeData) + 1) - 1 + 6 + 12, 38 + 12), _RGB32(0, 0, 255, 255), BF
72.     LINE (12, 12)-(18 * (UBOUND(ShadeData) + 1) - 1 + 6 + 6, 38 + 6), _RGB32(255, 0, 255, 255), BF
73.     LINE (12, 12)-(18 * (UBOUND(ShadeData) + 1) - 1 + 6, 38), _RGB32(0, 0, 0, 255), BF
74. END SUB
75.  
76. SUB DrawPixels
77.     DIM k AS INTEGER
78.     DIM x AS DOUBLE
79.     DIM y AS DOUBLE
80.     DIM s AS DOUBLE
81.     FOR k = 1 TO UBOUND(PixelCloud)
82.         x = PixelCloud(k).position.x
83.         y = PixelCloud(k).position.y
84.         s = PixelCloud(k).size
85.         CALL clinebf(x - s, y - s, x + s, y + s, _RGBA(PixelCloud(k).TheShade.shadered, PixelCloud(k).TheShade.shadegreen, PixelCloud(k).TheShade.shadeblue, PixelCloud(k).TheShade.shadealpha))
86.     NEXT
87. END SUB
88.  
89. SUB DrawLevel
90.     DIM i AS INTEGER
91.     DIM j AS INTEGER
92.     DIM x AS DOUBLE
93.     DIM y AS DOUBLE
94.     DIM s AS DOUBLE
95.     s = ObjectSize
96.     FOR i = 1 TO GridSize.x
97.         FOR j = 1 TO GridSize.y
98.             x = (i - 1) * s
99.             y = (j - 1) * s
100.             IF (Level(i, j).shadered > 5) OR (Level(i, j).shadegreen > 5) OR (Level(i, j).shadeblue > 5) THEN
101.                 CALL slinebf(x - s / 2, y - s / 2, x + s / 2 - 1, y + s / 2 - 1, _RGBA(Level(i, j).shadered, Level(i, j).shadegreen, Level(i, j).shadeblue, Level(i, j).shadealpha))
102.             END IF
103.         NEXT
104.     NEXT
105. END SUB
106.  
107. SUB DrawOverlay
108.     DIM k AS INTEGER
109.     IF ActiveShade.shadered < 5 AND ActiveShade.shadegreen < 5 AND ActiveShade.shadeblue < 5 THEN
110.         LINE (ObjectSize * INT(_MOUSEX / ObjectSize) - ObjectSize / 2 - 1, ObjectSize * INT(_MOUSEY / ObjectSize) - ObjectSize / 2 - 1)-(ObjectSize * INT(_MOUSEX / ObjectSize) + ObjectSize / 2 - 1 + 1, ObjectSize * INT(_MOUSEY / ObjectSize) + ObjectSize / 2 - 1 + 1), _RGBA(255, 255, 255, 255), B
111.     END IF
112.     LINE (ObjectSize * INT(_MOUSEX / ObjectSize) - ObjectSize / 2, ObjectSize * INT(_MOUSEY / ObjectSize) - ObjectSize / 2)-(ObjectSize * INT(_MOUSEX / ObjectSize) + ObjectSize / 2 - 1, ObjectSize * INT(_MOUSEY / ObjectSize) + ObjectSize / 2 - 1), _RGBA(ActiveShade.shadered, ActiveShade.shadegreen, ActiveShade.shadeblue, ActiveShade.shadealpha), BF
113.     FOR k = 1 TO UBOUND(ShadeData)
114.         LINE (18 * k + 1, 18)-(18 * (k + 1) - 1, 32), _RGB32(ShadeData(k).TheShade.shadered, ShadeData(k).TheShade.shadegreen, ShadeData(k).TheShade.shadeblue, ShadeData(k).TheShade.shadealpha), BF
115.         LINE (18 * k + 1, 18)-(18 * (k + 1) - 1, 32), _RGB32(255, 255, 255, 255), B
116.     NEXT
117. END SUB
118.  
119. SUB InitializeAll
120.     DIM k AS INTEGER
121.     ShadeData(1).TheName = "Red"
122.     ShadeData(1).TheShade.shadered = 255
123.     ShadeData(1).TheShade.shadegreen = 0
124.     ShadeData(1).TheShade.shadeblue = 0
125.     ShadeData(1).TheShade.shadealpha = 255
126.     ShadeData(2).TheName = "Blue"
127.     ShadeData(2).TheShade.shadered = 0
128.     ShadeData(2).TheShade.shadegreen = 0
129.     ShadeData(2).TheShade.shadeblue = 255
130.     ShadeData(2).TheShade.shadealpha = 255
131.     ShadeData(3).TheName = "Green"
132.     ShadeData(3).TheShade.shadered = 0
133.     ShadeData(3).TheShade.shadegreen = 255
134.     ShadeData(3).TheShade.shadeblue = 0
135.     ShadeData(3).TheShade.shadealpha = 255
136.     ShadeData(4).TheName = "White"
137.     ShadeData(4).TheShade.shadered = 255
138.     ShadeData(4).TheShade.shadegreen = 255
139.     ShadeData(4).TheShade.shadeblue = 255
140.     ShadeData(4).TheShade.shadealpha = 255
141.     ShadeData(5).TheName = "Yellow"
142.     ShadeData(5).TheShade.shadered = 255
143.     ShadeData(5).TheShade.shadegreen = 255
144.     ShadeData(5).TheShade.shadeblue = 0
145.     ShadeData(5).TheShade.shadealpha = 255
146.     ShadeData(6).TheName = "Aqua"
147.     ShadeData(6).TheShade.shadered = 0
148.     ShadeData(6).TheShade.shadegreen = 255
149.     ShadeData(6).TheShade.shadeblue = 255
150.     ShadeData(6).TheShade.shadealpha = 255
151.     ShadeData(7).TheName = "Violet"
152.     ShadeData(7).TheShade.shadered = 255
153.     ShadeData(7).TheShade.shadegreen = 0
154.     ShadeData(7).TheShade.shadeblue = 255
155.     ShadeData(7).TheShade.shadealpha = 255
156.     ShadeData(8).TheName = "Black"
157.     ShadeData(8).TheShade.shadered = 0
158.     ShadeData(8).TheShade.shadegreen = 0
159.     ShadeData(8).TheShade.shadeblue = 0
160.     ShadeData(8).TheShade.shadealpha = 255
161.  
162.     FOR k = 1 TO UBOUND(PixelCloud)
163.         PixelCloud(k).size = 3
164.         PixelCloud(k).acceleration.x = 0
165.         PixelCloud(k).acceleration.y = 0
166.         PixelCloud(k).velocity.x = 0
167.         PixelCloud(k).velocity.y = 0
168.         PixelCloud(k).position.x = (RND - .5) * _WIDTH * .8
169.         PixelCloud(k).position.y = (RND - .5) * _HEIGHT * .8
170.         CALL SetPixelShade(k, 0, 0, 255, 150)
171.     NEXT
172.  
173.     ActiveShade.shadered = 255
174.     ActiveShade.shadegreen = 0
175.     ActiveShade.shadeblue = 0
176.     ActiveShade.shadealpha = 255
177.  
178. END SUB
179.  
180. SUB SetPixelShade (i AS INTEGER, r AS INTEGER, g AS INTEGER, b AS INTEGER, a AS INTEGER)
181.     PixelCloud(i).TheShade.shadered = r
182.     PixelCloud(i).TheShade.shadegreen = g
183.     PixelCloud(i).TheShade.shadeblue = b
184.     PixelCloud(i).TheShade.shadealpha = a
185. END SUB
186.  
187. SUB UserInput
188.     DIM mb1 AS INTEGER
189.     DIM mb2 AS INTEGER
190.     DIM mb3 AS INTEGER
191.     DIM i AS INTEGER
192.     DIM j AS INTEGER
193.     DIM k AS INTEGER
194.     mb1 = 0
195.     mb2 = 0
196.     mb3 = 0
197.     DO WHILE _MOUSEINPUT
198.         IF (_MOUSEBUTTON(1) = -1) AND (mb1 <> 1) THEN
199.             mb1 = -1
200.             i = 1 + INT(_MOUSEX / ObjectSize)
201.             j = 1 + INT(_MOUSEY / ObjectSize)
202.             Level(i, j).shadered = ActiveShade.shadered
203.             Level(i, j).shadegreen = ActiveShade.shadegreen
204.             Level(i, j).shadeblue = ActiveShade.shadeblue
205.             Level(i, j).shadealpha = ActiveShade.shadealpha
206.         END IF
207.         IF ((_MOUSEBUTTON(2) = -1) AND (mb2 <> -1)) THEN
208.             mb2 = -1
209.             i = ObjectSize * INT(_MOUSEX / ObjectSize)
210.             j = ObjectSize * INT(_MOUSEY / ObjectSize)
211.             ActiveShade.shadered = _RED32(POINT(i, j))
212.             ActiveShade.shadegreen = _GREEN32(POINT(i, j))
213.             ActiveShade.shadeblue = _BLUE32(POINT(i, j))
214.             ActiveShade.shadealpha = _ALPHA32(POINT(i, j))
215.         END IF
216.     LOOP
217.     SELECT CASE _KEYHIT
218.         CASE ASC("e"), ASC("E")
219.             CALL Export
220.         CASE ASC("r"), ASC("R")
221.             FOR k = 1 TO UBOUND(PixelCloud)
222.                 PixelCloud(k).TheShade.shadered = 255
223.                 PixelCloud(k).TheShade.shadegreen = 0
224.                 PixelCloud(k).TheShade.shadeblue = 0
225.             NEXT
226.         CASE ASC("b"), ASC("B")
227.             FOR k = 1 TO UBOUND(PixelCloud)
228.                 PixelCloud(k).TheShade.shadered = 0
229.                 PixelCloud(k).TheShade.shadegreen = 0
230.                 PixelCloud(k).TheShade.shadeblue = 255
231.             NEXT
232.         CASE ASC("0")
233.             FOR k = 1 TO UBOUND(PixelCloud)
234.                 PixelCloud(k).position.x = (RND - .5) * _WIDTH * .8
235.                 PixelCloud(k).position.y = (RND - .5) * _HEIGHT * .8
236.             NEXT
237.         CASE 27
238.             FOR i = 1 TO GridSize.x
239.                 FOR j = 1 TO GridSize.y
240.                     Level(i, j).shadered = 0
241.                     Level(i, j).shadegreen = 0
242.                     Level(i, j).shadeblue = 0
243.                     Level(i, j).shadealpha = 0
244.                 NEXT
245.             NEXT
246.     END SELECT
247.     'DO WHILE _MOUSEINPUT: LOOP
248. END SUB
249.  
250. SUB Export
251.     DIM i AS INTEGER
252.     DIM j AS INTEGER
253.     OPEN "FluidCraft" + LTRIM$(RTRIM$(STR$(INT(TIMER)))) + ".txt" FOR OUTPUT AS #1
254.     FOR i = 1 TO UBOUND(Level, 1)
255.         FOR j = 1 TO UBOUND(Level, 2)
256.             PRINT #1, i, j, Level(i, j).shadered, Level(i, j).shadegreen, Level(i, j).shadeblue, Level(i, j).shadealpha
257.         NEXT
258.     NEXT
259.     CLOSE #1
260. END SUB
261.  
262. SUB Dynamics
263.     DIM k AS INTEGER
264.     FOR k = 1 TO UBOUND(PixelCloud)
265.         CALL CalculateInfluence(k)
266.         CALL UpdatePosition(k)
267.     NEXT
268. END SUB
269.  
270. SUB UpdatePosition (i AS INTEGER)
271.     DIM dt AS DOUBLE
272.     DIM damp AS DOUBLE
273.     DIM brownian AS DOUBLE
274.     dt = 1
275.     damp = 0.8
276.     brownian = .65
277.     PixelCloud(i).velocity.x = damp * PixelCloud(i).velocity.x + dt * PixelCloud(i).acceleration.x
278.     PixelCloud(i).velocity.y = damp * PixelCloud(i).velocity.y + dt * PixelCloud(i).acceleration.y
279.     PixelCloud(i).position.x = PixelCloud(i).position.x + dt * PixelCloud(i).velocity.x + (RND - .5) * brownian
280.     PixelCloud(i).position.y = PixelCloud(i).position.y + dt * PixelCloud(i).velocity.y + (RND - .5) * brownian
281.     IF (PixelCloud(i).position.y <= -_HEIGHT / 2 + 2 * PixelCloud(i).size + 1) THEN
282.         PixelCloud(i).position.y = _HEIGHT / 2 - 2 * PixelCloud(i).size
283.     END IF
284. END SUB
285.  
286. SUB CalculateInfluence (i AS INTEGER)
287.     DIM x AS DOUBLE
288.     DIM y AS DOUBLE
289.     DIM dx AS DOUBLE
290.     DIM dy AS DOUBLE
291.     DIM xr AS DOUBLE
292.     DIM yr AS DOUBLE
293.     DIM xg AS DOUBLE
294.     DIM yg AS DOUBLE
295.     DIM xb AS DOUBLE
296.     DIM yb AS DOUBLE
297.     DIM WPoint(9) AS _UNSIGNED LONG
298.     x = PixelCloud(i).position.x
299.     y = PixelCloud(i).position.y
300.     dx = 2 * PixelCloud(i).size
301.     dy = 2 * PixelCloud(i).size
302.     WPoint(7) = cpoint(x - dx, y + dy)
303.     WPoint(8) = cpoint(x, y + dy)
304.     WPoint(9) = cpoint(x + dx, y + dy)
305.     WPoint(4) = cpoint(x - dx, y)
306.     WPoint(6) = cpoint(x + dx, y)
307.     WPoint(1) = cpoint(x - dx, y - dy)
308.     WPoint(2) = cpoint(x, y - dy)
309.     WPoint(3) = cpoint(x + dx, y - dy)
310.  
311.     DIM k AS INTEGER
312.     DIM WShade(9) AS DOUBLE
313.     DIM xc AS DOUBLE
314.     DIM yc AS DOUBLE
315.     DIM cs AS INTEGER
316.     cs = 0
317.     x = 0
318.     y = 0
319.  
320.     ' red
321.     FOR k = 1 TO 9
322.         IF (k <> 5) THEN
323.             IF ((_RED32(WPoint(k)) > 25) AND (_GREEN32(WPoint(k)) < 5) AND (_BLUE32(WPoint(k)) < 25)) THEN
324.                 WShade(k) = _RED32(WPoint(k)) + _GREEN32(WPoint(k)) + _BLUE32(WPoint(k))
325.             ELSE
326.                 WShade(k) = 0
327.             END IF
328.         END IF
329.     NEXT
330.     xr = (WShade(6) - WShade(4) + (WShade(9) + WShade(3)) / SQR(2) - (WShade(7) + WShade(1)) / SQR(2))
331.     yr = (WShade(8) - WShade(2) + (WShade(7) + WShade(9)) / SQR(2) - (WShade(1) + WShade(3)) / SQR(2))
332.     x = x + xr
333.     y = y + yr
334.  
335.     ' blue
336.     FOR k = 1 TO 9
337.         IF (k <> 5) THEN
338.             IF ((_RED32(WPoint(k)) < 25) AND (_GREEN32(WPoint(k)) < 5) AND (_BLUE32(WPoint(k)) > 25)) THEN
339.                 WShade(k) = _RED32(WPoint(k)) + _GREEN32(WPoint(k)) + _BLUE32(WPoint(k))
340.             ELSE
341.                 WShade(k) = 0
342.             END IF
343.         END IF
344.     NEXT
345.     xb = (WShade(6) - WShade(4) + (WShade(9) + WShade(3)) / SQR(2) - (WShade(7) + WShade(1)) / SQR(2))
346.     yb = (WShade(8) - WShade(2) + (WShade(7) + WShade(9)) / SQR(2) - (WShade(1) + WShade(3)) / SQR(2))
347.     x = x + xb
348.     y = y + yb
349.  
350.     ' green
351.     FOR k = 1 TO 9
352.         IF (k <> 5) THEN
353.             IF ((_RED32(WPoint(k)) < 5) AND (_GREEN32(WPoint(k)) > 250) AND (_BLUE32(WPoint(k)) < 5)) THEN
354.                 WShade(k) = _RED32(WShade(k)) + _GREEN32(WPoint(k)) + _BLUE32(WPoint(k))
355.                 cs = 1
356.             ELSE
357.                 WShade(k) = 0
358.             END IF
359.         END IF
360.     NEXT
361.     xg = -(WShade(6) - WShade(4) + (WShade(9) + WShade(3)) / SQR(2) - (WShade(7) + WShade(1)) / SQR(2))
362.     yg = (0 - WShade(2) + (0 + 0) / SQR(2) - (WShade(1) + WShade(3)) / SQR(2))
363.     x = x + xg
364.     y = y + yg
365.  
366.     ' custom yellow
367.     FOR k = 1 TO 9
368.         IF (k <> 5) THEN
369.             IF ((_RED32(WPoint(k)) > 250) AND (_GREEN32(WPoint(k)) > 250) AND (_BLUE32(WPoint(k)) < 5)) THEN
370.                 WShade(k) = _RED32(WShade(k)) + _GREEN32(WPoint(k)) + _BLUE32(WPoint(k))
371.                 cs = 1
372.             ELSE
373.                 WShade(k) = 0
374.             END IF
375.         END IF
376.     NEXT
377.     xc = (WShade(6) - 0 + (WShade(9) + WShade(3)) / SQR(2) - (0 + 0) / SQR(2))
378.     yc = 0
379.     x = x + xc
380.     y = y + yc
381.  
382.     ' custom aqua
383.     FOR k = 1 TO 9
384.         IF (k <> 5) THEN
385.             IF ((_RED32(WPoint(k)) < 5) AND (_GREEN32(WPoint(k)) > 250) AND (_BLUE32(WPoint(k)) > 250)) THEN
386.                 WShade(k) = _RED32(WShade(k)) + _GREEN32(WPoint(k)) + _BLUE32(WPoint(k))
387.                 cs = 1
388.             ELSE
389.                 WShade(k) = 0
390.             END IF
391.         END IF
392.     NEXT
393.     xc = -(WShade(6) - 0 + (WShade(9) + WShade(3)) / SQR(2) - (0 + 0) / SQR(2))
394.     yc = 0
395.     x = x + xc
396.     y = y + yc
397.  
398.     ' custom white
399.     FOR k = 1 TO 9
400.         IF (k <> 5) THEN
401.             IF ((_RED32(WPoint(k)) > 250) AND (_GREEN32(WPoint(k)) > 250) AND (_BLUE32(WPoint(k)) > 250)) THEN
402.                 WShade(k) = _RED32(WShade(k)) + _GREEN32(WPoint(k)) + _BLUE32(WPoint(k))
403.                 cs = 1
404.             ELSE
405.                 WShade(k) = 0
406.             END IF
407.         END IF
408.     NEXT
409.     xc = -(WShade(6) - WShade(4) + (WShade(9) + WShade(3)) / SQR(2) - (WShade(7) + WShade(1)) / SQR(2))
410.     yc = -(0 - WShade(2) + (0 + 0) / SQR(2) - (WShade(1) + WShade(3)) / SQR(2))
411.     x = x + xc
412.     y = y + yc
413.  
414.     ' custom violet
415.     FOR k = 1 TO 9
416.         IF (k <> 5) THEN
417.             IF ((_RED32(WPoint(k)) > 250) AND (_GREEN32(WPoint(k)) < 5) AND (_BLUE32(WPoint(k)) > 250)) THEN
418.                 WShade(k) = _RED32(WShade(k)) + _GREEN32(WPoint(k)) + _BLUE32(WPoint(k))
419.                 cs = 1
420.             ELSE
421.                 WShade(k) = 0
422.             END IF
423.         END IF
424.     NEXT
425.     xc = (WShade(6) - WShade(4) + (WShade(9) + WShade(3)) / SQR(2) - (WShade(7) + WShade(1)) / SQR(2))
426.     yc = (WShade(8) - WShade(2) + (WShade(7) + WShade(9)) / SQR(2) - (WShade(1) + WShade(3)) / SQR(2))
427.     x = x + xc
428.     y = y + yc
429.  
430.     ' Conductivity
431.     IF (cs = 0) THEN
432.         IF ((xr * xr + yr * yr) > (xb * xb + yb * yb)) THEN
433.             PixelCloud(i).TheShade.shadered = PixelCloud(i).TheShade.shadered + 64
434.             IF (PixelCloud(i).TheShade.shadered >= 255) THEN PixelCloud(i).TheShade.shadered = 255
435.             PixelCloud(i).TheShade.shadeblue = PixelCloud(i).TheShade.shadeblue - 64
436.             IF (PixelCloud(i).TheShade.shadeblue <= 0) THEN PixelCloud(i).TheShade.shadeblue = 0
437.         END IF
438.         IF ((xb * xb + yb * yb) > (xr * xr + yr * yr)) THEN
439.             PixelCloud(i).TheShade.shadered = PixelCloud(i).TheShade.shadered - 64
440.             IF (PixelCloud(i).TheShade.shadered <= 0) THEN PixelCloud(i).TheShade.shadered = 0
441.             PixelCloud(i).TheShade.shadeblue = PixelCloud(i).TheShade.shadeblue + 64
442.             IF (PixelCloud(i).TheShade.shadeblue >= 255) THEN PixelCloud(i).TheShade.shadeblue = 255
443.         END IF
444.     END IF
445.  
446.     ' Gravity vs. levity
447.     IF (cs = 0) THEN
448.         y = y - (PixelCloud(i).TheShade.shadered - PixelCloud(i).TheShade.shadeblue) / 255
449.     END IF
450.  
451.     ' Normalize acceleration
452.     IF (ABS(x) < .001) THEN
453.         PixelCloud(i).acceleration.x = 0
454.     ELSE
455.         PixelCloud(i).acceleration.x = -x / SQR(x * x + y * y)
456.     END IF
457.     IF (ABS(y) < .001) THEN
458.         PixelCloud(i).acceleration.y = 0
459.     ELSE
460.         PixelCloud(i).acceleration.y = -y / SQR(x * x + y * y)
461.     END IF
462.  
463.     ' Auto-cooling
464.     IF (cs = 0) THEN
465.         PixelCloud(i).TheShade.shadered = PixelCloud(i).TheShade.shadered - 2
466.         IF (PixelCloud(i).TheShade.shadered <= 0) THEN PixelCloud(i).TheShade.shadered = 0
467.         PixelCloud(i).TheShade.shadeblue = PixelCloud(i).TheShade.shadeblue + 2
468.         IF (PixelCloud(i).TheShade.shadeblue >= 255) THEN PixelCloud(i).TheShade.shadeblue = 255
469.     END IF
470. END SUB
471.  
472. FUNCTION cpoint& (x1 AS DOUBLE, y1 AS DOUBLE)
473.     DIM TheReturn AS _UNSIGNED LONG
474.     TheReturn = POINT(_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)
475.     cpoint = TheReturn
476. END FUNCTION
477.  
478. SUB clinebf (x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE, col AS _UNSIGNED LONG)
479.     LINE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)-(_WIDTH / 2 + x2 - 0, -y2 + _HEIGHT / 2 + 0), col, BF
480. END SUB
481.  
482. SUB slinebf (x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE, col AS _UNSIGNED LONG)
483.     LINE (x1, y1)-(x2, y2), col, BF
484. END SUB
485.  
486. SUB cprintstring (y1 AS DOUBLE, a AS STRING)
487.     _PRINTSTRING (_WIDTH / 2 - (LEN(a) * 8) / 2, -y1 + _HEIGHT / 2), a
488. END SUB
489.  
490. SUB LoadFile
491.     DIM i AS INTEGER
492.     DIM j AS INTEGER
493.     DIM r AS INTEGER
494.     DIM g AS INTEGER
495.     DIM b AS INTEGER
496.     DIM a AS INTEGER
497.     IF (COMMAND$ <> "") THEN
498.         PRINT "Loading..."
499.         OPEN COMMAND$ FOR INPUT AS #1
500.         DO WHILE NOT EOF(1)
501.             INPUT #1, i, j, r, g, b, a
502.             Level(i, j).shadered = r
503.             Level(i, j).shadegreen = g
504.             Level(i, j).shadeblue = b
505.             Level(i, j).shadealpha = a
506.         LOOP
507.         CLOSE #1
508.     END IF
509. END SUB
510.  

[Dav]

@johnno56: That sounds good to me.  The top was as afterthought.  I should have made it silver or something before posting.

@STxAxTIC: That looks pretty cool...

Here is something I started working on last night, a multi-note PLAY like system using sound files.  Since it's Christmas I made it play a Christmas song and will post it here.  I wanted to make PLAY songs that used real sounds and play chords, so here it is playing Silent Night. The sound files I ripped from my TankDrum thing.

NOTE: .OGG Alert for those who have problems opening files with .OGG files...

Download   

SPLAY.zip

   (385k)

Here's the source code, but you will need the SPLAY.ZIP above to run it...

- Dav

Note: Edited code to v1.02. (12/15/2020)

Code: QB64: [Select]

1. '=========
2. 'SPLAY.BAS v1.02
3. '=========
4. 'A multi-note PLAY-like method using sound files to
5. 'play notes, and allow more than one note at a time.
6. 'This demo plays Silent Night.
7. 'Coded By Dav, DEC/2020
8.  
9. 'Added: Added Rests (RN).
10. 'Fixed: Replace delay routine. Actually works now.
11. 'Fixed: Allows spaces in note groups ( )
12. 'Added: Added inkey$ bail-out of SUB playing notes
13.  
14. 'Over time I'll adapt this to math PLAY commands as
15. 'much as possible, but for now heres how you use it:
16.  
17. 'For now, there only 15 notes playable, about 2 octaves.
18. ' e1 f1 g1 a1 b1 | c2 d2 e2 f2 g2 a2 b2 | c3 d3 e3
19.  
20. 'You can play a chord of notes by grouping inside ()
21. ' (c2 e2 g2)
22.  
23. 'Assign current note/rest length values like this...
24. 'WN = Whole note, HN = Half note, DQ = Dotted quarter note
25. 'QN = Quarter note, EN = Eighth note, SN = Sixteenth note
26.  
27. 'Rests - nothing played, but time continues
28. 'RN = Rest note.  Uses current note length value set.
29. 'For example, to rest a quarter note, do this:
30. 'QN RN
31.  
32. 'Assign Tempos like this (always must be in 4 characters):
33. 'T120  ... or T060   ...  or  T100
34.  
35. 'Assign current meter (for whole length value to work)
36. 'M3  (thats for 3/4)....  M4   (Thats for 4/4)
37.  
38.  
39. '=========================================================
40.  
41. 'Sound file handles
42. DIM SHARED e1&, f1&, g1&, a1&, b1&, c2&, d2&
43. DIM SHARED e2&, f2&, g2&, a2&, b2&, c3&, d3&, e3&
44. DIM SHARED Tempo, Meter, NoteValue 'playing values
45.  
46. 'Load sound samples
47. e1& = _SNDOPEN("ogg/e1.ogg"): f1& = _SNDOPEN("ogg/f1.ogg")
48. g1& = _SNDOPEN("ogg/g1.ogg"): a1& = _SNDOPEN("ogg/a1.ogg")
49. b1& = _SNDOPEN("ogg/b1.ogg"): c2& = _SNDOPEN("ogg/c2.ogg")
50. d2& = _SNDOPEN("ogg/d2.ogg"): e2& = _SNDOPEN("ogg/e2.ogg")
51. f2& = _SNDOPEN("ogg/f2.ogg"): g2& = _SNDOPEN("ogg/g2.ogg")
52. a2& = _SNDOPEN("ogg/a2.ogg"): b2& = _SNDOPEN("ogg/b2.ogg")
53. c3& = _SNDOPEN("ogg/c3.ogg"): d3& = _SNDOPEN("ogg/d3.ogg")
54. e3& = _SNDOPEN("ogg/e3.ogg")
55.  
56.  
57. PRINT "Testing all notes...e1 to e3"
58. 'Set tempo 120, meter 4/4, set sixteen note value, play all notes
59. SPLAY "t120 m4 sn e1f1g1a1b1c2d2e2f2g2a2b2c3d3e3"
60. _DELAY 1
61.  
62. 'Note: You don't have to include spaces, but I did here...
63.  
64. PRINT "Playing chords..."
65. 'Note: tempo and meter already set in earlier call, so
66. '      below will play with that, but you can change it...
67. SPLAY "qn (c2 e2 g2) rn rn (f2a2c3) (g2b2d3) wn (c3g2e2c2g1)"
68. _DELAY 1
69.  
70. 'Now, since it's Christmas, play a Christmas song...
71.  
72. DO
73.     CLS: PRINT
74.     PRINT "Silent night...";
75.     SPLAY "t100m3dq(c2e2g2)en(c2f2a2)qn(c2e2g2)wn(g1c2e2)"
76.     PRINT "Holy night..."
77.     SPLAY "dq(c2e2g2)en(c2f2a2)qn(c2e2g2)wn(g1c2e2)"
78.     PRINT "All is calm....";
79.     SPLAY "hn(d3b2g2)qnd3(g2b2)c3(d3g2f2)"
80.     PRINT "All is bright..."
81.     SPLAY "hn(c3g2e2)en(c3g2)f2qn(c2e2g3)d2e2"
82.     PRINT "Round 'yon virgin...";
83.     SPLAY "en(a2f2)g2f2g2(a2f2)(g2b2)qn(c3a2f2)(b2g2)(a2f2)"
84.     PRINT "Mother and child...."
85.     SPLAY "dq(g2e2c2)en(a2f2)qn(g2e2)(e2c2)d2e2"
86.     PRINT "Holy Infant so ";
87.     SPLAY "en(a2f2)g2f2g2(a2f2)(g2b2)qn(c3a2f2)(b2g2)(a2f2)"
88.     PRINT "Tender and mild."
89.     SPLAY "dq(g2e2c2)en(a2f2)qn(g2e2)(e2c2)a1g1"
90.     PRINT "Sleep in heavenly peace...."
91.     SPLAY "hn(d3b2bg2f2)qn(d2b2)dq(d2f2g2)enc3qn(b2g2f2)wn(e2g2c3)(e3c3g3)"
92.     PRINT "Sleep in heavenly peace."
93.     SPLAY "qn(c3g2e2c2)g2e2dq(g2f2d2b1)enf2qnd2wn(c2g1e1)qnc3g2d2"
94. LOOP UNTIL INKEY$ <> ""
95.  
96.  
97. SUB SPLAY (Music$)
98.  
99.     'Set Defaults, just in case empty
100.     IF Tempo = 0 THEN Tempo = 60
101.     IF Meter = 0 THEN Meter = 3
102.     IF NoteValue = 0 THEN NoteValue = 1
103.  
104.     Music$ = UCASE$(Music$)
105.     cur = 1
106.  
107.     DO
108.  
109.         'skip any spaces
110.         IF MID$(Music$, cur, 1) = " " THEN cur = cur + 1
111.  
112.         'Check for tempo
113.         IF MID$(Music$, cur, 1) = "T" THEN
114.             cur = cur + 1
115.             Tempo = VAL(MID$(Music$, cur, 3)): cur = cur + 3
116.         END IF
117.  
118.         'Check for Meter
119.         IF MID$(Music$, cur, 1) = "M" THEN
120.             cur = cur + 1
121.             Meter = VAL(MID$(Music$, cur, 1)): cur = cur + 1
122.         END IF
123.  
124.         'Get notevalue
125.         SELECT CASE MID$(Music$, cur, 2)
126.             CASE IS = "DQ": cur = cur + 2: NoteValue = 1.5
127.             CASE IS = "EN": cur = cur + 2: NoteValue = .5
128.             CASE IS = "QN": cur = cur + 2: NoteValue = 1
129.             CASE IS = "HN": cur = cur + 2: NoteValue = 2
130.             CASE IS = "WN": cur = cur + 2
131.                 IF Meter = 3 THEN NoteValue = 3 ELSE NoteValue = 4
132.             CASE IS = "SN": cur = cur + 2: NoteValue = .25
133.         END SELECT
134.  
135.         'If regular note/rest found (not a group)
136.         SELECT CASE MID$(Music$, cur, 2)
137.             CASE IS = "E1": _SNDPLAYCOPY e1&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
138.             CASE IS = "F1": _SNDPLAYCOPY f1&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
139.             CASE IS = "G1": _SNDPLAYCOPY g1&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
140.             CASE IS = "A1": _SNDPLAYCOPY a1&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
141.             CASE IS = "B1": _SNDPLAYCOPY b1&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
142.             CASE IS = "C2": _SNDPLAYCOPY c2&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
143.             CASE IS = "D2": _SNDPLAYCOPY d2&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
144.             CASE IS = "E2": _SNDPLAYCOPY e2&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
145.             CASE IS = "F2": _SNDPLAYCOPY f2&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
146.             CASE IS = "G2": _SNDPLAYCOPY g2&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
147.             CASE IS = "A2": _SNDPLAYCOPY a2&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
148.             CASE IS = "B2": _SNDPLAYCOPY b2&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
149.             CASE IS = "C3": _SNDPLAYCOPY c3&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
150.             CASE IS = "D3": _SNDPLAYCOPY d3&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
151.             CASE IS = "E3": _SNDPLAYCOPY e3&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
152.             CASE IS = "RN": cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
153.         END SELECT
154.  
155.         'if group of notes found
156.         IF MID$(Music$, cur, 1) = "(" THEN
157.             cur = cur + 1
158.             'Grab up until ')' found
159.             Group$ = ""
160.             DO
161.                 a$ = MID$(Music$, cur, 1): cur = cur + 1
162.                 IF a$ = ")" THEN EXIT DO
163.                 IF a$ <> " " THEN Group$ = Group$ + a$
164.             LOOP
165.             FOR N = 1 TO LEN(Group$) STEP 2
166.                 note$ = MID$(Group$, N, 2)
167.                 IF note$ = "E1" THEN _SNDPLAYCOPY e1&
168.                 IF note$ = "F1" THEN _SNDPLAYCOPY f1&
169.                 IF note$ = "G1" THEN _SNDPLAYCOPY g1&
170.                 IF note$ = "A1" THEN _SNDPLAYCOPY a1&
171.                 IF note$ = "B1" THEN _SNDPLAYCOPY b1&
172.                 IF note$ = "C2" THEN _SNDPLAYCOPY c2&
173.                 IF note$ = "D2" THEN _SNDPLAYCOPY d2&
174.                 IF note$ = "E2" THEN _SNDPLAYCOPY e2&
175.                 IF note$ = "F2" THEN _SNDPLAYCOPY f2&
176.                 IF note$ = "G2" THEN _SNDPLAYCOPY g2&
177.                 IF note$ = "A2" THEN _SNDPLAYCOPY a2&
178.                 IF note$ = "B2" THEN _SNDPLAYCOPY b2&
179.                 IF note$ = "C3" THEN _SNDPLAYCOPY c3&
180.                 IF note$ = "D3" THEN _SNDPLAYCOPY d3&
181.                 IF note$ = "E3" THEN _SNDPLAYCOPY e3&
182.             NEXT
183.             _DELAY (60 * NoteValue / Tempo)
184.         END IF
185.  
186.         IF cur >= LEN(Music$) THEN EXIT DO
187.  
188.         IF INKEY$ <> "" THEN EXIT SUB
189.  
190.     LOOP
191.  
192.     EXIT SUB
193.  
194. END SUB
195.  

[bplus]

I see Santa's elves have been busy :)

@STxAxTIC  what fun to modify a Christmas Card or animation!
 

FluidCraft39733.txt

I suspect Dav's been smitten by the Christmas spirits ;-))

[Dav]

I suspect Dav's been smitten by the Christmas spirits ;-))

Trying to get in the mood I guess.  Finding it harder to do that this year for some reason.

I just updated the SPLAY program posted above.  Fixed something, added something.

- Dav

[bplus]

@Dav are the oggs all in separate folder? I have no problems with Explorer if I know where not to go with it but of course I use it to access the bas source. I find it easier to navigate (and perform file maintenance, like Delete, Copy, Move Files and Folders) in Explorer than QB64 IDE so I am in habit of using that specially for downloads. PS I don't visit my BlackJack files except through QB64 IDE because of the oggs.

[Dav]

No folders in the zip, just the .OGG files and the BAS zipped up altogether.  I forget whats the right way to include the .OGG files -- put them in a separate folder?

- Dav

[bplus]

No folders in the zip, just the .OGG files and the BAS zipped up altogether.  I forget whats the right way to include the .OGG files -- put them in a separate folder?

- Dav

Yes Oggs in separate and marked folder, for me and I suspect for Windows users that aren't very tech savvy (two v's ??). It's just Windows 10 (only?) Explorer without the downloaded patch you have to get at the Windows Store which means getting an account and possibly being barraged with more Windows updates, notifications or spam.

[Petr]

@Dav Very nice work. For me, this is a very exemplary explanation of notes. I saved the program, I have to study it properly in the future.

@STxAxTIC very nice program. Do I see it supposed to simulate something like thermal flow? So I wouldn't dare do that. Just the idea of doing this is just brilliant.

[bplus]

@STxAxTIC very nice program. Do I see it supposed to simulate something like thermal flow? So I wouldn't dare do that. Just the idea of doing this is just brilliant.

Yeah when I just ran FluidCraft without any drawing, I was reminded of my Particles Fountain only taken to a way higher level.

[Dav]

@Petr: Thanks!

@bplus: I repackaged the ZIP, putting the ogg files in a separate folder named ogg/.

I also added the option of including rests in the songs now. New ZIP and code.

- Dav

[bplus]

@bplus: I repackaged the ZIP, putting the ogg files in a separate folder named ogg/.

Thanks @Dav what's your favorite charity?

Update: Beautiful! Soothing for the kind of year we've all had.