( ------------------------------------------------------------
( This example demonstrates how to expand the animation system
( of Real 3D by defining new methods. The file defines three new
( methods: ABS_PATH, CHAIN and WEIRD_FORCE. If you add the line
( "methods.rpl" LOAD to you rpl-startup, these methods will be
( automatically installed.
( ------------------------------------------------------------

"r3d2:rpl/sys/vectors.rpl" LOAD
"r3d2:rpl/sys/objects.rpl" LOAD
"r3d2:rpl/sys/tags.rpl"    LOAD

( This function is used by all custom methods found from this file.
( It fetches addresses of all valid target objects on the stack.

: GetTargets
    0               ( 0 terminates the list
    o2 FETCH O_GETSUB   ( variable o2 points to first sub object
    BEGIN
        DUP IF      ( test if the object address is not zero
            DUP O.wMETHOD + WFETCH ( fetch the contents of wMETHOD field
            NOT IF  ( if zero, valid target
		DUP
            ENDIF
        ELSE        ( object address was zero,
            DROP
            EXIT
        ENDIF
        O_GETNEXT   ( fetch the address of the next object
    AGAIN
;

( ABS_PATH
( This is the actual object procedure for ABS_PATH

: OP_AbsPath
    GetTargets      ( fetch target objects
    o1 FETCH O_GETSUB   ( find the parameter object
    DUP NOT IF      ( if no parameter object, syntax error
 	DROP
        "Parameter Object Missing" ERROR
    ENDIF
    t FFETCH u FFETCH v FFETCH O_EVAL
    0 M_MOVECOG
    1               ( return 1, everything is okay
;

( This creates the method ABS_PATH

& OP_AbsPath "ABS_PATH" MTH_CREATE DROP

( The CHAIN method attemps to keep the distance between all objects
( the same.

FVARIABLE fLen
VVARIABLE vTmp

: Distribute ( 0 aObjects .... fDist )
    fLen FSTORE
    iOP_COG O_PROP vTmp VSTORE
    BEGIN
        DUP
    WHILE
        DUP iOP_COG O_PROP
        vTmp VFETCH VSUB VNORM
        fLen FFETCH VMUL
        vTmp VFETCH VADD vTmp VSTORE
        0 SWAP vTmp VFETCH 0 M_MOVECOG
    REPEAT
    DROP
;

( Actual CHAIN Object Procedure. The tag "FDIS" can be associated with
( the method object in order to define the distance between targets.
( If the tag is not defined, the default distance 0.5 is used.

: OP_Chain
    GetTargets
    o1 FETCH "FDIS" O_FINDTAG DUP
    IF
        4 + FETCH FFETCH
    ELSE
        DROP
        0.5
    ENDIF
    Distribute
    1
; 

( Create CHAIN method

& OP_Chain "CHAIN" MTH_CREATE DROP

( The WEIRD_FORCE demonstrates how to create physical oriented `particle-
( system` methods. The method generates random force fields affecting to
( the velocity and the spin of target objects.

: GetVelForce
    RANDOM 0.5 F- RANDOM 0.5 F- RANDOM 0.5 F- 
;

: GetSpinForce
    RANDOM 0.5 F- RANDOM 0.5 F- RANDOM 0.5 F- 
;

: DoWeirdSPI ( aObj )
    "VSPI" O_FINDTAG DUP        ( attemp to find VSPI tag of given object
    IF                          ( found, so
        T.aVAL + FETCH DUP VFETCH       ( fetch the tag value
        GetSpinForce            ( fetch force affecting to target
        dt FFETCH 6.28 F* VMUL VADD ( calculate new velocity
        4 ROLL VSTORE               ( assign it back to the target`s tag
    ELSE                    ( not found, so create it
        DROP DUP "CEND" 0 0 0 "VSPI" O_CREATAG DROP
    ENDIF
;

: DoWeirdVEL ( aObj )
    "VVEL" O_FINDTAG DUP
    IF
        T.aVAL + FETCH DUP VFETCH GetVelForce dt FFETCH 
	VMUL VADD 4 ROLL VSTORE
    ELSE
        DROP DUP "CEND" 0 0 0 "VVEL" O_CREATAG DROP
    ENDIF
;

: OP_WeirdForce
    GetTargets          ( fetch all targets on the stack
    BEGIN               ( loop through all of them
        DUP
    WHILE
        DUP DoWeirdVEL  ( apply force field to velocity
        DUP DoWeirdSPI  ( apply force field to spin
        DROP
    REPEAT
    DROP
    1                   ( all OK
;

( Install WEIRD_FORCE method

& OP_WeirdForce "WEIRD FORCE" MTH_CREATE DROP

