BASIC

Author Topic: CloudGen, a fractal generator for clouds, terrains, planets  (Read 1222 times)

Offline sf-in-sf

  • Mr. Drawsprite
  • **
  • Posts: 92
  • Artist F.P. Brixey
    • View Profile
    • My computed art project
I wanted to see the sky...  :happy: it took me a few hours. Now I can die in peace.
I don't guarantee it's 100% right, but it works. Image size must be 2^n+1. This fractal generator is the base for anything like terrains: you will have to re-map colors to heights of the map/image. Those textures can be mapped later to low-poly surfaces, for fast 3D.
   Limitations: a) how to make images larger than the screen? even with CREATESCREEN() I don't get it. b) MEM2SPRITE() looks fast but a similar function is needed in order to accept directly a 2D array[][], and possibly setup the image size automatically.
   What else? ...  Licence? use and modify at will, but don't sell it without my consent. Credits: please mention my artist's name: F.P. Brixey
   Some post-stretching helps further (see pictures).
Here is a useful reference: http://www.gameprogrammer.com/fractal.html
Now go and be creative! -oh, and share your best groundbreaking images here. Thank you.
CloudGen.gbas:
Code: GLBasic [Select]
// --------------------------------- //
// Project: CloudGen
// Start: Tuesday, March 17, 2015
// IDE Version: 12.308


// SETCURRENTDIR("Media") // go to media files

CONSTANT N%= 9 //  image size = 2^N
CONSTANT startval=0xf000
CONSTANT damping=0.72277 //high value-> high contrast. lo ->no fine tesseling.
                                        // min. value should be 0.5 i.e. 50%
GLOBAL shift=0.03611 // i.e. % of displacement. Low values produce haze.

        GLOBAL s2%=twoPn(N)+1 , xx%=twoPn(N)
GLOBAL im_dat%[]; //DIM im_dat[s2*s2] // 1D only!
GLOBAL tmp%[]   ; DIM tmp[s2][s2];

GLOBAL range%=twoPn(N-1)

//set start values of 4 corners. Subdivide the square later, and reign.
tmp[0 ][0 ]=startval
tmp[0 ][xx]=startval
tmp[xx][0 ]=startval
tmp[xx][xx]=startval

GOSUB fill

GOSUB mem2s

SHOWSCREEN ; MOUSEWAIT ; END ;

fn.gbas:
Code: GLBasic [Select]
// --------------------------------- //
// Project: CloudGen
// Start: Tuesday, March 17, 2015
// IDE Version: 12.308



FUNCTION twoPn: n%
RETURN ASL(0x1,n)
ENDFUNCTION

FUNCTION setminmax: BYREF a, mi, ma
IF a<mi THEN a=mi
IF a>ma THEN a=ma
ENDFUNCTION

FUNCTION frnd:
?IFDEF PHASE1+
        STATIC a=0.41,b
                IF RND(1)
                        b= a*(RND(2000)-1000.0)*0.001
                        RETURN b
                ELSE
                        RETURN 0.0
                ENDIF
?ELSE
        RETURN 0.0
?ENDIF
ENDFUNCTION

SUB fill:

// GLOBAL s2%=twoPn(N)+1
// DIM tmp[s2][s2];
// GLOBAL range%=twoPn(N-1) //start value.
// CONSTANT rough=0.5 ; GLOBAL shift=0.4

// Say the output values are 32bits.
// 123
// 456
// 789 Supplied: 1379
//      Goal:    2 456 8

?IF 0
STATIC i%,j%,s5%,ste%
STATIC nb%=1

REPEAT
        ste=twoPn(N-nb+1)
        ste=twoPn(N-nb+1)
//      INC div; ste=(s2-1)/div

        FOR i=1 TO nb
        FOR j=1 TO nb
                setheight(tmp[i*ste][j*ste],tmp[(i+1)*ste][(j+1)*ste]) //5
        NEXT; NEXT;

        INC nb
UNTIL (N-nb+1)<0
?ENDIF

//////////////////////////////

ini:
LOCAL incr%=twoPn(N), i%, i2%
LOCAL j%,j2% //  xx%=twoPn(N)
LOCAL cnt%=0

REPEAT
        i=0
        REPEAT
        //      DEBUG incr ; DEBUG " "
                i2=i+incr

                        j=0
                        REPEAT
                                //DEBUG j ; DEBUG "_" ; DEBUG incr ; DEBUG "  ";
                                j2=j+incr
                                        tmp[(i+i2)*0.5][ j        ]=setheight(tmp[i][j],tmp[i2][j])
                                        tmp[ i        ][(j+j2)*0.5]=setheight(tmp[i][j],tmp[i][j2])

                                        tmp[(i+i2)*0.5][ j2       ]=setheight(tmp[i][j2],tmp[i2][j2])
                                        tmp[ i2       ][(j+j2)*0.5]=setheight(tmp[i2][j],tmp[i2][j2])
IF RND(100)>33 //let's mix the 2
                                        tmp[i+incr*0.5][j+incr*0.5]=setheight(tmp[i][j],tmp[i2][j2]) //produces diagonals.
ELSE
                                        tmp[i+incr*0.5][j+incr*0.5]=setheight(tmp[i+incr*0.5][j],tmp[i+incr*0.5][j2]) //no effect?
ENDIF
                                j=j2 ; INC j2,incr
                        UNTIL j2>xx


                i=i2 ; INC i2,incr
        UNTIL i2>xx
//      ASR(incr,1) //  x0.5 ASR not working!!!
        incr=incr*0.5
        shift=shift*damping

        //(debugging safety, sorry) INC cnt; IF cnt>144 THEN END
UNTIL incr < 2
//DEBUG "fill finished.   "
ENDSUB

SUB mem2s:
LOCAL a,col
//DEBUG MEM2SPRITE(......)    --> 1 or 0.
?IF 0 // long method... because 1 dimpush[] per pixel. not good.
//this section is excluded from pgm.
FOR i%=0 TO xx; FOR j%=0 TO xx;
        IF tmp[i][j]>startval //0x10000
                DIMPUSH im_dat[], 0xff007700//tmp[i][j] //orientation correct?
        ELSE
                DIMPUSH im_dat[], 0xaaffffff
        ENDIF
NEXT; NEXT;

IF MEM2SPRITE(im_dat[],0,s2,s2) THEN DEBUG "MEM2S' is o.k. "// :( Same size! 1D array only!
?ENDIF

//\/\/\/\/\/\/\/\/\/\/\/ faster:



FOR i%=0 TO xx; FOR j%=0 TO xx;

        a=((tmp[i][j])/startval +(0.2-1.0))/0.4 -1.0; setminmax(a,-0.99,-0.001)
        //ALPHAMODE a/2550
        //col=a*RGB(200,5,8) + (1.0-a)*RGB(250,250,250)
        ALPHAMODE 0
        col=0xbb3333
        SETPIXEL i,j, col  //no, use a single DRAWRECT at the start.
        ALPHAMODE a
        col=0xeeeeee
        SETPIXEL i,j, col //

NEXT; NEXT;

//MEM2SPRITE() could be faster, but accepts only 1D arrays.
ENDSUB

FUNCTION setheight: a,b
//STATIC k
//k=RND(3636)
IF RND(1)
        //RETURN (a+b)*0.5*(1+shift*100/RND(100)) // wow!
        RETURN (a+b)*0.5*(1+shift*(1.0+RND(1)*0.5))
ELSE
        RETURN (a+b)*0.5*(1-shift)
ENDIF
// or make up your own law of displacement. Be creative.
ENDFUNCTION
 
« Last Edit: 2015-Mar-22 by sf-in-sf »
On the day the atom is a cube I will start believing in the square pixel.

Offline mentalthink

  • Prof. Inline
  • *****
  • Posts: 3318
  • Integrated Brain
    • View Profile
Interesting code, when I compiled I get the 3rd image... seems very real Sky. :o

This it's like do a shader?¿ , perhaps making some modifications can be use for do procedural textures in movement over surfaces directly in Basic.

I liked a lot the program...  :booze:

Online erico

  • Community Developer
  • Prof. Inline
  • ******
  • Posts: 4041
    • View Profile
    • Portfolio
This looks great, heck, such a small code!
I must give a try soon.  :good: