Comments and docstrings

This commit is contained in:
Vivianne 2024-02-29 11:55:55 -05:00
parent a904504a12
commit a9ceb3d1e4

View file

@ -14,6 +14,7 @@
;; TODO: create helpers that allow the reflow to operate properly.
(define (make-ansi-port-tuple o-port)
"Return the wrapping port and 3 functions acting on it: `current-sequence', `reset-sequence', `restore-sequence'. `current-sequence': Returns the current, complete sequence applied to the port. `reset-sequence': Sends a reset sequence to the port if necessary (if there is currently a sequence). `restore-sequence': If there is a sequence, send it to the port."
;; The sequence we are currently building up, a list of characters (reversed).
(define wip-sequence-list '())
@ -21,7 +22,10 @@
;; These will be compressed into a single string upon reading.
(define current-sequence-list '())
;; #t if we are currently defining an escape sequence
(define in-escape-sequence? #f)
;; #t if there is a sequence stored.
(define (sequence?) (not (null? current-sequence-list)))
(define-syntax-rule (cons! item lst)
@ -30,25 +34,32 @@
;; rune by rune
(define (put-char c)
(cond
;; If we see a marker, flag it and begin building the sequence list
((equal? %MARKER c)
(set! in-escape-sequence? #t)
(cons! c wip-sequence-list))
(in-escape-sequence?
;; If we are still in an escape sequence continue building
(cons! c wip-sequence-list)
(when (ansi-terminator? c)
;; If we reach a terminator char, we have completed building the sequence
(set! in-escape-sequence? #f)
;; Convert it to a string (reverse, because we used cons)
(let ((sequence (reverse-list->string wip-sequence-list)))
(cond
;; Is it a reset sequence? Clear it
((string-suffix? %RESET sequence)
;; Reset sequence, clear the saved sequence!
(set! current-sequence-list '()))
;; Is it a color code? Add it to the sequence!
((equal? c #\m)
;; color code, add the sequence
(cons! sequence current-sequence-list)))
;; Now we can output the full sequence in one go
;; and clear the work-in-progress list
(display sequence o-port)
(set! wip-sequence-list '()))))
(else
;; Just display the text right away
(display c o-port))))
(define port
@ -56,17 +67,19 @@
(vector
;; Char out
(λ (c) (put-char c))
;; String out
;; String out, go char by char
(λ (s) (string-for-each put-char s))
;; Flush
;; (question: do we want to force output work-in-progress sequences on flush? Probably not?)
(λ () (flush-output-port o-port))
;; Get char
;; Get char - write-only, we ignore
(λ () #f)
;; Close port
;; Close port - no work to do - we don't take ownership of the child port
(λ () #f))
"w"))
(define (current-sequence)
"Returns the currently defined ansi sequence."
(and
(sequence?)
(if (= 1 (length current-sequence-list))
@ -77,10 +90,12 @@
str))))
(define (reset-ansi)
"Reset the current ansi sequence if needed by outputting to the wrapped port."
(when (sequence?)
(display %RESET-SEQ o-port)))
(define (restore-ansi)
"Restore the current ansi sequence by outputting to the wrapped port."
(let ((seq (current-sequence)))
(when seq
(display seq o-port))))