add mouse support
SCIP Index / index (push) Failing after 1m40s

This commit is contained in:
2026-03-09 23:13:11 -04:00
parent 4a05130488
commit 91b9760983
4 changed files with 356 additions and 98 deletions
+116 -36
View File
@@ -109,6 +109,19 @@
;; Unknown type - dispatch to update function
(put! msg-chan event)))))
;; === Mouse Hit Testing ===
(defn- zone-handler-at
"Find the handler for event-type at (x, y) in zones.
Children render before parents, so they register first in the list.
Walking forward finds the innermost (child) handler first."
[zones x y event-type]
(some (fn [{zx :x zy :y zw :w zh :h :keys [handlers]}]
(when (and (<= zx x (+ zx zw -1))
(<= zy y (+ zy zh -1)))
(get handlers event-type)))
zones))
;; === Input Loop ===
(defn- start-input-loop!
"Start thread that reads input and puts events on channel.
@@ -135,9 +148,10 @@
- :init-events - Vector of events to dispatch at startup
- :fps - Target frames per second (default 60)
- :alt-screen - Use alternate screen buffer (default true)
- :mouse - Enable mouse tracking (default false)
Returns the final model."
[{:keys [init update view init-events fps alt-screen]
[{:keys [init update view init-events fps alt-screen mouse]
:or {fps 60 alt-screen true}}]
(let [msg-chan (chan 256)
running? (atom true)
@@ -147,6 +161,7 @@
(term/raw-mode!)
(term/init-input!)
(when alt-screen (term/alt-screen!))
(when mouse (term/enable-mouse!))
(term/clear!)
(try
@@ -160,51 +175,116 @@
;; Initial render
(let [size (term/get-terminal-size)
ctx {:available-height (:height size)
:available-width (:width size)}]
(term/render! (render/render (view init) ctx)))
;; 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)))
event (alt!!
msg-chan ([v] v)
(timeout remaining) nil)]
(if (or (nil? event) (not @running?))
;; No message, just continue
(recur model (System/currentTimeMillis))
;; Check for quit
(if (= (:type event) :quit)
;; Quit - return final model
model
;; Update model
(let [result (update {:model model :event event})
new-model (:model result)
size (term/get-terminal-size)
ctx {:available-height (:height size)
ctx (cond-> {:available-height (:height size)
:available-width (:width size)}
now (System/currentTimeMillis)]
mouse (assoc :mouse true))
render-result (render/render (view init) ctx)
output (if (map? render-result) (:output render-result) render-result)
initial-zones (when (map? render-result) (:zones render-result))]
(term/render! output)
;; Execute events
(when-let [events (:events result)]
(doseq [e events]
(execute-event! e msg-chan)))
;; Main loop
(loop [model init
last-render (System/currentTimeMillis)
zones initial-zones]
(let [;; Wait for message with timeout for frame limiting
remaining (max 1 (- frame-time (- (System/currentTimeMillis) last-render)))
event (alt!!
msg-chan ([v] v)
(timeout remaining) nil)]
;; Render with context for flex layouts
(term/render! (render/render (view new-model) ctx))
(if (or (nil? event) (not @running?))
;; No message, just continue
(recur model (System/currentTimeMillis) zones)
(recur new-model now))))))
;; Check for quit
(if (= (:type event) :quit)
;; Quit - return final model
model
;; Handle mouse events
(if (= (:type event) :mouse)
(cond
;; Left click → find :on-click handler, dispatch directly
(and zones (= (:button event) :left) (= (:action event) :press))
(if-let [handler (zone-handler-at zones (:x event) (:y event) :on-click)]
(let [click-event (assoc handler :mouse-x (:x event) :mouse-y (:y event))
result (update {:model model :event click-event})
new-model (:model result)
size (term/get-terminal-size)
ctx (cond-> {:available-height (:height size)
:available-width (:width size)}
mouse (assoc :mouse true))
now (System/currentTimeMillis)]
(when-let [events (:events result)]
(doseq [e events] (execute-event! e msg-chan)))
(let [render-result (render/render (view new-model) ctx)
output (if (map? render-result) (:output render-result) render-result)
new-zones (when (map? render-result) (:zones render-result))]
(term/render! output)
(recur new-model now new-zones)))
(recur model (System/currentTimeMillis) zones))
;; Scroll wheel → process directly, drain queued scrolls
(and zones (#{:wheel-up :wheel-down} (:button event)))
(if-let [handler (zone-handler-at zones (:x event) (:y event) :on-scroll)]
(let [;; Apply this scroll event
scroll-event (assoc handler :direction (:button event))
result (update {:model model :event scroll-event})
;; Drain and apply all queued scroll events
final-model (loop [m (:model result)]
(if-let [next (async/poll! msg-chan)]
(if (and (= (:type next) :mouse)
(#{:wheel-up :wheel-down} (:button next)))
(if-let [h (zone-handler-at zones (:x next) (:y next) :on-scroll)]
(recur (:model (update {:model m
:event (assoc h :direction (:button next))})))
(do (put! msg-chan next) m))
(do (put! msg-chan next) m))
m))
size (term/get-terminal-size)
ctx (cond-> {:available-height (:height size)
:available-width (:width size)}
mouse (assoc :mouse true))
now (System/currentTimeMillis)]
(let [render-result (render/render (view final-model) ctx)
output (if (map? render-result) (:output render-result) render-result)
new-zones (when (map? render-result) (:zones render-result))]
(term/render! output)
(recur final-model now new-zones)))
(recur model (System/currentTimeMillis) zones))
;; Other mouse events (release, etc.) → ignore
:else
(recur model (System/currentTimeMillis) zones))
;; Update model for non-mouse events
(let [result (update {:model model :event event})
new-model (:model result)
size (term/get-terminal-size)
ctx (cond-> {:available-height (:height size)
:available-width (:width size)}
mouse (assoc :mouse true))
now (System/currentTimeMillis)]
;; Execute events
(when-let [events (:events result)]
(doseq [e events]
(execute-event! e msg-chan)))
;; Render with context for flex layouts
(let [render-result (render/render (view new-model) ctx)
output (if (map? render-result) (:output render-result) render-result)
new-zones (when (map? render-result) (:zones render-result))]
(term/render! output)
(recur new-model now new-zones)))))))))
(finally
;; Cleanup
(reset! running? false)
(reset! debounce-timers {})
(close! msg-chan)
(when mouse (term/disable-mouse!))
(when alt-screen (term/exit-alt-screen!))
(term/restore!)
(term/close-input!)
+68 -16
View File
@@ -16,7 +16,8 @@
{:type :key, :key \\c, :modifiers #{:ctrl}} ; Ctrl+C
{:type :key, :key :enter} ; Enter key
{:type :key, :key :f1, :modifiers #{:alt}} ; Alt+F1"
(:require [tui.terminal :as term]))
(:require [tui.terminal :as term]
[clojure.string :as str]))
;; === Control Key Mappings ===
;; Maps byte codes 0-31 to either:
@@ -83,27 +84,78 @@
(make-key-event :escape)
(= c2 \[)
;; CSI sequence
(loop [buf []]
(let [c (term/read-char-timeout 50)]
(cond
(nil? c)
(make-key-event :escape)
;; CSI sequence - check for SGR mouse (ESC [ <)
(let [c3 (term/read-char-timeout 50)]
(cond
(nil? c3)
(make-key-event :escape)
;; Parameters and intermediates
(or (<= 0x30 (int c) 0x3F) ; 0-9:;<=>?
(<= 0x20 (int c) 0x2F)) ; space to /
(recur (conj buf c))
;; SGR mouse sequence: ESC [ < Cb ; Cx ; Cy M/m
(= c3 \<)
(loop [buf []]
(let [c (term/read-char-timeout 50)]
(cond
(nil? c)
(make-key-event :unknown)
;; Final byte
(<= 0x40 (int c) 0x7E)
(let [seq-str (str (apply str buf) c)]
;; Final byte M (press) or m (release)
(or (= c \M) (= c \m))
(let [params (str/split (apply str buf) #";")]
(if (= (count params) 3)
(let [cb (parse-long (nth params 0))
cx (parse-long (nth params 1))
cy (parse-long (nth params 2))
action (if (= c \M) :press :release)
;; Decode button: bits 0-1 = button, bit 6 = wheel
wheel? (bit-test cb 6)
btn-bits (bit-and cb 3)
button (if wheel?
(if (zero? btn-bits) :wheel-up :wheel-down)
(case btn-bits
0 :left
1 :middle
2 :right
:unknown))]
{:type :mouse
:button button
:action action
:x (dec cx) ; SGR is 1-indexed
:y (dec cy)})
(make-key-event :unknown)))
;; Accumulate digits and semicolons
:else
(recur (conj buf c)))))
;; Regular CSI sequence — c3 is first char after "ESC ["
:else
(if (<= 0x40 (int c3) 0x7E)
;; c3 is already a final byte (e.g. ESC [ A for arrow up)
(let [seq-str (str c3)]
(if-let [key (get csi-sequences seq-str)]
(make-key-event key)
(make-key-event :unknown)))
;; c3 is a parameter/intermediate, read more chars
(loop [buf [c3]]
(let [c (term/read-char-timeout 50)]
(cond
(nil? c)
(make-key-event :escape)
:else
(make-key-event :unknown))))
;; 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)]
(make-key-event key)
(make-key-event :unknown)))
:else
(make-key-event :unknown)))))))
(= c2 \O)
;; SS3 sequence (F1-F4 on some terminals)
+158 -46
View File
@@ -108,15 +108,32 @@
;; Phase 4: Apply constraints (min/max)
constrained (mapv (fn [size p]
(if (and size (or (:min p) (:max p)))
(cond-> size
(:min p) (max (:min p))
(:max p) (min (:max p)))
size))
raw-sizes
parsed)]
(if (and size (or (:min p) (:max p)))
(cond-> size
(:min p) (max (:min p))
(:max p) (min (:max p)))
size))
raw-sizes
parsed)]
constrained))
;; === Mouse Zone Tracking ===
(def ^:dynamic *zones* nil)
(defn- extract-handlers
"Extract mouse handler attrs (:on-click, :on-scroll) from an element's attrs."
[attrs]
(cond-> {}
(:on-click attrs) (assoc :on-click (:on-click attrs))
(:on-scroll attrs) (assoc :on-scroll (:on-scroll attrs))))
(defn- register-zone!
"Register a mouse zone with its bounding box and handlers."
[x y width height handlers]
(when (and *zones* (seq handlers))
(swap! *zones* conj {:x x :y y :w width :h height :handlers handlers})))
;; === Hiccup Parsing ===
(defn- flatten-children
"Flatten sequences in children (but not vectors, which are hiccup elements)."
@@ -155,9 +172,14 @@
(defn- render-text
"Render :text element."
[attrs children]
(let [content (apply str (flatten children))]
(apply-style content attrs)))
[attrs children ctx]
(let [content (apply str (flatten children))
result (apply-style content attrs)]
(let [handlers (extract-handlers attrs)]
(when (seq handlers)
(register-zone! (or (:x ctx) 0) (or (:y ctx) 0)
(count content) 1 handlers)))
result))
;; === Layout Primitives ===
(declare render-element)
@@ -175,18 +197,32 @@
\"N%\" (percentage), \"Nfr\" (fractional unit), or nil (auto).
Example: [:row {:widths [20 :flex :flex]} child1 child2 child3]
Example: [:row {:widths [\"30%\" \"2fr\" \"1fr\"]} child1 child2 child3]"
[{:keys [gap widths] :or {gap 0}} children ctx]
[{:keys [gap widths] :as attrs :or {gap 0}} children ctx]
(let [available-width (or (:available-width ctx) 120)
available-height (or (:available-height ctx) 100)
parent-x (or (:x ctx) 0)
parent-y (or (:y ctx) 0)
;; Use new enhanced sizing system
calculated-widths (when widths
(calculate-sizes widths children available-width gap))
;; Pre-calculate x offsets for each child
child-x-offsets (if calculated-widths
(reductions + parent-x
(map-indexed
(fn [idx _]
(+ (or (nth calculated-widths idx 0) 0)
(if (pos? idx) gap 0)))
children))
nil)
;; Render each child with its allocated width in context
rendered (map-indexed
(fn [idx child]
(let [child-width (when calculated-widths
(nth calculated-widths idx nil))
child-ctx (cond-> ctx
child-x (if child-x-offsets
(nth (vec child-x-offsets) idx parent-x)
parent-x)
child-ctx (cond-> (assoc ctx :x child-x :y parent-y)
child-width (assoc :available-width child-width))]
(render-element child child-ctx)))
children)
@@ -214,9 +250,12 @@
width (get child-widths child-idx 0)]
(ansi/pad-right line (or width 0))))
child-lines)))]
;; Register zone for row itself if it has handlers
(let [handlers (extract-handlers attrs)
total-width (+ (reduce + 0 child-widths) (* gap (max 0 (dec (count children)))))]
(register-zone! parent-x parent-y total-width max-height handlers))
(str/join "\n" combined-lines)))
(defn- render-col
"Render :col - vertical layout.
Supports :heights for distributing vertical space.
@@ -224,32 +263,49 @@
\"N%\" (percentage), \"Nfr\" (fractional unit), or nil (auto).
Example: [:col {:heights [3 :flex :flex 4]} child1 child2 child3 child4]
Example: [:col {:heights [\"10%\" \"2fr\" \"1fr\"]} child1 child2 child3]"
[{:keys [gap heights width height] :or {gap 0}} children ctx]
[{:keys [gap heights width height] :as attrs :or {gap 0}} children ctx]
(let [;; Use explicit width/height if provided, otherwise from context
available-width (or width (:available-width ctx) 120)
available-height (or height (:available-height ctx) 100)
parent-x (or (:x ctx) 0)
parent-y (or (:y ctx) 0)
;; Use new enhanced sizing system
calculated-heights (when heights
(calculate-sizes heights children available-height gap))
;; Render each child with its allocated height in context
rendered (map-indexed
(fn [idx child]
(let [child-height (when calculated-heights
(nth calculated-heights idx nil))
child-ctx (cond-> (assoc ctx :available-width available-width)
child-height (assoc :available-height child-height))]
(render-element child child-ctx)))
children)
;; Render each child, tracking y offset
rendered (loop [idx 0
y-offset parent-y
results []]
(if (>= idx (count children))
results
(let [child (nth children idx)
child-height (when calculated-heights
(nth calculated-heights idx nil))
child-ctx (cond-> (assoc ctx :available-width available-width
:x parent-x :y y-offset)
child-height (assoc :available-height child-height))
result (render-element child child-ctx)
result-height (if child-height
child-height
(inc (count (re-seq #"\n" result))))]
(recur (inc idx)
(+ y-offset result-height gap)
(conj results result)))))
separator (str/join (repeat gap "\n"))]
;; Register zone for col itself if it has handlers
(let [handlers (extract-handlers attrs)]
(register-zone! parent-x parent-y available-width available-height handlers))
(str/join (str "\n" separator) rendered)))
(defn- render-box
"Render :box - bordered container.
Supports :width/:height as number or :fill (uses available size from ctx)."
[{:keys [border title padding width height]
[{:keys [border title padding width height] :as attrs
:or {border :rounded padding 0}}
children ctx]
(let [;; Calculate target dimensions first (for passing to children)
(let [parent-x (or (:x ctx) 0)
parent-y (or (:y ctx) 0)
;; Calculate target dimensions first (for passing to children)
target-width (cond
(number? width) width
(= width :fill) (or (:available-width ctx) 80)
@@ -258,8 +314,8 @@
(number? height) height
(= height :fill) (or (:available-height ctx) 24)
:else nil)
;; Pass constrained dimensions to children
child-ctx (cond-> ctx
;; Pass constrained dimensions to children (offset by border)
child-ctx (cond-> (assoc ctx :x (+ parent-x 1) :y (+ parent-y 1))
target-width (assoc :available-width (- target-width 2))
target-height (assoc :available-height (- target-height 2)))
chars (get ansi/box-chars border (:rounded ansi/box-chars))
@@ -278,11 +334,28 @@
[0 0 0 0])
:else [0 0 0 0])
;; Render title - string or vector of strings/[:text] elements
;; Each [:text] in a vector title renders via render-text for automatic zone registration
title-rendered (when title
(if (string? title)
title
(loop [parts title, out "", x (+ parent-x 3)]
(if (empty? parts)
out
(let [part (first parts)]
(if (string? part)
(recur (rest parts) (str out part) (+ x (count part)))
(let [[_ attrs & children] part
content (apply str (flatten children))
rendered (render-text attrs children (assoc ctx :x x :y parent-y))]
(recur (rest parts) (str out rendered) (+ x (count content))))))))))
title-visible-len (when title-rendered (ansi/visible-length title-rendered))
;; Calculate content width
max-content-width (apply max 0 (map ansi/visible-length lines))
inner-width (+ max-content-width pad-left pad-right)
;; Title needs: "─ title " = title-length + 3
title-width (if title (+ (count title) 3) 0)
title-width (if title-rendered (+ title-visible-len 3) 0)
box-width (or target-width (+ (max inner-width title-width) 2))
content-width (- box-width 2)
@@ -312,9 +385,9 @@
;; Build box
top-line (str (:tl chars)
(if title
(str (:h chars) " " title " "
(apply str (repeat (max 0 (- content-width (count title) 3)) (:h chars))))
(if title-rendered
(str (:h chars) " " title-rendered " "
(apply str (repeat (max 0 (- content-width title-visible-len 3)) (:h chars))))
(apply str (repeat content-width (:h chars))))
(:tr chars))
bottom-line (str (:bl chars)
@@ -323,7 +396,11 @@
body-lines (for [line all-lines]
(str (:v chars)
(ansi/fit-width line content-width)
(:v chars)))]
(:v chars)))
total-height (+ 2 (count (vec all-lines)))]
;; Register zone for the box
(let [handlers (extract-handlers attrs)]
(register-zone! parent-x parent-y box-width total-height handlers))
(str/join "\n" (concat [top-line] body-lines [bottom-line]))))
(defn- render-space
@@ -383,11 +460,18 @@
(let [available-width (or (:available-width ctx) 120)
available-height (or (:available-height ctx) 30)
[bg-child modal-child] children
;; Render background
;; Render background with position
bg-rendered (render-element bg-child ctx)
bg-lines (str/split bg-rendered #"\n" -1)
;; Render modal
modal-rendered (render-element modal-child ctx)
;; Calculate modal position (centered)
modal-pre-rendered (render-element modal-child ctx)
modal-lines-pre (str/split modal-pre-rendered #"\n" -1)
modal-height (count modal-lines-pre)
modal-width (apply max 0 (map ansi/visible-length modal-lines-pre))
modal-x (max 0 (quot (- available-width modal-width) 2))
modal-y (max 0 (quot (- available-height modal-height) 2))
;; Re-render modal with correct position for zone tracking
modal-rendered (render-element modal-child (assoc ctx :x modal-x :y modal-y))
modal-lines (str/split modal-rendered #"\n" -1)
;; Overlay
result-lines (overlay-lines bg-lines modal-lines available-width available-height)]
@@ -430,8 +514,10 @@
- :indicators - show scroll indicators when clipped (default true)
Example: [:scroll {:cursor 3} child0 child1 child2 child3 child4 ...]"
[{:keys [cursor indicators] :or {cursor 0 indicators true}} children ctx]
[{:keys [cursor indicators] :as attrs :or {cursor 0 indicators true}} children ctx]
(let [available-height (or (:available-height ctx) 100)
parent-x (or (:x ctx) 0)
parent-y (or (:y ctx) 0)
total-items (count children)
;; Reserve space for indicators if enabled
indicator-height (if indicators 1 0)
@@ -441,8 +527,13 @@
{:keys [start end has-above has-below]} (visible-window-calc total-items cursor max-visible)
;; Get visible children
visible-children (subvec (vec children) start end)
;; Render visible children
rendered-lines (mapv #(render-element % ctx) visible-children)
;; y offset: starts after up-indicator if present
y-start (+ parent-y (if (and indicators has-above) 1 0))
;; Render visible children with y position tracking
rendered-lines (vec (map-indexed
(fn [idx child]
(render-element child (assoc ctx :x parent-x :y (+ y-start idx))))
visible-children))
;; Build result with indicators
up-indicator (when (and indicators has-above)
(ansi/style "↑" :fg :cyan))
@@ -451,7 +542,19 @@
all-lines (cond-> []
up-indicator (conj up-indicator)
true (into rendered-lines)
down-indicator (conj down-indicator))]
down-indicator (conj down-indicator))
container-width (or (:available-width ctx) 120)]
;; Register zone for scroll container if it has handlers
(let [handlers (extract-handlers attrs)]
(register-zone! parent-x parent-y container-width available-height handlers))
;; Register clickable zones for scroll indicators
(when (and indicators has-above (:on-scroll attrs))
(register-zone! parent-x parent-y container-width 1
{:on-click (assoc (:on-scroll attrs) :direction :wheel-up)}))
(when (and indicators has-below (:on-scroll attrs))
(let [down-y (+ parent-y (dec (count all-lines)))]
(register-zone! parent-x down-y container-width 1
{:on-click (assoc (:on-scroll attrs) :direction :wheel-down)})))
(str/join "\n" all-lines)))
;; === Grid Primitive ===
@@ -611,16 +714,20 @@
col-span (or (:col-span attrs) 1)
;; Calculate cell dimensions
cell-height (+ (reduce + 0 (take row-span (drop row row-heights)))
(* row-gap (max 0 (dec row-span))))
(* row-gap (max 0 (dec row-span))))
cell-width (+ (reduce + 0 (take col-span (drop col col-widths)))
(* col-gap (max 0 (dec col-span))))
(* col-gap (max 0 (dec col-span))))
;; Calculate cell position
cell-y (nth (vec row-positions) row 0)
cell-x (nth (vec col-positions) col 0)
;; Render content with cell dimensions in context
;; Render content with cell dimensions and position in context
parent-x (or (:x ctx) 0)
parent-y (or (:y ctx) 0)
cell-ctx (assoc ctx
:available-width cell-width
:available-height cell-height)
:available-height cell-height
:x (+ parent-x cell-x)
:y (+ parent-y cell-y))
rendered (render-element content cell-ctx)]
(overlay-on-canvas c rendered cell-x cell-y cell-width cell-height)))
canvas
@@ -646,7 +753,7 @@
(vector? elem)
(let [[tag attrs children] (parse-element elem)]
(case tag
:text (render-text attrs children)
:text (render-text attrs children ctx)
:row (render-row attrs children ctx)
:col (render-col attrs children ctx)
:box (render-box attrs children ctx)
@@ -663,10 +770,15 @@
:else (str elem)))
(defn render
"Render hiccup to ANSI string."
"Render hiccup to ANSI string. When :mouse is truthy in ctx,
returns {:output string :zones [...]} instead of a plain string."
([hiccup] (render hiccup {}))
([hiccup ctx]
(render-element hiccup ctx)))
(if (:mouse ctx)
(binding [*zones* (atom [])]
(let [result (render-element hiccup (assoc ctx :x 0 :y 0))]
{:output result :zones @*zones*}))
(render-element hiccup ctx))))
;; === Convenience Components ===
(defn text
+14
View File
@@ -75,6 +75,20 @@
(print ansi/cursor-home)
(flush))
(defn enable-mouse!
"Enable mouse tracking (SGR extended mode)."
[]
(print "\033[?1000h") ; button tracking
(print "\033[?1006h") ; SGR extended coordinates
(flush))
(defn disable-mouse!
"Disable mouse tracking."
[]
(print "\033[?1006l")
(print "\033[?1000l")
(flush))
(defn render!
"Render string to terminal."
[s]