🎄🎁✨ Holiday Season Code Sampler 2021

[FellippeHeitor]

🎄☃️🔔

Lights and jingly bells are already all around.

If you're already feeling inspired by @SMcNeill's season project, get it going so you can also be featured in this year's traditional sampler.

Let's group entries under this thread. Rules are the same as last year's: Make it beautiful, preferably with no extra files.

Who'll start?
✨🎁

[FellippeHeitor]

It's also time to remember last year's samples, which can be viewed in the video below, with the delightful soundtrack provided by our very own @Dav:

[FellippeHeitor]

Also notice that by sharing your works of art in this thread, you hereby grant me the right to include your entry in the video we'll feature in our YouTube channel.

🤩

[Dav]

Lol, had I’d known it was going to be a soundtrack I’d had prepared something better than that,  it it was fun last year participating with everyone though. 

- Dav

[madscijr]

It's also time to remember last year's samples, which can be viewed in the video below, with the delightful soundtrack provided by our very own @Dav:

This is great!
I'm so glad to have found QB64 and the wonderful community around it...

[bplus]

More Lights:

Code: QB64: [Select]

1. _Title "More Lights" 'b+ 2021-11-28
2. ' ref:   https://justbasiccom.proboards.com/thread/759/polinom-interpolation-3-points
3. ' mod to xmax tree ?
4. ' 2021-12-02 start More Lights mod
5.  
6.  
7. Const sw = 600, sh = 700, cx = sw / 2, cy = sh / 2, treeAreaDvPI = 22707
8. Screen _NewImage(sw, sh, 32)
9. _ScreenMove 320, 40
10. Randomize Timer
11. Dim As Integer topLight
12. lastTopLight = 2
13. topLight = 50
14. Dim Shared pX(1 To 3), pY(1 To 3)
15. ReDim lx(1 To topLight), ly(1 To topLight)
16.  
17. moreLights:
18. Cls
19. 'tree
20. stepper = .75 * sh / 12
21. For y = .125 * sh To .875 * sh Step stepper
22.     r = (y - .125 * sh) * Sin(_Pi(1 / 12))
23.     pX(1) = cx - r: pX(2) = cx: pX(3) = cx + r
24.     pY(1) = y: pY(2) = y - 1.5 * stepper: pY(3) = y
25.     'Line (pX(1), pY(1))-(pX(3), pY(3)), &HFF00FF00
26.     For x = pX(1) To pX(3)
27.         If Rnd < .75 Then PSet (x, para(x)), &HFF005500
28.     Next
29.     pY(2) = y - .5 * stepper
30.     For x = pX(1) To pX(3)
31.         If Rnd < .15 Then PSet (x, para(x)), &HFF005500
32.     Next
33. Next
34.  
35. 'lights
36.  
37. lx(1) = cx: ly(1) = .125 * sh - .5 * stepper - 5
38. Circle (lx(1), ly(1)), 4, &HFFFFFF88 ' topper
39. Circle (lx(1), ly(1)), 6, &HFFFFFFFF
40. For r = 3 To 30 Step 1
41.     fcirc lx(1), ly(1), r, &H03FFFFFF
42. Next
43. dTopSq = Sqr(treeAreaDvPI / (topLight - .5 * topLight)) ' best spread of lights
44. For i = lastTopLight To topLight ' save 1 for top of tree
45.     If i Mod 100 = 0 Then 'light the whole area around the tree
46.         If i > 1200 Then
47.             For rr = 0 To sh Step 1
48.                 fcirc cx, cy, rr, _RGB32(255, 255 - rr / 2, 200 - rr, 20)
49.                 _Limit 250 + 2 * rr
50.             Next
51.             GoTo finished
52.         Else
53.             For rr = cy To 0 Step -20
54.                 fcirc cx, cy, rr, _RGB32(255, 255, 255, 1)
55.             Next
56.         End If
57.     End If
58.  
59.     again:
60.     x = Rnd * sw + 1: y = Rnd * sh + 1
61.     If y > .125 * sh And y <= .875 * sh Then
62.         If x > cx - (y - .125 * sh) * Sin(_Pi(1 / 12)) And x < cx + (y - .125 * sh) * Sin(_Pi(1 / 12)) Then
63.  
64.             ' dang have to space them out better
65.             If i > 2 Then
66.                 ok = -1
67.                 For j = 1 To i - 1
68.                     d = ((lx(j) - x) ^ 2 + (ly(j) - y) ^ 2) ^ .5
69.                     If d < dTopSq Then ok = 0: Exit For
70.                 Next
71.                 If ok Then
72.                     rc~& = _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
73.                     For r = 0 To 2 Step .5
74.                         Circle (x, y), r, rc~&
75.                     Next
76.                     For r = 3 To 10 Step 1
77.                         fcirc x, y, r, &H03FFFFFF
78.                     Next
79.  
80.                     lx(i) = x: ly(i) = y ' save the place
81.                 Else
82.                     GoTo again
83.                 End If
84.             End If
85.         Else
86.             GoTo again
87.         End If
88.     Else
89.         GoTo again
90.     End If
91. Next
92. ' Beep ' make sure we finish in reasonable amount of time  ie balance number of lights to distance d
93. startLights = Timer
94. pause = pause + 2
95. While Timer - startLights < (3 + pause) And _KeyDown(27) = 0
96.     Locate 1, 1: Print topLight ', dTopSq
97.     rl = Int(Rnd * (topLight - 1)) + 1
98.     rc~& = _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
99.     For r = 0 To 2 Step .5
100.         If lx(rl) <> 0 And ly(rl) <> 0 Then Circle (lx(rl), ly(rl)), r, rc~&
101.     Next
102.     _Limit 15
103. Wend
104. Cls
105. s$ = "More lights!"
106. _PrintString ((_Width - Len(s$) * 8) / 2, _Height / 2 - 8), s$
107. _Delay 2
108. topLight = topLight + .5 * topLight
109. ReDim lx(1 To topLight), ly(1 To topLight)
110. GoTo moreLights
111.  
112. finished:
113. Cls
114. _Delay 2
115. s$ = "Oops,  ZZZ..."
116. _PrintString ((_Width - Len(s$) * 8) / 2, _Height / 2 - 8), s$
117. Sleep
118. s$ = "Have a Merry (and safe) Christmas!"
119. _PrintString ((_Width - Len(s$) * 8) / 2, _Height / 2 - 8), s$
120.  
121.  
122.  
123. Function para (x)
124.     'uses shared arrays  pX(), pY()
125.     y = 0
126.     For i = 1 To 3
127.         p = 1
128.         For j = 1 To 3
129.             If i <> j Then
130.                 p = p * (x - pX(j)) / (pX(i) - pX(j))
131.             End If
132.         Next
133.         y = y + pY(i) * p
134.     Next
135.     para = y
136. End Function
137.  
138. 'from Steve Gold standard
139. Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
140.     Dim Radius As Long, RadiusError As Long
141.     Dim X As Long, Y As Long
142.     Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
143.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
144.     Line (CX - X, CY)-(CX + X, CY), C, BF
145.     While X > Y
146.         RadiusError = RadiusError + Y * 2 + 1
147.         If RadiusError >= 0 Then
148.             If X <> Y + 1 Then
149.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
150.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
151.             End If
152.             X = X - 1
153.             RadiusError = RadiusError - X * 2
154.         End If
155.         Y = Y + 1
156.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
157.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
158.     Wend
159. End Sub
160.  
161.  

[FellippeHeitor]

Thanks for getting it started, bplus! That was gorgeous (and fun)!

[Dav]

Beautiful tree & lights, @bplus! Nice subtle twinkles.

- Dav

[bplus]

Thanks guys, the fun is why I am ruined for any other PL! ;-))

[Dav]

Well, I want to contribute something at least this year, so here's a couple things I posted earlier this year combined to make a simple Christmas puzzle.  It's a a Picture un-scrambler with falling snowflakes effect and some background music.  BAS Code is too big to post, so it's attached.  It's big because it has encode files in the code.  It will create 3 files on first run in the current directory, xmasdav2021.jpg,  xmasdav2021.png,  xmasdav2021.ogg.

Merry Christmas!

- Dav

  [ You are not allowed to view this attachment ]   (465k)

[bplus]

Nice one Dav!

I like the snow fall while doing the puzzle and the Christmas music is a nice break from regular car radio stuff repeated more than TV commercials.

[FellippeHeitor]

Well, I want to contribute something at least this year, so here's a couple things I posted earlier this year combined to make a simple Christmas puzzle.  It's a a Picture un-scrambler with falling snowflakes effect and some background music.  BAS Code is too big to post, so it's attached.  It's big because it has encode files in the code.  It will create 3 files on first run in the current directory, xmasdav2021.jpg,  xmasdav2021.png,  xmasdav2021.ogg.

Merry Christmas!

- Dav

  [ You are not allowed to view this attachment ]   (465k)

So much fun, Dav!

Damn, you guys are already setting the bar pretty high this year! 🤩

[Dav]

Thanks, @bplus & @FellippeHeitor.  I should have thanked @SMcNeill in the code for his contribution to my snowflake code - he fixed it earlier this year to help it work fast enough to be used in this way. (Thanks, Steve!)

- Dav

[FellippeHeitor]

Here's my lazy first submission, the Lazy Laser Xmas Tree:

Code: QB64: [Select]

1. Option _Explicit
2. Randomize Timer
3. Screen _NewImage(600, 600, 32)
4.  
5. Dim m$
6. m$ = "*** Merry Christmas, QB64 Community! ***"
7.  
8. Dim As Integer i
9. Type coord
10.     As Integer x, y, size
11.     As _Unsigned Long c
12.     As Single inc, angle
13. End Type
14. Dim As coord this, ornament(50), tree(1 To 3)
15.  
16. tree(1).x = _Width / 2
17. tree(1).y = 30
18. tree(2).x = 0
19. tree(2).y = _Height - 10
20. tree(3).x = _Width
21. tree(3).y = _Height - 10
22.  
23. ornament(1).x = tree(1).x
24. ornament(1).y = tree(1).y
25. ornament(1).size = 30
26. ornament(1).c = _RGB32(211, 183, 22)
27. ornament(1).inc = .5
28. Do
29.     'fade to black cls
30.     Line (0, 0)-(_Width - 1, _Height - 1), _RGB32(0, 15), BF
31.  
32.     'tree
33.     Line (tree(1).x, tree(1).y)-(Rnd * _Width, _Height - 10), _RGB32(0, 255, 0, 100)
34.  
35.     'ornaments
36.     For i = 1 To UBound(ornament)
37.         'initialize as needed
38.         If ornament(i).c = 0 Then
39.             Do
40.                 ornament(i).y = tree(1).y + (_Height - (10 + tree(1).y)) * Rnd
41.                 ornament(i).x = _Width * Rnd
42.             Loop Until isInside(tree(1), tree(2), tree(3), ornament(i))
43.             ornament(i).size = 10 * Rnd
44.             ornament(i).c = _RGB32(255 * Rnd, 255 * Rnd, 255 * Rnd)
45.             ornament(i).inc = _Pi(.3)
46.             ornament(i).angle = _Pi(Rnd)
47.         End If
48.  
49.         ornament(i).angle = ornament(i).angle + ornament(i).inc
50.         If ornament(i).angle > _Pi(2) Then ornament(i).angle = ornament(i).angle - (_Pi(2))
51.  
52.         this = ornament(i)
53.         Line (this.x, this.y)-Step(Cos(this.angle) * this.size, Sin(this.angle) * this.size), this.c
54.     Next
55.  
56.     printMessage m$
57.  
58.     _Limit 15
59. Loop Until _KeyHit
60.  
61. Sub printMessage (text$)
62.     Static x As Integer, setup As _Byte
63.     Dim As Integer y, i, tempX
64.     If setup = 0 Then x = _Width - _FontWidth: setup = -1
65.     tempX = x
66.     For i = 1 To Len(text$)
67.         If tempX < 0 Then tempX = tempX + _FontWidth: _Continue
68.         y = _Height / 2 + Sin(tempX)
69.         Color _RGB32(255), _RGB32(0, 100)
70.         _PrintString (tempX, y), Mid$(text$, i, 1)
71.         tempX = tempX + _FontWidth
72.     Next
73.     x = x - 1
74.     If x < -(_PrintWidth(text$)) Then x = _Width - _FontWidth
75. End Sub
76.  
77. Function area! (t1 As coord, t2 As coord, t3 As coord)
78.     'from https://www.geeksforgeeks.org/check-whether-a-given-point-lies-inside-a-triangle-or-not/
79.     '/* A utility function to calculate area of triangle formed by (x1, y1),
80.     '   (x2, y2) and (x3, y3) */
81.     area! = Abs((t1.x * (t2.y - t3.y) + t2.x * (t3.y - t1.y) + t3.x * (t1.y - t2.y)) / 2.0)
82. End Function
83.  
84. Function isInside%% (t1 As coord, t2 As coord, t3 As coord, p As coord)
85.     'from https://www.geeksforgeeks.org/check-whether-a-given-point-lies-inside-a-triangle-or-not/
86.     '/* A function to check whether point P(x, y) lies inside the triangle formed
87.     '   by A(x1, y1), B(x2, y2) and C(x3, y3) */
88.     Dim As Single A, A1, A2, A3 'area of triangles ABC, PBC, PAC, PAB
89.  
90.     A = area!(t1, t2, t3)
91.     A1 = area!(p, t2, t3)
92.     A2 = area!(t1, p, t3)
93.     A3 = area!(t1, t2, p)
94.  
95.     isInside%% = (A = A1 + A2 + A3)
96. End Function

[bplus]

@FellippeHeitor That's pretty neat how you determine if a point is inside a triangle.

More ornaments! ;-))