membrane_humble_ui.clj

(ns membrane-humble-ui
  (:require
   [fipp.edn :as fipp.edn]
   [io.github.humbleui.ui :as hui]
   [io.github.humbleui.window :as window]
   [io.github.humbleui.canvas :as canvas]
   [io.github.humbleui.typeface :as typeface]
   [membrane.ui :as mui :refer [IBounds -bounds]]
   [membrane.basic-components]
   [clojure.string :as string]
   [io.github.humbleui.protocols :as hui.proto]
   [io.github.humbleui.core :as hui.core]
   [io.github.humbleui.ui.dynamic :as dynamic])
  (:import
   [io.github.humbleui.types IPoint IRect RRect Rect]
   [io.github.humbleui.skija Canvas Color4f Font Path Typeface]
   [io.github.humbleui.skija Paint PaintMode]))

(defonce *window (atom nil))

(def ^:dynamic *canvas* nil)
(def ^:dynamic *context* {})
(def ^:dynamic *paint* {})
(def ^:dynamic *color* nil)
(def ^:dynamic *stroke-width* nil)
(def ^:dynamic *translate* nil)
(def ^:dynamic *font* nil)

(defprotocol IDraw
  :extend-via-metadata true
  (draw [this]))

(mui/add-default-draw-impls! IDraw #'draw)

(defn paint []
  (let [^Paint paint (Paint.)]
    (when-let [stroke-width (::stroke-width *paint*)]
      (.setStrokeWidth paint (float stroke-width)))
    (when-let [style (::style *paint*)]
      (.setMode paint (case style
                        :membrane.ui/style-fill            PaintMode/FILL
                        :membrane.ui/style-stroke          PaintMode/STROKE
                        :membrane.ui/style-stroke-and-fill PaintMode/STROKE_AND_FILL
                        ;; else
                        (assert false "Unknown Fill Style"))))
    (when-let [color (::color *paint*)]
      (.setColor paint color))
    paint))

(defn make-font
  ([ui-font] (make-font (:name ui-font) (:size ui-font)))
  ([font-name font-size]
   ;; TODO fix typeface
   (prn "MAKE FONT" font-name font-size)
   (let [todo-font-size (or font-size 12)]
     (Font. @typeface/*default (float todo-font-size)))))

(defn- text-bounds
  [text ^Font skija-font]
  (let [lines        (string/split text #"\n" -1)
        line-spacing (if skija-font
                       (.getSpacing skija-font)
                       10)

        widths       (map (fn [line]
                            (.measureTextWidth skija-font line))
                          lines)
        maxx         (reduce max 0 widths)
        maxy         (* line-spacing
                        (count lines))]
    [maxx maxy]))

(extend-type membrane.ui.Label
  IBounds
  (-bounds [this]
    (text-bounds (:text this) *font*))

  IDraw
  (draw [this]
    (let [lines            (string/split (:text this) #"\n" -1)
          ^Font skija-font *font*
          line-spacing     (.getSpacing skija-font)]
      (canvas/with-canvas *canvas*
        (doseq [line lines]
          (canvas/translate *canvas* 0 line-spacing)
          (canvas/draw-string *canvas* line 0 0 *font* (paint)))))))

#_(defn text-selection-draw [ui-font text [selection-start selection-end] selection-color]
  (let [skija-font       (make-font ui-font)
        line-spacing     (.getSpacing ^Font skija-font)
        selection-height line-spacing
        text             (str text "8")
        glyphs           (.getStringGlyphs ^Font skija-font text)
        glyph-widths     (.getWidths ^Font skija-font glyphs)
        glyph-count      (alength glyphs)]
    (loop [x                0
           y                0
           idx              0
           selection-start  selection-start
           selection-length (- selection-end selection-start)]
      (when (and (pos? selection-length)
                 (< idx glyph-count))
        (let [c           (nth text idx)
              glyph-width (aget glyph-widths idx)
              new-x       (if (= c \newline)
                            0
                            (+ x glyph-width))
              new-y       (if (= c \newline)
                            (+ y line-spacing)
                            y)]
          (if (<= selection-start 0)
            (do
              (prn "DRAW here")
              (let [selection-width (if (= c \newline) 5 (- new-x x))]
                (draw (mui/translate x (+ y (- line-spacing
                                               selection-height))
                                     (mui/filled-rectangle selection-color
                                                           selection-width selection-height))))
              (recur new-x new-y 0 (dec selection-length) (inc idx)))
            (recur new-x new-y (dec selection-start) selection-length (inc idx))))))))

#_(extend-type membrane.ui.TextSelection
  IBounds
  (-bounds [this]
    (let [^Font font (if-let [el-font (:font this)]
                       (make-font el-font)
                       *font*)]
      (text-bounds (:text this) font)))

  IDraw
  (draw [this]
    (prn "DRAW text selection")
    #_(text-selection-draw
       (:font this)
       (:text this)
       (:selection this)
       selection-color)))


#_(extend-type membrane.ui.TextCursor
  IBounds
  (-bounds [this]
    (let [^Font font (if-let [el-font (:font this)]
                       (make-font el-font)
                       *font*
                       )]
      (text-bounds (:text this) font)))

  IDraw
  (draw [this]
    (let [cursor          (min (count (:text this)) (:cursor this))
          selection-color [0.9 0.9 0.9]]
      (prn "TEXT CURSOR DRAW" this)
      (text-selection-draw (:font this) (:text this) [cursor (inc cursor)] selection-color))))

(defn- index-for-position-line [skija-font text px]
  (let [
        glyphs       (.getStringGlyphs ^Font skija-font text)
        glyph-widths (.getWidths ^Font skija-font glyphs)
        glyph-count  (alength glyphs)

        max-index (max 0 (dec (.length text)))
        chs       (char-array (inc max-index))
        ;; fill chs
        _         (.getChars text 0 max-index chs 0)]
    (loop [index 0
           px    px]
      (if (or (> index max-index)
              (not (< index glyph-count)))
        index
        (let [width  (aget glyph-widths index)
              new-px (- px width)]
          (if (neg? new-px)
            index
            (recur (inc index)
                   new-px)))))))

(defn- index-for-position [font text px py]
  (assert (some? text) "can't find index for nil text")
  (let [skija-font (make-font font)
        line-spacing (.getSpacing ^Font skija-font)

        line-no (loop [py py
                       line-no 0]
                  (if (> py line-spacing)
                    (recur (- py line-spacing)
                           (inc line-no))
                    line-no))
        lines (clojure.string/split-lines text)]
    (if (>= line-no (count lines))
      (count text)
      (let [line (nth lines line-no)]
        (apply +
               ;; newlines
               line-no
               (index-for-position-line skija-font line px)
               (map count (take line-no lines)))))))


;; AssertionError: Assert failed: index-for-position should be replaced by implementation
;; TODO from skija
(intern (the-ns 'membrane.ui) 'index-for-position index-for-position)

(extend-type membrane.ui.Rectangle
  IDraw
  (draw [this]
    (canvas/draw-rect *canvas*
                      (Rect/makeWH (:width this) (:height this))
                      (paint))))

(extend-type membrane.ui.RoundedRectangle
  IDraw
  (draw [this]
    (canvas/draw-rect *canvas*
                      (RRect/makeXYWH 0 0 (:width this) (:height this) (:border-radius this))
                      (paint))))

(extend-type membrane.ui.WithColor
  IDraw
  (draw [this]
    (let [[r g b a]    (:color this)
          ^Color4f c4f (if a
                         (Color4f. r g b a)
                         (Color4f. r g b))]
      (binding [*paint* (assoc *paint* ::color (.toColor c4f))]
        (doseq [x (:drawables this)]
          (draw x))))))


(extend-type membrane.ui.WithStyle
  IDraw
  (draw [this]
    (binding [*paint* (assoc *paint* ::style (:style this))]
      (doseq [drawable (:drawables this)]
        (draw drawable)))))


(extend-type membrane.ui.WithStrokeWidth
  IDraw
  (draw [this]
    (binding [*paint* (assoc *paint* ::stroke-width (:stroke-width this))]
      (doseq [drawable (:drawables this)]
        (draw drawable)))))


(extend-type membrane.ui.Path
  IDraw
  (draw [this]
    (when-let [points (seq (:points this))]
      (let [^Path path (Path.)]
        (let [[x y] (first points)]
          (.moveTo ^Path path ^float x ^float y)
          (doseq [[x y] (next points)]
            (.lineTo ^Path path x y)))
        (.drawPath ^Canvas *canvas* path (paint))))))

(extend-type membrane.ui.Translate
  IDraw
  (draw [this]
    (canvas/with-canvas *canvas*
      (canvas/translate *canvas* (:x this) (:y this))
      (draw (:drawable this)))))

(extend-type membrane.ui.Spacer
  IDraw
  (draw [this]
    ;; TODO?
    ))

(extend-type clojure.lang.PersistentVector
  IDraw
  (draw [this]
    (doseq [x this]
      (draw x))))

(extend-type membrane.ui.Image
  IDraw
  (draw [{:keys [image-path size _opacity]}]
    (let [[w h] size]
      (hui.core/draw (hui/image image-path)
                     *context*
                     (IRect/makeWH w h)
                     *canvas*))))

(extend-type membrane.ui.Button
  IDraw
  (draw [this]
    (let [[w h] (mui/bounds this)
          btn   (hui/button {:on-click (constantly nil)} (hui/label (:text this)))]
      (hui.core/draw btn *context* (IRect/makeXYWH 0 0 w h) *canvas*))))

(extend-type membrane.basic_components.Textarea
  IDraw
  (draw [this]
    (let [[w h]      (mui/bounds this)
          text-input (hui/with-context
                       {:hui.text-field/padding-top (float 10)}
                       (hui/text-field
                        {:padding-top (float 10)
                         :cursor-width 1}
                        (atom {:text (:text this)
                               ;; :placeholder "type"
                               :from 1
                               :to   1})))]
      (hui.core/draw text-input *context* (IRect/makeWH w h) *canvas*))))

(def *view (atom nil))

(defn on-paint
  [view-fn {:keys [include-container-info]} ctx ^Canvas canvas ^IPoint size]
  (let [{:keys [font-ui fill-text leading scale]} ctx
        {:keys [width height]}                    size]
    (binding [*font* font-ui]
      (let [to-render (if include-container-info
                        (view-fn {:container-size [width height]})
                        (view-fn))]
        (reset! *view to-render)
        (canvas/with-canvas canvas
          (binding [*canvas*  canvas
                    *context* ctx]
            (draw to-render)))))))

(defmulti on-event (fn [window event-map] (:event event-map)))

(defmethod on-event :mouse-button
  [_window event]
  ;; button (= 1 action) mods
  (if (and (:x event) (:y event))
    (mui/mouse-event @*view
                     [(double (:x event))
                      (double (:y event))]
                     (:button event)
                     (:pressed? event)
                     (:modifiers event))
    ;; else
    (prn "BAD EVENT" event)
    ))

(defmethod on-event :key
  [_window event]
  ;; button (= 1 action) mods

  (when (and (:pressed? event)
             (not (contains? (:key-types event) :letter)))
    (prn "ON EVENT KEY" event)
    (mui/key-press @*view (:key event))))

(defmethod on-event :text-input
  [_window event]
  (mui/key-press @*view (:text event)))

(def ^:private basic-event?
  #{:mouse-move :frame :frame-skija})

(def ^:private window-focus-event?
  #{:window-focus-in :window-focus-out})

(defmethod on-event :default [_ _e]
  (when (window-focus-event? (:event _e))
    (window/request-frame @*window))
  (when-not (or (window-focus-event? (:event _e))
                (basic-event? (:event _e)))
    (prn _e)))

(defn- ->humble-ui-app
  [view-fn options]
  (hui/default-theme
   {}
   (try
     (hui/center
      (hui/canvas {:on-paint (partial on-paint view-fn options)
                   :on-event on-event}))
     (catch Exception e
       (hui/center
        (hui/label "Error" (ex-message e)))))))

(defn run
  ([view-fn] (run view-fn {}))
  ([view-fn {:keys [window-title] :as options}]
   (hui/start-app!
    ;; TODO figure out appropriate width/height
    (let [{:keys [scale work-area]} {:scale 1 :work-area {:width 1000}}
          width                     (quot (:width work-area) 3)]
      (reset! *window
              (hui/window
               {:title  (or window-title "Membrane")
                :width  (/ width scale)
                :height 400
                :x      :left
                :y      :center}
               (->humble-ui-app view-fn (select-keys options [:include-container-info]))))))))