Janus

utils.ft.md


Utilities for strings and paths

Copy or append a memory region to a counted string:

: place         ( c-addr u s -- ) 2dup c! 1+ swap cmove ;
: +place        ( c-addr u s -- )
                dup >r count + swap dup >r cmove
                >r >r dup c@ rot + swap c!
                ;

: dup$          2dup ;
: drop$         2drop ;
: swap$         2swap ;
: over$         2over ;
: r@$           2r@ ;
: nip$          2nip ;
: c@$           + c@ ;
: count$        nip ;

: append$       ( c-addr n c-addr1 n1 -- c-addr n+n1 )
                swap$ dup$ 2>r +
                swap dup >r
                cmove
                2r> + r> swap ;

: cappend$      ( c-addr n c -- c-addr n+1 )
                >r dup$ + r> swap c! 1+ ;

: find<$        ( c-addr n c -- n -1 | 0 )
                over 0= if drop nip exit then
                >r begin
                  dup 0> while
                  1- dup$ c@$ r@ <> while
                repeat then
                2dup + c@ r> = if nip true else 2drop 0 then
                ;

: tail$         ( c-addr n t -- c-addr+t n-t )
                rot over + -rot - ;

Copy the absolute path for a given absolute or relative path to a string:

: copy-abs-path ( c-addr n c-addr' n' -- c-addr n )
                over c@ [char] / = if append$ exit then
                swap$ drop #1024 get-dir [char] / cappend$
                swap$ append$
                ;

: uppercase     dup $61 $7B within $20 and xor ;

: 1/string      1- swap 1+ swap ;

: setbase       ( addr n -- addr' n' )
                over c@ dup 0<> and
                dup [char] $ = if drop $10 else
                dup [char] # = if drop $0A else
                    [char] % = if $02 else exit
                then then then base ! 1/string ;

: >number       ( u addr u --  u' addr' u' )
                setbase
                begin dup while
                  over c@ uppercase digit? 0= if drop exit then
                  >r rot base @ * r> + -rot
                  1/string
                repeat ;

: ?sign         ( addr n --  addr' n' f )
                over c@ $2C - dup abs 1 = and
                dup if 1+ >r 1/string r> then ;

: ?number       ( c-addr -- n -1 | c-addr 0 )
                base @ >r
                dup 0 0 rot count
                ?sign >r >number if rdrop 2drop drop 0
                else 2swap 2drop drop r> if negate then
                true then r> base ! ;

: buffer: create allot ;