From 5d7557df553ff85386ec4f7d991831154d4b7794 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Wed, 7 Sep 2016 07:54:21 -0400
Subject: [PATCH] TUI experiment WIP

---
 racket/syndicate-ide/diff.rkt             | 129 +++++++++++
 racket/syndicate-ide/display-terminal.rkt | 269 ++++++++++++++++++++++
 racket/syndicate-ide/display.rkt          | 208 +++++++++++++++++
 racket/syndicate-ide/tui.rkt              |  63 +++++
 racket/syndicate-ide/wm.rkt               | 158 +++++++++++++
 5 files changed, 827 insertions(+)
 create mode 100644 racket/syndicate-ide/diff.rkt
 create mode 100644 racket/syndicate-ide/display-terminal.rkt
 create mode 100644 racket/syndicate-ide/display.rkt
 create mode 100644 racket/syndicate-ide/tui.rkt
 create mode 100644 racket/syndicate-ide/wm.rkt

diff --git a/racket/syndicate-ide/diff.rkt b/racket/syndicate-ide/diff.rkt
new file mode 100644
index 0000000..5e1c637
--- /dev/null
+++ b/racket/syndicate-ide/diff.rkt
@@ -0,0 +1,129 @@
+#lang racket/base
+;; Text diff algorithm after Myers 1986 and Ukkonen 1985, following
+;; Levente Uzonyi's Squeak Smalltalk implementation at
+;; http://squeaksource.com/DiffMerge.html
+;;
+;; E. W. Myers, “An O(ND) difference algorithm and its variations,”
+;; Algorithmica, vol. 1, no. 1–4, pp. 251–266, Nov. 1986.
+;;
+;; E. Ukkonen, “Algorithms for approximate string matching,” Inf.
+;; Control, vol. 64, no. 1–3, pp. 100–118, Jan. 1985.
+
+(provide diff-indices
+         apply-patch!)
+
+(require racket/match)
+
+(define (longest-common-subsequence* xs ys)
+  (define xs-length (vector-length xs))
+  (define ys-length (vector-length ys))
+  (define total-length (+ xs-length ys-length))
+  (define storage-length (+ 1 (* 2 total-length)))
+  (define frontier (make-vector storage-length 0))
+  (define candidates (make-vector storage-length '()))
+  (let/ec return
+    (for ((d (in-range 0 (+ total-length 1))))
+      (for ((k (in-range (- d) (+ d 1) 2)))
+        (define-values (index x)
+          (if (or (= k (- d))
+                  (and (not (= k d))
+                       (< (vector-ref frontier (+ total-length k -1))
+                          (vector-ref frontier (+ total-length k 1)))))
+              (values (+ total-length k 1) (vector-ref frontier (+ total-length k 1)))
+              (values (+ total-length k -1) (+ (vector-ref frontier (+ total-length k -1)) 1))))
+        (let loop ((x x) (y (- x k)) (chain (vector-ref candidates index)))
+          (cond
+           [(and (< x xs-length) (< y ys-length) (equal? (vector-ref xs x) (vector-ref ys y)))
+            (loop (+ x 1) (+ y 1) (cons (cons x y) chain))]
+           [(and (>= x xs-length) (>= y ys-length))
+            (return (reverse chain))]
+           [else
+            (vector-set! frontier (+ total-length k) x)
+            (vector-set! candidates (+ total-length k) chain)]))))))
+
+(define (sequence->vector xs) (for/vector ((x xs)) x))
+
+(define (longest-common-subsequence xs ys)
+  (longest-common-subsequence* (sequence->vector xs) (sequence->vector ys)))
+
+(define (diff-indices xs0 ys0)
+  (define xs (sequence->vector xs0))
+  (define ys (sequence->vector ys0))
+  (let loop ((i -1)
+             (j -1)
+             (matches (append (longest-common-subsequence* xs ys)
+                              (list (cons (vector-length xs) (vector-length ys))))))
+    (match matches
+      ['() '()]
+      [(cons (cons mi mj) rest)
+       (define li (- mi i 1))
+       (define lj (- mj j 1))
+       (if (or (positive? li) (positive? lj))
+           (cons (list (+ i 1) li (+ j 1) lj) (loop mi mj rest))
+           (loop mi mj rest))])))
+
+;; patch-indices is a result from a call to diff-indices
+(define (apply-patch! patch-indices ;; DiffIndices
+                      remove-elements! ;; Nat Nat -> Void
+                      insert-elements! ;; Nat Nat Nat -> Void
+                      )
+  (for/fold [(skew 0)] [(patch patch-indices)]
+    (match-define (list old-i old-n new-i new-n) patch)
+    (define delta (- new-n old-n))
+    (if (negative? delta)
+        (begin (remove-elements! (+ old-i skew) (- delta))
+               (+ skew delta))
+        skew))
+  (for/fold [(skew 0)] [(patch patch-indices)]
+    (match-define (list old-i old-n new-i new-n) patch)
+    (define delta (- new-n old-n))
+    (insert-elements! (+ old-i skew) (max 0 delta) new-n)
+    (+ skew delta))
+  (void))
+
+(module+ test
+  (require rackunit)
+
+  ;; (define (test-example xs ys)
+  ;;   (printf "~v\n" (longest-common-subsequence xs ys))
+  ;;   (printf "~v\n" (diff-indices xs ys)))
+  ;; (test-example "The red brown fox jumped over the rolling log"
+  ;;               "The brown spotted fox leaped over the rolling log")
+
+  (check-equal? (diff-indices "The red brown fox jumped over the rolling log"
+                              "The brown spotted fox leaped over the rolling log")
+                '((4 4 4 0) (14 0 10 8) (18 3 22 3)))
+
+  (check-equal? (longest-common-subsequence "acbcaca" "bcbcacb")
+                '((1 . 1) (2 . 2) (3 . 3) (4 . 4) (5 . 5)))
+  (check-equal? (longest-common-subsequence "bcbcacb" "acbcaca")
+                '((1 . 1) (2 . 2) (3 . 3) (4 . 4) (5 . 5)))
+  (check-equal? (longest-common-subsequence "acba" "bcbb")
+                '((1 . 1) (2 . 2)))
+  (check-equal? (longest-common-subsequence "abcabba" "cbabac")
+                '((2 . 0) (3 . 2) (4 . 3) (6 . 4)))
+  (check-equal? (longest-common-subsequence "cbabac" "abcabba")
+                '((1 . 1) (2 . 3) (3 . 4) (4 . 6)))
+
+  (check-equal? (longest-common-subsequence
+                 (vector (vector 1 1 1) (vector 1 1 1) (vector 1 1 1) (vector 1 1 1))
+                 (vector (vector 1 1 1) (vector 2 2 2) (vector 1 1 1) (vector 4 4 4)))
+                '((0 . 0) (1 . 2)))
+  (check-equal? (diff-indices
+                 (vector (vector 1 1 1) (vector 1 1 1) (vector 1 1 1) (vector 1 1 1))
+                 (vector (vector 1 1 1) (vector 2 2 2) (vector 1 1 1) (vector 4 4 4)))
+                '((1 0 1 1) (2 2 3 1)))
+
+  (check-equal? (longest-common-subsequence '(a b c) '(d e f)) '())
+  (check-equal? (diff-indices '(a b c) '(d e f)) '((0 3 0 3)))
+
+  (let ((size 400))
+    (local-require profile)
+    (profile-thunk
+     (lambda ()
+       (diff-indices (make-vector size 'x)
+                     (let ((v (make-vector size 'x)))
+                       (vector-set! v 0 'a)
+                       (vector-set! v 1 'b)
+                       (vector-set! v 2 'c)
+                       v))))))
diff --git a/racket/syndicate-ide/display-terminal.rkt b/racket/syndicate-ide/display-terminal.rkt
new file mode 100644
index 0000000..c05040f
--- /dev/null
+++ b/racket/syndicate-ide/display-terminal.rkt
@@ -0,0 +1,269 @@
+#lang racket/base
+;; Implicitly provides a factory via display.rkt's `register-tty-backend!`.
+
+(require racket/set)
+(require racket/match)
+(require (only-in racket/vector vector-copy))
+(require (prefix-in ansi: ansi))
+(require "display.rkt")
+(require "diff.rkt")
+
+(struct terminal (input ;; InputPort
+                  output ;; OutputPort
+                  [displayed-screen #:mutable] ;; Screen
+                  [pending-screen #:mutable] ;; Screen
+                  [utf-8-input? #:mutable] ;; Boolean
+                  [displayed-title #:mutable] ;; (Option String)
+                  [pending-title #:mutable] ;; (Option String)
+                  )
+  #:methods gen:tty
+  [(define (tty-pending-screen t) (terminal-pending-screen t))
+   (define (set-tty-pending-screen! t s) (set-terminal-pending-screen! t s))
+   (define (tty-reset t) (reset t))
+   (define (tty-flush t) (terminal-flush t))
+   (define (tty-set-title! t title) (set-terminal-pending-title! t title))
+   (define (tty-next-key t) (terminal-next-key t))
+   (define (tty-next-key-evt t) (terminal-next-key-evt t))
+   (define (tty-input-available-evt t) (terminal-input t))])
+
+(define *stdin-tty* #f)
+(define (stdin-tty)
+  (when (not *stdin-tty*)
+    (ansi:tty-raw!)
+    (set! *stdin-tty*
+          (terminal
+           (current-input-port)
+           (current-output-port)
+           (make-screen 24 80 tty-default-pen)
+           (make-screen 24 80 tty-default-pen)
+           (match (getenv "RMACS_UTF8_INPUT")
+             [(or #f "yes" "true" "1") #t]
+             [(or "no" "false" "0") #f]
+             [v (error 'RMACS_UTF8_INPUT
+                       "Environment variable RMACS_UTF8_INPUT value ~v invalid: must be in ~v"
+                       v
+                       (list "yes" "true" "1" "no" "false" "0"))])
+           #f
+           #f))
+    (reset *stdin-tty*)
+    (plumber-add-flush! (current-plumber)
+                        (lambda (h)
+                          (output *stdin-tty*
+                                  (ansi:select-graphic-rendition ansi:style-normal)
+                                  (ansi:goto (tty-rows *stdin-tty*) 1))
+                          (flush *stdin-tty*))))
+  *stdin-tty*)
+
+(define (collect-position-report tty)
+  (let loop ()
+    (sync/timeout 0.5
+                  (handle-evt (terminal-input tty)
+                              (lambda (p)
+                                (match (ansi:lex-lcd-input p)
+                                  [(? ansi:position-report? r) r]
+                                  [_ (loop)]))))))
+
+(define (reset tty)
+  (output tty
+          (ansi:clear-screen)
+          (ansi:goto 999 999)
+          (ansi:position-report-request))
+  (flush tty)
+  (define report (or (collect-position-report tty)
+                     (ansi:position-report 24 80))) ;; TODO: have a more flexible fallback
+  (define rows (ansi:position-report-row report))
+  (define columns (ansi:position-report-column report))
+  (set-pen tty tty-default-pen #:force #t)
+  (clear tty)
+  (flush tty)
+  (set-terminal-displayed-screen! tty (make-screen rows columns tty-default-pen))
+  (set-terminal-pending-screen! tty (make-screen rows columns tty-default-pen))
+  tty)
+
+(define (set-pen tty p #:force [force #f])
+  (when (or force (not (equal? p (screen-pen (terminal-displayed-screen tty)))))
+    (match p
+      [(pen fgcolor bgcolor bold? italic?)
+       (output tty
+               (apply ansi:select-graphic-rendition
+                      `(,@(if bold? (list ansi:style-bold) (list))
+                        ,@(if italic? (list ansi:style-italic/inverse) (list))
+                        ,(ansi:style-text-color fgcolor)
+                        ,(ansi:style-background-color bgcolor))))]
+      ['default
+       (output tty (ansi:select-graphic-rendition ansi:style-normal))])
+    (set-screen-pen! (terminal-displayed-screen tty) p))
+  tty)
+
+(define (clear tty)
+  (output tty (ansi:clear-screen/home))
+  (set-screen-cursor-row! (terminal-displayed-screen tty) 0)
+  (set-screen-cursor-column! (terminal-displayed-screen tty) 0)
+  tty)
+
+(define (color-near-cursor s row-delta column-delta)
+  (define r (max 0 (min (- (screen-rows s) 1) (+ (screen-cursor-row s) row-delta))))
+  (define c (max 0 (min (- (screen-columns s) 1) (+ (screen-cursor-column s) column-delta))))
+  (car (vector-ref (vector-ref (screen-contents s) r) c)))
+
+(define (vector-delete! v base count fill)
+  (vector-copy! v base v (+ base count) (vector-length v))
+  (for ((i (in-range (- (vector-length v) count) (vector-length v)))) (vector-set! v i fill)))
+
+(define (vector-insert! v base count fill)
+  (vector-copy! v (+ base count) v base (- (vector-length v) count))
+  (for ((i (in-range base (+ base count)))) (vector-set! v i fill)))
+
+(define (delete-lines tty n)
+  (define s (terminal-displayed-screen tty))
+  (set-pen tty tty-default-pen)
+  (output tty (ansi:delete-lines n))
+  (define blank-line (make-vector (screen-columns s) (cons (screen-pen s) 'empty)))
+  (vector-delete! (screen-contents s) (screen-cursor-row s) n blank-line)
+  tty)
+
+(define (insert-lines tty n)
+  (define s (terminal-displayed-screen tty))
+  (set-pen tty tty-default-pen)
+  (output tty (ansi:insert-lines n))
+  (define blank-line (make-vector (screen-columns s) (cons (screen-pen s) 'empty)))
+  (vector-insert! (screen-contents s) (screen-cursor-row s) n blank-line)
+  tty)
+
+(define (delete-columns tty n)
+  (define s (terminal-displayed-screen tty))
+  (set-pen tty tty-default-pen)
+  (output tty (ansi:delete-characters n))
+  (define blank-cell (cons (screen-pen s) 'empty))
+  (define line (vector-ref (screen-contents s) (screen-cursor-row s)))
+  (vector-delete! line (screen-cursor-column s) n blank-cell)
+  tty)
+
+(define (insert-columns tty n)
+  (define s (terminal-displayed-screen tty))
+  (set-pen tty (color-near-cursor s 0 -1))
+  (output tty (ansi:insert-characters n))
+  (define blank-cell (cons (screen-pen s) 'empty))
+  (define line (vector-ref (screen-contents s) (screen-cursor-row s)))
+  (vector-insert! line (screen-cursor-column s) n blank-cell)
+  tty)
+
+(define (output tty . items)
+  (for ((i items)) (display i (terminal-output tty))))
+
+(define (flush tty)
+  (flush-output (terminal-output tty)))
+
+;;---------------------------------------------------------------------------
+;; Display to buffered screen
+
+(define (goto-if-needed s row column)
+  (cond
+   [(and (= (screen-cursor-row s) row) (= (screen-cursor-column s) column))
+    ""]
+   [(= (screen-cursor-row s) row)
+    (begin0 (ansi:goto-column (+ column 1))
+      (set-screen-cursor-column! s column))]
+   [else
+    (begin0 (ansi:goto (+ row 1) (+ column 1))
+      (set-screen-cursor-row! s row)
+      (set-screen-cursor-column! s column))]))
+
+(define (advance-cursor! tty s)
+  (set-screen-cursor-column! s (+ (screen-cursor-column s) 1))
+  (when (= (screen-cursor-column s) (screen-columns s))
+    (when (< (screen-cursor-row s) (- (screen-rows s) 1))
+      (output tty "\r\n"))
+    (set-screen-cursor-column! s 0)
+    (set-screen-cursor-row! s (+ (screen-cursor-row s) 1))))
+
+;; Answers #t when an edit to a line would produce a visible effect.
+(define (interesting-change? old-line new-line column right-margin)
+  (for/or [(i (in-range column right-margin))]
+    (not (equal? (vector-ref old-line i) (vector-ref new-line i)))))
+
+(define (non-empty? ch) (not (equal? ch 'empty)))
+
+(define (repair-span! tty old new-line row first-col cell-count)
+  (define trailing-empty-count
+    (for/fold [(empty-count 0)] [(column (in-range first-col (+ first-col cell-count)))]
+      (match-define (cons new-pen new-ch) (vector-ref new-line column))
+      (if (non-empty? new-ch)
+          (begin (set-pen tty new-pen)
+                 (output tty (goto-if-needed old row column) new-ch)
+                 (advance-cursor! tty old)
+                 0)
+          (+ empty-count 1))))
+  (when (and (positive? trailing-empty-count) (= (+ first-col cell-count) (tty-columns tty)))
+    (output tty (ansi:clear-to-eol))))
+
+(define (repair-line! tty old new row)
+  (define columns (screen-columns new))
+  (define old-line (vector-ref (screen-contents old) row))
+  (define new-line (vector-ref (screen-contents new) row))
+  (define patches (diff-indices old-line new-line))
+  (if (<= (length patches) 3)
+      (apply-patch! patches
+                    (lambda (first-col cols-to-remove)
+                      (when (interesting-change? old-line new-line first-col columns)
+                        (output tty (goto-if-needed old row first-col))
+                        (delete-columns tty cols-to-remove)))
+                    (lambda (first-col cols-to-insert cell-count)
+                      (when (interesting-change? old-line new-line first-col columns)
+                        (output tty (goto-if-needed old row first-col))
+                        (when (and (positive? cols-to-insert)
+                                   (interesting-change? old-line
+                                                        new-line
+                                                        (+ first-col cols-to-insert)
+                                                        columns))
+                          (insert-columns tty cols-to-insert))
+                        (repair-span! tty old new-line row first-col cell-count))))
+      (repair-span! tty old new-line row 0 columns)))
+
+(define (terminal-flush t)
+  (define old (terminal-displayed-screen t))
+  (define new (terminal-pending-screen t))
+  (apply-patch! (diff-indices (screen-contents old) (screen-contents new))
+                (lambda (first-row lines-to-remove)
+                  (output t (goto-if-needed old first-row (screen-cursor-column old)))
+                  (delete-lines t lines-to-remove))
+                (lambda (first-row lines-to-insert line-count)
+                  (when (positive? lines-to-insert)
+                    (output t (goto-if-needed old first-row (screen-cursor-column old)))
+                    (insert-lines t lines-to-insert))
+                  (for ((row (in-range first-row (+ first-row line-count))))
+                    (repair-line! t old new row))))
+  (output t (goto-if-needed old (screen-cursor-row new) (screen-cursor-column new)))
+  (let ((new-title (terminal-pending-title t)))
+    (when (not (equal? new-title (terminal-displayed-title t)))
+      (when new-title (output t (ansi:xterm-set-window-title new-title)))
+      (set-terminal-displayed-title! t new-title)))
+  (flush t)
+  (set-terminal-displayed-screen! t (struct-copy screen new [pen (screen-pen old)]))
+  (set-terminal-pending-screen! t (copy-screen new))
+  t)
+
+;;---------------------------------------------------------------------------
+;; Input
+
+(define (has-control-modifier? modifiers)
+  (set-member? modifiers 'control))
+
+(define (terminal-next-key tty)
+  (define k (ansi:lex-lcd-input (terminal-input tty) #:utf-8? (terminal-utf-8-input? tty)))
+  (match k
+    [(ansi:key #\tab modifiers) (ansi:key 'tab modifiers)]
+    [(ansi:key #\I (? has-control-modifier? ms)) (ansi:key 'tab (set-remove ms 'control))]
+    [(ansi:key #\M (? has-control-modifier? ms)) (ansi:key 'return (set-remove ms 'control))]
+    [(ansi:key #\[ (? has-control-modifier? ms)) ;; ESC
+     (or (sync/timeout 0.5
+                       (handle-evt (terminal-next-key-evt tty)
+                                   (lambda (k) (ansi:add-modifier 'meta k))))
+         (ansi:key 'escape (set-remove ms 'control)))]
+    [_ k]))
+
+(define (terminal-next-key-evt tty)
+  (handle-evt (terminal-input tty)
+              (lambda (_) (terminal-next-key tty))))
+
+(register-tty-backend! 'terminal stdin-tty)
diff --git a/racket/syndicate-ide/display.rkt b/racket/syndicate-ide/display.rkt
new file mode 100644
index 0000000..d24ffad
--- /dev/null
+++ b/racket/syndicate-ide/display.rkt
@@ -0,0 +1,208 @@
+#lang racket/base
+
+(provide gen:tty
+         tty?
+         tty-pending-screen
+         set-tty-pending-screen!
+         tty-rows
+         tty-columns
+         tty-last-row
+         tty-last-column
+         tty-cursor-row
+         tty-cursor-column
+         tty-display
+         tty-newline
+         tty-clear
+         tty-clear-to-eol
+         tty-reset
+         tty-goto
+         tty-set-pen!
+         tty-default-pen
+         tty-pen
+         tty-flush
+         tty-set-title!
+         tty-next-key
+         tty-next-key-evt
+         tty-input-available-evt
+
+         (struct-out pen)
+
+         register-tty-backend!
+         default-tty
+
+         (struct-out screen)
+         make-screen
+         copy-screen
+         screen-last-row
+         screen-last-column
+         screen-goto
+         screen-putc
+         screen-puts
+         screen-clear-to-eol
+
+         ;; From ansi. TODO: better color & keyboard abstractions
+         (struct-out key)
+         (rename-out [ansi:color-black color-black]
+                     [ansi:color-red color-red]
+                     [ansi:color-green color-green]
+                     [ansi:color-yellow color-yellow]
+                     [ansi:color-blue color-blue]
+                     [ansi:color-magenta color-magenta]
+                     [ansi:color-cyan color-cyan]
+                     [ansi:color-white color-white]))
+
+(require racket/match)
+(require racket/generic)
+(require (only-in racket/vector vector-copy))
+(require (prefix-in ansi: (only-in ansi
+                                   color-black
+                                   color-red
+                                   color-green
+                                   color-yellow
+                                   color-blue
+                                   color-magenta
+                                   color-cyan
+                                   color-white)))
+(require (only-in ansi struct:key key key? key-value key-modifiers))
+
+;; A Color is a Nat. TODO: better color abstraction.
+
+(define-generics tty
+  (tty-pending-screen tty)
+  (set-tty-pending-screen! tty s)
+  (tty-reset tty)
+  (tty-flush tty)
+  (tty-set-title! tty title)
+  (tty-next-key tty)
+
+  ;; Do not retain the events returned by these functions across
+  ;; actual input from the tty! See comment in editor-sit-for, and
+  ;; implementations of these functions in display-gui.rkt. (The
+  ;; fragility of the pushback in display-gui.rkt is the cause of this
+  ;; restriction.)
+  (tty-next-key-evt tty)
+  (tty-input-available-evt tty)
+  )
+
+(define (tty-rows t) (screen-rows (tty-pending-screen t)))
+(define (tty-columns t) (screen-columns (tty-pending-screen t)))
+
+(define (tty-last-row t) (- (tty-rows t) 1))
+(define (tty-last-column t) (- (tty-columns t) 1))
+
+(define (tty-cursor-row t) (screen-cursor-row (tty-pending-screen t)))
+(define (tty-cursor-column t) (screen-cursor-column (tty-pending-screen t)))
+
+(define (tty-display t . strings)
+  (for [(str strings)]
+    (screen-puts (tty-pending-screen t) str)))
+
+(define (tty-newline t)
+  (define s (tty-pending-screen t))
+  (screen-clear-to-eol s)
+  (screen-putc s #\return)
+  (screen-putc s #\newline))
+
+(define (tty-clear t)
+  (define s (tty-pending-screen t))
+  (set-tty-pending-screen! t (make-screen (screen-rows s) (screen-columns s) (screen-pen s)))
+  t)
+
+(define (tty-clear-to-eol t) (screen-clear-to-eol (tty-pending-screen t)))
+(define (tty-goto t row col) (screen-goto (tty-pending-screen t) row col))
+(define (tty-set-pen! t p) (set-screen-pen! (tty-pending-screen t) p))
+(define (tty-pen t) (screen-pen (tty-pending-screen t)))
+
+(define tty-default-pen 'default)
+
+(struct pen (foreground-color ;; Color
+             background-color ;; Color
+             bold? ;; Boolean
+             italic? ;; Boolean
+             ) #:prefab)
+
+(struct backend (name ;; Symbol
+                 priority ;; Integer
+                 factory ;; (-> TTY)
+                 )
+  #:prefab)
+
+(struct screen (rows ;; Nat
+                columns ;; Nat
+                [cursor-row #:mutable] ;; Nat
+                [cursor-column #:mutable] ;; Nat
+                [pen #:mutable] ;; Pen
+                contents ;; (Vector[rows] (Vector[columns] (Cons Pen Character)))
+                ) #:prefab)
+
+(define (screen-last-row s) (- (screen-rows s) 1))
+(define (screen-last-column s) (- (screen-columns s) 1))
+
+(define (make-screen rows columns pen)
+  (define contents (for/vector ((row rows)) (make-vector columns (cons pen 'empty))))
+  (screen rows columns 0 0 pen contents))
+
+(define (copy-screen s)
+  (match-define (screen rows columns cursor-row cursor-column pen contents) s)
+  (define new-contents (for/vector ((row rows)) (vector-copy (vector-ref contents row))))
+  (screen rows columns cursor-row cursor-column pen new-contents))
+
+(define (screen-goto s row0 column0)
+  (define row (max 0 (min (screen-last-row s) row0)))
+  (define column (max 0 (min (screen-last-column s) column0)))
+  (set-screen-cursor-row! s row)
+  (set-screen-cursor-column! s column)
+  s)
+
+(define (non-empty? ch) (not (equal? ch 'empty)))
+
+(define (screen-putc s ch)
+  (match ch
+    [#\return
+     (screen-goto s (screen-cursor-row s) 0)]
+    [#\newline
+     (screen-goto s (+ (screen-cursor-row s) 1) (screen-cursor-column s))]
+    [#\tab
+     (for ((i (- 8 (modulo (screen-cursor-column s) 8)))) (screen-putc s #\space))]
+    [(and (? non-empty?) (? char-iso-control?))
+     (screen-puts s (format "[~x]" (char->integer ch)))]
+    [_
+     (when (< (screen-cursor-column s) (screen-columns s))
+       (vector-set! (vector-ref (screen-contents s) (screen-cursor-row s))
+                    (screen-cursor-column s)
+                    (cons (screen-pen s) ch)))
+     (set-screen-cursor-column! s (+ (screen-cursor-column s) 1))]))
+
+(define (screen-puts s str)
+  (for ((ch str)) (screen-putc s ch)))
+
+(define (screen-clear-to-eol s)
+  (define start-column (screen-cursor-column s))
+  (define pen (screen-pen s))
+  (set-screen-pen! s tty-default-pen)
+  (for ((i (max 0 (- (screen-columns s) (screen-cursor-column s)))))
+    (screen-putc s 'empty))
+  (set-screen-pen! s pen)
+  (screen-goto s (screen-cursor-row s) start-column)
+  s)
+
+(define *tty-backends* '())
+
+(define (register-tty-backend! name factory #:priority [priority 0])
+  (set! *tty-backends* (cons (backend name priority factory)
+                             (filter (lambda (b) (not (eq? (backend-name b) name)))
+                                     *tty-backends*)))
+  (set! *tty-backends* (sort *tty-backends* > #:key backend-priority)))
+
+(define *default-tty* #f)
+(define (default-tty)
+  (when (not *default-tty*)
+    (let loop ((backends *tty-backends*))
+      (match backends
+        ['() (error 'default-tty "No available tty backends")]
+        [(cons (backend name _priority factory) rest)
+         (define t (factory))
+         (if t
+             (set! *default-tty* t)
+             (loop rest))])))
+  *default-tty*)
diff --git a/racket/syndicate-ide/tui.rkt b/racket/syndicate-ide/tui.rkt
new file mode 100644
index 0000000..42cdb8a
--- /dev/null
+++ b/racket/syndicate-ide/tui.rkt
@@ -0,0 +1,63 @@
+#lang racket/base
+
+(provide tui-dataspace
+         install-tui-dataspace!)
+
+(require racket/async-channel)
+(require racket/match)
+(require racket/set)
+(require (only-in racket/string string-replace))
+
+(require (only-in syndicate seal process-name process-behavior process))
+(require (only-in syndicate/dataspace dataspace?))
+(require (only-in syndicate/relay relay))
+(require (only-in syndicate/lang current-ground-dataspace))
+(require syndicate/patch)
+(require syndicate/ground)
+(require syndicate/trace)
+(require syndicate/store)
+
+(require "display.rkt")
+(require "display-terminal.rkt")
+
+(define (process-is-dataspace? p)
+  (match p
+    [(process _name _beh (? dataspace? _)) #t]
+    [(process _name _beh (relay _ _ _ _ _ (process _inner-name _inner-beh (? dataspace? _)))) #t]
+    [_ #f]))
+
+(define ((tui-dataspace) . boot-actions)
+  (define from-user-thread-ch (make-async-channel))
+
+  (define user-thread
+    (thread (lambda ()
+              (with-store ((current-trace-procedures
+                            (cons (lambda (n) (async-channel-put from-user-thread-ch n))
+                                  (current-trace-procedures))))
+                (run-ground boot-actions)))))
+
+  (signal-background-activity! #t)
+  (define tty (default-tty))
+
+  (define (dump x)
+    (tty-display tty (string-replace (format "~v\n" x) "\n" "\r\n")))
+
+  (let loop ()
+    (tty-flush tty)
+    (sync (handle-evt from-user-thread-ch
+                      (lambda (n)
+                        (dump n)
+                        (loop)))
+          (handle-evt (tty-next-key-evt tty)
+                      (lambda (k)
+                        (match k
+                          [(key #\q (== (set))) (void)]
+                          [_
+                           (dump k)
+                           (loop)]))))))
+
+(define install-tui-dataspace!
+  (make-keyword-procedure
+   (lambda (ks vs . positionals)
+     (define installed-dataspace (current-ground-dataspace))
+     (current-ground-dataspace (keyword-apply tui-dataspace ks vs positionals)))))
diff --git a/racket/syndicate-ide/wm.rkt b/racket/syndicate-ide/wm.rkt
new file mode 100644
index 0000000..1334ded
--- /dev/null
+++ b/racket/syndicate-ide/wm.rkt
@@ -0,0 +1,158 @@
+#lang racket/base
+;; TUI Window Manager
+
+;; A TBox is a thing that can be laid out, displayed, and interacted
+;; with.
+
+;; TBoxes can be placed in relationship to other boxes:
+;;  - h{t,c,b}-append
+;;  - v{l,c,r}-append
+;;  - {l,c,r}{t,c,b}-superimpose
+;;  - wrap
+
+;; Sources of inspiration:
+;;   http://icie.cs.byu.edu/cs456/UIBook/05-Layout.pdf
+;;   http://doc.qt.io/qt-5/qtwidgets-tutorials-widgets-nestedlayouts-example.html
+;;   http://www.math.utah.edu/~beebe/reports/2009/boxes.pdf
+
+;; EXAMPLES for developing intuition:
+;;  1. a button
+;;  2. a scrollbar
+;;  3. a list of items with a panel to its right having a
+;;     variable-width pretty-printing of the selected item
+;;
+;; Button: Minimum size reflects minimal chrome; simply the smallest
+;; possible workable size. Desired and maximum size are the same,
+;; large enough to contain the usual chrome.
+;;
+;; Scrollbar: wolog, horizontal. Height is fixed. Minimum width
+;; reflects thumbless condition. Desired width might reflect some
+;; arbitrary size where the thumb could be moved around. Max width
+;; would usually involve a horizontal fill of some weight and rank.
+;; Hmm, but then why not have the desired width just be the max width?
+;; Perhaps desired and max are the same?
+;;
+;; Items and pretty-printing: Something like this:
+;;
+;; +----------+------------+
+;; |*(foo ...*| (foo (bar  |
+;; | (b () .. |       zot) |
+;; | 123      |      ()    |
+;; |          |      quux  |
+;; |          |      baz)  |
+;; +----------+------------+
+;;
+;; We want the item list to get some reasonable minimal amount of
+;; space, and otherwise to take up space not used by the
+;; pretty-printing. The pretty-printing should try to use vertical
+;; space within reason and otherwise should try to be as compact as
+;; possible.
+;;
+;; ---
+;;
+;; This min/desired/max split is a bit clunky. Could we have a list of
+;; preferred TeX-style sizings, ordered most-preferred first? They
+;; could include information to send back to the box at render time.
+;; For example, the button might offer horizontal sizings
+;;
+;; (list (sizing 'normal-chrome 10 (fill 1 1) 2)
+;;       (sizing 'no-chrome 6 0 0))
+;;
+;; ---
+;;
+;; How does arithmetic on sizings work?
+;;
+;; Ideals are never fills, they're simply naturals. They can be
+;; added/min'd/max'd as usual.
+;;
+;; Stretch is sometimes a natural, and sometimes a fill.
+;;
+;;    n         + fill w  r = fill w r
+;;    fill w1 r + fill w2 r = fill (w1 + w2) r
+;;    fill _  s + fill w  r = fill w r          when r > s
+;;
+;; The definitions of `max` is similar, with `max` for `+`. A fill
+;; behaves as a zero for the purposes of `min`.
+
+(require racket/generic)
+
+;;---------------------------------------------------------------------------
+
+;; A Fill is one of
+;; - a Nat, a fixed amount of space
+;; - a (fill Nat Nat), a potentially infinite amount of space
+(struct fill (weight rank) #:transparent)
+
+;; A Sizing is a (sizing Nat Fill Fill)
+(struct sizing (ideal stretch shrink) #:transparent)
+
+;; (Nat Nat -> Nat) -> (Fill Fill -> Fill)
+(define ((fill-binop op) a b)
+  (match* (a b)
+    [((? number?) (? number?)) (op a b)]
+    [((? number?) (? fill?)) b]
+    [((? fill?) (? number?)) a]
+    [((fill w1 r1) (fill w2 r2))
+     (cond [(= r1 r2) (fill (op w1 w2) r1)]
+           [(> r1 r2) (fill w1 r1)]
+           [(< r1 r2) (fill w2 r2)])]))
+
+;; Fill Fill -> Fill
+(define fill+ (fill-binop +))
+(define fill-max (fill-binop max))
+(define (fill-min a b)
+  (if (and (number? a) (number? b))
+      (min a b)
+      0))
+
+;; (Nat Nat -> Nat) (Fill Fill -> Fill) -> (Sizing Sizing -> Sizing)
+;;
+;; TODO: for max and min, do we really want fop to be used for both
+;; stretch and shrink?
+;;
+(define ((sizing-binop iop fop) a b)
+  (match-define (sizing ia ta ha) a)
+  (match-define (sizing ib tb hb) b)
+  (sizing (iop ia ib) (fop ta tb) (fop ha hb)))
+
+;; Sizing Sizing -> Sizing
+(define sizing+ (sizing-binop + fill+))
+(define sizing-max (sizing-binop max fill-max))
+(define sizing-min (sizing-binop min fill-min))
+
+;;---------------------------------------------------------------------------
+
+(define-generics tbox
+  ;; TBox (Option Nat) (Option Nat) -> (Listof (List Sizing Sizing))
+  (tbox-sizings tbox maybe-speculative-width maybe-speculative-height)
+  ;; TBox TTY Nat Nat Nat Nat -> Void
+  (tbox-render! tbox tty top left width height))
+
+(struct glue-tbox (horizontal vertical string pen) #:transparent
+  #:methods gen:tbox
+  [(define (tbox-sizings t w h)
+     (list (list (glue-tbox-horizontal t) (glue-tbox-vertical t))))
+   (define (tbox-render! t tty top left width height)
+     (define str (fill-tbox-string t))
+     (define whole-repeats (quotient width (string-length str)))
+     (define fragment (substring str 0 (remainder width (string-length str))))
+     (tty-set-pen! tty (fill-tbox-pen t))
+     (for [(y (in-range height))]
+       (tty-goto tty (+ top y) left)
+       (for [(i (in-range whole-repeats))] (tty-display tty str))
+       (tty-display tty fragment)))])
+
+;; Nat -> (Cons X (Listof X)) -> X
+(define ((nth-or-last n) xs)
+  (cond [(zero? n) (car xs)]
+        [(null? (cdr xs)) (car xs)]
+        [else (drop-n-or-last (- n 1) (cdr xs))]))
+
+(define (layout-horizontal items width height)
+  (define item-count (length items))
+  (define size-preferences (map (lambda (i) (tbox-sizings i #f #f)) items))
+  (let try-nth-choices ((nth-choice 0))
+    (define candidates (map (nth-or-last nth-choice) size-preferences))
+    (define aggregate-h (apply sizing+ (map car candidates)))
+    ...
+