misc-deps
/
raart
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

proactive culling

This commit is contained in:
Jay McCarthy 2018-01-03 15:50:00 -05:00
parent cb03cdcaff
commit 6800e23dc7
2 changed files with 106 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
buffer.rkt
View File

@ -66,31 +66,33 @@
(define last-b #f) (define last-b #f)
(define cur-r 1) (define cur-r 1)
(define cur-c 1) (define cur-c 1)
(λ (s f b r c ch) (values
(cond ok-rows ok-cols
[(or (< r 0) (λ (s f b r c ch)
(<= ok-rows r) (cond
(< c 0) [(or (< r 0)
(<= ok-cols c)) (<= ok-rows r)
#f] (< c 0)
[else (<= ok-cols c))
(maybe-update last-s s select-style*) #f]
(maybe-update last-f f select-text-color*) [else
(maybe-update last-b b select-background-color*) (maybe-update last-s s select-style*)
(maybe-update last-f f select-text-color*)
(maybe-update last-b b select-background-color*)
(define tr (add1 r)) (define tr (add1 r))
(define tc (add1 c)) (define tc (add1 c))
(unless (and (= cur-r tr) (unless (and (= cur-r tr)
(= cur-c tc)) (= cur-c tc))
(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]))) #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)
@ -153,7 +155,7 @@
(buffer-resize! buf draw-rows draw-cols) (buffer-resize! buf draw-rows draw-cols)
(define cs (output-buffer-cells buf)) (define cs (output-buffer-cells buf))
(clear-cells! cs) (clear-cells! cs)
(draw-cell! cs)) (values draw-rows draw-cols (draw-cell! cs)))
(define (buffer-commit! buf) (define (buffer-commit! buf)
(define op (output-buffer-op buf)) (define op (output-buffer-op buf))
(define cells (cells-vec (output-buffer-cells buf))) (define cells (cells-vec (output-buffer-cells buf)))
@ -197,9 +199,11 @@
[buffer-start! [buffer-start!
(-> buffer? (-> buffer?
exact-nonnegative-integer? exact-nonnegative-integer? exact-nonnegative-integer? exact-nonnegative-integer?
(-> style/c color/c color/c (values exact-nonnegative-integer?
exact-nonnegative-integer? exact-nonnegative-integer? (or/c char? #f) exact-nonnegative-integer?
boolean?))] (-> style/c color/c color/c
exact-nonnegative-integer? exact-nonnegative-integer? (or/c char? #f)
boolean?)))]
[buffer-commit! [buffer-commit!
(-> buffer? void?)] (-> buffer? void?)]
[make-terminal-buffer [make-terminal-buffer

125
draw.rkt
View File

@ -18,101 +18,128 @@
#'(let ([t (λ () (with-maybe-parameterize m . body))]) #'(let ([t (λ () (with-maybe-parameterize m . body))])
(if v (parameterize ([p v]) (t)) (t)))])) (if v (parameterize ([p v]) (t)) (t)))]))
(define (rectangle-intersect a-x1 a-y1
a-x2 a-y2
b-x1 b-y1
b-x2 b-y2)
(and (< a-x1 b-x2)
(> a-x2 b-x1)
(< a-y1 b-y2)
(> a-y2 b-y1)))
;; w : exact-nonnegative-integer? ;; w : exact-nonnegative-integer?
;; h : exact-nonnegative-integer? ;; h : exact-nonnegative-integer?
;; ! : (row col char -> void) row col -> bool ;; ! : okay? (row col char -> void) row col -> bool
(struct raart (w h !)) (struct raart (w h !))
(define (draw buf x) (define (draw buf x)
(match-define (raart w h !) x) (match-define (raart w h !) x)
(define draw-char! (buffer-start! buf h w)) (define-values
(! (λ (r c ch) (max-rows max-cols draw-char!)
(draw-char! (current-style) (current-fg) (current-bg) (buffer-start! buf h w))
r c ch)) (define (draw-with-params r c ch)
0 0) (draw-char! (current-style) (current-fg) (current-bg)
r c ch))
(define (on-screen? w h r c)
(rectangle-intersect 0 0
max-cols max-rows
c r
(+ c w) (+ r h)))
(! on-screen? draw-with-params 0 0)
(buffer-commit! buf)) (buffer-commit! buf))
(define (raart* w h !)
(raart w h
(λ (okay? d r c)
(and (okay? w h r c)
(! okay? d r c)))))
;; Core forms ;; Core forms
(define (with-drawing s f b x) (define (with-drawing s f b x)
(match-define (raart w h !) x) (match-define (raart w h !) x)
(raart w h (λ (d r c) (raart* w h (λ (okay? d r c)
(with-maybe-parameterize ([current-style s] (with-maybe-parameterize ([current-style s]
[current-fg f] [current-fg f]
[current-bg b]) [current-bg b])
(! d r c))))) (! okay? d r c)))))
(define (blank [w 0] [h 1]) (define (blank [w 0] [h 1])
(raart w h (λ (d r c) #f))) (raart* w h (λ (okay? d r c) #f)))
(define (char ch) (define (char ch)
(when (char-iso-control? ch) (when (char-iso-control? ch)
(error 'char "Illegal character: ~v" ch)) (error 'char "Illegal character: ~v" ch))
(raart 1 1 (λ (d r c) (d r c ch)))) (raart* 1 1 (λ (okay? d r c) (d r c ch))))
(define (place-at back dr dc front) (define (place-at back dr dc front)
(match-define (raart bw bh b!) back) (match-define (raart bw bh b!) back)
(match-define (raart fw fh f!) front) (match-define (raart fw fh f!) front)
(unless (and (<= fw bw) (<= fh bh)) (unless (and (<= fw bw) (<= fh bh))
(error 'place-at "Foreground must fit inside background")) (error 'place-at "Foreground must fit inside background"))
(raart bw bh (raart* bw bh
(λ (d r c) (λ (okay? d r c)
(strict-or (strict-or
(b! d r c) (b! okay? d r c)
(f! d (+ r dr) (+ c dc)))))) (f! okay? d (+ r dr) (+ c dc))))))
(define (mask mc mw mr mh x) (define (mask mc mw mr mh x)
(match-define (raart xw xh x!) x) (match-define (raart xw xh x!) x)
(raart xw xh (raart* xw xh
(λ (d r c) (λ (okay? d r c)
(x! (x!
(λ (r c ch) (λ (w h r c)
(and (<= mr r) (< r (+ mr mh)) (and (okay? w h r c)
(<= mc c) (< c (+ mc mw)) (rectangle-intersect mc mr
(d r c ch))) (+ mc mw) (+ mr mh)
r c)))) c r
(+ c w) (+ r h))))
d r c))))
(define (crop cc cw cr ch x) (define (crop cc cw cr ch x)
(match-define (raart mw mh m!) (mask cc cw cr ch x)) (define mx (mask cc cw cr ch x))
(raart cw ch (match-define (raart mw mh m!) mx)
(λ (d r c) (raart* cw ch
(m! (λ (r c ch) (λ (okay? d r c)
(d (- r cr) (- c cc) ch)) (m! (λ (w h r c)
r c)))) (okay? w h (- r cr) (- c cc)))
(λ (r c ch)
(d (- r cr) (- c cc) ch))
r c))))
(define (if-drawn f x) (define (if-drawn f x)
(match-define (raart w h !) x) (match-define (raart w h !) x)
(raart w h (λ (d r c) (raart* w h (λ (okay? d r c)
(define ? (! d r c)) (define ? (! okay? d r c))
(when ? (f)) (when ? (f))
?))) ?)))
(define (place-cursor-after x cr cc) (define (place-cursor-after x cr cc)
(match-define (raart w h !) x) (match-define (raart w h !) x)
(raart w h (λ (d r c) (raart* w h (λ (okay? d r c)
(strict-or (! d r c) (strict-or (! okay? d r c)
(d cr cc #f))))) (d cr cc #f)))))
(define (*vappend2 y x) (define (*vappend2 y x)
(match-define (raart xw xh x!) x) (match-define (raart xw xh x!) x)
(match-define (raart yw yh y!) y) (match-define (raart yw yh y!) y)
(unless (= xw yw) (unless (= xw yw)
(error '*vappend2 "Widths must be equal: ~e vs ~e" xw yw)) (error '*vappend2 "Widths must be equal: ~e vs ~e" xw yw))
(raart xw (+ xh yh) (raart* xw (+ xh yh)
(λ (d r c) (λ (okay? d r c)
(strict-or (strict-or
(x! d (+ r 0) c) (x! okay? d (+ r 0) c)
(y! d (+ r xh) c))))) (y! okay? d (+ r xh) c)))))
(define (*happend2 y x) (define (*happend2 y x)
(match-define (raart xw xh x!) x) (match-define (raart xw xh x!) x)
(match-define (raart yw yh y!) y) (match-define (raart yw yh y!) y)
(unless (= xh yh) (unless (= xh yh)
(error '*happend2 "Heights must be equal: ~e vs ~e" xh yh)) (error '*happend2 "Heights must be equal: ~e vs ~e" xh yh))
(raart (+ xw yw) xh (raart* (+ xw yw) xh
(λ (d r c) (λ (okay? d r c)
(strict-or (strict-or
(x! d r (+ c 0)) (x! okay? d r (+ c 0))
(y! d r (+ c xw)))))) (y! okay? d r (+ c xw))))))
;; Library ;; Library
(define (style s x) (with-drawing s #f #f x)) (define (style s x) (with-drawing s #f #f x))