ajet/clojure-tui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

init

Browse Source
This commit is contained in:
Adam Jeniski
2026-01-21 01:16:37 -05:00
commit a990076b03
17 changed files with 2713 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/tui/ansi.clj
+157
View File
@@ -0,0 +1,157 @@
(ns tui.ansi
"ANSI escape codes for terminal styling and control.")
;; === Escape Sequences ===
(def esc "\u001b")
(def csi (str esc "["))
;; === Screen Control ===
(def clear-screen (str csi "2J"))
(def clear-line (str csi "2K"))
(def clear-to-end (str csi "0J"))
(def cursor-home (str csi "H"))
(def hide-cursor (str csi "?25l"))
(def show-cursor (str csi "?25h"))
;; Alternate screen buffer
(def enter-alt-screen (str csi "?1049h"))
(def exit-alt-screen (str csi "?1049l"))
;; === Cursor Movement ===
(defn cursor-to [row col]
(str csi row ";" col "H"))
(defn cursor-up [n]
(str csi n "A"))
(defn cursor-down [n]
(str csi n "B"))
(defn cursor-forward [n]
(str csi n "C"))
(defn cursor-back [n]
(str csi n "D"))
(def cursor-save (str csi "s"))
(def cursor-restore (str csi "u"))
;; === Colors ===
(def reset (str csi "0m"))
;; Foreground colors
(def fg-colors
{:black 30 :red 31 :green 32 :yellow 33
:blue 34 :magenta 35 :cyan 36 :white 37
:default 39
;; Bright variants
:bright-black 90 :bright-red 91 :bright-green 92 :bright-yellow 93
:bright-blue 94 :bright-magenta 95 :bright-cyan 96 :bright-white 97
;; Aliases
:gray 90 :grey 90})
;; Background colors
(def bg-colors
{:black 40 :red 41 :green 42 :yellow 43
:blue 44 :magenta 45 :cyan 46 :white 47
:default 49
;; Bright variants
:bright-black 100 :bright-red 101 :bright-green 102 :bright-yellow 103
:bright-blue 104 :bright-magenta 105 :bright-cyan 106 :bright-white 107})
;; Text attributes
(def attrs
{:bold 1 :dim 2 :italic 3 :underline 4
:blink 5 :inverse 7 :hidden 8 :strike 9})
(defn sgr
"Generate SGR (Select Graphic Rendition) sequence."
[& codes]
(str csi (clojure.string/join ";" codes) "m"))
(defn style
"Apply style attributes to text.
Options: :fg :bg :bold :dim :italic :underline :inverse :strike"
[text & {:keys [fg bg bold dim italic underline inverse strike]}]
(let [codes (cond-> []
fg (conj (get fg-colors fg fg))
bg (conj (get bg-colors bg bg))
bold (conj 1)
dim (conj 2)
italic (conj 3)
underline (conj 4)
inverse (conj 7)
strike (conj 9))]
(if (empty? codes)
text
(str (apply sgr codes) text reset))))
(defn fg
"Set foreground color."
[color text]
(style text :fg color))
(defn bg
"Set background color."
[color text]
(style text :bg color))
;; 256-color support
(defn fg-256 [n text]
(str csi "38;5;" n "m" text reset))
(defn bg-256 [n text]
(str csi "48;5;" n "m" text reset))
;; True color (24-bit) support
(defn fg-rgb [r g b text]
(str csi "38;2;" r ";" g ";" b "m" text reset))
(defn bg-rgb [r g b text]
(str csi "48;2;" r ";" g ";" b "m" text reset))
;; === Box Drawing Characters ===
(def box-chars
{:rounded {:tl "╭" :tr "╮" :bl "╰" :br "╯" :h "─" :v "│"}
:single {:tl "┌" :tr "┐" :bl "└" :br "┘" :h "─" :v "│"}
:double {:tl "╔" :tr "╗" :bl "╚" :br "╝" :h "═" :v "║"}
:heavy {:tl "┏" :tr "┓" :bl "┗" :br "┛" :h "━" :v "┃"}
:ascii {:tl "+" :tr "+" :bl "+" :br "+" :h "-" :v "|"}})
;; === String Utilities ===
(defn visible-length
"Get visible length of string (excluding ANSI codes)."
[s]
(count (clojure.string/replace s #"\u001b\[[0-9;]*m" "")))
(defn pad-right
"Pad string to width with spaces."
[s width]
(let [vlen (visible-length s)
padding (max 0 (- width vlen))]
(str s (apply str (repeat padding " ")))))
(defn pad-left
"Pad string to width with spaces on left."
[s width]
(let [vlen (visible-length s)
padding (max 0 (- width vlen))]
(str (apply str (repeat padding " ")) s)))
(defn pad-center
"Center string within width."
[s width]
(let [vlen (visible-length s)
total-padding (max 0 (- width vlen))
left-padding (quot total-padding 2)
right-padding (- total-padding left-padding)]
(str (apply str (repeat left-padding " "))
s
(apply str (repeat right-padding " ")))))
(defn truncate
"Truncate string to max width, adding ellipsis if needed."
[s max-width]
(if (<= (visible-length s) max-width)
s
(str (subs s 0 (max 0 (- max-width 1))) "…")))
src/tui/core.clj
+197
View File
@@ -0,0 +1,197 @@
(ns tui.core
"Core TUI framework - Elm architecture runtime."
(:require [tui.terminal :as term]
[tui.input :as input]
[tui.render :as render]
[tui.ansi :as ansi]
[clojure.core.async :as async :refer [go go-loop chan <! >! >!! <!! put! close! timeout alt!]]))
;; === Command Types ===
;; nil - no-op
;; [:quit] - exit program
;; [:tick ms] - send :tick message after ms
;; [:batch cmd1 cmd2 ...] - run commands in parallel
;; [:seq cmd1 cmd2 ...] - run commands sequentially
;; (fn [] msg) - arbitrary async function returning message
;; === Built-in Commands ===
(def quit [:quit])
(defn tick
"Send a :tick message after ms milliseconds."
[ms]
[:tick ms])
(defn batch
"Run multiple commands in parallel."
[& cmds]
(into [:batch] (remove nil? cmds)))
(defn sequentially
"Run multiple commands sequentially."
[& cmds]
(into [:seq] (remove nil? cmds)))
(defn send-msg
"Create a command that sends a message."
[msg]
(fn [] msg))
;; === Internal Command Execution ===
(defn- execute-cmd!
"Execute a command, putting resulting messages on the channel."
[cmd msg-chan]
(when cmd
(cond
;; Quit command
(= cmd [:quit])
(put! msg-chan [:quit])
;; Tick command
(and (vector? cmd) (= (first cmd) :tick))
(let [ms (second cmd)]
(go
(<! (timeout ms))
(>! msg-chan [:tick (System/currentTimeMillis)])))
;; Batch - run all in parallel
(and (vector? cmd) (= (first cmd) :batch))
(doseq [c (rest cmd)]
(execute-cmd! c msg-chan))
;; Sequence - run one after another
(and (vector? cmd) (= (first cmd) :seq))
(go-loop [[c & rest-cmds] (rest cmd)]
(when c
(let [result-chan (chan 1)]
(execute-cmd! c result-chan)
(when-let [msg (<! result-chan)]
(>! msg-chan msg)
(recur rest-cmds)))))
;; Function - execute and send result
(fn? cmd)
(go
(let [msg (cmd)]
(when msg
(>! msg-chan msg))))
:else
nil)))
;; === Input Loop ===
(defn- start-input-loop!
"Start goroutine that reads input and puts messages on channel."
[msg-chan running?]
(go-loop []
(when @running?
(when-let [key-msg (input/read-key)]
(>! msg-chan key-msg))
(recur))))
;; === Main Run Loop ===
(defn run
"Run a TUI application.
Options:
- :init - Initial model (required)
- :update - (fn [model msg] [new-model cmd]) (required)
- :view - (fn [model] hiccup) (required)
- :init-cmd - Initial command to run
- :fps - Target frames per second (default 60)
- :alt-screen - Use alternate screen buffer (default false)
Returns the final model."
[{:keys [init update view init-cmd fps alt-screen]
:or {fps 60 alt-screen false}}]
(let [msg-chan (chan 256)
running? (atom true)
frame-time (/ 1000 fps)]
;; Setup terminal
(term/init-input!)
(term/raw-mode!)
(when alt-screen (term/alt-screen!))
(term/clear!)
(try
;; Start input loop
(start-input-loop! msg-chan running?)
;; Execute initial command
(when init-cmd
(execute-cmd! init-cmd msg-chan))
;; Initial render
(let [initial-view (render/render (view init))]
(term/render! initial-view))
;; Main loop
(loop [model init
last-render (System/currentTimeMillis)]
(let [;; Wait for message with timeout for frame limiting
remaining (max 1 (- frame-time (- (System/currentTimeMillis) last-render)))
msg (alt!
msg-chan ([v] v)
(timeout remaining) nil)]
(if (or (nil? msg) (not @running?))
;; No message, just continue
(recur model (System/currentTimeMillis))
;; Process message
(if (= msg [:quit])
;; Quit - return final model
model
;; Update model
(let [[new-model cmd] (update model msg)
new-view (render/render (view new-model))
now (System/currentTimeMillis)]
;; Execute command
(when cmd
(execute-cmd! cmd msg-chan))
;; Render
(term/render! new-view)
(recur new-model now))))))
(finally
;; Cleanup
(reset! running? false)
(close! msg-chan)
(when alt-screen (term/exit-alt-screen!))
(term/restore!)
(term/close-input!)
(println)))))
;; === Convenience Macros ===
(defmacro defapp
"Define a TUI application.
(defapp my-app
:init {:count 0}
:update (fn [model msg] ...)
:view (fn [model] ...))"
[name & {:keys [init update view init-cmd]}]
`(def ~name
{:init ~init
:update ~update
:view ~view
:init-cmd ~init-cmd}))
;; === Key Matching Helpers ===
(defn key=
"Check if message is a specific key."
[msg key-pattern]
(input/key-match? msg key-pattern))
(defn key-str
"Get string representation of key."
[msg]
(input/key->str msg))
;; Re-export render function
(def render render/render)
src/tui/input.clj
+152
View File
@@ -0,0 +1,152 @@
(ns tui.input
"Parse terminal input into key messages."
(:require [tui.terminal :as term]))
;; === Key Message Structure ===
;; [:key {:type :rune :char \a}]
;; [:key {:type :special :key :up}]
;; [:key {:type :special :key :enter}]
;; [:key {:type :ctrl :char \c}]
(def ^:private ctrl-keys
{0 [:ctrl \space] ; Ctrl+Space / Ctrl+@
1 [:ctrl \a] 2 [:ctrl \b] 3 [:ctrl \c]
4 [:ctrl \d] 5 [:ctrl \e] 6 [:ctrl \f]
7 [:ctrl \g] 8 :backspace 9 :tab
10 :enter 11 [:ctrl \k] 12 [:ctrl \l]
13 :enter 14 [:ctrl \n] 15 [:ctrl \o]
16 [:ctrl \p] 17 [:ctrl \q] 18 [:ctrl \r]
19 [:ctrl \s] 20 [:ctrl \t] 21 [:ctrl \u]
22 [:ctrl \v] 23 [:ctrl \w] 24 [:ctrl \x]
25 [:ctrl \y] 26 [:ctrl \z] 27 :escape
28 [:ctrl \\] 29 [:ctrl \]] 30 [:ctrl \^]
31 [:ctrl \_] 127 :backspace})
(def ^:private csi-sequences
{"A" :up "B" :down "C" :right "D" :left
"H" :home "F" :end "Z" :shift-tab
"1~" :home "2~" :insert "3~" :delete
"4~" :end "5~" :page-up "6~" :page-down
"7~" :home "8~" :end
;; Function keys
"11~" :f1 "12~" :f2 "13~" :f3 "14~" :f4
"15~" :f5 "17~" :f6 "18~" :f7 "19~" :f8
"20~" :f9 "21~" :f10 "23~" :f11 "24~" :f12
;; xterm-style function keys
"OP" :f1 "OQ" :f2 "OR" :f3 "OS" :f4})
(defn- read-escape-sequence
"Read and parse an escape sequence."
[]
(let [c2 (term/read-char-timeout 50)]
(cond
(nil? c2)
[:key :escape]
(= c2 \[)
;; CSI sequence
(loop [buf []]
(let [c (term/read-char-timeout 50)]
(cond
(nil? c)
[:key :escape]
;; Parameters and intermediates
(or (<= 0x30 (int c) 0x3F) ; 0-9:;<=>?
(<= 0x20 (int c) 0x2F)) ; space to /
(recur (conj buf c))
;; Final byte
(<= 0x40 (int c) 0x7E)
(let [seq-str (str (apply str buf) c)]
(if-let [key (get csi-sequences seq-str)]
[:key key]
[:key :unknown seq-str]))
:else
[:key :unknown (str "[" (apply str buf) c)])))
(= c2 \O)
;; SS3 sequence (F1-F4 on some terminals)
(let [c3 (term/read-char-timeout 50)]
(if c3
(if-let [key (get csi-sequences (str "O" c3))]
[:key key]
[:key :unknown (str "O" c3)])
[:key :escape]))
:else
;; Alt+key
[:key {:alt true :char c2}])))
(defn read-key
"Read a single key event. Returns [:key ...] message."
[]
(when-let [c (term/read-char)]
(let [code (int c)]
(cond
;; Escape sequence
(= code 27)
(read-escape-sequence)
;; Control characters
(<= 0 code 31)
(let [key (get ctrl-keys code)]
(if (vector? key)
[:key {:ctrl true :char (second key)}]
[:key key]))
;; DEL (Ctrl+Backspace on some terminals)
(= code 127)
[:key :backspace]
;; Normal character
:else
[:key {:char c}]))))
(defn key-match?
"Check if a key message matches a pattern.
Patterns: :enter, :up, \"q\", [:ctrl \\c], etc."
[msg pattern]
(when (= (first msg) :key)
(let [key (second msg)]
(cond
;; Simple keyword match
(keyword? pattern)
(or (= key pattern)
(= (:key key) pattern))
;; String match (single char)
(string? pattern)
(and (map? key)
(= (:char key) (first pattern))
(not (:ctrl key))
(not (:alt key)))
;; Vector pattern [:ctrl \c]
(vector? pattern)
(let [[mod ch] pattern]
(and (map? key)
(case mod
:ctrl (and (:ctrl key) (= (:char key) ch))
:alt (and (:alt key) (= (:char key) ch))
false)))
:else false))))
(defn key->str
"Convert key message to human-readable string."
[msg]
(when (= (first msg) :key)
(let [key (second msg)]
(cond
(keyword? key)
(name key)
(map? key)
(str (when (:ctrl key) "ctrl+")
(when (:alt key) "alt+")
(:char key))
:else
(str key)))))
src/tui/render.clj
+185
View File
@@ -0,0 +1,185 @@
(ns tui.render
"Render hiccup to ANSI strings."
(:require [tui.ansi :as ansi]
[clojure.string :as str]))
;; === Hiccup Parsing ===
(defn- parse-element
"Parse hiccup element into [tag attrs children]."
[elem]
(cond
(string? elem) [:text {} [elem]]
(number? elem) [:text {} [(str elem)]]
(nil? elem) [:text {} [""]]
(vector? elem)
(let [[tag & rest] elem
[attrs children] (if (map? (first rest))
[(first rest) (vec (next rest))]
[{} (vec rest)])]
[tag attrs children])
:else [:text {} [(str elem)]]))
;; === Text Rendering ===
(defn- apply-style
"Apply style attributes to text."
[text {:keys [fg bg bold dim italic underline inverse strike]}]
(if (or fg bg bold dim italic underline inverse strike)
(ansi/style text
:fg fg :bg bg
:bold bold :dim dim :italic italic
:underline underline :inverse inverse :strike strike)
text))
(defn- render-text
"Render :text element."
[attrs children]
(let [content (apply str (flatten children))]
(apply-style content attrs)))
;; === Layout Primitives ===
(declare render-element)
(defn- render-children
"Render all children and return list of rendered strings."
[children ctx]
(mapv #(render-element % ctx) children))
(defn- render-row
"Render :row - horizontal layout."
[{:keys [gap justify align] :or {gap 0}} children ctx]
(let [rendered (render-children children ctx)
separator (apply str (repeat gap " "))]
(str/join separator rendered)))
(defn- render-col
"Render :col - vertical layout."
[{:keys [gap] :or {gap 0}} children ctx]
(let [rendered (render-children children ctx)
separator (str/join (repeat gap "\n"))]
(str/join (str "\n" separator) rendered)))
(defn- render-box
"Render :box - bordered container."
[{:keys [border title padding width]
:or {border :rounded padding 0}}
children ctx]
(let [chars (get ansi/box-chars border (:rounded ansi/box-chars))
content (str/join "\n" (render-children children ctx))
lines (str/split content #"\n" -1)
;; Calculate padding
[pad-top pad-right pad-bottom pad-left]
(cond
(number? padding) [padding padding padding padding]
(vector? padding)
(case (count padding)
1 (let [p (first padding)] [p p p p])
2 (let [[v h] padding] [v h v h])
4 padding
[0 0 0 0])
:else [0 0 0 0])
;; Calculate content width
max-content-width (apply max 0 (map ansi/visible-length lines))
inner-width (+ max-content-width pad-left pad-right)
box-width (or width (+ inner-width 2))
content-width (- box-width 2)
;; Pad lines
padded-lines (for [line lines]
(str (apply str (repeat pad-left " "))
(ansi/pad-right line (- content-width pad-left pad-right))
(apply str (repeat pad-right " "))))
;; Add vertical padding
empty-line (apply str (repeat content-width " "))
all-lines (concat
(repeat pad-top empty-line)
padded-lines
(repeat pad-bottom empty-line))
;; Build box
top-line (str (:tl chars)
(if title
(str " " title " "
(apply str (repeat (- content-width (count title) 3) (:h chars))))
(apply str (repeat content-width (:h chars))))
(:tr chars))
bottom-line (str (:bl chars)
(apply str (repeat content-width (:h chars)))
(:br chars))
body-lines (for [line all-lines]
(str (:v chars)
(ansi/pad-right line content-width)
(:v chars)))]
(str/join "\n" (concat [top-line] body-lines [bottom-line]))))
(defn- render-space
"Render :space - empty space."
[{:keys [width height] :or {width 1 height 1}} _ _]
(let [line (apply str (repeat width " "))]
(str/join "\n" (repeat height line))))
;; === Main Render Function ===
(defn render-element
"Render a hiccup element to ANSI string."
[elem ctx]
(cond
;; Raw string - just return it
(string? elem) elem
;; Number - convert to string
(number? elem) (str elem)
;; Nil - empty string
(nil? elem) ""
;; Vector - hiccup element
(vector? elem)
(let [[tag attrs children] (parse-element elem)]
(case tag
:text (render-text attrs children)
:row (render-row attrs children ctx)
:col (render-col attrs children ctx)
:box (render-box attrs children ctx)
:space (render-space attrs children ctx)
;; Default: just render children
(apply str (render-children children ctx))))
;; Anything else - convert to string
:else (str elem)))
(defn render
"Render hiccup to ANSI string."
([hiccup] (render hiccup {}))
([hiccup ctx]
(render-element hiccup ctx)))
;; === Convenience Components ===
(defn text
"Create a text element."
[& args]
(if (map? (first args))
(into [:text (first args)] (rest args))
(into [:text {}] args)))
(defn row
"Create a row (horizontal) layout."
[& args]
(if (map? (first args))
(into [:row (first args)] (rest args))
(into [:row {}] args)))
(defn col
"Create a col (vertical) layout."
[& args]
(if (map? (first args))
(into [:col (first args)] (rest args))
(into [:col {}] args)))
(defn box
"Create a bordered box."
[& args]
(if (map? (first args))
(into [:box (first args)] (rest args))
(into [:box {}] args)))
src/tui/simple.clj
+68
View File
@@ -0,0 +1,68 @@
(ns tui.simple
"Simplified TUI runtime - no core.async, works with Babashka.
Synchronous event loop, no timers/async commands."
(:require [tui.terminal :as term]
[tui.input :as input]
[tui.render :as render]
[tui.ansi :as ansi]))
;; === Commands ===
(def quit [:quit])
;; === Key Matching ===
(defn key=
"Check if message is a specific key."
[msg key-pattern]
(input/key-match? msg key-pattern))
(defn key-str
"Get string representation of key."
[msg]
(input/key->str msg))
;; === Simple Run Loop ===
(defn run
"Run a TUI application (synchronous, no async commands).
Options:
- :init - Initial model (required)
- :update - (fn [model msg] [new-model cmd]) (required)
- :view - (fn [model] hiccup) (required)
- :alt-screen - Use alternate screen buffer (default false)
Returns the final model."
[{:keys [init update view alt-screen]
:or {alt-screen false}}]
;; Setup terminal
(term/init-input!)
(term/raw-mode!)
(when alt-screen (term/alt-screen!))
(term/clear!)
(try
;; Initial render
(term/render! (render/render (view init)))
;; Main loop - simple synchronous
(loop [model init]
(if-let [key-msg (input/read-key)]
(let [[new-model cmd] (update model key-msg)]
;; Render
(term/render! (render/render (view new-model)))
;; Check for quit
(if (= cmd [:quit])
new-model
(recur new-model)))
(recur model)))
(finally
;; Cleanup
(when alt-screen (term/exit-alt-screen!))
(term/restore!)
(term/close-input!)
(println))))
;; Re-export render
(def render render/render)
src/tui/terminal.clj
+127
View File
@@ -0,0 +1,127 @@
(ns tui.terminal
"Terminal management: raw mode, size, input/output."
(:require [tui.ansi :as ansi]
[clojure.java.io :as io]
[clojure.java.shell :refer [sh]])
(:import [java.io BufferedReader InputStreamReader]))
;; === Terminal State ===
(def ^:private original-stty (atom nil))
(defn- stty [& args]
(let [result (apply sh "stty" (concat args [:in (io/file "/dev/tty")]))]
(when (zero? (:exit result))
(clojure.string/trim (:out result)))))
(defn get-terminal-size
"Get terminal dimensions as [width height]."
[]
(try
(let [result (stty "size")]
(when result
(let [[rows cols] (map parse-long (clojure.string/split result #"\s+"))]
{:width cols :height rows})))
(catch Exception _
{:width 80 :height 24})))
(defn raw-mode!
"Enter raw terminal mode (no echo, no line buffering)."
[]
(reset! original-stty (stty "-g"))
(stty "raw" "-echo" "-icanon" "min" "1")
(print ansi/hide-cursor)
(flush))
(defn restore!
"Restore terminal to original state."
[]
(when @original-stty
(stty @original-stty)
(reset! original-stty nil))
(print ansi/show-cursor)
(print ansi/reset)
(flush))
(defn alt-screen!
"Enter alternate screen buffer."
[]
(print ansi/enter-alt-screen)
(flush))
(defn exit-alt-screen!
"Exit alternate screen buffer."
[]
(print ansi/exit-alt-screen)
(flush))
(defn clear!
"Clear screen and move cursor home."
[]
(print ansi/clear-screen)
(print ansi/cursor-home)
(flush))
(defn render!
"Render string to terminal."
[s]
(print ansi/cursor-home)
(print ansi/clear-to-end)
(print s)
(flush))
;; === Input Handling ===
(def ^:private tty-reader (atom nil))
(defn init-input!
"Initialize input reader from /dev/tty."
[]
(reset! tty-reader
(BufferedReader.
(InputStreamReader.
(java.io.FileInputStream. "/dev/tty")))))
(defn close-input!
"Close input reader."
[]
(when-let [r @tty-reader]
(.close r)
(reset! tty-reader nil)))
(defn read-char
"Read a single character. Blocking."
[]
(when-let [r @tty-reader]
(let [c (.read r)]
(when (>= c 0)
(char c)))))
(defn read-available
"Read all available characters without blocking."
[]
(when-let [r @tty-reader]
(loop [chars []]
(if (.ready r)
(let [c (.read r)]
(if (>= c 0)
(recur (conj chars (char c)))
chars))
chars))))
(defn read-char-timeout
"Read char with timeout in ms. Returns nil on timeout."
[timeout-ms]
(when-let [r @tty-reader]
(let [deadline (+ (System/currentTimeMillis) timeout-ms)]
(loop []
(cond
(.ready r)
(let [c (.read r)]
(when (>= c 0) (char c)))
(> (System/currentTimeMillis) deadline)
nil
:else
(do
(Thread/sleep 1)
(recur)))))))