This commit is contained in:
parent
f84fd13c34
commit
ce775238cc
7
main.rkt
7
main.rkt
|
@ -37,10 +37,11 @@
|
|||
;; h : exact-nonnegative-integer?
|
||||
;; ! : (row col char -> void) row col -> void
|
||||
(struct rart (w h !))
|
||||
(define (draw row col x)
|
||||
(define (draw row col x #:clear? [clear? #t])
|
||||
(match-define (rart w h !) x)
|
||||
(display (A:dec-soft-terminal-reset))
|
||||
(display (A:clear-screen/home))
|
||||
(display (A:dec-soft-terminal-reset))
|
||||
(when clear?
|
||||
(display (A:clear-screen/home)))
|
||||
(set-drawing-parameters!)
|
||||
(! (λ (r c ch)
|
||||
(display (A:goto r c))
|
||||
|
|
72
size.rkt
72
size.rkt
|
@ -17,37 +17,69 @@
|
|||
[(== byte) empty]
|
||||
[next (cons next (loop))]))))
|
||||
|
||||
(define (screen-size)
|
||||
(define tty-str "/dev/tty")
|
||||
(define (bytes->number bs)
|
||||
(string->number (bytes->string/utf-8 bs)))
|
||||
|
||||
(define default-tty "/dev/tty")
|
||||
(struct term (f in out))
|
||||
(define (open-term #:tty [tty default-tty])
|
||||
(system* "/bin/stty"
|
||||
stty-minus-f-arg-string
|
||||
tty-str
|
||||
tty
|
||||
"raw"
|
||||
"-echo")
|
||||
(define-values (in out)
|
||||
(open-input-output-file tty-str #:exists 'update))
|
||||
(write-bytes #"\e[18t" out) (flush-output out)
|
||||
(dynamic-wind
|
||||
void
|
||||
(λ ()
|
||||
(open-input-output-file tty #:exists 'update))
|
||||
(term tty in out))
|
||||
|
||||
(define (close-term t)
|
||||
(match-define (term f in out) t)
|
||||
(close-input-port in)
|
||||
(close-output-port out)
|
||||
(system* "/bin/stty"
|
||||
stty-minus-f-arg-string
|
||||
f
|
||||
"cooked"
|
||||
"echo"))
|
||||
|
||||
(define (with-term f #:tty [tty default-tty])
|
||||
(define t (open-term #:tty tty))
|
||||
(define (close!) (close-term t))
|
||||
(with-handlers ([exn:fail? (λ (x) (close!) (raise x))])
|
||||
(begin0 (f t) (close!))))
|
||||
|
||||
(define (with-term* t f)
|
||||
(if t (f t) (with-term f)))
|
||||
|
||||
(define (screen-size [t #f])
|
||||
(with-term* t
|
||||
(λ (t)
|
||||
(match-define (term _ in out) t)
|
||||
(write-bytes #"\e[18t" out) (flush-output out)
|
||||
(match (read-until in #\;)
|
||||
[#"\e[8"
|
||||
(define row-s (read-until in #\;))
|
||||
(define col-s (read-until in #\t))
|
||||
(values (bytes->number row-s)
|
||||
(bytes->number col-s))]
|
||||
[_ (values #f #f)]))
|
||||
(λ ()
|
||||
(close-input-port in)
|
||||
(close-output-port out)
|
||||
(system* "/bin/stty"
|
||||
stty-minus-f-arg-string
|
||||
tty-str
|
||||
"cooked"
|
||||
"echo"))))
|
||||
[x (error 'screen-size "Something weird happened, got ~e" x)]))))
|
||||
|
||||
(define (bytes->number bs)
|
||||
(string->number (bytes->string/utf-8 bs)))
|
||||
(define (cursor-position [t #f])
|
||||
(with-term* t
|
||||
(λ (t)
|
||||
(match-define (term _ in out) t)
|
||||
(display (position-report-request) out) (flush-output out)
|
||||
(match (read-bytes 2 in)
|
||||
[#"\e["
|
||||
(define row-s (read-until in #\;))
|
||||
(define col-s (read-until in #\R))
|
||||
(values (bytes->number row-s)
|
||||
(bytes->number col-s))]
|
||||
[x (error 'cursor-position "Something weird happened, got ~e" x)]))))
|
||||
|
||||
(module+ main
|
||||
(screen-size))
|
||||
(with-term
|
||||
(λ (t)
|
||||
(screen-size t)
|
||||
(cursor-position t))))
|
||||
|
||||
|
|
Loading…
Reference in New Issue