Author 
Topic: Winter fun 2016 Snow Scene (Read 242 times) 

Rod
Global Moderator
member is offline
Graphics = goosebumps!
Gender:
Posts: 5287


Winter fun 2016 Snow Scene
« Thread started on: Nov 1^{st}, 2016, 04:14am » 

It is winter in the northern hemisphere, time to retire indoors and code. So if you cannot see the snow falling, draw some.
Create a snow scene either with moving text or graphically. The more realistic the action the better. Will it accumulate on the ground? Will it hang on branches?
Post your finished result here or if you need help with code post in the general board.

« Last Edit: Nov 3^{rd}, 2016, 09:22am by Rod » 
Logged




Jack Kelly
New Member
member is offline
Gender:
Posts: 17


Re: Winter fun 2016 Snow Scene
« Reply #1 on: Nov 10^{th}, 2016, 02:45am » 

The author would like to share this creation with all the LB Community.
"There are a few interesting features. Firstly it draws a different tree every time it is run, using a fractal algorithm with random terms; I think it's quite realistic. Secondly it contains a 'getpixel' function which works without an API call, by reading from a saved BMP file (not an original idea by any means, but I coded this one from scratch)."
Code: ' Snow Scene for Liberty BASIC,
' (C) 2016 Richard Russell, http://www.rtrussell.co.uk/
WindowWidth = 800
WindowHeight = 600
UpperLeftX = (DisplayWidth  WindowWidth)/2
UpperLeftY = (DisplayHeight  WindowHeight)/2
Flakes = 500
global Flakes
dim flake(Flakes,2)
nomainwin
open "Snow Scene" for graphics_nsb as #w
#w "trapclose quit"
call getmargins MarginX, MarginY
floor = WindowHeight  MarginY
#w "fill 0 0 200; down; rule over"
call branch WindowWidth/3, WindowHeight, WindowHeight/5, 1.6, 10
#w "flush; rule xor"
#w "getbmp tree 0 0 ";WindowWidthMarginX;" ";WindowHeightMarginY
bmp$ = getbmp$("tree")
call initflakes
timer 20, [animate]
wait
[animate]
timer 0
winda = (winda + rnd(1)/10) mod (8 * atn(1))
wind = sin(winda)
gr$ = ""
for i = 1 to Flakes
if flake(i,2) <> flake(i1,2) then gr$ = gr$;"size ";flake(i,2);";"
flag = 0
if rnd(1) < 0.02 then
if flake(i,0) < WindowWidthMarginX and flake(i,1) < WindowHeightMarginY then
if getpixel(bmp$, flake(i,0), flake(i,1)) = 0 then flag = 1
end if
end if
if flake(i,1) > floor or flag then
gr$ = gr$;"color white;rule over;"
gr$ = gr$;"set ";int(flake(i,0));" ";int(flake(i,1));";"
gr$ = gr$;"color black;rule xor;"
flake(i,0) = rnd(1) * WindowWidth
flake(i,1) = rnd(1) * 10
else
gr$ = gr$;"set ";int(flake(i,0));" ";int(flake(i,1));";"
end if
flake(i,0) = flake(i,0) + wind
flake(i,1) = flake(i,1) + rnd(1)*3 + 1
gr$ = gr$;"set ";int(flake(i,0));" ";int(flake(i,1));";"
next
#w gr$ + "segment seg;flush"
#w "delsegment ";seg
floor = floor  0.01
timer 20, [animate]
wait
sub initflakes
gr$ = ""
for i = 1 to Flakes
flake(i,0) = rnd(1) * (WindowWidth + 200)  100
flake(i,1) = rnd(1) * WindowHeight
flake(i,2) = int(rnd(1) * 4 + 1)
gr$ = gr$;"size ";flake(i,2);";"
gr$ = gr$ + "set ";int(flake(i,0));" ";int(flake(i,1));";"
next
#w gr$
end sub
sub branch x1, y1, size, angle, depth
x2 = x1  size * cos(angle)
y2 = y1  size * sin(angle)
#w "size ";depth;";line ";x1;" ";y1;" ";x2;" ";y2
if depth > 0 then
call branch x2, y2, size * (rnd(1)/5 + 0.64), angle  0.1  rnd(1)/2, depth  1
call branch x2, y2, size * (rnd(1)/5 + 0.64), angle + 0.1 + rnd(1)/2, depth  1
if depth > 2 then
call branch (x1+x2)/2, (y1+y2)/2, size * 0.4, angle + rnd(1)  0.5, depth  3
end if
end if
end sub
sub getmargins byref x, byref y
#w "home;posxy xpos ypos"
x = WindowWidth  2 * xpos
y = WindowHeight  2 * ypos
end sub
function getbmp$(bmp$)
dummy = mkdir("\temp\")
bmpsave bmp$, "\temp\";bmp$;".bmp"
open "\temp\";bmp$;".bmp" for input as #f
getbmp$ = input$(#f, lof(#f))
close #f
kill "\temp\";bmp$;".bmp"
end function
function getpixel(bmp$, x, y)
b = asc(mid$(bmp$,29,1)) / 8
o = asc(mid$(bmp$,11,1)) + 256*asc(mid$(bmp$,12,1)) + 1
w = asc(mid$(bmp$,19,1)) + 256*asc(mid$(bmp$,20,1))
h = asc(mid$(bmp$,23,1)) + 256*asc(mid$(bmp$,24,1))
w = ((w * b) + 3) and 4
y = h  y  1
getpixel = asc(mid$(bmp$,o+b*int(x)+w*int(y),1))
end function
sub quit h$
close #h$
end
end sub

« Last Edit: Nov 10^{th}, 2016, 04:10am by Rod » 
Logged




