scheme-sokoban/libraries.scm

(define (fake-open-input-file filename)
  (define p (assoc filename file-system-level-data))
  (define s (cdr p))
  (open-input-string s))

(define (string->vector s)
  (list->vector (string->list s)))

(define (vector->string v)
  (list->string (vector->list v)))

(define (vector-map lam . vs)
  (list->vector (apply map lam (map vector->list vs))))

(define (vector-copy v)
  (list->vector (list-copy (vector->list v))))

(define (list-copy l)
  (let loop ((in l)
             (out '()))
    (if (null? in)
        (reverse out)
        (loop (cdr in)
              (cons (car in) out)))))

(define (string-take s nchars)
  (let loop ((in (string->list s))
             (out '())
             (i 0))
    (if (or (null? in)
            (= i nchars))
        (list->string (reverse out))
        (loop (cdr in)
              (cons (car in) out)
              (+ i 1)))))

(define (string-split-with-args s delimiter)
  (let loop ((in (string->list s))
             (out '(())))
    (if (null? in)
        (reverse (map (lambda (soc) (list->string (reverse soc))) out))
        (loop (cdr in)
              (if (char=? (car in) (string-ref delimiter 0))
                  (cons '() out)
                  (cons (cons (car in) (car out))
                        (cdr out)))))))

(define (string-split . args)                  
  (define sz (length args))
  (cond
   ((< sz 1) (error "not enough arguments"))
   ((= sz 1)
    (string-split-with-args (list-ref args 0)
                            " "))
   ((= sz 2)
    (string-split-with-args (list-ref args 0)
                            (list-ref args 1)))
   (else
    (error "Too many arguments"))))

(define (string-join-with-args string-list delimiter)
  (cond
    ((null? string-list)
     "")
    ((null? (cdr string-list))
     (car string-list))
    (else
      (let loop ((in string-list)
                 (out '()))
        (if (null? in)
            (apply string-append (reverse (cdr out)))
            (loop (cdr in)
                  (cons delimiter
                        (cons (car in)
                              out))))))))
        
(define (string-join . args)
  (define sz (length args))
  (cond
   ((< sz 1) (error "not enough arguments"))
   ((= sz 1)
    (string-join-with-args (list-ref args 0)
                           " "))
   ((= sz 2)
    (string-join-with-args (list-ref args 0)
                           (list-ref args 1)))
   (else
    (error "Too many arguments"))))

(define (list-pad-right-with-args s len char)
  (let loop ((in s)
             (out '())
             (i 0))
    (if (= i len)
        (reverse out)
        (loop (if (null? in)
                  '()
                  (cdr in))
              (cons (if (null? in)
                        char
                        (car in))
                    out)
              (+ i 1)))))

(define (string-pad-right . args)
  (define sz (length args))
  (cond
   ((< sz 2) (error "not enough arguments"))
   ((= sz 2)
    (list->string
    (list-pad-right-with-args (string->list (list-ref args 0))
                                (list-ref args 1)
                                #\space)))
   ((= sz 3)
    (list->string
    (list-pad-right-with-args (string->list (list-ref args 0))
                                (list-ref args 1)
                                (list-ref args 2))))
   (else
    (error "Too many arguments"))))


(define (list-pad-left-with-args s len char)
  (reverse (list-pad-right-with-args (reverse s) len char)))

(define (string-pad-left . args)
  (define sz (length args))
  (cond
   ((< sz 2) (error "not enough arguments"))
   ((= sz 2)
    (list->string
    (list-pad-left-with-args (string->list (list-ref args 0))
                                (list-ref args 1)
                                #\space)))
   ((= sz 3)
    (list->string
    (list-pad-left-with-args (string->list (list-ref args 0))
                                (list-ref args 1)
                                (list-ref args 2))))
   (else
    (error "Too many arguments"))))

(define (iota n)
  (let loop ((result '())
             (i 0))
    (if (< i n)
        (loop (cons i result)
              (+ i 1))
        (reverse result))))