diff --git a/reflow/ports.scm b/reflow/ports.scm new file mode 100644 index 0000000..54a35bd --- /dev/null +++ b/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"))