
( FILE
( 	SATURNUS
(
( DESCRIPTION
( 	Creates a saturn planet with rings consisting of particles
(
( USAGE
(	Execute this file as a macro
( ---------------------------------------------------------------

6.28    FCONSTANT PI2

FVARIABLE fPartSize    	( size of one particle 
FVARIABLE fPlanetSize	( sizeo of the planet to be created
VARIABLE iPartCnt      	( number of particles in one ring
VARIABLE iCircCnt      	( number of rings
FVARIABLE fTemp
VARIABLE aBusyHnd

( Defaults
0.01 fPartSize	 FSTORE
1.0  fPlanetSize FSTORE
100  iPartCnt    STORE
10   iCircCnt    STORE


( Material for planet 

iLOCK_EXCL MAT_LOCK

"planet" ( name )
0 ( specularity )
25 ( specbright )
0 ( brilliancy )
0 ( transparency )
0 ( turbidity )
0 ( refraction )
0 ( currindex )
100 ( effectiveness )
0 ( density )
0 ( roughness )
204 ( flags )
46 ( turbidpower )
6 ( method )
0 ( handler )
0 ( txt_freqx )
0 ( txt_freqy )
0 ( sp_x )
0 ( sp_y )
1 ( sp_w )
1 ( sp_h )
"" ( handler_prg )
"marble1" ( picture )
0 0 0 0 ( transp.color )
5 ( bumph )
0 ( ditherscale )
0 ( scopehandler )
"" ( scopeexpr )
0 ( scope1 )
0 ( scope2 )
0 ( tcoorhandler )
"" ( tcoorexpr )
0 ( tco1 )
0 ( tco2 )
0 ( bumphandler )
"" ( bumpexpr )
0 ( bmp1 )
0 ( bmp2 )
0 ( colorhandler )
"" ( colorexpr )
0 ( co1 )
0 ( co2 )
0 ( indexhandler )
"" ( indexexpr )
0 ( id1 )
0 ( id2 )
"CEND"
MAT_CREATE DROP

iLOCK_REMOVE MAT_LOCK


( Object Attributes for Particles. The color is generated randomly for
( each particle

: Attributes ( - )
    255 RANDOM F* 255 RANDOM F* 255 RANDOM F* 0 ( RGBA )
    "noname"
    0
    "CEND"
;

( This function creates the actual planet

: CrPlanet ( - )

    2 ( subtype )
    "level" ( name )
    0 ( flags )
    "CEND"
    C_LEVEL O_CURRENT DROP

        0 0 0               ( center
        fPlanetSize FFETCH 0 0     ( a
        0 fPlanetSize FFETCH 0     ( b
        0 0 fPlanetSize FFETCH     ( c
        Attributes
        C_ELLIPSOID DROP

        0 0 0               ( center
        fPlanetSize FFETCH 0 0     ( a
        0 fPlanetSize FFETCH 0     ( b
        0 0 fPlanetSize FFETCH     ( c
        255 255 255 0 ( RGBA )
        "planet" ( name )
        2048     ( flags = texture )
        "CEND"
        "planet" "SMAT"
        C_ELLIPSOID DROP

    O_GETCURR O_GETPAR O_CURRENT DROP
;

( This creates one particle in given position

: CrParticle ( vCenter )
    fPartSize FFETCH 0 0       ( a
    0 fPartSize FFETCH 0       ( b
    0 0 fPartSize FFETCH       ( c
    Attributes
    C_ELLIPSOID DROP
;


( Computes the radius for particles 

: CrRad ( iCircOrd )
    fPartSize FFETCH 4 F* F* fPlanetSize FFETCH 1.5 F* F+
    fPartSize FFETCH 0.3 F* RANDOM F* F+
;


( direction of particles 

: CrAngle ( iPartOrd )
    iPartCnt FETCH F/ PI2 F* PI2 iPartCnt FETCH F/ RANDOM F* F+
;


: CrSaturn

    fPartSize "Size of particles" GET_FLT
    NOT IF
    	EXIT
    ENDIF

    fPlanetSize "Size of the planet" GET_FLT
    NOT IF
    	EXIT
    ENDIF    

    iPartCnt FETCH fTemp FSTORE
    fTemp "Number of Particles per ring" GET_FLT
    NOT IF
    	EXIT
    ENDIF    
    fTemp FFETCH iPartCnt STORE

    iCircCnt FETCH fTemp FSTORE
    fTemp "Number of rings" GET_FLT
    NOT IF
    	EXIT
    ENDIF    
    fTemp FFETCH iCircCnt STORE

    "Creating particles" BUSY_OPEN aBusyHnd STORE
    
    iLOCK_EXCL O_LOCK
    CrPlanet
    iCircCnt FETCH 0 DO
        iPartCnt FETCH 0 DO
	    ( create particle
            I CrAngle SIN J CrRad F*
            I CrAngle COS J CrRad F*
            fPartSize FFETCH RANDOM F*
            CrParticle

        LOOP

        ( update progress indicator
        aBusyHnd FETCH 0 100 I * iCircCnt FETCH / BUSY_UPDATE 

        ( Check if the user pressed cancel
        aBusyHnd FETCH BUSY_CANCEL
        IF
            LEAVE
	ENDIF
    LOOP
    iLOCK_REMOVE O_LOCK
    aBusyHnd FETCH BUSY_CLOSE
;


( Create planet
CrSaturn

( get rid of defined words
FORGET PI2

