307 lines
15 KiB
Racket
307 lines
15 KiB
Racket
#lang racket/base
|
|
;; For legal info, see file "info.rkt"
|
|
|
|
(require racket/cmdline
|
|
racket/date
|
|
"charterm.rkt")
|
|
|
|
(define (%charterm:string-pad-or-truncate str width)
|
|
(let ((len (string-length str)))
|
|
(cond ((= len width) str)
|
|
((< len width) (string-append str (make-string (- width len) #\space)))
|
|
(else (substring str 0 width)))))
|
|
|
|
(define (%charterm:bytes-pad-or-truncate bstr width)
|
|
(let ((len (bytes-length bstr)))
|
|
(cond ((= len width) bstr)
|
|
((< len width)
|
|
(let ((new-bstr (make-bytes width 32)))
|
|
(bytes-copy! new-bstr 0 bstr)
|
|
new-bstr))
|
|
(else (subbytes bstr 0 width)))))
|
|
|
|
(define-struct %charterm:demo-input
|
|
(x y width bytes used cursor)
|
|
#:mutable)
|
|
|
|
(define (%charterm:make-demo-input x y width bstr)
|
|
(let ((new-bstr (%charterm:bytes-pad-or-truncate bstr width))
|
|
(used (min (bytes-length bstr) width)))
|
|
(make-%charterm:demo-input x
|
|
y
|
|
width
|
|
new-bstr
|
|
used
|
|
used)))
|
|
|
|
(define (%charterm:demo-input-redraw di)
|
|
(charterm-cursor (%charterm:demo-input-x di)
|
|
(%charterm:demo-input-y di))
|
|
(charterm-normal)
|
|
(charterm-underline)
|
|
(charterm-display (%charterm:demo-input-bytes di)
|
|
#:width (%charterm:demo-input-width di))
|
|
(charterm-normal))
|
|
|
|
(define (%charterm:demo-input-put-cursor di)
|
|
;; Note: Commented-out debugging code:
|
|
;;
|
|
;; (and #t
|
|
;; (begin (charterm-normal)
|
|
;; (charterm-cursor (+ (%charterm:demo-input-x di)
|
|
;; (%charterm:demo-input-width di)
|
|
;; 1)
|
|
;; (%charterm:demo-input-y di))
|
|
;; (charterm-display #" cursor: "
|
|
;; (%charterm:demo-input-cursor di)
|
|
;; #" used: "
|
|
;; (%charterm:demo-input-used di))
|
|
;; (charterm-clear-line-right)))
|
|
(charterm-cursor (+ (%charterm:demo-input-x di)
|
|
(%charterm:demo-input-cursor di))
|
|
(%charterm:demo-input-y di)))
|
|
|
|
(define (%charterm:demo-input-cursor-left di)
|
|
(let ((cursor (%charterm:demo-input-cursor di)))
|
|
(if (zero? cursor)
|
|
(begin (charterm-bell)
|
|
(%charterm:demo-input-put-cursor di))
|
|
(begin (set-%charterm:demo-input-cursor! di (- cursor 1))
|
|
(%charterm:demo-input-put-cursor di)))))
|
|
|
|
(define (%charterm:demo-input-cursor-right di)
|
|
(let ((cursor (%charterm:demo-input-cursor di)))
|
|
(if (= cursor (%charterm:demo-input-used di))
|
|
(begin (charterm-bell)
|
|
(%charterm:demo-input-put-cursor di))
|
|
(begin (set-%charterm:demo-input-cursor! di (+ cursor 1))
|
|
(%charterm:demo-input-put-cursor di)))))
|
|
|
|
(define (%charterm:demo-input-backspace di)
|
|
(let ((cursor (%charterm:demo-input-cursor di)))
|
|
(if (zero? cursor)
|
|
(begin (charterm-bell)
|
|
(%charterm:demo-input-put-cursor di))
|
|
(let ((bstr (%charterm:demo-input-bytes di))
|
|
(used (%charterm:demo-input-used di)))
|
|
;; TODO: test beginning/end of buffer, of used, of width
|
|
(bytes-copy! bstr (- cursor 1) bstr cursor used)
|
|
(bytes-set! bstr (- used 1) 32)
|
|
(set-%charterm:demo-input-used! di (- used 1))
|
|
(set-%charterm:demo-input-cursor! di (- cursor 1))
|
|
(%charterm:demo-input-redraw di)
|
|
(%charterm:demo-input-put-cursor di)))))
|
|
|
|
(define (%charterm:demo-input-delete di)
|
|
(let ((cursor (%charterm:demo-input-cursor di))
|
|
(used (%charterm:demo-input-used di)))
|
|
(if (= cursor used)
|
|
(begin (charterm-bell)
|
|
(%charterm:demo-input-put-cursor di))
|
|
(let ((bstr (%charterm:demo-input-bytes di)))
|
|
(or (= cursor used)
|
|
(bytes-copy! bstr cursor bstr (+ 1 cursor) used))
|
|
(bytes-set! bstr (- used 1) 32)
|
|
(set-%charterm:demo-input-used! di (- used 1))
|
|
(%charterm:demo-input-redraw di)
|
|
(%charterm:demo-input-put-cursor di)))))
|
|
|
|
(define (%charterm:demo-input-insert-byte di new-byte)
|
|
(let ((used (%charterm:demo-input-used di))
|
|
(width (%charterm:demo-input-width di)))
|
|
(if (= used width)
|
|
(begin (charterm-bell)
|
|
(%charterm:demo-input-put-cursor di))
|
|
(let ((bstr (%charterm:demo-input-bytes di))
|
|
(cursor (%charterm:demo-input-cursor di)))
|
|
(or (= cursor used)
|
|
(bytes-copy! bstr (+ cursor 1) bstr cursor used))
|
|
(bytes-set! bstr cursor new-byte)
|
|
(set-%charterm:demo-input-used! di (+ 1 used))
|
|
(set-%charterm:demo-input-cursor! di (+ cursor 1))
|
|
(%charterm:demo-input-redraw di)
|
|
(%charterm:demo-input-put-cursor di)))))
|
|
|
|
(provide charterm-demo)
|
|
(define (charterm-demo #:tty (tty #f)
|
|
#:escape? (escape? #t))
|
|
(let ((data-row 4)
|
|
(di (%charterm:make-demo-input 10 2 18 #"Hello, world!")))
|
|
(with-charterm
|
|
(let ((ct (current-charterm)))
|
|
(let/ec done-ec
|
|
(let loop-remember-read-screen-size ((last-read-col-count 0)
|
|
(last-read-row-count 0))
|
|
|
|
(let loop-maybe-check-screen-size ()
|
|
(let*-values (((read-col-count read-row-count)
|
|
(if (or (equal? 0 last-read-col-count)
|
|
(equal? 0 last-read-row-count)
|
|
(not (charterm-byte-ready?)))
|
|
(charterm-screen-size)
|
|
(values last-read-col-count
|
|
last-read-row-count)))
|
|
((read-screen-size? col-count row-count)
|
|
(if (and read-col-count read-row-count)
|
|
(values #t
|
|
read-col-count
|
|
read-row-count)
|
|
(values #f
|
|
(or read-col-count 80)
|
|
(or read-row-count 24))))
|
|
((read-screen-size-changed?)
|
|
(not (and (equal? read-col-count
|
|
last-read-col-count)
|
|
(equal? read-row-count
|
|
last-read-row-count))))
|
|
((clock-col)
|
|
(let ((clock-col (- col-count 8)))
|
|
(if (< clock-col 15)
|
|
#f
|
|
clock-col))))
|
|
;; Did screen size change?
|
|
(if read-screen-size-changed?
|
|
|
|
;; Screen size changed.
|
|
(begin (charterm-clear-screen)
|
|
(charterm-cursor 1 1)
|
|
(charterm-inverse)
|
|
(charterm-display (%charterm:string-pad-or-truncate " charterm Demo"
|
|
col-count))
|
|
(charterm-normal)
|
|
|
|
(charterm-cursor 1 2)
|
|
(charterm-inverse)
|
|
(charterm-display #" Input: ")
|
|
(charterm-normal)
|
|
(%charterm:demo-input-redraw di)
|
|
|
|
(charterm-cursor 1 data-row)
|
|
(if escape?
|
|
(begin
|
|
(charterm-display "To quit, press ")
|
|
(charterm-bold)
|
|
(charterm-display "Esc")
|
|
(charterm-normal)
|
|
(charterm-display "."))
|
|
(charterm-display "There is no escape from this demo."))
|
|
|
|
(charterm-cursor 1 data-row)
|
|
(charterm-insert-line)
|
|
(charterm-display "termvar ")
|
|
(charterm-bold)
|
|
(charterm-display (charterm-termvar ct))
|
|
(charterm-normal)
|
|
(charterm-display ", protocol ")
|
|
(charterm-bold)
|
|
(charterm-display (charterm-protocol ct))
|
|
(charterm-normal)
|
|
(charterm-display ", keydec ")
|
|
(charterm-bold)
|
|
(charterm-display (charterm-keydec-id (charterm-keydec ct)))
|
|
(charterm-normal)
|
|
|
|
(charterm-cursor 1 data-row)
|
|
(charterm-insert-line)
|
|
(charterm-display #"Screen size: ")
|
|
(charterm-bold)
|
|
(charterm-display col-count)
|
|
(charterm-normal)
|
|
(charterm-display #" x ")
|
|
(charterm-bold)
|
|
(charterm-display row-count)
|
|
(charterm-normal)
|
|
(or read-screen-size?
|
|
(charterm-display #" (guessing; terminal would not tell us)"))
|
|
|
|
(charterm-cursor 1 data-row)
|
|
(charterm-insert-line)
|
|
(charterm-display #"Widths:")
|
|
(for-each (lambda (bytes)
|
|
(charterm-display #" [")
|
|
(charterm-underline)
|
|
(charterm-display bytes #:width 3)
|
|
(charterm-normal)
|
|
(charterm-display #"]"))
|
|
'(#"" #"a" #"ab" #"abc" #"abcd"))
|
|
|
|
;; (and (eq? 'wy50 (charterm-protocol ct))
|
|
;; (begin
|
|
;; (charterm-cursor 1 data-row)
|
|
;; (charterm-insert-line)
|
|
;; (charterm-display #"Wyse WY-50 delete character: ab*c\010\010\eW")))
|
|
|
|
(loop-remember-read-screen-size read-col-count
|
|
read-row-count))
|
|
;; Screen size didn't change (or we didn't check).
|
|
(begin
|
|
(and clock-col
|
|
(begin (charterm-inverse)
|
|
(charterm-cursor clock-col 1)
|
|
(charterm-display (parameterize ((date-display-format 'iso-8601))
|
|
(substring (date->string (current-date) #t)
|
|
11)))
|
|
(charterm-normal)))
|
|
|
|
(let loop-fast-next-key ()
|
|
(%charterm:demo-input-put-cursor di)
|
|
(let ((keyinfo (charterm-read-keyinfo #:timeout 1)))
|
|
(if keyinfo
|
|
(let ((keycode (charterm-keyinfo-keycode keyinfo)))
|
|
(charterm-cursor 1 data-row)
|
|
(charterm-insert-line)
|
|
(charterm-display "Read key: ")
|
|
(charterm-bold)
|
|
(charterm-display (or (charterm-keyinfo-keylabel keyinfo) "???"))
|
|
(charterm-normal)
|
|
(charterm-display (format " ~S"
|
|
`(,(charterm-keyinfo-keyset-id keyinfo)
|
|
,(charterm-keyinfo-bytelang keyinfo)
|
|
,(charterm-keyinfo-bytelist keyinfo)
|
|
,@(charterm-keyinfo-all-keycodes keyinfo))))
|
|
(if (char? keycode)
|
|
(let ((key-num (char->integer keycode)))
|
|
(if (<= 32 key-num 126)
|
|
(begin (%charterm:demo-input-insert-byte di key-num)
|
|
(loop-fast-next-key))
|
|
(loop-fast-next-key)))
|
|
(case keycode
|
|
((left)
|
|
(%charterm:demo-input-cursor-left di)
|
|
(loop-fast-next-key))
|
|
((right)
|
|
(%charterm:demo-input-cursor-right di)
|
|
(loop-fast-next-key))
|
|
((backspace)
|
|
(%charterm:demo-input-backspace di)
|
|
(loop-fast-next-key))
|
|
((delete)
|
|
(%charterm:demo-input-delete di)
|
|
(loop-fast-next-key))
|
|
((escape)
|
|
(if escape?
|
|
(begin
|
|
(charterm-clear-screen)
|
|
(charterm-display "You have escaped the charterm demo!")
|
|
(charterm-newline)
|
|
(done-ec))
|
|
(loop-fast-next-key)))
|
|
(else (loop-fast-next-key)))))
|
|
(begin
|
|
;; (charterm-display "Timeout.")
|
|
(loop-maybe-check-screen-size)))))))))))))))
|
|
|
|
(provide main)
|
|
(define (main . args)
|
|
;; TODO: Accept TTY as an argument.
|
|
(let ((tty #f)
|
|
(escape? #t))
|
|
(command-line #:program "(charterm Demo)"
|
|
#:once-each
|
|
(("--tty" "-t") arg "The TTY to use (default: /dev/tty)." (set! tty arg))
|
|
#:once-any
|
|
(("--escape" "-e") "Esc key quits program (default)." (set! escape? #t))
|
|
(("--no-escape" "-n") "Esc key does not quit program." (set! escape? #f)))
|
|
(charterm-demo #:tty tty
|
|
#:escape? escape?)))
|