( Simple `keyframer` RPL example
( This program defines some RPL words and loads Tool window whose buttons
( are bind to the words

0 CONSTANT KEYFRAME

"sys\objects.rpl" LOAD

?& KF_Start NOT ?IF

( Variables needed in this example

VARIABLE iLock
VARIABLE aTarget
VARIABLE aKeys
VARIABLE aRoot
VARIABLE iKfActive

( Locking and unlocking object data

: KF_Lock   iLOCK_EXCL   O_LOCK 1 iLock STORE ;
: KF_Unlock iLOCK_REMOVE O_LOCK 0 iLock STORE ;

( Error handler

: KF_Error
    iLock FETCH IF
        KF_Unlock
    ENDIF
    0 iKfActive STORE
;

( Word used for O_SCAN

: KF_Cmp
    OVER = IF
        0       ( found, stop scanning
    ELSE
        1       ( continue
    ENDIF
;

( Checks the `validity` of key framing sequence

: KF_StillValid

    ( Check if aRoot pointer is still valid
    aRoot FETCH O_GETROOT [&] KF_Cmp O_SCAN IF
        "CONTINUE" "Cannot Find Keyframed Object" GET_KEY DROP
        DROP 0 EXIT
    ENDIF

    DROP

    ( Check if aTarget pointer is still valid
    aTarget FETCH aRoot FETCH [&] KF_Cmp O_SCAN IF
        "CONTINUE" "Target Object Missing" GET_KEY DROP
        DROP 0 EXIT
    ENDIF

    DROP

    ( Check if aKeys pointer is still valid
    aKeys FETCH aRoot FETCH [&] KF_Cmp O_SCAN IF
        "CONTINUE" "Cannot find Key objects" GET_KEY DROP
        DROP 0 EXIT
    ENDIF

    DROP

    1
;


( Handle `Record` button; creates a new keyframe object

: Record

    iKfActive FETCH NOT IF
        "CONTINUE" "Start first please" GET_KEY DROP
        0 EXIT
    ENDIF

    KF_Lock
    KF_StillValid IF
        0 aTarget FETCH M_COPY
        aKeys FETCH 0 M_PASTE
        0 aTarget FETCH O_SELECT
    ELSE
        0 iKfActive STORE
    ENDIF
    KF_Unlock
    0
;

( Start keyframing sequence

: Start
    iKfActive FETCH IF
        "CONTINUE" "Sequence already active" GET_KEY DROP
        0 EXIT
    ENDIF

    [&] KF_Error ERR_INSTALL
    KF_Lock
    O_GETSEL DUP NOT IF
        "CONTINUE" "Select Objects to be keyframed" GET_KEY DROP
        0 EXIT
    ENDIF
    M_CUT
    wOT_OR "kfobj"  0 "CEND" C_LEVEL DUP aRoot STORE O_CURRENT DROP
    wOT_OR "target" 0 "CEND" C_LEVEL aTarget STORE
    wOT_OR "keys" lOF_RTINVISIBLE lOF_WFINVISIBLE BOR "CEND" "MORPHING OPEN" "SMTH" C_LEVEL aKeys STORE
    aTarget FETCH 0 M_PASTE
    0 aTarget FETCH M_COPY
    aKeys FETCH 0 M_PASTE
    0 aTarget FETCH O_SELECT
    KF_Unlock
    [&] KF_Error ERR_REMOVE
    1 iKfActive STORE
    lWR_SELECT
;

: End
    iKfActive FETCH NOT IF
        "CONTINUE" "Sequence already terminated" GET_KEY DROP
        0 EXIT
    ENDIF
    0 iKfActive STORE
    4 1 8 MENU 0
;

: >> 4 3 0 MENU 0 ;     ( play forwards
: << 4 3 1 MENU 0 ;     ( play backwards
: >| 4 3 3 MENU 0 ;     ( go to end
: |< 4 3 2 MENU 0 ;     ( go to beginning
: STOP 5 4 0 MENU 0 ;   ( cancell all

?ENDIF


( load the Tool window referring to these words
"ENV\KEYFRAME.ENV" lIO_RWIN 0 FIL_LOAD