CloudGen, a fractal generator for clouds, terrains, planets

Previous topic - Next topic

sf-in-sf

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

On the day the atom is a cube I will start believing in the square pixel.

mentalthink

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:

erico

This looks great, heck, such a small code!
I must give a try soon.  :good: