@program lib-strings.muf
1 1000 d
i
( Modified for ANSI! Syvel @ FurryFaire )
( Modified for Proto Alynna @ Pokemon X )

( If this is a glow database running on proto, handle things compatibally )
$iflib $ansihack
 $def specialparse 1 parse_ansi 3 parse_ansi dup strlen 4 - dup 0 < if pop 0 then strcut pop
 $def ansi_strcut swap specialparse swap \ansi_strcut
 $def ansi_strlen specialparse \ansi_strlen
$endif

( ***** Misc String routines -- STR *****
These routines deal with spaces in strings.
 STRblank?   [       str -- bool         ]  true if str null or only spaces
 STRsls      [       str -- str'         ]  strip leading spaces
 STRsts      [       str -- str'         ]  strip trailing spaces
 STRstrip    [       str -- str'         ]  strip lead and trail spaces
 STRsms      [       str -- str'         ]  strips out mult. internal spaces

These two are routines to split a string on a substring, non-inclusive.
 STRsplit    [ str delim -- prestr postr ]  splits str on first delim. nonincl.
 STRrsplit   [ str delim -- prestr postr ]  splits str on last delim. nonincl.

The following are useful for formatting strings into fields.
 STRfillfield [str char width -- padstr  ] return padding string to width chars
 STRcenter   [ str width -- str'         ]  center a string in a field.
 STRleft     [ str width -- str'         ]  pad string w/ spaces to width chars
 STRright    [ str width -- str'         ]  right justify string to width chars

The following are case insensitive versions of instr and rinstr:
 instring    [  str str2 -- position     ]  find str2 in str and return pos
 rinstring   [  str str2 -- position     ]  find last str2 in str & return pos

These convert between ascii integers and string character.
 STRasc      [      char -- i            ]  convert character to ASCII number
 STRchar     [         i -- char         ]  convert number to character

This routine is useful for parsing command line input:
  STRparse   [       str -- str1 str2 str3] " #X Y  y = Z"  ->  "X" "Y y" " Z"
)


( dump split and rsplit, in server -- Alynna )

: sms ( str -- str')
    dup "  " instr if
        " " "  " subst 'sms jmp
    then
;


: fillfield (str padchar fieldwidth -- padstr)
  rot ansi_strlen - dup 1 < if pop pop "" exit then
  swap over begin swap dup strcat swap 2 / dup not until pop
  swap ansi_strcut pop
;

: left (str fieldwidth -- str')
  over " " rot fillfield strcat
;

: right (str fieldwidth -- str')
  over " " rot fillfield swap strcat
;

: center (str fieldwidth -- str')
  over " " rot fillfield
  dup ansi_strlen 2 / ansi_strcut
  rot swap strcat strcat
;


( alias to proto prims )

: STRasc ( c -- i )
 ctoi
;

: STRchr ( i -- c )
 itoc
;

: STRparse ( s -- s1 s2 s3 ) (
    Before: " #option  tom dick  harry = message "
    After:  "option" "tom dick harry" " message "
    )
    "=" rsplit swap
    striplead dup "#" 1 strncmp not if
        1 ansi_strcut swap pop
        " " split
    else
        "" swap
    then
    strip sms rot
;

public sms
public fillfield
public left
public right
public center
public STRasc
public STRchr
public STRparse
.
c
q
@reg lib-strings=lib/strings
@reg lib-strings=lib/astrings
@set $lib/strings=/_defs/.asc:"$lib/strings" match "STRasc" call
@set $lib/strings=/_defs/.blank?:\striplead not
@set $lib/strings=/_defs/.center:"$lib/strings" match "center" call
@set $lib/strings=/_defs/.chr:"$lib/strings" match "STRchr" call
@set $lib/strings=/_defs/.command_parse:"$lib/strings" match "STRparse" call
@set $lib/strings=/_defs/.fillfield:"$lib/strings" match "fillfield" call
@set $lib/strings=/_defs/.left:"$lib/strings" match "left" call
@set $lib/strings=/_defs/.right:"$lib/strings" match "right" call
@set $lib/strings=/_defs/.rsplit:\rsplit
@set $lib/strings=/_defs/.singlespace:"$lib/strings" match "sms" call
@set $lib/strings=/_defs/.sls:\striplead
@set $lib/strings=/_defs/.sms:"$lib/strings" match "sms" call
@set $lib/strings=/_defs/.split:\split
@set $lib/strings=/_defs/.strip:strip
@set $lib/strings=/_defs/.stripspaces:strip
@set $lib/strings=/_defs/.sts:\striptail
@set $lib/strings=/_defs/STRasc:"$lib/strings" match "STRasc" call
@set $lib/strings=/_defs/STRblank?:\striplead not
@set $lib/strings=/_defs/STRcenter:"$lib/strings" match "center" call
@set $lib/strings=/_defs/STRchr:"$lib/strings" match "STRchr" call
@set $lib/strings=/_defs/STRfillfield:"$lib/strings" match "fillfield" call
@set $lib/strings=/_defs/STRleft:"$lib/strings" match "left" call
@set $lib/strings=/_defs/STRparse:"$lib/strings" match "STRparse" call
@set $lib/strings=/_defs/STRright:"$lib/strings" match "right" call
@set $lib/strings=/_defs/STRrsplit:\rsplit
@set $lib/strings=/_defs/STRsinglespace:"$lib/strings" match "sms" call
@set $lib/strings=/_defs/STRsls:\striplead
@set $lib/strings=/_defs/STRsms:"$lib/strings" match "sms" call
@set $lib/strings=/_defs/STRsplit:\split
@set $lib/strings=/_defs/STRstrip:strip
@set $lib/strings=/_defs/STRsts:\striptail