Some Animated Cloud Action, Improved Again!

Source-code only - please, don't post questions here.
Zamaster
Posts: 1020
Joined: Jun 20, 2005 21:40
Contact:

Some Animated Cloud Action, Improved Again!

Postby Zamaster » Dec 30, 2006 2:08

Okay, I know its sloppy, poorly organized and very inefficient. I powered through this in an hour just for fun. Enjoy, and the texture is seamless too in the event that anybody would have a use for it.

One of the reasons its not very fast is because its employs realtime bi-linear filtering, resampling, smoothing and dynamic interpolation.

Code: Select all

Option Explicit

CONST FinalSZ AS INTEGER = 128
CONST IndSZ   AS INTEGER = 16


Const IndSZM  As INTEGER = IndSZ-1


Dim shared as integer Tile(1 To IndSZ, 1 To IndSZ), FinalIMG(1 to FinalSZ, 1 To FinalSZ)
Dim shared as integer PT(1 To 4, 1 To 3, 1 To FinalSZ, 1 To FinalSZ)
Dim shared as integer QuickSelect(1 to 4)
QuickSelect(1) = 1
QuickSelect(2) = 2
QuickSelect(3) = 4
QuickSelect(4) = 8
 
Sub SmoothNoise()
    Dim as integer x,y
    For y = 1 to IndSZ
        For x = 1 To IndSZ
            Tile(x,y) = int(rnd * 256) - 128
        Next x
    Next y
   
    dim as integer x1, x2, y1, y2, c, s, m, Temp(1 To IndSZ, 1 To IndSZ)
    For y = 1 to IndSZ
        If y=1 Then
            y1 = IndSZ
            y2 = 2
        Elseif y=IndSZ then
            y1 = IndSZM
            y2 = 1
        else
            y1 = y-1
            y2 = y+1
        Endif
        For x = 1 To IndSZ
            If x=1 Then
                x1 = IndSZ
                x2 = 2
            Elseif x=IndSZ then
                x1 = IndSZM
                x2 = 1
            else
                x1 = x-1
                x2 = x+1
            Endif
            c = (Tile(x1,y1)+Tile(x2,y1)+Tile(x1,y2)+Tile(x2,y2)) SHR 4
            s = (Tile(x ,y1)+Tile(x2,y )+Tile(x ,y2)+Tile(x1,y )) SHR 3
            m = Tile(x,y) SHR 2
            Temp(x,y) = c+s+m
        Next x
    Next y

    For y=1 To IndSZ:For x=1 To IndSZ:Tile(x,y)=Temp(x,y):Next x:Next y

End Sub

Sub Resample(byval tle as integer, byval wne as integer, byval amt as double)
    dim as double  fz, fzm, xm, ym, xd, yd, v1,v2,v3,v4,l1,l2
    dim as integer Temp(1 To FinalSZ, 1 To FinalSZ),x,y,xs,ys,f1
    fz  = FinalSZ / amt
    fzm = IndSZ/fz
    ym = 1
    For y = 1 to FinalSZ
        ym += fzm
        If int(ym) = IndSZ+1 Then ym = 1
        ys  = Int(ym)
        yd  = ym-ys
        xm  = 1
        For x = 1 To FinalSZ
            xm += fzm
            If int(xm) = IndSZ+1 Then xm = 1
            xs  = Int(xm)
            xd  = xm-xs
            v1 = Tile(xs,ys)
            If xs >= IndSZ and ys <> IndSZ Then
                v2 = Tile(1   ,ys  )
                v3 = Tile(1   ,ys+1)
                v4 = Tile(xs  ,ys+1)
            Elseif xs >= IndSZ and ys >= IndSZ then
                v2 = Tile(1   ,ys  )
                v3 = Tile(1   ,1   )
                v4 = Tile(xs  ,1   )
            Elseif xs <> IndSZ and ys >= IndSZ Then
                v2 = Tile(xs+1,ys  )
                v3 = Tile(xs+1,1   )
                v4 = Tile(xs  ,1   )
            else
                v2 = Tile(xs+1,ys  )
                v3 = Tile(xs+1,ys+1)
                v4 = Tile(xs  ,ys+1)
            Endif
            l1 = (v2-v1) * xd + v1
            l2 = (v3-v4) * xd + v4
            f1 = (l2-l1) * yd + l1
            PT(tle,wne,x,y) = f1
        Next x
    Next y 
End Sub

Sub AddToFinal(byval tle2 as integer)
    Dim as integer x,y
    For y=1 To FinalSZ:For x=1 To FinalSZ
        FinalIMG(x,y)+=(PT(tle2,3,x,y) / QuickSelect(tle2))
        If FinalIMG(x,y)<-128 Then FinalIMG(x,y)=-128
        If FinalIMG(x,y)> 127 Then FinalIMG(x,y)= 127
    Next x:Next y
End Sub
Sub ResetFinal()
    Dim as integer x,y
    For y=1 To FinalSZ:For x=1 To FinalSZ:FinalIMG(x,y)=0:Next x:Next y
End Sub

Dim shared as integer EX(0 To 255)
Sub Exponential()
    Dim as integer c,d,cv
    For cv = 0 To 255
        c = cv-128
        If c<0 Then c=0
        d = 255-((0.95^c)*255)
        EX(cv)=d
    Next cv
End Sub

Sub CreateFinal()
    Dim as integer x,y
    For y=1 To FinalSZ
        For x=1 To FinalSZ
            FinalIMG(x,y)=EX(FinalIMG(x,y)+128)
        Next x
    Next y
End Sub

Sub DrawFinal(byval ox as integer, byval oy as integer)
    Dim as integer x,y,c,xx,yy
    screenlock
    For y=1 To FinalSZ
        For x=1 To FinalSZ
            c=FinalIMG(x,y)
            xx=ox+x:yy=oy+y
            PSET (xx,yy), RGB(c,c,c)
        Next x
    Next y
    screenunlock
End Sub

Sub SwapChannels(byval tle as integer)
    Dim as integer x,y
    For y=1 To FinalSZ
        For x=1 To FinalSZ
            PT(tle,1,x,y) = PT(tle,2,x,y)
        Next x
    Next y
End Sub


Sub InterpolateChannels(byval tle as integer, byval amt as double)
    Dim as integer x,y, itf
    For y=1 To FinalSZ
        For x=1 To FinalSZ
            PT(tle,3,x,y) = (PT(tle,2,x,y)-PT(tle,1,x,y)) * amt + PT(tle,1,x,y)
        Next x
    Next y
End Sub

'-------------------------------------------MAIN--------------------------------
screenres 320,200,32,2,1
screenset 1,0
Randomize Timer
Dim as double  iT(1 to 4), iTs(1 to 4)
Dim as integer i, b
Exponential
iT(1) = 100: iTs(1)=.001: SmoothNoise: Resample 1,2,1
iT(2) = 100: iTs(2)=.002: SmoothNoise: Resample 2,2,2
iT(3) = 100: iTs(3)=.005: SmoothNoise: Resample 3,2,4
iT(4) = 100: iTs(4)=.010: SmoothNoise: Resample 4,2,8


Do
    ResetFinal
    b = 0
    If multikey(&H39) Then b = 1
    For i = 1 To 4
        If iT(i) >= 1 Then
            iT(i) = 0
            SwapChannels i
            SmoothNoise
            Resample i,2,QuickSelect(i)
        Else
            If b = 1 Then
                iT(i) += iTs(i)*10
            Else
                iT(i) += iTs(i)
            Endif
            InterpolateChannels i, iT(i)
        Endif
        AddToFinal i
    Next i
   
    CreateFinal
   
    Locate 13,3: Print "FAUX ClOUDS -->"
    Line (155,32)-(284,161),&HFFFF00,B
    Line (156,33)-(283,160),rgb(100,120,255),B
    DrawFinal 155,32

   
   
    Flip
Loop until multikey(&h01)
end

Last edited by Zamaster on Dec 31, 2006 21:32, edited 3 times in total.
n00b
Posts: 26
Joined: Aug 17, 2006 1:12
Contact:

Postby n00b » Dec 30, 2006 3:04

Thats pretty cool. And what do you mean by sloppy, poorly organized, and inefficient. Thats some of the cleaness code I have seen in a long time. (Probally because the only code I have seen lately is mine)
Pritchard
Posts: 5425
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

Postby Pritchard » Dec 30, 2006 3:22

Zamaster. You think ANY code that isn't full of 100 GOTOs is spaghetti code, for whatever reason. Did you use any GOTO's at all? Trust me, GOTO's are your inefficiencies. Anyways, lemme actually run this code.

That's very nice looking code, actually. However, what's it's speed? It took a fair while over here for changes to be made. I see no sleep so I imagine it's just not as fast as it could be. Perhaps what you meant by it's inefficiency?

Wow. Those clouds are amazing. I had no idea that clouds could even be rendered with that little code.
Zamaster
Posts: 1020
Joined: Jun 20, 2005 21:40
Contact:

Postby Zamaster » Dec 30, 2006 3:30

Its not changing very fast partially because its sposed to, try holding down the spacebar : )
cha0s
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Postby cha0s » Dec 30, 2006 5:39

it's cool, the alpha makes them look fluffy...
KristopherWindsor
Posts: 2428
Joined: Jul 19, 2006 19:17
Location: Sunnyvale, CA
Contact:

Postby KristopherWindsor » Dec 30, 2006 5:58

I notice the program tries to run in full screen, but it can't for me, so it runs in a window. Can other people see this in full-screen?
Pritchard
Posts: 5425
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

Postby Pritchard » Dec 30, 2006 5:59

KristopherWindsor wrote:I notice the program tries to run in full screen, but it can't for me, so it runs in a window. Can other people see this in full-screen?
You probably don't support 320 x 200 resolution.
badmrbox
Posts: 659
Joined: Oct 27, 2005 14:40
Location: Sweden
Contact:

Postby badmrbox » Dec 30, 2006 15:40

Yeah, it's probably like that. It runs in fullscreen for me and I no prob with 320x200. The program looks nice -the clouds looks like clouds and it runs in a good speed. I would also say that the code looks good to :)
E.K.Virtanen
Posts: 785
Joined: May 28, 2005 9:19
Location: Finland

Postby E.K.Virtanen » Dec 30, 2006 18:08

Cool one.
Zamaster
Posts: 1020
Joined: Jun 20, 2005 21:40
Contact:

Postby Zamaster » Dec 30, 2006 18:58

I said what I did about the code because I planned it badly. I didnt take into account how the cloud cover would morph while I was creating the method to generate them. So I ended up using the slowest combination of methods to draw the clouds >_<. The algorithm re-samples smaller images to create a smoother cloud cover, they morph by generating similar large bitmaps in which the original maps interpolate to. If I had thought about it before I started coding, I wouldve cut out the re-sampling and just gone straight perlin noise bitmaps. Than just lowered the octaves in each successive layer. Ah well, it still works, just not as well as I had hoped.
Veggiet
Posts: 156
Joined: Apr 17, 2006 19:41

Postby Veggiet » Dec 30, 2006 19:17

very cool :) would be cool if you mapped it onto a globe
Zamaster
Posts: 1020
Joined: Jun 20, 2005 21:40
Contact:

Postby Zamaster » Dec 31, 2006 2:39

not a bad idea, ill see if it still doesnt yutz along at 2 fps or something If I ceiling map it.
Zamaster
Posts: 1020
Joined: Jun 20, 2005 21:40
Contact:

Postby Zamaster » Dec 31, 2006 3:19

Okay, just for kicks, heres a serene little scene with ceiling mapped faux clouds... and FAUX BUSHES!!!!

http://www.box.net/public/xn7d0ludn2

^^^^download link^^^^
Dr_D
Posts: 2345
Joined: May 27, 2005 4:59
Contact:

Postby Dr_D » Dec 31, 2006 3:54

That's pretty damn cool man! I like that little scene. ;)
acetoline
Posts: 228
Joined: Oct 27, 2006 6:50
Contact:

Postby acetoline » Dec 31, 2006 6:36

That is a VERY neat effect. I'm definitely going to use that at some point in the future. I hope you don't mind ;)

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests