+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Snowflakes (/showthread.php?tid=612)
Snowflakes - SierraKen - 07-14-2022
![[Image: Snowflakes.png]](https://i.ibb.co/SBG5rNg/Snowflakes.png)
Here is a modification (mod) of B+'s "Basic Polygon and Multiplier Mod" of snowflakes falling down. He probably has made this before but I thought I would try it myself.
Thanks B+!
Code: (Select All)
'Snowflakes - mod from B+'s Basic Polygon and Multiplier Mod
'b+ 2022-07-13, SierraKen 2022-07-13
_Title "Snowflakes" 'b+ 2022-07-13, SierraKen 2022-07-13
Dim xc(500), yc(500), r(500), n(500), x(500), y(500)
' a circle is 360 degree
' a polyon of n side has central angles 360 / n > think of a pie the central angle are the angle of slices in center
Screen _NewImage(800, 600, 32)
_ScreenMove 350, 100
Randomize Timer
Do
_Limit 30
If Rnd > .25 Then
t = t + 1
If t > 495 Then t = 0
xc(t) = Rnd * _Width
yc(t) = 1
r(t) = Rnd * 20
n(t) = Int(Rnd * 10) + 3
End If
For tt = 1 To t
yc(tt) = yc(tt) + 1
For m = 1 To n(tt) - 1
For angle = 0 To 720 Step 360 / n(tt) ' step the size of pie angles
' let xC, yC be the coordinates at the center of the pie circle
' let r be the radius of the pie
' then the n outside points are
x(tt) = xc(tt) + r(tt) * Cos(m * _D2R(angle) - _Pi / 2) ' x coordinate of outter edge point
y(tt) = yc(tt) + r(tt) * Sin(m * _D2R(angle) - _Pi / 2) ' y coordinate of outter edge point
If angle = 0 Then PSet (x(tt), y(tt)) Else Line -(x(tt), y(tt)) ' outter edge edge
Line (xc(tt), yc(tt))-(x(tt), y(tt)) ' slice from center of pie
Next
Next m
Next tt
_Display
Cls
Loop Until InKey$ = Chr$(27)RE: Snowflakes - James D Jarvis - 07-14-2022
I admit it I'm impressed by your polygons, but i like my snowflakes more branch-like
Code: (Select All)
'let it snow
'press any key to quit when running
Screen _NewImage(800, 500, 32)
Randomize Timer
Dim flakearm$(300)
Dim fx(300), fy(300), fv(300, 2), frot(300)
Color _RGB32(255, 255, 255), _RGB32(10, 10, 150)
'build flakes
For f = 1 To 300
r1 = Int(Rnd * 12) + 4
r2 = r1 / 4 + Int(Rnd * (r1 / 4))
flakearm$(f) = " r" + Str$(r1) + "f" + Str$(r2) + "h" + Str$(r2) + "e" + Str$(r2) + "g" + Str$(r2) + "r" + Str$(r1 / 2)
If Rnd * 6 > 3 Then flakearm$(f) = flakearm$(f) + "f" + Str$(r2) + "h" + Str$(r2) + "e" + Str$(r2) + "g" + Str$(r2)
If Rnd * 6 > 4 Then flakearm$(f) = flakearm$(f) + "r3" + "f" + Str$(r2 / 2) + "h" + Str$(r2 / 2) + "e" + Str$(r2 / 2) + "g" + Str$(r2 / 2) + "r2"
fx(f) = Int(Rnd * 800)
fy(f) = Int(Rnd(50)) - 80
fv(f, 1) = Rnd * (r1 / 16) - Rnd * (r1 / 16)
fv(f, 2) = Rnd * (r1 / 4)
frot(f) = Int(Rnd * 28)
Next f
'snow
Do
_Limit 30
Cls
For f = 1 To 200
For d = 0 + frot(f) To 360 + frot(f) Step 60
PSet (fx(f), fy(f))
Draw "ta" + Str$(d) + flakearm$(f)
Next d
fx(f) = fx(f) + fv(f, 1): fy(f) = fy(f) + fv(f, 2)
If fy(f) > 550 Then fy(f) = -3 * (Rnd * 30)
If fx(f) < -30 Or fx(f) > 830 Then
fx(f) = Int(Rnd * 600) + 100
fy(f) = -3 * (Rnd * 30)
frot(f) = Int(Rnd * 28)
End If
If Rnd * 8 > 6.5 Then frot(f) = frot(f) + Rnd * 1.2 - Rnd * 2.4
Next f
_Display
a$ = InKey$
Loop Until a$ <> ""RE: Snowflakes - bplus - 07-14-2022
Some more flakey designs ;-))
Code: (Select All)
_Title "draw flake test 2" ' B+ 2018-12-05 from JB 2016-11-07
' revist 2021-11-24 and demo better. ' revise again for 2022-07-14 post
Const XMAX = 400, YMAX = 400
Randomize Timer
Screen _NewImage(XMAX, YMAX, 32)
_ScreenMove 400, 150
Do
DV = 2.1 + .4 * Rnd 'global dictates density of flake
rr = 45 * Rnd + 3
For rAng = 0 To _Pi / 16 Step _Pi(1 / 120)
Cls
rFlake XMAX * .5, YMAX * .5, rr, DV, rAng
_Display
_Limit 6
Next
Loop Until _KeyDown(27)
Sub rFlake (x, y, r, DV, rAng)
'DV = flake density
Color _RGBA32(225, 225, 245, 100)
For a = 0 To 5
armX = x + r * Cos(a * _Pi(1 / 3) + rAng)
armY = y + r * Sin(a * _Pi(1 / 3) + rAng)
Line (x, y)-(armX, armY)
If r > 2.5 Then rFlake armX, armY, r / DV, DV, rAng
Next
End SubRE: Snowflakes - SierraKen - 07-14-2022
Very cool James, and good use of the draw command. B+ way cool, I wish I could learn how to do equations like that without just copying, maybe someday.
RE: Snowflakes - SierraKen - 07-14-2022
To make more realistic snowflakes, I changed n (points) to just 13 which is my favorite one. I also added background hills that change with the Space Bar and the Copy to Clipboard feature in case people want to make their own Christmas decorations or cards using another graphics program to paste it to. I also added the ability for the snowflakes to wiggle and the smaller ones move faster to simulate depth, as well as a blue sky.
![[Image: Snowflakes-with-hills.png]](https://i.ibb.co/0GTRVrB/Snowflakes-with-hills.png)
Code: (Select All)
'Snowflakes - mod from B+'s Basic Polygon and Multiplier Mod
'b+ 2022-07-13, SierraKen 2022-07-13
'Changed n to only be 13 so I got rid of n.
'Added hills and clipboard.
'Added the snowflakes to wiggle and move at different speeds.
_Title "Snowflakes - Space Bar changes hills - C copies to clipboard - Esc quits" 'b+ 2022-07-13, SierraKen 2022-07-13
Dim xc(500), yc(500), r(500), x(500), y(500), fx(500), rr(500), hillx(100), sz3(100)
Dim img As Long
Screen _NewImage(800, 600, 32)
_ScreenMove 350, 100
start:
Cls
Randomize Timer
Paint (0, 50), _RGB32(0, 128, 255)
For hills = 3 To 20
cl = 255
hillx(hills) = Rnd * 800
sz = (Rnd * 300) + 100
For sz2 = .25 To sz Step .25
cl = cl - .05
sz3(hills) = sz2
Circle (hillx(hills), 600), sz2, _RGB32(cl, cl, cl)
Next sz2
Next hills
Do
_Limit 2000
Paint (0, 50), _RGB32(0, 128, 255)
For hills = 3 To 20
cl = 255
For sz2 = .25 To sz3(hills) Step .25
cl = cl - .075
Circle (hillx(hills), 600), sz2, _RGB32(cl, cl, cl)
Next sz2
Next hills
If Rnd > .75 Then
t = t + 1
If t > 495 Then t = 0
xc(t) = Rnd * _Width
yc(t) = -40
r(t) = Rnd * 40
rr(t) = 40 / r(t)
fx(t) = (Rnd * 8) - 4
End If
For tt = 1 To t
yc(tt) = yc(tt) + rr(tt)
fx(tt) = fx(tt) + (Rnd * 8) - 4
For m = 1 To 13 - 1
For angle = 0 To 720 Step 360 / 13 ' step the size of pie angles
' let xC, yC be the coordinates at the center of the pie circle
' let r be the radius of the pie
' then the n outside points are
x(tt) = xc(tt) + r(tt) * Cos(m * _D2R(angle) - _Pi / 2) ' x coordinate of outter edge point
y(tt) = yc(tt) + r(tt) * Sin(m * _D2R(angle) - _Pi / 2) ' y coordinate of outter edge point
If angle = 0 Then PSet (x(tt) + fx(tt), y(tt)) Else Line -(x(tt) + fx(tt), y(tt)) ' outter edge edge
Line (xc(tt) + fx(tt), yc(tt))-(x(tt) + fx(tt), y(tt)) ' slice from center of pie
Next
Next m
Next tt
a$ = InKey$
If a$ = " " Then GoTo start:
If a$ = Chr$(27) Then End
If a$ = "c" Or a$ = "C" Then
_AutoDisplay
If img& <> 0 Then _FreeImage (img&)
img& = _CopyImage(0)
_ClipboardImage = img&
_Delay .25
Color _RGB32(0, 0, 0), _RGB32(0, 128, 255)
Locate 1, 1: Print "Copied To Clipboard"
Color _RGB32(255, 255, 255)
_Delay 2
End If
_Display
Cls
Loop Until InKey$ = Chr$(27)RE: Snowflakes - James D Jarvis - 07-15-2022
From watching 2 runs : You know what that last on needs don't ya? Piles of snow that grow as it snows.
RE: Snowflakes - SierraKen - 07-16-2022
Thanks for the idea James. I had done this already for a Christmas app I made a few years ago. So today I added the snowflakes to it instead of just round snow. Check it out:
Code: (Select All)
'Snowflakes 2 by SierraKen
'July 16, 2022
'Thanks to B+ for the snowflake design!
'Thanks to James D. Jarvis for the idea.
Screen _NewImage(800, 600, 32)
Dim rr(600)
Dim stackx(2000), stacky(2000), stackr(2000)
Dim cx As Integer, cy As Integer, r As Integer, c As _Unsigned Long
Dim xc(2000), yc(2000), fx(2000), x(2000), y(2000)
size = 1
_Title "Snowflakes 2"
Do
_Limit 20
a$ = InKey$
If a$ = Chr$(27) Then End
'Hill
For sz = .25 To 700 Step .25
cl = cl + .05
Circle (400, 1100), sz, _RGB32(0, cl, 0)
Next sz
cl2 = cl
cl = 0
'Tree
tx = 390: ty = 400: r = 10: c = _RGB32(255, 0, 0)
Line (tx, ty)-(tx + 20, ty - 74), _RGB32(183, 127, 127), BF
Line (tx, ty - 75)-(tx + 20, ty - 75), _RGB32(127, 255, 127)
'left side
Line (tx, ty - 75)-(tx - 150, ty - 75), _RGB32(127, 255, 127)
Line (tx - 150, ty - 75)-(tx, ty - 150), _RGB32(127, 255, 127)
cx = tx - 150: cy = ty - 75
'fillCircle cx, cy, r, c
Line (tx, ty - 150)-(tx - 100, ty - 150), _RGB32(127, 255, 127)
Line (tx - 100, ty - 150)-(tx, ty - 200), _RGB32(127, 255, 127)
cx = tx - 100: cy = ty - 150
'fillCircle cx, cy, r, c
Line (tx, ty - 200)-(tx - 50, ty - 200), _RGB32(127, 255, 127)
Line (tx - 50, ty - 200)-(tx + 5, ty - 250), _RGB32(127, 255, 127)
cx = tx - 50: cy = ty - 200
'fillCircle cx, cy, r, c
'right side
Line (tx + 20, ty - 75)-(tx + 170, ty - 75), _RGB32(127, 255, 127)
Line (tx + 170, ty - 75)-(tx + 20, ty - 150), _RGB32(127, 255, 127)
cx = tx + 170: cy = ty - 75
'fillCircle cx, cy, r, c
Line (tx + 20, ty - 150)-(tx + 120, ty - 150), _RGB32(127, 255, 127)
Line (tx + 120, ty - 150)-(tx + 20, ty - 200), _RGB32(127, 255, 127)
cx = tx + 120: cy = ty - 150
'fillCircle cx, cy, r, c
Line (tx + 20, ty - 200)-(tx + 70, ty - 200), _RGB32(127, 255, 127)
Line (tx + 70, ty - 200)-(tx + 5, ty - 250), _RGB32(127, 255, 127)
cx = tx + 70: cy = ty - 200
'fillCircle cx, cy, r, c
cx = tx + 5: cy = ty - 260
r = 10
c = _RGB32(255, 255, 127)
'fillCircle cx, cy, r, c
Paint (tx, ty - 77), _RGB32(127, 255, 127)
If Rnd > .96 Then
tt = tt + 1
If tt > 495 Then tt = 0
xc(tt) = Rnd * _Width
yc(tt) = -40
rr(tt) = (Rnd * 20) + 10
fx(tt) = (Rnd * 8) - 4
End If
For t = 1 To tt
yc(t) = yc(t) + 1
yc(t) = yc(t) + (Rnd * 5)
fx(t) = fx(t) + (Rnd * 8) - 4
For m = 1 To 13 - 1
For angle = 0 To 720 Step 360 / 11
x(t) = xc(t) + rr(t) * Cos(m * _D2R(angle) - _Pi / 2)
y(t) = yc(t) + rr(t) * Sin(m * _D2R(angle) - _Pi / 2)
If angle = 0 Then PSet (x(t) + fx(t), y(t)) Else Line -(x(t) + fx(t), y(t))
Line (xc(t) + fx(t), yc(t))-(x(t) + fx(t), y(t))
Next
Next m
cl2 = Int(cl2)
For check = 100 To 200 Step .25
If Point(xc(t), yc(t) + rr(t) + 1) = _RGB32(0, check, 0) Then GoTo stacked:
Next check
If Point(xc(t), yc(t) + rr(t) + 1) = _RGB32(127, 255, 127) Then GoTo stacked:
'If Point(xc(t), yc(t) + rr(t) + 1) = _RGB32(255, 255, 127) Then GoTo stacked:
'If Point(xc(t), yc(t) + rr(t) + 1) = _RGB32(255, 0, 0) Then GoTo stacked:
Next t
nex:
If snow <> 0 Then
For sn = 1 To snow
cx = stackx(sn)
cy = stacky(sn)
r = stackr(sn)
c = _RGB32(252, 252, 252)
fillCircle cx, cy, r, c
Next sn
End If
_Display
Line (0, 0)-(_Width, _Height), _RGB32(0, 0, 0), BF
Loop
stacked:
snow = snow + 1
If snow > 1800 Then snow = 1: size = 1
If snow / 200 = Int(snow / 200) Then size = size * 1.4
stackx(snow) = xc(t)
stacky(snow) = yc(t) - (size / 2) + rr(t)
stackr(snow) = (rr(t) / 2) + size
xc(t) = -200: yc(t) = 800: rr(t) = 0
GoTo nex:
'from Steve Gold standard
Sub fillCircle (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, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End SubRE: Snowflakes - vinceg2022 - 07-19-2022
Very mesmerizing Ken, nice job
RE: Snowflakes - James D Jarvis - 07-19-2022
nice.
RE: Snowflakes - SierraKen - 07-19-2022
Thanks guys!
