Dark Bit Factory & Gravity

PROGRAMMING => Freebasic => Topic started by: DrewPee on November 22, 2007

Title: Help with Snow . . . please?
Post by: DrewPee on November 22, 2007
Hello again!
Can anybody help me? I have created a snowstorm sort of thing . . . lol!
I have basically altered my starfield code and now it looks a little like snow
What I am struggling with is getting the snow to accumulate at the bottom of the screen, my code wraps the snow back to the top of the screen.
Not sure if this is very clear . . . and yes it is for the christmas comp so if nobody wants to help I will understand!!
The code in question was posted on here a couple of months ago . . . as a parallax starfield.

Regards and thanks (again)

Drew
Title: Re: Help with Snow . . . please?
Post by: Jim on November 22, 2007
Instead of checking every snowflake against 480 (or whatever the bottom y of the screen is), keep an array of 640 (or screen width) of height values.  One for each x pixel.  Initialise each of the 640 members of the array to 479.  Then, when snowflakes move down, instead of stopping or wrapping them when y >= 480, stop them when they hit the value in the array, and set the array to be the new y value.
Code: [Select]
...
for x=0 to 639
height(x)=479
next
...
...
for s = 0 to n_flakes
...
if flakes(s).y > height(flakes(s).x)
  height(flakes(s).x) = flakes(s).y
  flakes(s).dead = true
end if
...
next

Jim
Title: Re: Help with Snow . . . please?
Post by: DrewPee on November 22, 2007
Jim,
Thanks for the quick reply! I think I know what you mean! I will try and figure it out from what you have just said . . .

thanks again

Drew
Title: Re: Help with Snow . . . please?
Post by: Shockwave on November 22, 2007
The thing that you'll also need to take into account when you use the method Jim gives you there is clearing the screen :) You won't want to erase your newly created snowdrift would you?

Title: Re: Help with Snow . . . please?
Post by: DrewPee on November 22, 2007
@Shockwave - yeah! that is a major problem as I have just found out . . . buggery! I will take another look when I get time.
It is like I need to create an array for the screen and keep that refreshing instead of a blank screen?
Bloody hell I thought this would be easy . . . ive got a great idea for the xmas demo as well!

Drew
Title: Re: Help with Snow . . . please?
Post by: Jim on November 22, 2007
You could avoid the problem by
Code: [Select]
for x =0 to 639
  for y=height(flakes(x).y) to 479
    draw_flake(x,y)
  next
next
You'll be redrawing all the stacked flakes every time, but you can cls now!

Jim
Title: Re: Help with Snow . . . please?
Post by: DrewPee on November 22, 2007
Here is my code so far . . . see what you think . . .
If you can imagine, i want the snow to stack up on the white block at the bottom, this will eventually be a graphic/image of a bank of snow (sort of).

option explicit
#include once "tinyptc.bi"
#include once "crt.bi"

const xres = 640
const yres = 480
Dim shared as Integer NS
NS=256
Dim shared as Integer x(ns),y(ns)
dim shared as integer r,g,b
Dim shared as Integer a,w
dim shared as integer g1(xres),h1(xres),j1(xres)
Dim shared as String key
Declare Sub DrawSnow
Declare Sub MoveSnow
Declare Sub DrawGround

for a=0 to ns-1
    x(a)=int(rnd(1)*xres)
    y(a)=24+int(rnd(1)*(yres-48))
next   

r=255:g=255:b=255

If(ptc_open("Christmas 'Snow' Demo",XRES,YRES)=0) Then
End -1
End If
Dim Shared sb(xres*yres)
#define PP(x,y,argb) sb(y*XRES+x)=argb

for a=0 to xres-1   
    g1(a)=0
    h1(a)=5+int(rnd(1)*31)
    j1(a)=-int(rnd(1)*7)+int(rnd(1)*14)
next a   

while key<>chr$(27)
    key = inkey$()
    DrawGround
    DrawSnow
    MoveSnow
    ptc_update @sb(0)
    memset @sb(0),0,xres*yres*4
Wend

Sub DrawSnow
    for a=0 to ns-1
        pp(x(a),g1(a),rgb(r,g,b))
        g1(a)=g1(a)+h1(a)
        x(a)=x(a)+j1(a)
        if x(a)<0 then x(a)=x(a)=xres-15
        if x(a)>xres-1 then x(a)=15
        j1(a)=-int(rnd(1)*7)+int(rnd(1)*15)
    next a
End Sub

Sub MoveSnow
    for a=0 to ns-1
        if g1(a)>=yres-1 then g1(a)=0
        for w=0 to 30000:next w     ' yeah i know - very lazy!!!!!
    next a
End Sub

Sub DrawGround
    for a=0 to xres-1
        for w=420 to yres-1
            pp(a,w,rgb(r,g,b))
        next w
    next a
End Sub

This is very lazy code at the moment! my timing is shite so far!
Cheers
Andy
Title: Re: Help with Snow . . . please?
Post by: Jim on November 22, 2007
Some tiny mods showing what I mean
Code: [Select]
option explicit
#include once "tinyptc.bi"
#include once "crt.bi"

const xres = 640
const yres = 480
Dim shared as Integer NS
NS=256
Dim shared as Integer x(ns),y(ns)
dim shared as integer r,g,b
Dim shared as Integer a,w
dim shared as integer g1(xres),h1(xres),j1(xres)
Dim shared as String key
Declare Sub DrawSnow
Declare Sub MoveSnow
Declare Sub DrawGround

dim shared height(xres) as integer

for a=0 to ns-1
    x(a)=int(rnd(1)*xres)
    y(a)=24+int(rnd(1)*(yres-48))
next   

r=255:g=255:b=255

If(ptc_open("Christmas 'Snow' Demo",XRES,YRES)=0) Then
End -1
End If
Dim Shared sb(xres*yres)
#define PP(x,y,argb) sb(y*XRES+x)=argb

for a=0 to xres-1   
    g1(a)=0
    h1(a)=5+int(rnd(1)*31)
    j1(a)=-int(rnd(1)*7)+int(rnd(1)*14)
    height(a)=420 'yres-1
next a   

while key<>chr$(27)
    key = inkey$()
    DrawGround
    DrawSnow
    MoveSnow
    ptc_update @sb(0)
    memset @sb(0),0,xres*yres*4
Wend

Sub DrawSnow
    for a=0 to ns-1
        pp(x(a),g1(a),rgb(r,g,b))
        g1(a)=g1(a)+h1(a)
        x(a)=x(a)+j1(a)
        if x(a)<0 then x(a)=x(a)=xres-15
        if x(a)>xres-1 then x(a)=15
        j1(a)=-int(rnd(1)*7)+int(rnd(1)*15)
    next a

    for a=0 to xres-1

for b=height(a) to yres-1
pp(a,b,rgb(r,g,b))
next
    next

End Sub

Sub MoveSnow
    for a=0 to ns-1
if g1(a)>height(x(a)) then
if height(x(a))>0 then
height(x(a)) = height(x(a))-1
end if
g1(a)=0
end if

        rem if g1(a)>=yres-1 then g1(a)=0

        rem for w=0 to 30000:next w     ' yeah i know - very lazy!!!!!
rem yeah, shite, don't ever do that ;-)
    next a
    Sleep(16) 'if you must pause, do this
End Sub

Sub DrawGround
    for a=0 to xres-1
        for w=420 to yres-1
            pp(a,w,rgb(r,g,b))
        next w
    next a
End Sub

The bar growing real quick on the left is because of the way you wrap the flakes going off the right hand side.

Jim
Title: Re: Help with Snow . . . please?
Post by: DrewPee on November 23, 2007
Jim,
That is exactly what i wanted!!!
Thanks so much for that! really appreciated.

Drew
Title: Re: Help with Snow . . . please?
Post by: Shockwave on November 23, 2007
You should be using ptc_ext for this too Drew :)

There's no reason to have to slow down your code if you use that.
Title: Re: Help with Snow . . . please?
Post by: DrewPee on November 24, 2007
Thanks Shockwave - I noticed that as well, now changed.

Thanks to both Jim and Shockwave for help and advice (again!!!)

Please find attached an exe of the effect so far.

Drew
Title: Re: Help with Snow . . . please?
Post by: Shockwave on November 25, 2007
Yay!
Title: Re: Help with Snow . . . please?
Post by: Rbz on November 25, 2007
Thanks Shockwave - I noticed that as well, now changed.

Thanks to both Jim and Shockwave for help and advice (again!!!)

Please find attached an exe of the effect so far.

Drew
Works fine here Drew