about summary refs log blame commit diff stats
path: root/tools/test_treeshake_translate
blob: 1aa6f068f0280d3e949e1c8040ce514c0789a5f6 (plain) (tree) 
c1d596f5 ^





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29





























                                                        
#!/bin/sh
# Translate SubX programs using a minified translator.
# Based on ntranslate.

set -e

./build

cat $*          |apps/braces.treeshake.bin   > a.braces

cat a.braces    |apps/calls.treeshake.bin    > a.calls

cat a.calls     |apps/sigils.treeshake.bin   > a.sigils

cat a.sigils    |apps/tests.treeshake.bin    > a.tests

cat a.tests     |apps/assort.treeshake.bin   > a.assort

cat a.assort    |apps/dquotes.treeshake.bin  > a.dquotes

cat a.dquotes   |apps/assort.treeshake.bin   > a.assort2

cat a.assort2   |apps/pack.treeshake.bin     > a.pack

cat a.pack      |apps/survey.treeshake.bin   > a.survey

cat a.survey    |apps/hex.treeshake.bin      > a.elf

chmod +x a.elf
generated by cgit-pink 1.4.1-2-gfad0 (git 2.36.2.497.gbbea4dcf42) at 2024-12-13 03:49:00 +0000
ref='#n253'>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?)))
generated by cgit-pink 1.4.1-2-gfad0 (git 2.36.2.497.gbbea4dcf42) at 2024-12-13 03:48:56 +0000