1 files changed, 39 insertions, 0 deletions

@@ -0,0 +1,39 @@
+;;; (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))))