Tree + lights + options

Merry Christmas to all the Friends of Basic!

Here is idea worked on a little more, started last year, programmable Tree lights. 

Use digits 0 to 9 for color palette and letters e, d for diagonls or v, h for vertical or horizontal plasma color striping.

Option _Explicit
_Title "Programmable Tree Lights v4" ' b+ 2020-12-19 2022-12-18 fixed k$ v3 random position lights v4 more!
Randomize Timer
Const Xmax = 700, Ymax = 700, N_Rows = 10, N_Cols = 2 * N_Rows - 1
Const X_Spacer = 30, Y_Spacer = 52, X_Offset = 50
Type ColorSeed
   Red As Single
   Green As Single
   Blue As Single
End Type
Dim Shared ColorSet(10) As ColorSeed, ColorSetIndex As Long
Dim Shared pR, pG, pB, pN, pStart, pMode$
Dim Shared As Long TG(1 To N_Cols, 1 To N_Rows), Rd(1 To N_Cols, 1 To N_Rows), Rd2(1 To N_Cols, 1 To N_Rows)
Screen _NewImage(Xmax, Ymax, 32)
_Delay .25
_ScreenMove _Middle
Dim As Long i, row, Col, nstars, back, cc
Dim horizon, r, land
Dim l$, o$, b$, k$
' setup some color seeds in ColorSet user can change out with Shift + digit key
For i = 0 To 9 ' 10 random color seeds
   resetPlasma
   ColorSet(i).Red = pR: ColorSet(i).Green = pG: ColorSet(i).Blue = pB
Next

'Stringing the lights on tree, adjusted to fit mostly on the tree   2*N - 1 Pryramid
For row = 1 To 10
   l$ = xStr$(2 * row - 1, "X")
   o$ = xStr$(10 - row, "O")
   b$ = o$ + l$ + o$
   For Col = 1 To N_Cols
       If Mid$(b$, Col, 1) = "O" Then TG(Col, row) = 0 Else TG(Col, row) = -1
       Rd(Col, row) = Rnd * 8 - 4
       Rd2(Col, row) = Rnd * 10 - 5
   Next
   Print b$
Next

' making the stars
horizon = Ymax - 4 * r
nstars = 100
Dim xstar(100), ystar(100), rstar(100)
For i = 1 To 100
   xstar(i) = Rnd * (Xmax): ystar(i) = Rnd * horizon:
   If i < 75 Then
       rstar(i) = 0
   ElseIf i < 95 Then
       rstar(i) = 1
   Else
       rstar(i) = 2
   End If
Next
Cls
' make a circle tree and align circles to tree with spacers and offsets with new Pyramid Scheme
'Pinetree 25, 30, 650, 600
'FOR row = 1 TO N_Rows
'    FOR col = 1 TO N_Cols
'        IF TG(col, row) THEN CIRCLE (col * X_Spacer + X_Offset, row * Y_Spacer), 10
'    NEXT
'NEXT

' making the background
back = _NewImage(_Width, _Height, 32)
Cls
horizon = Ymax - 100
For i = 0 To horizon
   Line (0, i)-(Xmax, i), _RGB32(i / horizon * 70, i / horizon * 22, 60 * (i) / horizon)
Next
land = Ymax - horizon
For i = horizon To Ymax
   cc = 128 + (i - horizon) / land * 127
   Line (0, i)-(Xmax, i), _RGB32(cc, cc, cc)
Next
For i = 1 To 100
   fcirc xstar(i), ystar(i), rstar(i), &HFFEEEEFF
Next
_PutImage , 0, back

ColorSetIndex = 1: pMode$ = "h"
show ' avoid the pause for key checking
Do
   k$ = InKey$
   If Len(k$) Then
       If InStr("0123456789", k$) > 0 Then
           ColorSetIndex = Val(k$)
       ElseIf InStr("vhde", k$) > 0 Then
           pMode$ = k$
       End If
   End If
   _PutImage , back, 0
   show
   _Display
   _Limit 10
Loop Until _KeyDown(27)

Sub show
   Dim row, prow, col
   _Title "Programmable Tree Lights    (0-9) Color Set: " + TS$(ColorSetIndex) + "      (v, h, d, e) Mode: " + pMode$

   pR = ColorSet(ColorSetIndex).Red: pG = ColorSet(ColorSetIndex).Green: pB = ColorSet(ColorSetIndex).Blue
   pStart = pStart + 1
   Select Case pMode$
       Case "h"
           For row = 1 To N_Rows
               prow = pStart + row
               For col = 1 To N_Cols
                   pN = prow
                   If TG(col, row) Then Lite col * X_Spacer + X_Offset + Rd(col, row), row * Y_Spacer + 7 * Sin(col * X_Spacer + X_Offset) + 1.3 * col + 5, Plasma~&
               Next
           Next
       Case "v"
           For row = 1 To N_Rows
               For col = 1 To N_Cols
                   pN = pStart + col
                   If TG(col, row) Then Lite col * X_Spacer + X_Offset + Rd(col, row), row * Y_Spacer + 7 * Sin(col * X_Spacer + X_Offset) + 1.3 * col + 5, Plasma~&
               Next
           Next
       Case "d"
           For row = 1 To N_Rows
               For col = 1 To N_Cols
                   pN = pStart + col - row
                   If TG(col, row) Then Lite col * X_Spacer + X_Offset + Rd(col, row), row * Y_Spacer + 7 * Sin(col * X_Spacer + X_Offset) + 1.3 * col + 5, Plasma~&
               Next
           Next
       Case "e"
           For row = 1 To N_Rows
               For col = 1 To N_Cols
                   pN = pStart + row + col
                   If TG(col, row) Then Lite col * X_Spacer + X_Offset + Rd(col, row), row * Y_Spacer + 7 * Sin(col * X_Spacer + X_Offset) + 1.3 * col + 5, Plasma~&
               Next
           Next

   End Select


   Pinetree 25, 30, 650, 600

   pR = ColorSet(ColorSetIndex).Red: pG = ColorSet(ColorSetIndex).Green: pB = ColorSet(ColorSetIndex).Blue
   pStart = pStart + 1
   Select Case pMode$
       Case "h"
           For row = 1 To N_Rows
               prow = pStart + row
               For col = 1 To N_Cols
                   pN = prow
                   If TG(col, row) Then Lite col * X_Spacer + X_Offset + Rd2(col, row), row * Y_Spacer + 7 * Sin(col * X_Spacer + X_Offset) - 1.3 * col + 5, Plasma~&
               Next
           Next
       Case "v"
           For row = 1 To N_Rows
               For col = 1 To N_Cols
                   pN = pStart + col
                   If TG(col, row) Then Lite col * X_Spacer + X_Offset + Rd2(col, row), row * Y_Spacer + 7 * Sin(col * X_Spacer + X_Offset) - 1.3 * col + 5, Plasma~&
               Next
           Next
       Case "d"
           For row = 1 To N_Rows
               For col = 1 To N_Cols
                   pN = pStart + col - row
                   If TG(col, row) Then Lite col * X_Spacer + X_Offset + Rd2(col, row), row * Y_Spacer + 7 * Sin(col * X_Spacer + X_Offset) - 1.3 * col + 5, Plasma~&
               Next
           Next
       Case "e"
           For row = 1 To N_Rows
               For col = 1 To N_Cols
                   pN = pStart + row + col
                   If TG(col, row) Then Lite col * X_Spacer + X_Offset + Rd2(col, row), row * Y_Spacer + 7 * Sin(col * X_Spacer + X_Offset) - 1.3 * col + 5, Plasma~&
               Next
           Next

   End Select
End Sub


Sub Lite (x, y, c As _Unsigned Long)
   Dim cR, cG, cB, cA, r
   cAnalysis c, cR, cG, cB, cA
   For r = 35 To 0 Step -2
       fcirc x, y, r, _RGB32(cR, cG, cB, 1)
   Next
   fcirc x, y, 4, c
End Sub

Sub Pinetree (treeX, treeY, wide, high)
   Dim bpx, bpy, tpx, bpxx, bpyy, aa, ra, tpy, ht, xs, xsh, rs, tpxx, tpyy, fra, x1, x2, y1, y2, wf, hf
   'tannen baum by PeterMaria W  orig 440x460
   'fits here  LINE (0, 0)-(440, 410), , B
   Static t&
   If t& = 0 Then
       t& = _NewImage(440, 410, 32)
       _Dest t&
       bpx = 220: bpy = 410
       tpx = bpx
       For aa = -4 To 4
           bpxx = bpx + aa
           bpyy = bpy - 390
           Line (bpxx, bpy)-(bpx, bpyy), _RGB32(30, 30, 0)
       Next
       ra = 160
       tpy = bpy - 40
       For ht = 1 To 40
           For xs = -100 To 100 Step 40
               xsh = xs / 100
               rs = Rnd * 4 / 10
               tpxx = tpx + (xsh * ra)
               tpyy = tpy - rs * ra
               Line (tpx, tpy)-(tpxx, tpyy), _RGB32(50, 40, 20)
               For aa = 1 To 30
                   fra = Rnd * 10 / 10 * ra
                   x1 = tpx + (xsh * fra)
                   y1 = tpy - rs * fra
                   x2 = tpx + xsh * (fra + ra / 5)
                   y2 = tpy - rs * fra + (-rs + (Rnd * 8) / 10 - 0.4) * (ra / 5)
                   Line (x1, y1)-(x2, y2), _RGB32(Rnd * 80, Rnd * 70 + 40, Rnd * 60)
               Next
           Next
           ra = ra - 4
           tpy = tpy - 9
       Next
       _Dest 0
   End If
   wf = wide / 440: hf = high / 410
   _PutImage (treeX, treeY)-Step(440 * wf, 410 * hf), t&, 0
End Sub

Sub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)
   outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)
End Sub

Function Plasma~& ()
   pN = pN + 1 'dim shared cN as _Integer64, pR as integer, pG as integer, pB as integer
   Plasma~& = _RGB32(127 + 127 * Sin(pR * pN), 127 + 127 * Sin(pG * pN), 127 + 127 * Sin(pB * pN))
End Function

Sub resetPlasma ()
   pR = Rnd ^ 2: pG = Rnd ^ 2: pB = Rnd ^ 2: pN = 0
End Sub

Function xStr$ (x, strng$)
   Dim i, rtn$
   For i = 1 To x
       rtn$ = rtn$ + strng$
   Next
   xStr$ = rtn$
End Function

Function TS$ (n As Integer)
   TS$ = _Trim$(Str$(n))
End Function

'from Steve Gold standard
Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
   Dim Radius As Integer, RadiusError As Integer
   Dim X As Integer, Y As Integer
   Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
   If Radius = 0 Then PSet (CX, CY), C: Exit Sub
   Line (CX - X, CY)-(CX + X, CY), C, BF
   While X > Y
       RadiusError = RadiusError + Y * 2 + 1
       If RadiusError >= 0 Then
           If X <> Y + 1 Then
               Line (CX - Y, CY - X)-(CX + Y, CY - X), C
               Line (CX - Y, CY + X)-(CX + Y, CY + X), C
           End If
           X = X - 1
           RadiusError = RadiusError - X * 2
       End If
       Y = Y + 1
       Line (CX - X, CY - Y)-(CX + X, CY - Y), C
       Line (CX - X, CY + Y)-(CX + X, CY + Y), C
   Wend
End Sub


And look you can view it in action On-line!
Well this forum is screwing up the text in link, try linking from here:
qb64phoenix.com/forum/showthread.php?tid=1305&pid=11830#pid11830
Click View in QBJS

or from here:
basic4all.epizy.com/index.php?topic=298.15
Click giant blue link paragraph just after "Thanks dbox"

or from here:
qb64.boards.net/thread/69/tree-lights-options
The link is 2 reply in thread, again a giant blue paragraph.

Thankyou dbox for your work and help with QBJS