From 82a6e29eaad2944eb2e1a2213a9bce17e896add4 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Sun, 28 May 2023 21:47:09 -0500
Subject: initial commit

---
 yolk.common.ss | 39 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)
 create mode 100644 yolk.common.ss

(limited to 'yolk.common.ss')

diff --git a/yolk.common.ss b/yolk.common.ss
new file mode 100644
index 0000000..00aa91e
--- /dev/null
+++ b/yolk.common.ss
@@ -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))))
-- 
cgit 1.4.1-21-gabe81