90 lines
3.3 KiB
Scheme
90 lines
3.3 KiB
Scheme
(define-module (guart buffer)
|
|
#:use-module (uniseg graphemes)
|
|
#:use-module (srfi srfi-43)
|
|
#:export (make-buffer
|
|
write-buffer
|
|
buffer-set!
|
|
buffer-ref))
|
|
|
|
(define %empty-entry '(#\space))
|
|
|
|
;; Buffer is a 2d vector, containing lists as the innermost data type.
|
|
;; We use lists so that we can support multi-character graphemes at a single position.
|
|
;; Additionally, the vector's content is set to #f if a double- or triple-width character is to the left.
|
|
;; So, upon encountering a #f, we need to move to the left and reset all the cols set to #f or the multi-width glyph.
|
|
(define (make-buffer width height)
|
|
(define outer-vec (make-vector height #f))
|
|
(for-each
|
|
(λ (i) (vector-set! outer-vec i (make-vector width %empty-entry)))
|
|
(iota height))
|
|
outer-vec)
|
|
|
|
;; Naiively set without checking for multi-width neighbors or setting multi-width neighbors!
|
|
(define (_buffer-set! buf rpos cpos glyphs)
|
|
(vector-set! (vector-ref buf rpos) cpos glyphs))
|
|
|
|
(define (buffer-set! buf rpos cpos grapheme)
|
|
(define-values (entry col-vec) (_buffer-ref buf rpos cpos))
|
|
(unless entry
|
|
;; We found a #f entry. So to the left is a grapheme.
|
|
;; Iterate backwards from current pos - 1 until we find the grapheme or the first entry in the row.
|
|
;; Clear all entries including the grapheme.
|
|
(unless (= cpos 0)
|
|
(let loop ((c (- cpos 1))
|
|
(e (_buffer-ref buf rpos (- cpos 1))))
|
|
(_buffer-set! buf rpos c %empty-entry)
|
|
(unless (or e (= c 0))
|
|
(loop (- c 1) (_buffer-ref buf rpos (- c 1)))))))
|
|
|
|
;; Actually set the value now
|
|
(_buffer-set! buf rpos cpos (grapheme-glyphs grapheme))
|
|
|
|
;; Clear out `width-1' entries right from the new entry
|
|
(let ((width (grapheme-width grapheme))
|
|
(max-col (vector-length col-vec)))
|
|
(do ((c (1+ cpos) (1+ c)))
|
|
((or (>= c max-col)
|
|
(>= c (+ cpos width))))
|
|
(_buffer-set! buf rpos c #f))
|
|
;; We also have to make sure that if any of the right neighbors are #f
|
|
;; due to former now cleared multi-width graphemes, that they are all cleared as well!
|
|
(do ((c (+ cpos width) (1+ c)))
|
|
;; ensure in bounds and all values are false
|
|
((or (>= c max-col)
|
|
(_buffer-ref buf rpos c)))
|
|
(_buffer-set! buf rpos c %empty-entry))))
|
|
|
|
;; Internal direct buffer access, and also gives out the column vector for convenience
|
|
(define (_buffer-ref buf rpos cpos)
|
|
(let ((col-vec (vector-ref buf rpos)))
|
|
(values
|
|
(vector-ref col-vec cpos)
|
|
col-vec)))
|
|
|
|
;; Buffer ref that finds the actual grapheme and returns the actual column pos as a second value
|
|
(define (buffer-ref buf rpos cpos)
|
|
(let ((entry (_buffer-ref buf rpos cpos)))
|
|
(cond
|
|
(entry (values entry cpos))
|
|
((<= cpos 0) #f)
|
|
(else (buffer-ref buf rpos (- cpos 1))))))
|
|
|
|
|
|
(define* (write-buffer buf #:optional (port #f))
|
|
"Output the buffer to an output port. If `port' is not specified, uses current output port"
|
|
(unless port (set! port (current-output-port)))
|
|
(vector-for-each
|
|
(λ (rpos row)
|
|
(define row-str
|
|
(list->string
|
|
(vector-fold-right
|
|
(λ (cpos lst entry)
|
|
(if entry
|
|
(append entry lst)
|
|
lst))
|
|
'()
|
|
row)))
|
|
(display row-str port)
|
|
(display "\n" port))
|
|
buf))
|