Jazzy Blocks 🟦🟥🟪🟩🟨🟧🎵🎶🔊

[FellippeHeitor]

Here's Jazzy Blocks. You can run the code below (available here just for reference) without the files in the zip, but it won't be half as jazzy.

Inspired by this: https://www.reddit.com/r/oddlysatisfying/comments/tm37bn/these_squares_bouncing/?utm_source=share&utm_medium=ios_app&utm_name=iossmf

Piano notes from https://archive.org/details/24-piano-keys

Unpack to your QB64 folder, both the .bas and the notes subfolder.

 

Code: QB64: [Select]

1. Type Box
2.     As Single x, y, xv, yv, w, h, lastPlayed
3.     As Long sound
4.     As _Unsigned Long color
5. End Type
6.  
7. Dim As Box box(1 To 13), this
8.  
9. Screen _NewImage(600, 600, 32)
10. _Title "Jazzy Blocks"
11.  
12. size = 40
13. Randomize Timer
14. initialX = 0
15. initialY = _Height - size
16. Restore notes
17. For i = 1 To 13
18.     box(i).w = size
19.     box(i).h = size
20.     box(i).x = initialX
21.     box(i).y = initialY
22.     box(i).xv = map(i, 1, 13, .5, 2.5) 'going right
23.     box(i).yv = map(i, 1, 13, -.5, -3) 'going up
24.     box(i).color = hsb(map(i, 1, 13, 0, 180), 255, 127, 255)
25.     Read note
26.     fileName$ = "./24-piano-keys/key" + Right$("0" + LTrim$(Str$(note)), 2) + ".ogg"
27.     If _FileExists(fileName$) Then
28.         box(i).sound = _SndOpen(fileName$)
29.     End If
30. Next
31.  
32. notes:
33. 'notes files are named key##.ogg, ranging from
34. '01 (F) to 24 (E, two octaves up); these are
35. 'the desired notes, but you can change the
36. 'scale to play here, if you know what you're
37. 'after.
38. Data 1,3,5,6,8,10,12,13,15,17,18,20,22
39.  
40. Do
41.     Line (0, 0)-(_Width - 1, _Height - 1), _RGB32(51), BF
42.  
43.     For i = 1 To 12
44.         this = box(i)
45.         Line (this.x + this.w / 2, this.y + this.h / 2)-(box(i + 1).x + box(i).w / 2, box(i + 1).y + box(i).h / 2), _RGB32(0)
46.     Next
47.  
48.     For i = 1 To 13
49.         this = box(i)
50.         Line (this.x, this.y)-Step(this.w, this.h), this.color, BF
51.         Line (this.x, this.y)-Step(this.w, this.h), _RGB32(0), B
52.  
53.         If timeElapsedSince(this.lastPlayed) < 1 Then
54.             ripple = map(timeElapsedSince(this.lastPlayed), 0, 1, 1, 15)
55.             rippleAlpha = map(ripple, 1, 15, 127, 0)
56.             Line (this.x - ripple, this.y - ripple)-Step(this.w + ripple * 2, this.h + ripple * 2), _RGB32(255, rippleAlpha), B
57.  
58.             ripple = map(timeElapsedSince(this.lastPlayed), 0, .5, 1, 15)
59.             rippleAlpha = map(ripple, 1, 15, 64, 0)
60.             Line (this.x - ripple, this.y - ripple)-Step(this.w + ripple * 2, this.h + ripple * 2), _RGB32(255, rippleAlpha), B
61.         End If
62.  
63.         this.x = this.x + this.xv
64.         this.y = this.y + this.yv
65.  
66.         bump = 0
67.         If this.x + this.w > _Width Then this.x = _Width - this.w: this.xv = this.xv * -1: bump = -1
68.         If this.x < 0 Then this.x = 0: this.xv = this.xv * -1: bump = -1
69.         If this.y + this.h > _Height Then this.y = _Height - this.h: this.yv = this.yv * -1: bump = -1
70.         If this.y < 0 Then this.y = 0: this.yv = this.yv * -1: bump = -1
71.         If bump <> 0 And this.sound <> 0 Then _SndPlayCopy this.sound: this.lastPlayed = Timer
72.  
73.         box(i) = this
74.     Next
75.     _Display
76.     _Limit 60
77. Loop
78.  
79. Function map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
80.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
81. End Function
82.  
83. Function hsb~& (__H As _Float, __S As _Float, __B As _Float, A As _Float)
84.     Dim H As _Float, S As _Float, B As _Float
85.  
86.     H = map(__H, 0, 255, 0, 360)
87.     S = map(__S, 0, 255, 0, 1)
88.     B = map(__B, 0, 255, 0, 1)
89.  
90.     If S = 0 Then
91.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
92.         Exit Function
93.     End If
94.  
95.     Dim fmx As _Float, fmn As _Float
96.     Dim fmd As _Float, iSextant As Integer
97.     Dim imx As Integer, imd As Integer, imn As Integer
98.  
99.     If B > .5 Then
100.         fmx = B - (B * S) + S
101.         fmn = B + (B * S) - S
102.     Else
103.         fmx = B + (B * S)
104.         fmn = B - (B * S)
105.     End If
106.  
107.     iSextant = Int(H / 60)
108.  
109.     If H >= 300 Then
110.         H = H - 360
111.     End If
112.  
113.     H = H / 60
114.     H = H - (2 * Int(((iSextant + 1) Mod 6) / 2))
115.  
116.     If iSextant Mod 2 = 0 Then
117.         fmd = (H * (fmx - fmn)) + fmn
118.     Else
119.         fmd = fmn - (H * (fmx - fmn))
120.     End If
121.  
122.     imx = _Round(fmx * 255)
123.     imd = _Round(fmd * 255)
124.     imn = _Round(fmn * 255)
125.  
126.     Select Case Int(iSextant)
127.         Case 1
128.             hsb~& = _RGBA32(imd, imx, imn, A)
129.         Case 2
130.             hsb~& = _RGBA32(imn, imx, imd, A)
131.         Case 3
132.             hsb~& = _RGBA32(imn, imd, imx, A)
133.         Case 4
134.             hsb~& = _RGBA32(imd, imn, imx, A)
135.         Case 5
136.             hsb~& = _RGBA32(imx, imn, imd, A)
137.         Case Else
138.             hsb~& = _RGBA32(imx, imd, imn, A)
139.     End Select
140. End Function
141.  
142. Function timeElapsedSince! (startTime!)
143.     If startTime! > Timer Then startTime! = startTime! - 86400
144.     timeElapsedSince! = Timer - startTime!
145. End Function
146.  

[STxAxTIC]

saw this on reddit. nice.