;;; (yolk common) --- common stuff for ansi things

(import (scheme base)
        (scheme write))

(define (->string x)
  (let ((str (open-output-string)))
    (display x str)
    (close-output-port str)
    (get-output-string str)))

(define (esc . xs)
  (apply string-append (string #\escape)
         (map ->string xs)))

(define (csi . xs)
  (apply esc "[" xs))

(define (dcs . xs)
  (apply esc "P" xs))

(define (ocs . xs)
  (apply esc "]" xs))

(define-syntax define-esc-alt-wrapper
  (syntax-rules ()
    ((_ wrapper-proc-name param-name (default-proc args ...))
     (begin
       (define param-name
         (make-parameter default-proc
                         (parameter-assert procedure? "Must be a procedure")))
       (define (wrapper-proc-name args ...)
         ((param-name) args ...))))))

(define (parameter-assert predicate error-message)
  (lambda (x)
    (if (predicate x)
        x
        (error error-message x))))