6902 - mu - Soul of a tiny new machine. More thorough tests → More comprehensible and rewrite-friendly software → More resilient society.

about summary refs log tree commit diff stats
diff options
author	Kartik Agaram <vc@akkartik.com>	2020-09-29 19:24:29 -0700
committer	Kartik Agaram <vc@akkartik.com>	2020-09-29 19:24:29 -0700
commit	cf1ddc4170e9d76eea196e4bc34dcf5f9bc66fdd (patch)
tree	cd71b89a9cb02cfeab2013424d3bf38e71745854 /apps/braces
parent	d2b9c7283aa497d4bae69c0f6e50484ab7d104ea (diff)
download	mu-cf1ddc4170e9d76eea196e4bc34dcf5f9bc66fdd.tar.gz
6902
Diffstat (limited to 'apps/braces')
-rwxr-xr-x
apps/braces
bin
46729 -> 46729 bytes
1 files changed, 0 insertions, 0 deletions
'#n119'>119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 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?)))

context:
space:
mode: