diff --git a/src/tui/core.clj b/src/tui/core.clj index 92551f8..ad32cf4 100644 --- a/src/tui/core.clj +++ b/src/tui/core.clj @@ -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!) diff --git a/src/tui/input.clj b/src/tui/input.clj index 46df75a..b5ecfe2 100644 --- a/src/tui/input.clj +++ b/src/tui/input.clj @@ -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) diff --git a/src/tui/render.clj b/src/tui/render.clj index 3de784b..94fba0e 100644 --- a/src/tui/render.clj +++ b/src/tui/render.clj @@ -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 diff --git a/src/tui/terminal.clj b/src/tui/terminal.clj index 74e6488..90a8946 100644 --- a/src/tui/terminal.clj +++ b/src/tui/terminal.clj @@ -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]