( Define RPL words for icons if not already defined )

?& iMaxCnt NOT ?IF   ( if already defined, don`t redefine
"r3d2:rpl/sys/vectors.rpl" LOAD

200     CONSTANT iMaxCnt
iMaxCnt STRING   sFonts
200     STRING   sTmp
100     STRING   sDir
100     STRING   sName
VARIABLE         aPtr
VARIABLE         aInd
VVARIABLE        vCurPos
VARIABLE         iLocked
FVARIABLE        fSize

( locking and error handling

: FontLock
    iLOCK_EXCL O_LOCK
    1 iLocked !
;

: FontUnlock
    iLOCK_REMOVE O_LOCK
    0 iLocked !
;

: FontError
    iLocked @
    IF
        FontUnlock
    ENDIF
;

( Check if character is capital ie. its ASCII value is between 65 ... 90

: FontIsLCase ( bChar - iBoolean )
    DUP 125 > IF
        DROP 0
    ELSE
        97 < IF
            0
        ELSE
            1
        ENDIF
    ENDIF
;

: FontIsSpace ( bChar - iBoolean )
    32 = IF
        1
    ELSE
        0
    ENDIF
;

( Number of characters in the string

: StrLen ( aString - iCnt)

    aPtr !
    0
    BEGIN
        aPtr @ B@
    WHILE
        1 aPtr @ + aPtr !
        1 +
    REPEAT
;

: FontLoader

    ( ask user to define string to be loaded )
    sFonts iMaxCnt "Define Fonts to be Loaded" GET_STR NOT IF
        0
        EXIT
    ENDIF

    ( position for the first font )
    -1 0 0 vCurPos V!

    ( install error handler
    [&] FontError ERR_INSTALL

    ( set aPtr to point to the first character
    sFonts aPtr !

    ( loop through characters until terminator is found
    BEGIN
        aPtr @ B@ DUP
    WHILE
        ( build up file name
        DUP FontIsSpace IF
           DROP
           fSize F@ 0 0 vCurPos V@ VADD vCurPos V!
        ELSE
            DUP FontIsLCase IF
                sDir "%s_%c" sTmp SPRINTF
            ELSE
                sDir "%s%c" sTmp SPRINTF
            ENDIF

            ( load object in
            sTmp lIO_ROBJ 0 FIL_LOAD

            ( lock object data structure
            FontLock

            ( fetch the radius of the loaded object and make it vector
            O_GETSEL iOP_SIZE O_PROP DUP fSize F! 0 0

            ( calculate COG position
            VDUP vCurPos V@ VADD vCurPos V!

            ( move object to correct position
            O_GETSEL vCurPos V@ 0 M_MOVECOG

            ( move current position by radius
            vCurPos V@ VADD vCurPos V!

            ( unlock objects
            FontUnlock
        ENDIF
        ( increment character pointer by one
        1 aPtr @ + aPtr !
    REPEAT
    DROP
    [&] FontError ERR_REMOVE
    lWR_SELECT lWR_VIEW BOR      ( refresh View and Select windows
;

( Define the drawer from where to search fonts

: FontDrawer

    ( ask user to define font directory
    iIO_DIR sName sDir "Define Font Directory" GET_FIL NOT IF
        0 EXIT          ( cancelled
    ENDIF

    ( length of the directory path
    sDir StrLen DUP NOT IF
        DROP 0 EXIT  ( no directory defined
    ENDIF

    ( if the last character is `:`, exit
    DUP sDir + 1 - B@ ":" B@ = IF
        DROP 0 EXIT
    ENDIF

    ( if the last character is `/`, exit
    DUP sDir + 1 - B@ "/" B@ = IF
        DROP 0 EXIT
    ENDIF

    ( otherwise, add `/` so that we can concatenate drawer and filename
    DROP
    "/" sDir CAT
    0 ( don`t refresh windows )
;

: FontHelpMe
    "r3d2:help/tools.guide" "FontLoader" 0 AGUIDE
    0
;

?ENDIF