This commit is contained in:
Jay McCarthy 2018-01-02 22:39:24 -05:00
parent 2e420aef05
commit c3657e911f
3 changed files with 44 additions and 28 deletions

View File

@ -42,11 +42,14 @@
(struct terminal-buffer (clear? op [term-rows #:mutable] [term-cols #:mutable]) (struct terminal-buffer (clear? op [term-rows #:mutable] [term-cols #:mutable])
#:methods gen:buffer #:methods gen:buffer
[(define (buffer-resize! buf new-rows new-cols) [(define (buffer-resize! buf new-rows new-cols)
;; XXX use for internal cropping
(set-terminal-buffer-term-rows! buf new-rows) (set-terminal-buffer-term-rows! buf new-rows)
(set-terminal-buffer-term-cols! buf new-cols)) (set-terminal-buffer-term-cols! buf new-cols))
(define (buffer-start! buf draw-rows draw-cols) (define (buffer-start! buf draw-rows draw-cols)
(define op (terminal-buffer-op buf)) (define op (terminal-buffer-op buf))
(define ok-rows
(min draw-rows (terminal-buffer-term-rows buf)))
(define ok-cols
(min draw-cols (terminal-buffer-term-cols buf)))
(define-syntax-rule (define-syntax-rule
(maybe-update last-X X select-X) (maybe-update last-X X select-X)
(unless (eq? last-X X) (unless (eq? last-X X)
@ -63,6 +66,13 @@
(define cur-r 1) (define cur-r 1)
(define cur-c 1) (define cur-c 1)
(λ (s f b r c ch) (λ (s f b r c ch)
(cond
[(or (< r 0)
(<= ok-rows r)
(< c 0)
(<= ok-cols c))
#f]
[else
(maybe-update last-s s select-style*) (maybe-update last-s s select-style*)
(maybe-update last-f f select-text-color*) (maybe-update last-f f select-text-color*)
(maybe-update last-b b select-background-color*) (maybe-update last-b b select-background-color*)
@ -74,9 +84,12 @@
(display (A:goto tr tc) op) (display (A:goto tr tc) op)
(set! cur-r tr) (set! cur-r tr)
(set! cur-c tc)) (set! cur-c tc))
(when ch (when ch
(display ch op) (display ch op)
(set! cur-c (add1 cur-c))))) (set! cur-c (add1 cur-c)))
#t])))
(define (buffer-commit! buf) (define (buffer-commit! buf)
(define op (terminal-buffer-op buf)) (define op (terminal-buffer-op buf))
(display (A:show-cursor) op) (display (A:show-cursor) op)
@ -110,13 +123,21 @@
[cell (in-vector row)]) [cell (in-vector row)])
(clear-cell! cell))) (clear-cell! cell)))
(define (draw-cell! cs) (define (draw-cell! cs)
(match-define (cells _ _ vec) cs) (match-define (cells ok-rows ok-cols vec) cs)
(λ (s f b r c ch) (λ (s f b r c ch)
(cond
[(or (< r 0)
(<= ok-rows r)
(< c 0)
(<= ok-cols c))
#f]
[else
(define oc (vector-ref (vector-ref vec r) c)) (define oc (vector-ref (vector-ref vec r) c))
(set-output-cell-s! oc s) (set-output-cell-s! oc s)
(set-output-cell-f! oc f) (set-output-cell-f! oc f)
(set-output-cell-b! oc b) (set-output-cell-b! oc b)
(set-output-cell-ch! oc ch))) (set-output-cell-ch! oc ch)
#t])))
(define (make-output-buffer #:output [op (current-output-port)]) (define (make-output-buffer #:output [op (current-output-port)])
(output-buffer op (make-cells 0 0))) (output-buffer op (make-cells 0 0)))
@ -174,7 +195,7 @@
exact-nonnegative-integer? exact-nonnegative-integer? exact-nonnegative-integer? exact-nonnegative-integer?
(-> style/c color/c color/c (-> style/c color/c color/c
exact-nonnegative-integer? exact-nonnegative-integer? (or/c char? #f) exact-nonnegative-integer? exact-nonnegative-integer? (or/c char? #f)
void?))] boolean?))]
[buffer-commit! [buffer-commit!
(-> buffer? void?)] (-> buffer? void?)]
[make-terminal-buffer [make-terminal-buffer

View File

@ -22,8 +22,7 @@
(define draw-char! (buffer-start! buf h w)) (define draw-char! (buffer-start! buf h w))
(! (λ (r c ch) (! (λ (r c ch)
(draw-char! (current-style) (current-fg) (current-bg) (draw-char! (current-style) (current-fg) (current-bg)
r c ch) r c ch))
#t)
0 0) 0 0)
(buffer-commit! buf)) (buffer-commit! buf))

View File

@ -129,11 +129,7 @@
[e e]))) [e e])))
(define (chaos-output! c o) (define (chaos-output! c o)
(when o (when o
(draw (*term-buf c) (draw (*term-buf c) o)))
;; XXX put this crop inside buffer?
(crop 0 (add1 (*term-cols c))
0 (add1 (*term-rows c))
o))))
(define (chaos-label! c l) (define (chaos-label! c l)
(display/term (*term-t c) (xterm-set-window-title l))) (display/term (*term-t c) (xterm-set-window-title l)))
(define (chaos-stop! c) (define (chaos-stop! c)