Initial reflowing soft port

reflow/ports.scm

@@ -0,0 +1,65 @@
+(define-module (reflow ports)
+  #:use-module (rnrs io ports)
+  #:export (create-reflowing-output-port))
+
+(define %MARKER "\x1B")
+
+(define (ansi-terminator? char)
+  (let ((c (char->integer char)))
+    (pk c)
+    (or  (and (>= c #x40) (<= c #x5a)) (and (>= c #x61) (<= c #x7a)))))
+
+;; TODO: create helpers that allow the reflow to operate properly.
+
+(define (create-reflowing-output-port o-port)
+  ;; The current ansi sequence gets constructed slowly
+  ;; need to reset this after we write it out
+  (define-values (sequence-port sequence-port-get-bv)
+    (open-bytevector-output-port)) 
+
+  ;; The previous ansi sequence is stored as bytevector
+  (define last-seq #f)
+
+  (define in-escape-sequence? #f)
+  (define sequence-changed? #f)
+
+  ;; rune by rune
+  (define (put-char c)
+    (cond
+     ((equal? %MARKER c)
+      (set! in-escape-sequence? #t)
+      (set! sequence-changed? #t)
+      (display c sequence-port))
+     (in-escape-sequence?
+      (display c sequence-port)
+      (when (ansi-terminator? c)
+        (in-escape-sequence? #f)
+        (let* ((bv (sequence-port-get-bv))
+               (str (bytevector->string bv (native-transcoder))))
+
+          (cond
+           ((string-suffix? "[0m" str)
+            (set! last-seq #f)
+            (set! sequence-changed? #f))
+           ((equal? c #\m)
+            ;; color code
+            (set! last-seq str)))
+
+          ;; need to reset the sequence port and such here
+          (display str o-port))))
+     (else
+      (display c o-port))))
+
+  (make-soft-port
+   (vector
+    ;; Char out
+    (λ (c) (put-char c))
+    ;; String out
+    (λ (s) (string-for-each put-char s))
+    ;; Flush
+    (λ () (flush-output-port o-port))
+    ;; Get char
+    (λ () #f)
+    ;; Close port
+    (λ () #f))
+   "w"))