From b168596ace6b77132b3a1a0e9d19b2276a8a07b6 Mon Sep 17 00:00:00 2001 From: Timo Kramer Date: Wed, 8 Apr 2026 14:57:30 +0200 Subject: [PATCH 1/2] fix: mouse message API and improve public API surface - Fix mouse message conversion in program.clj: args were passed in wrong order and integer button codes were not converted to keywords - Add mouse predicates to charm.message (click?, left-click?, wheel-up?, etc.) so users don't need charm.input.mouse - Re-export width utilities (string-width, truncate, pad-right, pad-left, strip-ansi) from charm.style.core - Mark charm.input.mouse and charm.ansi.width as ^:no-doc (re-exported) - Add sketch example demonstrating mouse interaction --- docs/examples/src/examples/sketch.clj | 128 ++++++++++++++++++++++++++ src/charm/ansi/width.clj | 2 +- src/charm/input/mouse.clj | 2 +- src/charm/message.clj | 49 ++++++++++ src/charm/program.clj | 20 +++- src/charm/style/core.clj | 7 ++ test/charm/message_test.clj | 40 +++++++- 7 files changed, 240 insertions(+), 8 deletions(-) create mode 100644 docs/examples/src/examples/sketch.clj diff --git a/docs/examples/src/examples/sketch.clj b/docs/examples/src/examples/sketch.clj new file mode 100644 index 0000000..58b1040 --- /dev/null +++ b/docs/examples/src/examples/sketch.clj @@ -0,0 +1,128 @@ +(ns examples.sketch + "A mouse-driven drawing pad. + Click/drag to draw, right-click to erase, scroll to change brush. + Demonstrates mouse interaction in charm.clj." + (:require + [charm.message :as msg] + [charm.program :as program] + [charm.style.core :as style] + [clojure.string :as str])) + +;; --------------------------------------------------------------------------- +;; Brushes +;; --------------------------------------------------------------------------- + +(def brushes ["█" "░" "▒" "▓" "●" "◆" "★" "♦" "╳" "○"]) + +;; --------------------------------------------------------------------------- +;; Styles +;; --------------------------------------------------------------------------- + +(def title-style + (style/style :fg style/magenta :bold true)) + +(def help-style + (style/style :fg style/white :faint true)) + +(def brush-style + (style/style :fg style/cyan :bold true)) + +;; --------------------------------------------------------------------------- +;; Init +;; --------------------------------------------------------------------------- + +(defn init [] + [{:canvas {} + :brush-idx 0 + :width 80 + :height 24 + :mouse-pos nil} + nil]) + +;; --------------------------------------------------------------------------- +;; Update +;; --------------------------------------------------------------------------- + +(defn- draw [canvas x y brush] + (assoc canvas [x y] brush)) + +(defn update-fn [state msg] + (cond + (or (msg/key-match? msg "q") + (msg/key-match? msg "ctrl+c")) + [state program/quit-cmd] + + (msg/key-match? msg "c") + [(assoc state :canvas {}) nil] + + (msg/window-size? msg) + [(assoc state + :width (:width msg) + :height (:height msg)) + nil] + + ;; Left click or drag: draw + (or (msg/left-click? msg) + (and (msg/motion? msg) (= :left (:button msg)))) + (let [brush (nth brushes (:brush-idx state))] + [(-> state + (update :canvas draw (:x msg) (:y msg) brush) + (assoc :mouse-pos [(:x msg) (:y msg)])) + nil]) + + ;; Right click or drag: erase + (or (msg/right-click? msg) + (and (msg/motion? msg) (= :right (:button msg)))) + [(-> state + (update :canvas dissoc [(:x msg) (:y msg)]) + (assoc :mouse-pos [(:x msg) (:y msg)])) + nil] + + ;; Track mouse position on any motion + (msg/motion? msg) + [(assoc state :mouse-pos [(:x msg) (:y msg)]) nil] + + ;; Scroll wheel: cycle brush + (msg/wheel-up? msg) + [(update state :brush-idx #(mod (dec %) (count brushes))) nil] + + (msg/wheel-down? msg) + [(update state :brush-idx #(mod (inc %) (count brushes))) nil] + + :else + [state nil])) + +;; --------------------------------------------------------------------------- +;; View +;; --------------------------------------------------------------------------- + +(defn view [state] + (let [{:keys [canvas brush-idx width height mouse-pos]} state + brush (nth brushes brush-idx) + ;; Reserve 2 lines for status bar + canvas-height (- height 2)] + (str + ;; Canvas area + (str/join + "\n" + (for [y (range 1 (inc canvas-height))] + (apply str + (for [x (range 1 (inc width))] + (get canvas [x y] " "))))) + "\n" + ;; Status bar + (style/render title-style "Sketch") + " " + (style/render brush-style (str "Brush: " brush)) + (when mouse-pos + (str " " (style/styled (str "(" (first mouse-pos) "," (second mouse-pos) ")") + :faint true))) + "\n" + (style/render help-style "click:draw right-click:erase scroll:brush c:clear q:quit")))) + +(defn -main [& _args] + (program/run {:init init + :update update-fn + :view view + :alt-screen true + :mouse :cell})) diff --git a/src/charm/ansi/width.clj b/src/charm/ansi/width.clj index 3260ecc..e558079 100644 --- a/src/charm/ansi/width.clj +++ b/src/charm/ansi/width.clj @@ -1,4 +1,4 @@ -(ns charm.ansi.width +(ns ^:no-doc charm.ansi.width "Text width calculation for terminal display. Handles: diff --git a/src/charm/input/mouse.clj b/src/charm/input/mouse.clj index 26cb573..b64f8d1 100644 --- a/src/charm/input/mouse.clj +++ b/src/charm/input/mouse.clj @@ -1,4 +1,4 @@ -(ns charm.input.mouse +(ns ^:no-doc charm.input.mouse "Mouse event parsing for terminal input. Supports: diff --git a/src/charm/message.clj b/src/charm/message.clj index 293216f..88bb093 100644 --- a/src/charm/message.clj +++ b/src/charm/message.clj @@ -165,3 +165,52 @@ "Check if shift modifier is set." [msg] (:shift msg false)) + +;; --------------------------------------------------------------------------- +;; Mouse Helpers +;; --------------------------------------------------------------------------- + +(defn click? + "Check if a mouse message is a click (press action)." + [msg] + (and (mouse? msg) (= :press (:action msg)))) + +(defn release? + "Check if a mouse message is a release." + [msg] + (and (mouse? msg) (= :release (:action msg)))) + +(defn motion? + "Check if a mouse message is motion (drag)." + [msg] + (and (mouse? msg) (= :motion (:action msg)))) + +(defn left-click? + "Check if a mouse message is a left click." + [msg] + (and (click? msg) (= :left (:button msg)))) + +(defn right-click? + "Check if a mouse message is a right click." + [msg] + (and (click? msg) (= :right (:button msg)))) + +(defn middle-click? + "Check if a mouse message is a middle click." + [msg] + (and (click? msg) (= :middle (:button msg)))) + +(defn wheel-up? + "Check if a mouse message is a wheel up event." + [msg] + (and (mouse? msg) (= :wheel-up (:action msg)))) + +(defn wheel-down? + "Check if a mouse message is a wheel down event." + [msg] + (and (mouse? msg) (= :wheel-down (:action msg)))) + +(defn wheel? + "Check if a mouse message is any wheel event." + [msg] + (or (wheel-up? msg) (wheel-down? msg))) diff --git a/src/charm/program.clj b/src/charm/program.clj index 30bc6b3..ef45909 100644 --- a/src/charm/program.clj +++ b/src/charm/program.clj @@ -112,11 +112,21 @@ ;; Convert input event to message (let [m (cond (= :mouse (:type event)) - (msg/mouse (:button event) (:x event) (:y event) - :action (:action event) - :ctrl (:ctrl event) - :alt (:alt event) - :shift (:shift event)) + (let [raw-button (:button event) + wheel (case (int raw-button) + 4 :wheel-up 5 :wheel-down + 6 :wheel-left 7 :wheel-right + nil)] + (msg/mouse (if wheel wheel (:action event)) + (if wheel + :none + (case (int raw-button) + 0 :left 1 :middle 2 :right + :none)) + (:x event) (:y event) + :ctrl (:ctrl event) + :alt (:alt event) + :shift (:shift event))) (= :focus (:type event)) (msg/focus) diff --git a/src/charm/style/core.clj b/src/charm/style/core.clj index 0b6c558..2f78db6 100644 --- a/src/charm/style/core.clj +++ b/src/charm/style/core.clj @@ -274,6 +274,13 @@ (def join-horizontal l/join-horizontal) (def join-vertical l/join-vertical) +;; Text width utilities +(def string-width w/string-width) +(def truncate w/truncate) +(def pad-right w/pad-right) +(def pad-left w/pad-left) +(def strip-ansi w/strip-ansi) + ;; --------------------------------------------------------------------------- ;; Frame Size Calculation ;; --------------------------------------------------------------------------- diff --git a/test/charm/message_test.clj b/test/charm/message_test.clj index 600bd15..67ce2c6 100644 --- a/test/charm/message_test.clj +++ b/test/charm/message_test.clj @@ -78,4 +78,42 @@ (testing "mouse?" (is (msg/mouse? (msg/mouse :press :left 0 0))) - (is (not (msg/mouse? (msg/quit)))))) + (is (not (msg/mouse? (msg/quit))))) + + (testing "click?" + (is (msg/click? (msg/mouse :press :left 10 20))) + (is (not (msg/click? (msg/mouse :release :none 10 20)))) + (is (not (msg/click? (msg/quit))))) + + (testing "release?" + (is (msg/release? (msg/mouse :release :none 10 20))) + (is (not (msg/release? (msg/mouse :press :left 10 20))))) + + (testing "motion?" + (is (msg/motion? (msg/mouse :motion :left 10 20))) + (is (not (msg/motion? (msg/mouse :press :left 10 20))))) + + (testing "left-click?" + (is (msg/left-click? (msg/mouse :press :left 10 20))) + (is (not (msg/left-click? (msg/mouse :press :right 10 20))))) + + (testing "right-click?" + (is (msg/right-click? (msg/mouse :press :right 10 20))) + (is (not (msg/right-click? (msg/mouse :press :left 10 20))))) + + (testing "middle-click?" + (is (msg/middle-click? (msg/mouse :press :middle 10 20))) + (is (not (msg/middle-click? (msg/mouse :press :left 10 20))))) + + (testing "wheel-up?" + (is (msg/wheel-up? (msg/mouse :wheel-up :none 10 20))) + (is (not (msg/wheel-up? (msg/mouse :wheel-down :none 10 20))))) + + (testing "wheel-down?" + (is (msg/wheel-down? (msg/mouse :wheel-down :none 10 20))) + (is (not (msg/wheel-down? (msg/mouse :press :left 10 20))))) + + (testing "wheel?" + (is (msg/wheel? (msg/mouse :wheel-up :none 10 20))) + (is (msg/wheel? (msg/mouse :wheel-down :none 10 20))) + (is (not (msg/wheel? (msg/mouse :press :left 10 20)))))) From ca9ca053fad0b31781745e24b72aff9bc8b612b6 Mon Sep 17 00:00:00 2001 From: Timo Kramer Date: Wed, 8 Apr 2026 18:37:05 +0200 Subject: [PATCH 2/2] ci: vhs needs proper doc path --- .github/workflows/ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 76c8ce1..16eeaf7 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -52,8 +52,8 @@ jobs: run: | sudo apt-get -qq update sudo apt-get -qq install -y ffmpeg ttyd - go install github.com/charmbracelet/vhs@v0.10.0 - cd docs/examples/ + go install github.com/charmbracelet/vhs@v0.11.0 + cd doc/examples/ ${HOME}/go/bin/vhs vhs/pomodoro.tape ${HOME}/go/bin/vhs vhs/download.tape