diff options
Diffstat (limited to 'archive/0.vm.arc/charterm/demo.rkt')
| -rw-r--r-- | archive/0.vm.arc/charterm/demo.rkt | 306 |
1 files changed, 306 insertions, 0 deletions
diff --git a/archive/0.vm.arc/charterm/demo.rkt b/archive/0.vm.arc/charterm/demo.rkt new file mode 100644 index 00000000..4cbff6e5 --- /dev/null +++ b/archive/0.vm.arc/charterm/demo.rkt @@ -0,0 +1,306 @@ +#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?))) |