refactor
This commit is contained in:
+201
-43
@@ -1,57 +1,162 @@
|
||||
(ns tui.core
|
||||
"Core TUI framework - Elm architecture runtime."
|
||||
"Core TUI framework - Elm architecture runtime.
|
||||
|
||||
## New API (Recommended)
|
||||
|
||||
Update function signature:
|
||||
(fn [{:keys [model event]}]
|
||||
{:model new-model
|
||||
:events [...]}) ; :events is optional
|
||||
|
||||
Events are maps with :type discriminator. See tui.events namespace.
|
||||
|
||||
## Legacy API (Deprecated)
|
||||
|
||||
For backward compatibility, the old signature is still supported:
|
||||
(fn [model msg] [new-model cmd])
|
||||
|
||||
The runtime auto-detects which format is being used."
|
||||
(: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! alt!!]]))
|
||||
|
||||
;; === Command Types ===
|
||||
;; === Legacy Command Types (Deprecated) ===
|
||||
;; nil - no-op
|
||||
;; [:quit] - exit program
|
||||
;; [: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])
|
||||
;; === Legacy Built-in Commands (Deprecated) ===
|
||||
(def quit
|
||||
"DEPRECATED: Use (tui.events/quit) instead."
|
||||
[:quit])
|
||||
|
||||
(defn after
|
||||
"Returns a command that sends msg after ms milliseconds.
|
||||
Use this for timers, animations, or delayed actions.
|
||||
"DEPRECATED: Use (tui.events/delay ms event) instead.
|
||||
|
||||
Example:
|
||||
(after 1000 [:timer-tick])
|
||||
(after 80 [:spinner-frame {:id 1}])"
|
||||
Returns a command that sends msg after ms milliseconds."
|
||||
[ms msg]
|
||||
(fn []
|
||||
(Thread/sleep ms)
|
||||
msg))
|
||||
|
||||
(defn batch
|
||||
"Run multiple commands in parallel."
|
||||
"DEPRECATED: Use (tui.events/batch ...) instead.
|
||||
|
||||
Run multiple commands in parallel."
|
||||
[& cmds]
|
||||
(into [:batch] (remove nil? cmds)))
|
||||
|
||||
(defn sequentially
|
||||
"Run multiple commands sequentially."
|
||||
"DEPRECATED: Use (tui.events/sequential ...) instead.
|
||||
|
||||
Run multiple commands sequentially."
|
||||
[& cmds]
|
||||
(into [:seq] (remove nil? cmds)))
|
||||
|
||||
(defn send-msg
|
||||
"Create a command that sends a message."
|
||||
"DEPRECATED: Put event directly in :events vector instead.
|
||||
|
||||
Create a command that sends a message."
|
||||
[msg]
|
||||
(fn [] msg))
|
||||
|
||||
;; === Internal Command Execution ===
|
||||
;; === Debounce State ===
|
||||
(def ^:private debounce-timers (atom {}))
|
||||
|
||||
;; === Event Execution ===
|
||||
(defn- execute-event!
|
||||
"Execute an event, putting resulting events on the channel.
|
||||
Handles runtime events (:quit, :delay, :shell, :batch, :sequential, :debounce).
|
||||
Unknown event types are dispatched back to the update function."
|
||||
[event msg-chan]
|
||||
(when event
|
||||
(let [event-type (:type event)]
|
||||
(case event-type
|
||||
;; Quit - signal quit
|
||||
:quit
|
||||
(put! msg-chan {:type :quit})
|
||||
|
||||
;; Delay - wait then dispatch event
|
||||
:delay
|
||||
(let [{:keys [ms event]} event]
|
||||
(go
|
||||
(<! (timeout ms))
|
||||
(>! msg-chan event)))
|
||||
|
||||
;; Shell - run command async
|
||||
:shell
|
||||
(let [{:keys [cmd event]} event
|
||||
cmd-str (if (vector? cmd)
|
||||
(clojure.string/join " " cmd)
|
||||
cmd)]
|
||||
(go
|
||||
(try
|
||||
(let [proc (.. (ProcessBuilder. (into-array String ["sh" "-c" cmd-str]))
|
||||
(redirectErrorStream false)
|
||||
(start))
|
||||
out (slurp (.getInputStream proc))
|
||||
err (slurp (.getErrorStream proc))
|
||||
exit (.waitFor proc)
|
||||
success (zero? exit)]
|
||||
(>! msg-chan (assoc event :result
|
||||
{:exit exit
|
||||
:out out
|
||||
:err err
|
||||
:success success})))
|
||||
(catch Exception e
|
||||
(>! msg-chan (assoc event :result
|
||||
{:exit -1
|
||||
:out ""
|
||||
:err (str e)
|
||||
:success false}))))))
|
||||
|
||||
;; Batch - run all in parallel
|
||||
:batch
|
||||
(doseq [e (:events event)]
|
||||
(execute-event! e msg-chan))
|
||||
|
||||
;; Sequential - run one after another
|
||||
:sequential
|
||||
(go-loop [[e & rest-events] (:events event)]
|
||||
(when e
|
||||
(let [result-chan (chan 1)]
|
||||
(execute-event! e result-chan)
|
||||
(when-let [result (<! result-chan)]
|
||||
(>! msg-chan result)
|
||||
(recur rest-events)))))
|
||||
|
||||
;; Debounce - cancel pending, schedule new
|
||||
:debounce
|
||||
(let [{:keys [id ms event]} event]
|
||||
;; Cancel existing timer for this id
|
||||
(when-let [cancel-fn (get @debounce-timers id)]
|
||||
(cancel-fn))
|
||||
;; Schedule new timer
|
||||
(let [cancelled (atom false)
|
||||
cancel-fn #(reset! cancelled true)]
|
||||
(swap! debounce-timers assoc id cancel-fn)
|
||||
(go
|
||||
(<! (timeout ms))
|
||||
(when-not @cancelled
|
||||
(swap! debounce-timers dissoc id)
|
||||
(>! msg-chan event)))))
|
||||
|
||||
;; Unknown type - dispatch to update function
|
||||
(put! msg-chan event)))))
|
||||
|
||||
;; === Legacy Command Execution ===
|
||||
(defn- execute-cmd!
|
||||
"Execute a command, putting resulting messages on the channel."
|
||||
"Execute a legacy command, putting resulting messages on the channel."
|
||||
[cmd msg-chan]
|
||||
(when cmd
|
||||
(cond
|
||||
;; Quit command
|
||||
(= cmd [:quit])
|
||||
(put! msg-chan [:quit])
|
||||
(put! msg-chan {:type :quit})
|
||||
|
||||
;; Batch - run all in parallel
|
||||
(and (vector? cmd) (= (first cmd) :batch))
|
||||
@@ -80,37 +185,74 @@
|
||||
|
||||
;; === Input Loop ===
|
||||
(defn- start-input-loop!
|
||||
"Start thread that reads input and puts messages on channel.
|
||||
"Start thread that reads input and puts events on channel.
|
||||
Uses polling with timeout to allow clean shutdown when running? becomes false."
|
||||
[msg-chan running?]
|
||||
(async/thread
|
||||
(loop []
|
||||
(when @running?
|
||||
(if (term/input-ready?)
|
||||
(when-let [key-msg (input/read-key)]
|
||||
(>!! msg-chan key-msg))
|
||||
(when-let [key-event (input/read-key)]
|
||||
(>!! msg-chan key-event))
|
||||
;; No input ready, sleep briefly and check running? again
|
||||
(Thread/sleep 10))
|
||||
(recur)))))
|
||||
|
||||
;; === Update Function Detection ===
|
||||
(defn- detect-update-format
|
||||
"Detect if update function uses new or legacy format by examining its signature.
|
||||
Returns :new or :legacy."
|
||||
[update-fn]
|
||||
;; We can't easily detect at compile time, so we'll detect at runtime
|
||||
;; by checking the result format
|
||||
:unknown)
|
||||
|
||||
(defn- call-update
|
||||
"Call update function, handling both new and legacy formats.
|
||||
Returns {:model m :events [...]} in new format."
|
||||
[update-fn model event legacy-mode?]
|
||||
(if legacy-mode?
|
||||
;; Legacy: (fn [model msg] [new-model cmd])
|
||||
(let [[new-model cmd] (update-fn model event)]
|
||||
{:model new-model
|
||||
:legacy-cmd cmd})
|
||||
;; New: (fn [{:keys [model event]}] {:model m :events [...]})
|
||||
(let [result (update-fn {:model model :event event})]
|
||||
(if (vector? result)
|
||||
;; Got legacy format back, switch to legacy mode
|
||||
{:model (first result)
|
||||
:legacy-cmd (second result)
|
||||
:switch-to-legacy true}
|
||||
;; New format
|
||||
result))))
|
||||
|
||||
;; === Main Run Loop ===
|
||||
(defn run
|
||||
"Run a TUI application.
|
||||
|
||||
## New API (Recommended)
|
||||
|
||||
Options:
|
||||
- :init - Initial model (required)
|
||||
- :update - (fn [model msg] [new-model cmd]) (required)
|
||||
- :view - (fn [model size] hiccup) where size is {:width w :height h} (required)
|
||||
- :init-cmd - Initial command to run
|
||||
- :fps - Target frames per second (default 60)
|
||||
- :init - Initial model (required)
|
||||
- :update - (fn [{:keys [model event]}] {:model m :events [...]}) (required)
|
||||
- :view - (fn [model size] hiccup) where size is {:width w :height h} (required)
|
||||
- :fps - Target frames per second (default 60)
|
||||
- :alt-screen - Use alternate screen buffer (default true)
|
||||
|
||||
## Legacy API (Deprecated)
|
||||
|
||||
Also accepts:
|
||||
- :update - (fn [model msg] [new-model cmd])
|
||||
- :init-cmd - Initial command to run
|
||||
|
||||
Returns the final model."
|
||||
[{:keys [init update view init-cmd fps alt-screen]
|
||||
[{:keys [init update view init-cmd init-events fps alt-screen]
|
||||
:or {fps 60 alt-screen true}}]
|
||||
(let [msg-chan (chan 256)
|
||||
running? (atom true)
|
||||
frame-time (/ 1000 fps)]
|
||||
frame-time (/ 1000 fps)
|
||||
;; Start in auto-detect mode, will switch to legacy if needed
|
||||
legacy-mode? (atom false)]
|
||||
|
||||
;; Setup terminal
|
||||
(term/raw-mode!)
|
||||
@@ -122,7 +264,10 @@
|
||||
;; Start input loop
|
||||
(start-input-loop! msg-chan running?)
|
||||
|
||||
;; Execute initial command
|
||||
;; Execute initial events/command
|
||||
(when init-events
|
||||
(doseq [event init-events]
|
||||
(execute-event! event msg-chan)))
|
||||
(when init-cmd
|
||||
(execute-cmd! init-cmd msg-chan))
|
||||
|
||||
@@ -137,29 +282,36 @@
|
||||
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)]
|
||||
event (alt!!
|
||||
msg-chan ([v] v)
|
||||
(timeout remaining) nil)]
|
||||
|
||||
(if (or (nil? msg) (not @running?))
|
||||
(if (or (nil? event) (not @running?))
|
||||
;; No message, just continue
|
||||
(recur model (System/currentTimeMillis))
|
||||
|
||||
;; Process message
|
||||
(if (= msg [:quit])
|
||||
;; Check for quit
|
||||
(if (or (= event {:type :quit})
|
||||
(= event [:quit])) ; legacy
|
||||
;; Quit - return final model
|
||||
model
|
||||
|
||||
;; Update model
|
||||
(let [[new-model cmd] (update model msg)
|
||||
(let [result (call-update update model event @legacy-mode?)
|
||||
_ (when (:switch-to-legacy result)
|
||||
(reset! legacy-mode? true))
|
||||
new-model (:model result)
|
||||
size (term/get-terminal-size)
|
||||
ctx {:available-height (:height size)
|
||||
:available-width (:width size)}
|
||||
now (System/currentTimeMillis)]
|
||||
|
||||
;; Execute command
|
||||
(when cmd
|
||||
(execute-cmd! cmd msg-chan))
|
||||
;; Execute events (new API) or command (legacy)
|
||||
(if-let [events (:events result)]
|
||||
(doseq [e events]
|
||||
(execute-event! e msg-chan))
|
||||
(when-let [cmd (:legacy-cmd result)]
|
||||
(execute-cmd! cmd msg-chan)))
|
||||
|
||||
;; Render with context for flex layouts
|
||||
(term/render! (render/render (view new-model size) ctx))
|
||||
@@ -169,6 +321,7 @@
|
||||
(finally
|
||||
;; Cleanup
|
||||
(reset! running? false)
|
||||
(reset! debounce-timers {})
|
||||
(close! msg-chan)
|
||||
(when alt-screen (term/exit-alt-screen!))
|
||||
(term/restore!)
|
||||
@@ -182,23 +335,28 @@
|
||||
|
||||
(defapp my-app
|
||||
:init {:count 0}
|
||||
:update (fn [model msg] ...)
|
||||
:view (fn [model] ...))"
|
||||
[name & {:keys [init update view init-cmd]}]
|
||||
:update (fn [ctx] ...)
|
||||
:view (fn [model size] ...))"
|
||||
[name & {:keys [init update view init-cmd init-events]}]
|
||||
`(def ~name
|
||||
{:init ~init
|
||||
:update ~update
|
||||
:view ~view
|
||||
:init-cmd ~init-cmd}))
|
||||
:init-cmd ~init-cmd
|
||||
:init-events ~init-events}))
|
||||
|
||||
;; === Key Matching Helpers ===
|
||||
;; === Legacy Key Matching Helpers (Deprecated) ===
|
||||
(defn key=
|
||||
"Check if message is a specific key."
|
||||
"DEPRECATED: Use tui.events/key= instead.
|
||||
|
||||
Check if message is a specific key."
|
||||
[msg key-pattern]
|
||||
(input/key-match? msg key-pattern))
|
||||
|
||||
(defn key-str
|
||||
"Get string representation of key."
|
||||
"DEPRECATED: Use tui.input/key->str instead.
|
||||
|
||||
Get string representation of key."
|
||||
[msg]
|
||||
(input/key->str msg))
|
||||
|
||||
|
||||
@@ -0,0 +1,324 @@
|
||||
(ns tui.events
|
||||
"Event constructors and key matching for the TUI framework.
|
||||
|
||||
Events are the unified message format for the TUI system. All events
|
||||
are maps with a :type key as discriminator. Events flow in both
|
||||
directions: from the runtime to the update function (key presses,
|
||||
shell results), and from the update function to the runtime (quit,
|
||||
delay, shell commands).
|
||||
|
||||
## Event Format
|
||||
|
||||
All events are maps with :type as the discriminator:
|
||||
|
||||
{:type :key, :key \\a} ; key press
|
||||
{:type :key, :key :enter} ; special key
|
||||
{:type :key, :key \\c, :modifiers #{:ctrl}} ; with modifiers
|
||||
{:type :quit} ; quit app
|
||||
{:type :delay, :ms 2000, :event {...}} ; delayed event
|
||||
|
||||
## Update Function Contract
|
||||
|
||||
(fn [{:keys [model event]}]
|
||||
{:model new-model
|
||||
:events [...]}) ; :events is optional
|
||||
|
||||
## Key Event Format
|
||||
|
||||
Key events use :type :key with:
|
||||
:key - Character (\\a-\\z, \\0-\\9) or keyword (:enter, :up, etc.)
|
||||
:modifiers - Optional set of #{:ctrl :alt :shift :super :capslock}
|
||||
|
||||
Characters are normalized to lowercase. Uppercase letters have
|
||||
:shift in :modifiers.")
|
||||
|
||||
;;; ============================================================
|
||||
;;; Key Matching
|
||||
;;; ============================================================
|
||||
|
||||
(defn key=
|
||||
"Check if an event matches a key pattern.
|
||||
|
||||
Takes an event map and a key pattern, optionally with required modifiers.
|
||||
Returns true if the event is a key event matching the pattern.
|
||||
|
||||
Arguments:
|
||||
event - Event map from the TUI runtime
|
||||
key - Character (\\a-\\z, \\0-\\9, etc.) or keyword (:enter, :escape, :up, etc.)
|
||||
modifiers - Optional set of required modifiers: #{:ctrl :alt :shift :super :capslock}
|
||||
|
||||
Key patterns:
|
||||
Characters are normalized to lowercase. Use #{:shift} modifier for uppercase.
|
||||
Special keys use keywords: :enter :escape :tab :backspace :delete
|
||||
:up :down :left :right :home :end
|
||||
:page-up :page-down :insert
|
||||
:f1 :f2 ... :f12
|
||||
|
||||
Examples:
|
||||
;; Match plain 'q' key
|
||||
(key= event \\q)
|
||||
|
||||
;; Match Enter key
|
||||
(key= event :enter)
|
||||
|
||||
;; Match Ctrl+C
|
||||
(key= event \\c #{:ctrl})
|
||||
|
||||
;; Match uppercase 'Z' (Shift+z)
|
||||
(key= event \\z #{:shift})
|
||||
|
||||
;; Match Ctrl+Shift+Z (common redo shortcut)
|
||||
(key= event \\z #{:ctrl :shift})
|
||||
|
||||
;; Match Ctrl+Enter
|
||||
(key= event :enter #{:ctrl})
|
||||
|
||||
;; Match Alt+F4
|
||||
(key= event :f4 #{:alt})
|
||||
|
||||
Usage in update function:
|
||||
(defn update [{:keys [model event]}]
|
||||
(cond
|
||||
(key= event \\q) {:model model, :events [(quit)]}
|
||||
(key= event \\s #{:ctrl}) {:model (save model)}
|
||||
(key= event :up) {:model (cursor-up model)}
|
||||
(key= event \\z #{:ctrl}) {:model (undo model)}
|
||||
:else {:model model}))"
|
||||
([event key]
|
||||
(key= event key nil))
|
||||
([event key modifiers]
|
||||
(and (= (:type event) :key)
|
||||
(= (:key event) key)
|
||||
(= (:modifiers event) modifiers))))
|
||||
|
||||
;;; ============================================================
|
||||
;;; Event Constructors
|
||||
;;; ============================================================
|
||||
|
||||
(defn quit
|
||||
"Create a quit event that exits the application.
|
||||
|
||||
Takes no arguments. When processed, cleanly shuts down the TUI,
|
||||
restores terminal state, and returns the final model.
|
||||
|
||||
Returns:
|
||||
{:type :quit}
|
||||
|
||||
Examples:
|
||||
;; Quit on 'q' key
|
||||
(defn update [{:keys [model event]}]
|
||||
(if (key= event \\q)
|
||||
{:model model, :events [(quit)]}
|
||||
{:model model}))
|
||||
|
||||
;; Quit after confirmation
|
||||
(defn update [{:keys [model event]}]
|
||||
(cond
|
||||
(and (= (:mode model) :confirm-quit)
|
||||
(key= event \\y))
|
||||
{:model model, :events [(quit)]}
|
||||
|
||||
(key= event \\q)
|
||||
{:model (assoc model :mode :confirm-quit)}
|
||||
|
||||
:else
|
||||
{:model model}))"
|
||||
[]
|
||||
{:type :quit})
|
||||
|
||||
(defn delay
|
||||
"Create an event that dispatches another event after a delay.
|
||||
|
||||
The nested event is dispatched after the specified milliseconds elapse.
|
||||
Useful for transient messages, animations, debouncing, or timeouts.
|
||||
|
||||
Arguments:
|
||||
ms - Delay in milliseconds before dispatching
|
||||
event - Event map to dispatch after the delay
|
||||
|
||||
Returns:
|
||||
{:type :delay, :ms <ms>, :event <event>}
|
||||
|
||||
Examples:
|
||||
;; Show a message that auto-clears after 3 seconds
|
||||
(defn update [{:keys [model event]}]
|
||||
(case (:type event)
|
||||
:show-message
|
||||
{:model (assoc model :message (:text event))
|
||||
:events [(delay 3000 {:type :clear-message})]}
|
||||
|
||||
:clear-message
|
||||
{:model (dissoc model :message)}
|
||||
|
||||
{:model model}))
|
||||
|
||||
;; Auto-save after 5 seconds of inactivity
|
||||
(defn update [{:keys [model event]}]
|
||||
(if (= (:type event) :key)
|
||||
{:model (-> model
|
||||
(update :buffer conj event)
|
||||
(assoc :dirty true))
|
||||
:events [(delay 5000 {:type :auto-save})]}
|
||||
{:model model}))
|
||||
|
||||
;; Simple animation frame
|
||||
{:events [(delay 16 {:type :animation-tick})]}"
|
||||
[ms event]
|
||||
{:type :delay, :ms ms, :event event})
|
||||
|
||||
(defn shell
|
||||
"Create an event that runs a shell command asynchronously.
|
||||
|
||||
The command runs in a separate thread without blocking the UI.
|
||||
When complete, dispatches the provided event with :result merged in.
|
||||
|
||||
Arguments:
|
||||
cmd - Command as vector of strings [\"git\" \"status\"]
|
||||
event - Event map to dispatch when complete.
|
||||
The event will have :result key merged in with:
|
||||
:exit - Exit code (0 = success)
|
||||
:out - Stdout as string
|
||||
:err - Stderr as string
|
||||
:success - Boolean, true if exit code 0
|
||||
|
||||
Returns:
|
||||
{:type :shell, :cmd <cmd>, :event <event>}
|
||||
|
||||
Examples:
|
||||
;; Run git status and process result
|
||||
(defn update [{:keys [model event]}]
|
||||
(case (:type event)
|
||||
:refresh
|
||||
{:model (assoc model :loading true)
|
||||
:events [(shell [\"git\" \"status\" \"--porcelain\"]
|
||||
{:type :git-status-result})]}
|
||||
|
||||
:git-status-result
|
||||
(let [{:keys [success out err]} (:result event)]
|
||||
(if success
|
||||
{:model (-> model
|
||||
(assoc :loading false)
|
||||
(assoc :files (parse-status out)))}
|
||||
{:model (-> model
|
||||
(assoc :loading false)
|
||||
(assoc :error err))}))
|
||||
|
||||
{:model model}))
|
||||
|
||||
;; Run git diff for selected file
|
||||
(shell [\"git\" \"diff\" \"--\" path]
|
||||
{:type :diff-result, :file file})
|
||||
|
||||
;; Pass context through the event
|
||||
(shell [\"git\" \"add\" \"--\" path]
|
||||
{:type :file-staged, :path path})"
|
||||
[cmd event]
|
||||
{:type :shell, :cmd cmd, :event event})
|
||||
|
||||
(defn batch
|
||||
"Create an event that processes multiple events in parallel.
|
||||
|
||||
All events start immediately and run concurrently.
|
||||
Useful when you need to trigger multiple independent operations.
|
||||
|
||||
Arguments:
|
||||
events - Variable number of event maps
|
||||
|
||||
Returns:
|
||||
{:type :batch, :events [<events>]}
|
||||
Returns nil if no events provided.
|
||||
|
||||
Examples:
|
||||
;; Refresh multiple data sources in parallel
|
||||
(defn update [{:keys [model event]}]
|
||||
(if (key= event \\r)
|
||||
{:model (assoc model :loading true)
|
||||
:events [(batch
|
||||
(shell [\"git\" \"status\" \"--porcelain\"]
|
||||
{:type :status-result})
|
||||
(shell [\"git\" \"log\" \"--oneline\" \"-10\"]
|
||||
{:type :log-result})
|
||||
(shell [\"git\" \"branch\"]
|
||||
{:type :branch-result}))]}
|
||||
{:model model}))
|
||||
|
||||
;; Show message and trigger async operation
|
||||
(batch
|
||||
{:type :show-spinner}
|
||||
(shell [\"git\" \"push\"] {:type :push-complete}))"
|
||||
[& events]
|
||||
(when-let [evts (seq (remove nil? events))]
|
||||
{:type :batch, :events (vec evts)}))
|
||||
|
||||
(defn sequential
|
||||
"Create an event that processes multiple events in sequence.
|
||||
|
||||
Each event completes before the next one starts.
|
||||
The result events are dispatched in order.
|
||||
Useful when operations must happen in a specific order.
|
||||
|
||||
Arguments:
|
||||
events - Variable number of event maps
|
||||
|
||||
Returns:
|
||||
{:type :sequential, :events [<events>]}
|
||||
Returns nil if no events provided.
|
||||
|
||||
Examples:
|
||||
;; Stage file, then commit, then push
|
||||
(sequential
|
||||
(shell [\"git\" \"add\" \"--all\"] {:type :staged})
|
||||
(shell [\"git\" \"commit\" \"-m\" msg] {:type :committed})
|
||||
(shell [\"git\" \"push\"] {:type :pushed}))
|
||||
|
||||
;; Show message, wait, then clear
|
||||
(sequential
|
||||
{:type :show-message, :text \"Saved!\"}
|
||||
(delay 2000 {:type :clear-message}))
|
||||
|
||||
Note:
|
||||
For complex workflows, consider handling each step explicitly
|
||||
in your update function for better error handling and control."
|
||||
[& events]
|
||||
(when-let [evts (seq (remove nil? events))]
|
||||
{:type :sequential, :events (vec evts)}))
|
||||
|
||||
(defn debounce
|
||||
"Create an event that debounces dispatch.
|
||||
|
||||
Delays dispatching the event until the specified time has passed
|
||||
without another debounce event with the same id being created.
|
||||
Useful for search-as-you-type, resize handling, or any input
|
||||
that fires rapidly but should only trigger action after settling.
|
||||
|
||||
Arguments:
|
||||
id - Keyword identifying this debounce group. New debounce
|
||||
events with the same id cancel pending ones.
|
||||
ms - Milliseconds to wait after last debounce before dispatching
|
||||
event - Event map to dispatch after debounce period
|
||||
|
||||
Returns:
|
||||
{:type :debounce, :id <id>, :ms <ms>, :event <event>}
|
||||
|
||||
Examples:
|
||||
;; Search as you type with 300ms debounce
|
||||
(defn update [{:keys [model event]}]
|
||||
(if (and (= (:type event) :key)
|
||||
(= (:mode model) :search))
|
||||
(let [new-query (str (:query model) (:key event))]
|
||||
{:model (assoc model :query new-query)
|
||||
:events [(debounce :search 300
|
||||
{:type :execute-search, :query new-query})]})
|
||||
{:model model}))
|
||||
|
||||
;; Debounce window resize events
|
||||
(defn update [{:keys [model event]}]
|
||||
(if (= (:type event) :resize)
|
||||
{:model model
|
||||
:events [(debounce :resize 100
|
||||
{:type :layout-changed
|
||||
:width (:width event)
|
||||
:height (:height event)})]}
|
||||
{:model model}))"
|
||||
[id ms event]
|
||||
{:type :debounce, :id id, :ms ms, :event event})
|
||||
+140
-60
@@ -1,12 +1,27 @@
|
||||
(ns tui.input
|
||||
"Parse terminal input into key messages."
|
||||
"Parse terminal input into key events.
|
||||
|
||||
Key events are maps with the following structure:
|
||||
{:type :key, :key <key>, :modifiers <set>}
|
||||
|
||||
Where:
|
||||
:key - Character (lowercase \\a-\\z, \\0-\\9, etc.) or keyword
|
||||
(:enter, :escape, :up, :down, etc.)
|
||||
:modifiers - Optional set of #{:ctrl :alt :shift}
|
||||
Omitted when empty.
|
||||
|
||||
Examples:
|
||||
{:type :key, :key \\a} ; lowercase 'a'
|
||||
{:type :key, :key \\a, :modifiers #{:shift}} ; uppercase 'A'
|
||||
{: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]))
|
||||
|
||||
;; === Key Message Structure ===
|
||||
;; [:key {:type :rune :char \a}]
|
||||
;; [:key {:type :special :key :up}]
|
||||
;; [:key {:type :special :key :enter}]
|
||||
;; [:key {:type :ctrl :char \c}]
|
||||
;; === Control Key Mappings ===
|
||||
;; Maps byte codes 0-31 to either:
|
||||
;; - [:ctrl \x] for Ctrl+letter combinations
|
||||
;; - keyword for special keys (:enter, :tab, etc.)
|
||||
|
||||
(def ^:private ctrl-keys
|
||||
{0 [:ctrl \space] ; Ctrl+Space / Ctrl+@
|
||||
@@ -22,6 +37,9 @@
|
||||
28 [:ctrl \\] 29 [:ctrl \]] 30 [:ctrl \^]
|
||||
31 [:ctrl \_] 127 :backspace})
|
||||
|
||||
;; === CSI Escape Sequences ===
|
||||
;; Maps escape sequences to special key keywords
|
||||
|
||||
(def ^:private csi-sequences
|
||||
{"A" :up "B" :down "C" :right "D" :left
|
||||
"H" :home "F" :end "Z" :shift-tab
|
||||
@@ -35,13 +53,34 @@
|
||||
;; xterm-style function keys
|
||||
"OP" :f1 "OQ" :f2 "OR" :f3 "OS" :f4})
|
||||
|
||||
;; === Event Constructors ===
|
||||
|
||||
(defn- make-key-event
|
||||
"Create a key event map. Omits :modifiers when empty."
|
||||
([key]
|
||||
{:type :key, :key key})
|
||||
([key modifiers]
|
||||
(if (seq modifiers)
|
||||
{:type :key, :key key, :modifiers modifiers}
|
||||
{:type :key, :key key})))
|
||||
|
||||
(defn- normalize-char
|
||||
"Normalize a character to lowercase and return [char modifiers].
|
||||
Uppercase letters get #{:shift} modifier."
|
||||
[c]
|
||||
(if (Character/isUpperCase c)
|
||||
[(Character/toLowerCase c) #{:shift}]
|
||||
[c nil]))
|
||||
|
||||
;; === Escape Sequence Parsing ===
|
||||
|
||||
(defn- read-escape-sequence
|
||||
"Read and parse an escape sequence."
|
||||
[]
|
||||
(let [c2 (term/read-char-timeout 50)]
|
||||
(cond
|
||||
(nil? c2)
|
||||
[:key :escape]
|
||||
(make-key-event :escape)
|
||||
|
||||
(= c2 \[)
|
||||
;; CSI sequence
|
||||
@@ -49,7 +88,7 @@
|
||||
(let [c (term/read-char-timeout 50)]
|
||||
(cond
|
||||
(nil? c)
|
||||
[:key :escape]
|
||||
(make-key-event :escape)
|
||||
|
||||
;; Parameters and intermediates
|
||||
(or (<= 0x30 (int c) 0x3F) ; 0-9:;<=>?
|
||||
@@ -60,27 +99,39 @@
|
||||
(<= 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]))
|
||||
(make-key-event key)
|
||||
(make-key-event :unknown)))
|
||||
|
||||
:else
|
||||
[:key :unknown (str "[" (apply str buf) c)])))
|
||||
(make-key-event :unknown))))
|
||||
|
||||
(= 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]))
|
||||
(make-key-event key)
|
||||
(make-key-event :unknown))
|
||||
(make-key-event :escape)))
|
||||
|
||||
:else
|
||||
;; Alt+key
|
||||
[:key {:alt true :char c2}])))
|
||||
(let [[normalized-char shift-mod] (normalize-char c2)
|
||||
modifiers (if shift-mod
|
||||
#{:alt :shift}
|
||||
#{:alt})]
|
||||
(make-key-event normalized-char modifiers)))))
|
||||
|
||||
;; === Main Key Reading ===
|
||||
|
||||
(defn read-key
|
||||
"Read a single key event. Returns [:key ...] message."
|
||||
"Read a single key event from terminal input.
|
||||
|
||||
Returns a key event map:
|
||||
{:type :key, :key <key>}
|
||||
{:type :key, :key <key>, :modifiers #{...}}
|
||||
|
||||
Returns nil if no input available."
|
||||
[]
|
||||
(when-let [c (term/read-char)]
|
||||
(let [code (int c)]
|
||||
@@ -89,64 +140,93 @@
|
||||
(= code 27)
|
||||
(read-escape-sequence)
|
||||
|
||||
;; Control characters
|
||||
;; Control characters (0-31)
|
||||
(<= 0 code 31)
|
||||
(let [key (get ctrl-keys code)]
|
||||
(if (vector? key)
|
||||
[:key {:ctrl true :char (second key)}]
|
||||
[:key key]))
|
||||
;; [:ctrl \x] format
|
||||
(make-key-event (second key) #{:ctrl})
|
||||
;; keyword like :enter, :tab
|
||||
(make-key-event key)))
|
||||
|
||||
;; DEL (Ctrl+Backspace on some terminals)
|
||||
(= code 127)
|
||||
[:key :backspace]
|
||||
(make-key-event :backspace)
|
||||
|
||||
;; Normal character
|
||||
;; Normal character - normalize case
|
||||
:else
|
||||
[:key {:char c}]))))
|
||||
(let [[normalized-char shift-mod] (normalize-char c)]
|
||||
(make-key-event normalized-char shift-mod))))))
|
||||
|
||||
;; === Legacy Compatibility ===
|
||||
;; These functions support the old API during migration
|
||||
|
||||
(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))
|
||||
"DEPRECATED: Use tui.events/key= instead.
|
||||
|
||||
;; String match (single char)
|
||||
(string? pattern)
|
||||
(and (map? key)
|
||||
(= (:char key) (first pattern))
|
||||
(not (:ctrl key))
|
||||
(not (:alt key)))
|
||||
Check if a key event matches a pattern.
|
||||
Supports both old [:key ...] and new {:type :key ...} formats."
|
||||
[event pattern]
|
||||
(let [;; Handle both old and new event formats
|
||||
key-data (if (vector? event)
|
||||
(second event)
|
||||
event)
|
||||
;; Extract key and modifiers from new format
|
||||
key-val (if (map? key-data)
|
||||
(or (:key key-data) (:char key-data))
|
||||
key-data)
|
||||
modifiers (when (map? key-data)
|
||||
(:modifiers key-data))
|
||||
has-ctrl (or (contains? modifiers :ctrl)
|
||||
(when (map? key-data) (:ctrl key-data)))
|
||||
has-alt (or (contains? modifiers :alt)
|
||||
(when (map? key-data) (:alt key-data)))]
|
||||
(cond
|
||||
;; Simple keyword match (:enter, :up, etc.)
|
||||
(keyword? pattern)
|
||||
(= key-val pattern)
|
||||
|
||||
;; 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)))
|
||||
;; String match (single char) - no modifiers
|
||||
(string? pattern)
|
||||
(and (= key-val (first pattern))
|
||||
(not has-ctrl)
|
||||
(not has-alt))
|
||||
|
||||
:else false))))
|
||||
;; Vector pattern [:ctrl \c]
|
||||
(vector? pattern)
|
||||
(let [[mod ch] pattern]
|
||||
(and (= key-val ch)
|
||||
(case mod
|
||||
:ctrl has-ctrl
|
||||
:alt has-alt
|
||||
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)
|
||||
"Convert key event to human-readable string.
|
||||
Supports both old [:key ...] and new {:type :key ...} formats."
|
||||
[event]
|
||||
(let [;; Handle both old and new event formats
|
||||
key-data (if (vector? event)
|
||||
(second event)
|
||||
event)]
|
||||
(cond
|
||||
(keyword? key-data)
|
||||
(name key-data)
|
||||
|
||||
(map? key)
|
||||
(str (when (:ctrl key) "ctrl+")
|
||||
(when (:alt key) "alt+")
|
||||
(:char key))
|
||||
(map? key-data)
|
||||
(let [key-val (or (:key key-data) (:char key-data))
|
||||
modifiers (:modifiers key-data)
|
||||
ctrl (or (contains? modifiers :ctrl) (:ctrl key-data))
|
||||
alt (or (contains? modifiers :alt) (:alt key-data))
|
||||
shift (contains? modifiers :shift)]
|
||||
(str (when ctrl "ctrl+")
|
||||
(when alt "alt+")
|
||||
(when shift "shift+")
|
||||
(if (keyword? key-val)
|
||||
(name key-val)
|
||||
key-val)))
|
||||
|
||||
:else
|
||||
(str key)))))
|
||||
:else
|
||||
(str key-data))))
|
||||
|
||||
+395
-47
@@ -3,6 +3,120 @@
|
||||
(:require [tui.ansi :as ansi]
|
||||
[clojure.string :as str]))
|
||||
|
||||
;; === Enhanced Sizing System ===
|
||||
|
||||
(defn parse-size-spec
|
||||
"Parse a size specification into a normalized map.
|
||||
Supports:
|
||||
- Numbers: fixed size (e.g., 30)
|
||||
- :flex or {:flex n}: weighted flex (default weight 1)
|
||||
- \"N%\": percentage of remaining space
|
||||
- \"Nfr\": fractional unit (like CSS Grid fr)
|
||||
- {:percent N :min X :max Y}: percentage with constraints
|
||||
|
||||
Returns {:type :fixed|:flex|:percent|:fr :value N :min M :max M}"
|
||||
[spec]
|
||||
(cond
|
||||
;; nil means auto-size (not constrained)
|
||||
(nil? spec)
|
||||
{:type :auto :value nil}
|
||||
|
||||
;; Numbers are fixed
|
||||
(number? spec)
|
||||
{:type :fixed :value spec}
|
||||
|
||||
;; :flex is shorthand for {:flex 1}
|
||||
(= spec :flex)
|
||||
{:type :flex :value 1}
|
||||
|
||||
;; {:flex n} for weighted flex
|
||||
(and (map? spec) (:flex spec))
|
||||
{:type :flex :value (:flex spec) :min (:min spec) :max (:max spec)}
|
||||
|
||||
;; {:percent n ...} for percentage with constraints
|
||||
(and (map? spec) (:percent spec))
|
||||
{:type :percent :value (:percent spec) :min (:min spec) :max (:max spec)}
|
||||
|
||||
;; String "N%" for percentage
|
||||
(and (string? spec) (str/ends-with? spec "%"))
|
||||
(let [n (parse-long (subs spec 0 (dec (count spec))))]
|
||||
{:type :percent :value n})
|
||||
|
||||
;; String "Nfr" for fractional unit (treated like flex)
|
||||
(and (string? spec) (str/ends-with? spec "fr"))
|
||||
(let [n (parse-long (subs spec 0 (- (count spec) 2)))]
|
||||
{:type :fr :value n})
|
||||
|
||||
;; Unknown - treat as auto
|
||||
:else
|
||||
{:type :auto :value nil}))
|
||||
|
||||
(defn calculate-sizes
|
||||
"Calculate sizes for children given a size specification.
|
||||
Uses 4-phase algorithm:
|
||||
1. Fixed - subtract literal numbers from available
|
||||
2. Percentages - calculate against remaining (scale if >100%)
|
||||
3. Fr/Flex - divide remaining proportionally
|
||||
4. Constraints - apply min/max, redistribute if needed
|
||||
|
||||
Returns vector of calculated sizes (numbers or nil for auto)."
|
||||
[specs children available-size gap]
|
||||
(let [num-children (count children)
|
||||
;; Ensure we have specs for all children
|
||||
specs-vec (if specs
|
||||
(vec (take num-children (concat specs (repeat nil))))
|
||||
(vec (repeat num-children nil)))
|
||||
;; Parse all specs
|
||||
parsed (mapv parse-size-spec specs-vec)
|
||||
;; Calculate total gap
|
||||
total-gap (* gap (max 0 (dec num-children)))
|
||||
usable-size (max 0 (- available-size total-gap))
|
||||
|
||||
;; Phase 1: Fixed sizes
|
||||
fixed-total (reduce + 0 (for [p parsed :when (= (:type p) :fixed)]
|
||||
(:value p)))
|
||||
after-fixed (max 0 (- usable-size fixed-total))
|
||||
|
||||
;; Phase 2: Percentages (calculate against remaining after fixed)
|
||||
percent-specs (filter #(= (:type %) :percent) parsed)
|
||||
total-percent (reduce + 0 (map :value percent-specs))
|
||||
;; Scale down if percentages exceed 100%
|
||||
percent-scale (if (> total-percent 100) (/ 100.0 total-percent) 1.0)
|
||||
percent-sizes (for [p parsed]
|
||||
(when (= (:type p) :percent)
|
||||
(int (* after-fixed (/ (* (:value p) percent-scale) 100.0)))))
|
||||
percent-total (reduce + 0 (filter some? percent-sizes))
|
||||
after-percent (max 0 (- after-fixed percent-total))
|
||||
|
||||
;; Phase 3: Fr/Flex units (divide remaining proportionally)
|
||||
flex-specs (filter #(#{:flex :fr} (:type %)) parsed)
|
||||
total-flex-weight (reduce + 0 (map :value flex-specs))
|
||||
flex-unit (if (pos? total-flex-weight)
|
||||
(/ after-percent total-flex-weight)
|
||||
0)
|
||||
|
||||
;; Calculate final sizes
|
||||
raw-sizes (mapv (fn [p pct-size]
|
||||
(case (:type p)
|
||||
:fixed (:value p)
|
||||
:percent pct-size
|
||||
:flex (int (* (:value p) flex-unit))
|
||||
:fr (int (* (:value p) flex-unit))
|
||||
:auto nil))
|
||||
parsed
|
||||
(concat percent-sizes (repeat nil)))
|
||||
|
||||
;; 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)]
|
||||
constrained))
|
||||
|
||||
;; === Hiccup Parsing ===
|
||||
(defn- flatten-children
|
||||
"Flatten sequences in children (but not vectors, which are hiccup elements)."
|
||||
@@ -47,7 +161,6 @@
|
||||
|
||||
;; === Layout Primitives ===
|
||||
(declare render-element)
|
||||
(declare calculate-flex-sizes)
|
||||
|
||||
(defn- render-children
|
||||
"Render all children and return list of rendered strings."
|
||||
@@ -58,14 +171,16 @@
|
||||
"Render :row - horizontal layout with proper multi-line support.
|
||||
Each child is rendered and placed side-by-side, with lines aligned.
|
||||
Supports :gap for spacing and :widths for column widths.
|
||||
:widths can be numbers (fixed), :flex (share remaining), or nil (auto).
|
||||
Example: [:row {:widths [20 :flex :flex]} child1 child2 child3]"
|
||||
:widths can be: numbers (fixed), :flex/{:flex n} (weighted share),
|
||||
\"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]
|
||||
(let [available-width (or (:available-width ctx) 120)
|
||||
available-height (or (:available-height ctx) 100)
|
||||
;; Calculate flex widths if :flex is used
|
||||
calculated-widths (when (and widths (some #(= % :flex) widths))
|
||||
(calculate-flex-sizes widths children available-width gap))
|
||||
;; Use new enhanced sizing system
|
||||
calculated-widths (when widths
|
||||
(calculate-sizes widths children available-width gap))
|
||||
;; Render each child with its allocated width in context
|
||||
rendered (map-indexed
|
||||
(fn [idx child]
|
||||
@@ -79,10 +194,8 @@
|
||||
child-lines (mapv #(str/split % #"\n" -1) rendered)
|
||||
;; Calculate width of each child
|
||||
child-widths (cond
|
||||
;; Use calculated flex widths
|
||||
;; Use calculated widths (includes flex, percent, fr)
|
||||
calculated-widths calculated-widths
|
||||
;; Use provided fixed widths
|
||||
widths widths
|
||||
;; Auto: max visible length of lines
|
||||
:else (mapv (fn [lines]
|
||||
(apply max 0 (map ansi/visible-length lines)))
|
||||
@@ -99,49 +212,25 @@
|
||||
(fn [child-idx lines]
|
||||
(let [line (get lines line-idx "")
|
||||
width (get child-widths child-idx 0)]
|
||||
(ansi/pad-right line width)))
|
||||
(ansi/pad-right line (or width 0))))
|
||||
child-lines)))]
|
||||
(str/join "\n" combined-lines)))
|
||||
|
||||
(defn- calculate-flex-sizes
|
||||
"Calculate sizes for children given a spec.
|
||||
Sizes can be: numbers (fixed), :flex (share remaining), or nil (auto).
|
||||
Returns vector of calculated sizes."
|
||||
[sizes children available-size gap]
|
||||
(let [num-children (count children)
|
||||
sizes-vec (if sizes
|
||||
(vec (take num-children (concat sizes (repeat nil))))
|
||||
(vec (repeat num-children nil)))
|
||||
;; Total gap space
|
||||
total-gap (* gap (max 0 (dec num-children)))
|
||||
usable-size (- available-size total-gap)
|
||||
;; Count fixed sizes and flex items
|
||||
fixed-total (reduce + 0 (filter number? sizes-vec))
|
||||
flex-count (count (filter #(= % :flex) sizes-vec))
|
||||
;; Calculate size per flex item
|
||||
remaining (- usable-size fixed-total)
|
||||
flex-size (if (pos? flex-count)
|
||||
(max 1 (quot remaining flex-count))
|
||||
0)]
|
||||
;; Return calculated sizes
|
||||
(mapv (fn [s]
|
||||
(cond
|
||||
(number? s) s
|
||||
(= s :flex) flex-size
|
||||
:else nil)) ; nil means auto-size
|
||||
sizes-vec)))
|
||||
|
||||
(defn- render-col
|
||||
"Render :col - vertical layout.
|
||||
Supports :heights for distributing vertical space.
|
||||
Heights can be numbers (fixed) or :flex (share remaining space).
|
||||
Example: [:col {:heights [3 :flex :flex 4]} child1 child2 child3 child4]"
|
||||
Heights can be: numbers (fixed), :flex/{:flex n} (weighted share),
|
||||
\"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]
|
||||
(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)
|
||||
;; Use new enhanced sizing system
|
||||
calculated-heights (when heights
|
||||
(calculate-flex-sizes heights children available-height gap))
|
||||
(calculate-sizes heights children available-height gap))
|
||||
;; Render each child with its allocated height in context
|
||||
rendered (map-indexed
|
||||
(fn [idx child]
|
||||
@@ -304,6 +393,241 @@
|
||||
result-lines (overlay-lines bg-lines modal-lines available-width available-height)]
|
||||
(str/join "\n" result-lines)))
|
||||
|
||||
;; === Scroll Primitive ===
|
||||
|
||||
(defn visible-window-calc
|
||||
"Calculate the visible window of items for scrolling.
|
||||
Returns {:start start-index :end end-index :has-above bool :has-below bool}
|
||||
Keeps cursor visible by scrolling the window."
|
||||
[total-items cursor max-visible]
|
||||
(let [max-visible (max 1 max-visible)]
|
||||
(if (<= total-items max-visible)
|
||||
;; All items fit, no scrolling needed
|
||||
{:start 0 :end total-items :has-above false :has-below false}
|
||||
;; Need to scroll - calculate window that keeps cursor visible
|
||||
(let [half (quot max-visible 2)
|
||||
start-idx (cond
|
||||
;; Cursor near start - show from beginning
|
||||
(<= cursor half) 0
|
||||
;; Cursor near end - show end portion
|
||||
(>= cursor (- total-items half)) (- total-items max-visible)
|
||||
;; Cursor in middle - center it
|
||||
:else (- cursor half))
|
||||
start-idx (max 0 (min start-idx (- total-items max-visible)))
|
||||
end-idx (+ start-idx max-visible)]
|
||||
{:start start-idx
|
||||
:end end-idx
|
||||
:has-above (pos? start-idx)
|
||||
:has-below (< end-idx total-items)}))))
|
||||
|
||||
(defn- render-scroll
|
||||
"Render :scroll - scrollable container with automatic windowing.
|
||||
Renders only the visible children based on available-height and cursor position.
|
||||
Shows ↑/↓ indicators when content is clipped.
|
||||
|
||||
Attrs:
|
||||
- :cursor - index of currently selected item (default 0)
|
||||
- :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]
|
||||
(let [available-height (or (:available-height ctx) 100)
|
||||
total-items (count children)
|
||||
;; Reserve space for indicators if enabled
|
||||
indicator-height (if indicators 1 0)
|
||||
max-visible (- available-height (* 2 indicator-height))
|
||||
max-visible (max 1 max-visible)
|
||||
;; Calculate visible window
|
||||
{: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)
|
||||
;; Build result with indicators
|
||||
up-indicator (when (and indicators has-above)
|
||||
(ansi/style "↑" :fg :cyan))
|
||||
down-indicator (when (and indicators has-below)
|
||||
(ansi/style "↓" :fg :cyan))
|
||||
all-lines (cond-> []
|
||||
up-indicator (conj up-indicator)
|
||||
true (into rendered-lines)
|
||||
down-indicator (conj down-indicator))]
|
||||
(str/join "\n" all-lines)))
|
||||
|
||||
;; === Grid Primitive ===
|
||||
|
||||
(defn- parse-template
|
||||
"Parse grid template strings into a position map.
|
||||
Template like [\"header header\" \"nav main\" \"footer footer\"]
|
||||
Returns a map of {name {:row row :col col :row-span n :col-span n}}"
|
||||
[template]
|
||||
(let [rows (mapv #(str/split % #"\s+") template)
|
||||
num-rows (count rows)
|
||||
num-cols (apply max 1 (map count rows))
|
||||
;; Normalize rows to have same number of columns
|
||||
normalized-rows (mapv #(vec (take num-cols (concat % (repeat nil)))) rows)
|
||||
;; Build position map
|
||||
positions (atom {})]
|
||||
;; Find each named area's bounds
|
||||
(doseq [row-idx (range num-rows)
|
||||
col-idx (range num-cols)]
|
||||
(let [name (get-in normalized-rows [row-idx col-idx])]
|
||||
(when (and name (not= name ".")) ;; "." means empty cell
|
||||
(if-let [existing (get @positions name)]
|
||||
;; Extend existing area
|
||||
(swap! positions update name
|
||||
(fn [area]
|
||||
(-> area
|
||||
(update :row-span #(max % (- (inc row-idx) (:row area))))
|
||||
(update :col-span #(max % (- (inc col-idx) (:col area)))))))
|
||||
;; New area
|
||||
(swap! positions assoc name {:row row-idx :col col-idx :row-span 1 :col-span 1})))))
|
||||
@positions))
|
||||
|
||||
(defn- parse-area-children
|
||||
"Extract area definitions from grid children.
|
||||
Returns map of position -> child element for explicit positioning,
|
||||
or name -> child element for named template areas."
|
||||
[children]
|
||||
(reduce
|
||||
(fn [acc child]
|
||||
(if (and (vector? child) (= :area (first child)))
|
||||
(let [[_ attrs & content] (if (map? (second child))
|
||||
child
|
||||
(into [(first child) {}] (rest child)))
|
||||
content (if (= 1 (count content)) (first content) (vec content))]
|
||||
(if (:name attrs)
|
||||
;; Named area
|
||||
(assoc-in acc [:named (:name attrs)] {:attrs attrs :content content})
|
||||
;; Explicit position
|
||||
(let [row (or (:row attrs) 0)
|
||||
col (or (:col attrs) 0)]
|
||||
(assoc-in acc [:positioned [row col]] {:attrs attrs :content content}))))
|
||||
;; Not an area - treat as positioned at auto-incrementing position
|
||||
acc))
|
||||
{:named {} :positioned {}}
|
||||
children))
|
||||
|
||||
(defn- create-canvas
|
||||
"Create a 2D canvas (vector of vectors of characters/strings)."
|
||||
[width height]
|
||||
(vec (repeat height (vec (repeat width " ")))))
|
||||
|
||||
(defn- overlay-on-canvas
|
||||
"Overlay rendered content on canvas at given position."
|
||||
[canvas content x y width height]
|
||||
(let [lines (str/split content #"\n" -1)
|
||||
lines (take height lines)]
|
||||
(reduce
|
||||
(fn [c [line-idx line]]
|
||||
(let [line-chars (vec (seq (ansi/pad-right line width)))
|
||||
row-idx (+ y line-idx)]
|
||||
(if (< row-idx (count c))
|
||||
(update c row-idx
|
||||
(fn [row]
|
||||
(reduce
|
||||
(fn [r [char-idx char]]
|
||||
(let [col-idx (+ x char-idx)]
|
||||
(if (< col-idx (count r))
|
||||
(assoc r col-idx (str char))
|
||||
r)))
|
||||
row
|
||||
(map-indexed vector line-chars))))
|
||||
c)))
|
||||
canvas
|
||||
(map-indexed vector lines))))
|
||||
|
||||
(defn- render-grid
|
||||
"Render :grid - 2D grid layout.
|
||||
|
||||
Supports two positioning modes:
|
||||
|
||||
1. Explicit positioning:
|
||||
[:grid {:rows [3 :flex :flex] :cols [30 :flex] :gap 1}
|
||||
[:area {:row 0 :col 0 :col-span 2} header]
|
||||
[:area {:row 1 :col 0} nav]
|
||||
[:area {:row 1 :col 1} main]]
|
||||
|
||||
2. Named template:
|
||||
[:grid {:template [\"header header\"
|
||||
\"nav main\"]
|
||||
:rows [3 :flex]
|
||||
:cols [30 :flex]}
|
||||
[:area {:name \"header\"} header-content]
|
||||
[:area {:name \"nav\"} nav-content]
|
||||
[:area {:name \"main\"} main-content]]
|
||||
|
||||
Attrs:
|
||||
- :rows - row size specs (numbers, :flex, %, fr)
|
||||
- :cols - column size specs
|
||||
- :gap - gap between cells (number or [row-gap col-gap])
|
||||
- :template - optional template strings for named areas"
|
||||
[{:keys [rows cols gap template] :or {gap 0}} children ctx]
|
||||
(let [available-width (or (:available-width ctx) 120)
|
||||
available-height (or (:available-height ctx) 100)
|
||||
;; Parse gap
|
||||
[row-gap col-gap] (if (vector? gap) gap [gap gap])
|
||||
;; Parse template if provided
|
||||
template-positions (when template (parse-template template))
|
||||
;; Determine grid dimensions
|
||||
num-rows (if template
|
||||
(count template)
|
||||
(or (count rows) 1))
|
||||
num-cols (if template
|
||||
(apply max 1 (map #(count (str/split % #"\s+")) template))
|
||||
(or (count cols) 1))
|
||||
;; Default row/col specs if not provided
|
||||
rows (or rows (vec (repeat num-rows :flex)))
|
||||
cols (or cols (vec (repeat num-cols :flex)))
|
||||
;; Calculate row heights and column widths
|
||||
row-heights (calculate-sizes rows (range num-rows) available-height row-gap)
|
||||
col-widths (calculate-sizes cols (range num-cols) available-width col-gap)
|
||||
;; Parse area children
|
||||
{:keys [named positioned]} (parse-area-children children)
|
||||
;; Merge template positions with named areas
|
||||
areas (if template-positions
|
||||
(reduce-kv
|
||||
(fn [acc name pos]
|
||||
(if-let [area (get named name)]
|
||||
(assoc acc [(:row pos) (:col pos)]
|
||||
{:attrs (merge pos (:attrs area))
|
||||
:content (:content area)})
|
||||
acc))
|
||||
positioned
|
||||
template-positions)
|
||||
positioned)
|
||||
;; Calculate positions for each cell
|
||||
row-positions (reductions + 0 (interpose row-gap row-heights))
|
||||
col-positions (reductions + 0 (interpose col-gap col-widths))
|
||||
;; Create canvas
|
||||
total-height (+ (reduce + 0 row-heights) (* row-gap (max 0 (dec num-rows))))
|
||||
total-width (+ (reduce + 0 col-widths) (* col-gap (max 0 (dec num-cols))))
|
||||
canvas (create-canvas total-width total-height)
|
||||
;; Render each area
|
||||
final-canvas
|
||||
(reduce-kv
|
||||
(fn [c [row col] {:keys [attrs content]}]
|
||||
(let [row-span (or (:row-span attrs) 1)
|
||||
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))))
|
||||
cell-width (+ (reduce + 0 (take col-span (drop col col-widths)))
|
||||
(* 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
|
||||
cell-ctx (assoc ctx
|
||||
:available-width cell-width
|
||||
:available-height cell-height)
|
||||
rendered (render-element content cell-ctx)]
|
||||
(overlay-on-canvas c rendered cell-x cell-y cell-width cell-height)))
|
||||
canvas
|
||||
areas)]
|
||||
;; Convert canvas to string
|
||||
(str/join "\n" (map #(apply str %) final-canvas))))
|
||||
|
||||
;; === Main Render Function ===
|
||||
(defn render-element
|
||||
"Render a hiccup element to ANSI string."
|
||||
@@ -322,13 +646,16 @@
|
||||
(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)
|
||||
:input (render-input attrs children ctx)
|
||||
:modal (render-modal attrs children ctx)
|
||||
: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)
|
||||
:input (render-input attrs children ctx)
|
||||
:modal (render-modal attrs children ctx)
|
||||
:scroll (render-scroll attrs children ctx)
|
||||
:grid (render-grid attrs children ctx)
|
||||
:area (apply str (render-children children ctx)) ;; Areas are handled by grid
|
||||
;; Default: just render children
|
||||
(apply str (render-children children ctx))))
|
||||
|
||||
@@ -369,3 +696,24 @@
|
||||
(if (map? (first args))
|
||||
(into [:box (first args)] (rest args))
|
||||
(into [:box {}] args)))
|
||||
|
||||
(defn scroll
|
||||
"Create a scrollable container."
|
||||
[& args]
|
||||
(if (map? (first args))
|
||||
(into [:scroll (first args)] (rest args))
|
||||
(into [:scroll {}] args)))
|
||||
|
||||
(defn grid
|
||||
"Create a 2D grid layout."
|
||||
[& args]
|
||||
(if (map? (first args))
|
||||
(into [:grid (first args)] (rest args))
|
||||
(into [:grid {}] args)))
|
||||
|
||||
(defn area
|
||||
"Create a grid area (used inside :grid)."
|
||||
[& args]
|
||||
(if (map? (first args))
|
||||
(into [:area (first args)] (rest args))
|
||||
(into [:area {}] args)))
|
||||
|
||||
Reference in New Issue
Block a user