blob: 4cbff6e52b1352284c6f36f63c38237e14b3fd49 (
plain) (
tree)
|
|
#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?)))
|