102 lines
2.0 KiB
Scheme
102 lines
2.0 KiB
Scheme
;;; util.ss -- utility procedures for MysterX
|
|
|
|
(module util mzscheme
|
|
(require mzlib/unitsig)
|
|
(require mzlib/list)
|
|
|
|
(provide
|
|
fold-strings-with-spaces
|
|
map-to-string
|
|
empty-string?
|
|
bool->string
|
|
exact-with-bounds?
|
|
list-pos
|
|
remove-ws
|
|
symbols->string
|
|
hex-digit-string?
|
|
hex-color-string?
|
|
empty-property-error)
|
|
|
|
(define (fold-strings-with-spaces strs)
|
|
(foldr (lambda (s accum)
|
|
(if (string? accum)
|
|
(string-append s " " accum)
|
|
s))
|
|
'dummy
|
|
strs))
|
|
|
|
(define (map-to-string f)
|
|
(lambda (lst)
|
|
(let loop ([lst lst])
|
|
(cond
|
|
[(null? lst) ""]
|
|
[(null? (cdr lst))
|
|
(f (car lst))]
|
|
[else
|
|
(string-append (f (car lst))
|
|
" "
|
|
(loop (cdr lst)))]))))
|
|
|
|
(define empty-string?
|
|
(lambda (s)
|
|
(and (string? s)
|
|
(eq? (string-length s) 0))))
|
|
|
|
(define (bool->string v)
|
|
(if v
|
|
"true"
|
|
"false"))
|
|
|
|
(define (exact-with-bounds? n lo hi)
|
|
(and (number? n)
|
|
(exact? n)
|
|
(>= n lo)
|
|
(<= n hi)))
|
|
|
|
(define (list-pos v lst)
|
|
(let loop ([lst lst]
|
|
[n 0])
|
|
(if (eq? v (car lst))
|
|
n
|
|
(loop (cdr lst) (add1 n)))))
|
|
|
|
(define remove-ws ; remove leading whitespace
|
|
(lambda (cs)
|
|
(cond [(null? cs) '()]
|
|
[(char-whitespace? (car cs))
|
|
(remove-ws (cdr cs))]
|
|
[else cs])))
|
|
|
|
(define symbols->string ; '(a b c ...) => "a b c ..."
|
|
(lambda (syms)
|
|
(cond [(null? syms) ""]
|
|
[(null? (cdr syms))
|
|
(symbol->string (car syms))]
|
|
[else
|
|
(string-append (symbol->string (car syms))
|
|
" "
|
|
(symbols->string (cdr syms)))])))
|
|
|
|
(define (hex-digit-string? elt)
|
|
(let ([lst (string->list elt)]
|
|
[hex-digit?
|
|
(lambda (c)
|
|
(or (char-numeric? c)
|
|
(memq c '(#\a #\b #\c #\d #\e #\f
|
|
#\A #\B #\C #\D #\E #\F))))])
|
|
(and (= (length lst) 7)
|
|
(eq? (car lst) #\#)
|
|
(andmap hex-digit? (cdr lst)))))
|
|
|
|
(define (hex-color-string? s)
|
|
(and (string? s)
|
|
(hex-digit-string? s)))
|
|
|
|
(define empty-property-error
|
|
(lambda (p)
|
|
(error (format "Empty value for property ~a" p)))))
|
|
|
|
|
|
|
|
|