fix: mouse message API and improve public API surface

.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
 

doc/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}))

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:

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:

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)))

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)

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
 ;; ---------------------------------------------------------------------------

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))))))