## Some Animated Cloud Action, Improved Again!

Zamaster
Posts: 1024
Joined: Jun 20, 2005 21:40
Contact:

### Some Animated Cloud Action, Improved Again!

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 ExplicitCONST FinalSZ AS INTEGER = 128CONST IndSZ   AS INTEGER = 16Const IndSZM  As INTEGER = IndSZ-1Dim 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) = 1QuickSelect(2) = 2QuickSelect(3) = 4QuickSelect(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 SubSub 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 SubSub 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 SubSub 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 SubDim 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 cvEnd SubSub 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 SubSub 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     screenunlockEnd SubSub 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 SubSub 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,1screenset 1,0Randomize TimerDim as double  iT(1 to 4), iTs(1 to 4)Dim as integer i, bExponentialiT(1) = 100: iTs(1)=.001: SmoothNoise: Resample 1,2,1iT(2) = 100: iTs(2)=.002: SmoothNoise: Resample 2,2,2iT(3) = 100: iTs(3)=.005: SmoothNoise: Resample 3,2,4iT(4) = 100: iTs(4)=.010: SmoothNoise: Resample 4,2,8Do    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           FlipLoop 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:
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)
anonymous1337
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California
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: 1024
Joined: Jun 20, 2005 21:40
Contact:
Its not changing very fast partially because its sposed to, try holding down the spacebar : )
cha0s
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:
it's cool, the alpha makes them look fluffy...
KristopherWindsor
Posts: 2428
Joined: Jul 19, 2006 19:17
Location: Sunnyvale, CA
Contact:
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?
anonymous1337
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California
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.
Posts: 659
Joined: Oct 27, 2005 14:40
Location: Sweden
Contact:
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
Cool one.
Zamaster
Posts: 1024
Joined: Jun 20, 2005 21:40
Contact:
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
very cool :) would be cool if you mapped it onto a globe
Zamaster
Posts: 1024
Joined: Jun 20, 2005 21:40
Contact:
not a bad idea, ill see if it still doesnt yutz along at 2 fps or something If I ceiling map it.
Zamaster
Posts: 1024
Joined: Jun 20, 2005 21:40
Contact:
Okay, just for kicks, heres a serene little scene with ceiling mapped faux clouds... and FAUX BUSHES!!!!

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

Dr_D
Posts: 2396
Joined: May 27, 2005 4:59
Contact:
That's pretty damn cool man! I like that little scene. ;)
acetoline
Posts: 228
Joined: Oct 27, 2006 6:50
Contact:
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 ;)