5485 - promote SubX to top-level

1 files changed, 306 insertions, 0 deletions

diff --git a/archive/1.vm.arc/charterm/demo.rkt b/archive/1.vm.arc/charterm/demo.rkt
new file mode 100644
index 00000000..4cbff6e5
--- /dev/null
+++ b/archive/1.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?)))