#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?)))