This commit is contained in:
parent
2e420aef05
commit
c3657e911f
31
buffer.rkt
31
buffer.rkt
|
@ -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
|
||||||
|
|
3
draw.rkt
3
draw.rkt
|
@ -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))
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue