sähkökalusteet.clj

(ns experimentation.sähkökalusteet
  (:require [clojure.set :as set]
            [flow-gl.graphics.buffered-image :as buffered-image]
            [flow-gl.gui.animation :as animation]
            [flow-gl.gui.visuals :as visuals]
            [fungl.application :as application]
            [fungl.component.text-area :as text-area]
            [fungl.dependable-atom :as dependable-atom]
            [fungl.layouts :as layouts]))

(def icons (for [index (range 1 16)]
             {:id index
              :image (buffered-image/create-from-resource (str "icons/" index ".png"))}))

(def floor-images {:yläkerta {:image (buffered-image/create-from-resource "ylakerta.png")
                              :scale 1}
                   :alakerta {:image (buffered-image/create-from-resource "alakerta.png")
                              :scale 1}})

(defn text [string]
  (text-area/text  (str string)
                   [0 0 0 255]))

(defn set-height [image height]
  (let [scale (/ height
                 (:height image))]
    (-> image
        (update :width (partial * scale))
        (update :height (partial * scale)))))

(defn swap-state! [state-atom function & arguments]
  (apply swap! state-atom function arguments)
  #_(spit "sähkökalusteet.edn"
        @state-atom))

(defn selector [content active? on-click!]
  (layouts/box 4
               (visuals/rectangle-2 :fill-color (if active?
                                                  [100 100 100 255]
                                                  [255 255 255 255]))
               (assoc (layouts/box 0
                                   (visuals/rectangle-2 :fill-color [255 255 255 255])
                                   content)
                      :mouse-event-handler (fn [node event]
                                             (when (= :mouse-released (:type event))
                                               (on-click!))
                                             event))))

(defn icon-view [icon state-atom]
  (let [active? (= (:id icon)
                   (:active-icon @state-atom))]
    (layouts/horizontally-2 {}
                            (selector (set-height (visuals/image (:image icon))
                                                  50)
                                      active?
                                      (fn [] (swap-state! state-atom
                                                          assoc
                                                          :active-icon (:id icon))))
                            (text (reduce +
                                          (map (fn [floor]
                                                 (count (get-in floor [:markings (:id icon)])))
                                               (vals (:floors @state-atom))))))))

(defn marking-view [image-scale color on-click! marking]
  (let [size (* 30 image-scale)]
    (assoc (visuals/rectangle-2 :fill-color color)
           :width size
           :height size
           :x (- (* (:x marking)
                    image-scale)
                 (/ size 2))
           :y (- (* (:y marking)
                    image-scale)
                 (/ size 2))
           :mouse-event-handler (fn [node event]
                                  (when (and (= :mouse-released (:type event))
                                             (= :on-target (:handling-phase event)))

                                    (on-click!))
                                  event))))

(defn floor [state-atom id]
  (let [app-state @state-atom
        state (get-in @state-atom [:floors id])
        image (get floor-images id)]
    (assoc (layouts/superimpose (let [visual-image (visuals/image (:image image))]
                                  (set-height visual-image
                                              (* (:scale image)
                                                 (:height visual-image))))
                                (for [marking (get-in state [:markings (:active-icon app-state)])]
                                  (marking-view (:scale image)
                                                [255 0 0 120]
                                                (fn [] (swap-state! state-atom
                                                                    update-in
                                                                    [:floors id :markings (:active-icon app-state)]
                                                                    disj
                                                                    marking))
                                                marking))
                                (for [marking (set/difference (set (apply set/union (vals (:markings state))))
                                                              (set (get-in state [:markings (:active-icon app-state)])))]
                                  (marking-view (:scale image)
                                                [0 0 255 120]
                                                (fn [])
                                                marking)))
           :mouse-event-handler (fn [node event]
                                  (when (and (= :mouse-released (:type event))
                                             (= :on-target (:handling-phase event)))
                                    (swap-state! state-atom
                                                 update-in
                                                 [:floors id :markings (:active-icon app-state)]
                                                 (fnil conj #{})
                                                 {:x (/ (:local-x event)
                                                        (:scale image))

                                                  :y (/ (:local-y event)
                                                        (:scale image))}))
                                  event))))

(defn floor-selector-view [state-atom id]
  (selector (text id)
            (= id (:active-floor @state-atom))
            (fn [] (swap-state! state-atom
                                assoc :active-floor id))))

(def initial-state {:active-icon 1
                    :active-floor :yläkerta})

(defn base-view []
  (let [state-atom (dependable-atom/atom initial-state
                                         #_(read-string (slurp "sähkökalusteet.edn")))]
    (fn []
      (animation/swap-state! animation/set-wake-up 1000)
      @animation/state-atom
      (layouts/superimpose (visuals/rectangle-2 :fill-color [255 255 255 255])
                           (layouts/horizontally-2 {:margin 10}
                                                   (layouts/vertically-2 {:margin 5}
                                                                         (for [icon icons]
                                                                           (icon-view icon state-atom))
                                                                         (floor-selector-view state-atom :yläkerta)
                                                                         (floor-selector-view state-atom :alakerta))
                                                   (floor state-atom
                                                          (:active-floor @state-atom)))))))

(defn start []
  (application/start-window #'base-view))