( ------------------------------------------------------------------
( meshtosph.rpl
( Converts freeform objects to given number of spheres. 
( Can be easily changed to generate all kind of objects.
( USAGE: Load this through RPL window and call MTS_DoIt
( ------------------------------------------------------------------

( Variables needed in this module

FVARIABLE fSphCnt       ( number of spheres to be created
FVARIABLE fSphRad       ( radius for spheres
VARIABLE  aBsyHnd       ( for progress indicator
VARIABLE  iCntU         ( number of spheres in u & v directions
VARIABLE  iCntV
VARIABLE  aCurObj
VARIABLE  iLock

( Lock Object Data

: MTS_Lock iLOCK_EXCL O_LOCK 1 iLock ! ;

( Unlock Object Data

: MTS_Unlock iLOCK_REMOVE O_LOCK 0 iLock ! ;

( Error handler

: MTS_ErrHnd
    iLock @ IF               ( remove possible lock
        MTS_Unlock
    ENDIF
    aBsyHnd @ IF             ( close busy requester
	aBsyHnd @ BUSY_CLOSE
   	0 aBsyHnd !
    ENDIF
;

( Get necessary input from the user

: MTS_AskUsr
    fSphRad "Define Radius for Spheres" GET_FLT NOT
    IF
        0 EXIT
    ENDIF
    fSphRad F@ 0.00001 F< IF
        "UNDERSTOOD" "Bigger spheres please" GET_KEY DROP
        0 EXIT
    ENDIF

    fSphCnt "Number of Spheres" GET_FLT
    NOT IF
        0 EXIT
    ENDIF

    fSphCnt F@ 4 < IF
        "UNDERSTOOD" "More spheres please" GET_KEY DROP
        0 EXIT
    ENDIF
    fSphCnt F@ SQRT DUP iCntU ! iCntV !
    1
;

( Attributes for spheres

: MTS_GetAtt
    255 255 255 0 ( RGBA )
    "s" ( name )
    4 ( no wire frames )
    "CEND"
;


( Create one particle - sphere in this case

: MTS_CreParticle
    0 0 0 	        ( center )
    fSphRad F@ 0 0	( a )
    0 fSphRad F@ 0	( b )
    0 0 fSphRad F@	( c )
    MTS_GetAtt
    C_ELLIPSOID
;


( This word creates spheres to the current level

: MTS_CreSph
    fSphCnt F@ 0 DO
        MTS_CreParticle
        NOT IF
       	    "Cannot create sphere" ERROR
	ENDIF
	aBsyHnd @ 0 I 100 * fSphCnt F@ / BUSY_UPDATE
	aBsyHnd @ BUSY_CANCEL
	IF
	    "User Break" ERROR
        ENDIF
    LOOP
;

( This word distributes spheres evenly over the skeleton

: MTS_DefPhs ( aParent )

    O_GETSUB DUP NOT IF
        EXIT
    ENDIF

    aBsyHnd @ "Defining Positions" 0 BUSY_UPDATE
    iCntV @ 0 DO
        iCntU @ 0 DO
            DUP "CEND" I iCntU @ F/ J iCntV @ F/ 0.0 "VPHS" O_CREATAG
            NOT IF
                "Cannot create tag" ERROR
            ENDIF
            O_GETNEXT DUP NOT IF
		LEAVE
            ENDIF
        LOOP
        aBsyHnd @ 0 I 100 * iCntV @ / BUSY_UPDATE
    LOOP
    DROP
;

( MTS_Process scans through given objects and converts them to spheres

: MTS_Process ( 0  aObj1  ... )
    O_GETCURR aCurObj !
    BEGIN DUP WHILE
        0 SWAP M_CUT
        2 "level" 0 "CEND" C_LEVEL O_CURRENT DROP
        MTS_CreSph
        O_GETCURR MTS_DefPhs
        2 "skel" 128 "CEND" 3 "ISKE" "SIMPLE SKELETON" "SMTH" C_LEVEL
        DUP O_CURRENT DROP
        0 M_PASTE
        aCurObj @ O_CURRENT DROP
    REPEAT
;

( User Inteface Entry

: MTS_DoIt
    MTS_AskUsr NOT IF EXIT ENDIF
    [&] MTS_ErrHnd ERR_INSTALL
    "Creating Spheres..." BUSY_OPEN aBsyHnd !
    MTS_Lock
    O_GETSEL
    MTS_Process
    MTS_Unlock
    aBsyHnd @ BUSY_CLOSE 0 aBsyHnd !
    [&] MTS_ErrHnd ERR_REMOVE
;