Liberty BASIC Community Forum
« Winter fun 2016 Snow Scene »

Welcome Guest. Please Login or Register.
Sep 19th, 2017, 9:02pm


Rules|Home|Help|Search|Recent Posts|Notification


« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 sticky  Author  Topic: Winter fun 2016 Snow Scene  (Read 289 times)
Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Winter fun 2016 Snow Scene
« Thread started on: Nov 1st, 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 3rd, 2016, 09:22am by Rod » User IP Logged

Jack Kelly
New Member
Image


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 17
xx Re: Winter fun 2016 Snow Scene
« Reply #1 on: Nov 10th, 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 ";WindowWidth-MarginX;" ";WindowHeight-MarginY
    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(i-1,2) then gr$ = gr$;"size ";flake(i,2);";"
      flag = 0
      if rnd(1) < 0.02 then
        if flake(i,0) < WindowWidth-MarginX and flake(i,1) < WindowHeight-MarginY 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 10th, 2016, 04:10am by Rod » User IP Logged

Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Rules|Home|Help|Search|Recent Posts|Notification

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls