Fulcro RAD color picker

client.cljs

(ns my.app.client
  (:require
   ;...stuff
   [my.app.controls.controls :refer [all-ui-controls]]
   [com.fulcrologic.fulcro.application :as app]
   [com.fulcrologic.fulcro.mutations :as m]
   [com.fulcrologic.fulcro.algorithms.timbre-support :refer [console-appender prefix-output-fn]]
   [com.fulcrologic.rad.application :as rad-app]
   [com.fulcrologic.rad.report :as report]
   [com.fulcrologic.rad.authorization :as auth]
   [com.fulcrologic.rad.type-support.date-time :as datetime]
   [com.fulcrologic.rad.routing.html5-history :as hist5 :refer [html5-history]]
   [com.fulcrologic.rad.routing.history :as history]
   [com.fulcrologic.rad.routing :as routing]
   [com.fulcrologic.fulcro.routing.dynamic-routing :as dr]
   [com.fulcrologic.fulcro.components :as comp]
   [com.fulcrologic.fulcro.networking.http-remote :as net]
   [com.fulcrologic.fulcro.algorithms.denormalize :as fdn]
   [goog.functions :refer [debounce]]
   [taoensso.timbre :as log]
   [taoensso.tufte :as tufte :refer [profile]]))

;;;;;
;;; Look at the fulcro-rad-demo for the rest of this file
;;; https://github.com/fulcrologic/fulcro-rad-demo/blob/develop/src/shared/com/example/client.cljs


(defn setup-RAD [app]
  (rad-app/install-ui-controls! app all-ui-controls) ;; This is the crucial bit!
  (report/install-formatter! app :boolean :affirmation (fn [_ value] (if value "yes" "no"))))

(defn ^:export refresh []
  ;; hot code reload of installed controls
  (log/info "Reinstalling controls")
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;  You need to register your controls here
  (setup-RAD app)
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (comp/refresh-dynamic-queries! app)
  (app/mount! app Root "app"))

(defn ^:export init
  "Shadow-cljs sets this up to be our entry-point function.
   See shadow-cljs.edn `:init-fn` in the modules of the main build."
  []
  (reset! SPA app)
  (log/merge-config! {:output-fn prefix-output-fn
                      :appenders {:console (console-appender)}})
  (log/info "Starting App")
  ;; default time zone (should be changed at login for given user)
  (datetime/set-timezone! "Europe/Berlin")
  ;; Avoid startup async timing issues by pre-initializing things before mount
  (app/set-root! app Root {:initialize-state? true})
  (dr/initialize! app)
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;  You need to register your controls here
  (setup-RAD app)
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (dr/change-route! app (prefix-route-segment "landing-page"))
  (history/install-route-history! app (html5-history))
  (auth/start! app [LoginForm] {:after-session-check `fix-route})
  (app/mount! app Root "app" {:initialize-state? false}))

color_picker.cljc

(ns my.app.controls.color-picker
  (:require
    #?(:cljs
       [com.fulcrologic.fulcro.dom :as dom :refer [div label input span]]
       :clj
       [com.fulcrologic.fulcro.dom-server :as dom :refer [div label input span]])
    [com.fulcrologic.rad.attributes :as attr]
    [com.fulcrologic.fulcro.components :as comp]
    [com.fulcrologic.rad.form :as form]
    [com.fulcrologic.rad.options-util :refer [?!]]))

(def standard-color-map {:green  "#21ba45"
                         :teal   "#3082a7"
                         :orange "#f2711c"})

(defn render-field
  "Two arity version is for RAD.
  You can override the onClick behavior with the 3-arity version."
  ([{::form/keys [form-instance] :as env} attribute]
   (render-field env attribute {:onClick (fn [env k value]
                                           (form/input-changed! env k value))}))
  ([{::form/keys [form-instance] :as env} attribute {:keys [onClick]}]
   (let [k              (::attr/qualified-key attribute)
         props          (comp/props form-instance)
         user-color-map (?! (form/field-style-config env attribute :color-map) env)
         field-label    (form/field-label env attribute)
         read-only?     (form/read-only? form-instance attribute)
         current-value  (get props k false)
         color-map      (or user-color-map standard-color-map)
         color-map      (mapv (fn [[k v]] {:name k :value v}) color-map)]
     (div :.field.color-picker--container
       (label field-label)
       (div :.color-picker--values
         (map (fn [{:keys [name value]} x]
                (let [field-name (str field-label "--color-picker--" name)]
                  (div :.color-picker--inner {:key (str k field-name)}
                    (input
                      {:type     "radio"
                       :name     field-name
                       :disabled (boolean read-only?)
                       :value    value
                       :checked  (= value current-value)})
                    (label {:htmlFor   field-name
                            :title     name
                            :role      "button"
                            :className "color-picker--label"
                            :onClick   (fn []
                                         (when (and onClick (not read-only?))
                                           (onClick env k value)))}
                      (span {:className (:name x)
                             :style     {:background value
                                         :cursor (if read-only?
                                                   "auto"
                                                   "pointer")}}))))) color-map))))))

colors.cljc

(ns my.app.lib.colors
  "A rather colorful namespace, full of wonder :)")

(def red "#db2828")
(def red-rgb [219 40 40])

(def orange "#f2711c")
(def orange-rgb [242 113 28])

(def yellow "#fbbd08")
(def yellow-rgb [251 189 8])

(def olive "#b5cc18")
(def olive-rgb [181 204 24])

(def green "#21ba45")
(def green-rgb [33 186 69])

(def teal "#00b5ad")
(def teal-rgb [0 181 178])

(def blue "#2185d0")
(def blue-rgb [33 133 208])

(def violet "#6435c9")
(def violet-rgb [100 53 201])

(def purple "#a333c8")
(def purple-rgb [163 51 200])

(def pink "#e03997")
(def pink-rgb [224 57 151])

(def brown "#a5673f")
(def brown-rgb [165 103 63])

(def grey "#767676")
(def grey-rgb [118 118 118])

(def lightgrey "#e6e6e6")
(def lightgrey-rgb [230 230 230])

(def black "#1b1c1d")
(def black-rgb [27 28 29])

(def  all-colors
  "A map from keyword to hex color value"
  {:red       red
   :orange    orange
   :yellow    yellow
   :olive     olive
   :green     green
   :teal      teal
   :blue      blue
   :violet    violet
   :purple    purple
   :pink      pink
   :brown     brown
   :grey      grey
   :lightgrey lightgrey
   :black     black})

(defn rand-color
  "Returns a vector of random RGB values."
  []
  (vector
    (rand-int 256)
    (rand-int 256)
    (rand-int 256)))

controls.cljs

(ns gmbh.kreativraum.picard-web.controls.controls
  (:require
    [my.app.controls.color-picker :as color-picker]
    [com.fulcrologic.rad.rendering.semantic-ui.entity-picker :as entity-picker]
    [com.fulcrologic.rad.rendering.semantic-ui.text-field :as text-field]
    [com.fulcrologic.rad.rendering.semantic-ui.semantic-ui-controls :as sui]))

(defn deep-merge
  "Recursively merges maps."
  [& maps]
  (letfn [(m [& xs]
            (if (some #(and (map? %) (not (record? %))) xs)
              (apply merge-with m xs)
              (last xs)))]
    (reduce m maps)))


(defonce all-custom-controls
  {:com.fulcrologic.rad.form/type->style->control
   {:string  {:color-picker color-picker/render-field}}})

(defonce all-ui-controls (deep-merge sui/all-controls all-custom-controls))

some_thing.cljc

(ns my.app.model.some-thing
  (:require
  
   [com.fulcrologic.rad.attributes :refer [defattr make-attribute-validator]]
   [com.fulcrologic.rad.attributes-options :as ao]
   [com.fulcrologic.rad.form-options :as fo]
   [com.fulcrologic.fulcro.components :refer [defsc]]
   [com.fulcrologic.rad.report-options :as ro]
   [com.fulcrologic.rad.picker-options :as po]
   [com.fulcrologic.fulcro.algorithms.form-state :as fs]
   [my.app.lib.colors :as colors]))

;; Declare it like this
(defattr node-color
  "The user can pick a color to represent a node.
   The color will be saved as a hex-value."
  :sil.graph.node/color-hex :string
  {ao/identities         #{...}
   ao/schema             :production
   fo/field-style-config {:color-map colors/all-colors}
   fo/field-style        :color-picker
   fo/field-label        "My Fancy Color"})