(ns weathergen.ui.common (:require [cljsjs.tinycolor] [clojure.pprint :as pp] [clojure.string :as str] [garden.core :refer [css]] [garden.selectors :as css-sel] [garden.stylesheet :as css-style] [goog.string :as gstring] [goog.string.format] [hoplon.storage-atom :refer [local-storage]] [hoplon.svg :as svg] [taoensso.timbre :as log :refer-macros ^{:line 14, :column 28} (log trace debug info warn error fatal report logf tracef debugf infof warnf errorf fatalf reportf spy get-env log-env)] [weathergen.falcon.files.images :as im] [weathergen.falcon.files.mission :as mission] [weathergen.filesystem :as fs] [weathergen.math :as math] [weathergen.settings :refer [app-dir]] [javelin.core :refer [->Cell input? cell cell? destroy-cell! lift lens? set-formula! constant? cell-doseq* deref* set-cell! lens formula? alts! dosync* cell-map formula]] [hoplon.jquery :refer [set-attributes! check-val! set-styles! text-val!]] [hoplon.core :refer [form audio input menuitem hgroup do! timeout $text base h1 set-attributes! embed shadow h3 body keygen progress main cite on-page-load i p nav ruby a menu blockquote img $comment span track data u dl select html thead del fieldset aside figure figcaption q on! bdi append-child! video address caption dd rp hr tbody table html-var add-initfn! pre ul replace-child! html-time html-map sup dfn sub mark script button wbr insert-before! strong normalize-class li dt rtc td tr section th optgroup bust-cache iframe remove-child! legend em kbd spliced html-object article abbr template multicol prerendering? <!-- source output set-styles! route-cell header datalist tfoot s ins footer title h5 canvas param div option summary samp small style textarea loop-tpl* h4 head ol details col label picture rt when-dom h6 link page-load colgroup meter html-meta static-elements bdo --> b attribute? code dialog noframes do-watch noscript safe-nth h2 area br]]) (:require-macros [weathergen.cljs.macros :refer [with-attr-bindings with-bbox with-time formula-of hint-> hint]] [javelin.core :refer [with-let mx2 dosync cell= set-cell!= prop-cell cell-doseq formulet defc defc= macroexpand-all mx formula-of cell-let]] [hoplon.core :refer [definterval text elem+ cache-key with-timeout defelem+ when-tpl static sexp defelem elem def-values if-tpl cond-tpl with-page-load for-tpl with-dom case-tpl loop-tpl with-interval with-init!]]))























;; (set! *warn-on-infer* true)

;; This is a massive hack, and I have no idea what we're going to do if some other library decides to
;; say `module.exports` in its code.
(def ^js/tinycolor tinycolor (.-exports js/module)
  #_(if (= "nodejs" cljs.core/*target*)
    (.-exports js/module)
    js/tinycolor))

(defn px
  "Returns a pixel measurement string, e.g. '2px'. Allows multiple
  arguments, in which case it will return a margin-style string,
  e.g. `(px 1 2)` returns '1px 2px'."
  [& ns]
  (->> ns
       (map #(str % "px"))
       (str/join " ")))

(defn pct
  "Returns a percentage measurement string, e.g. '50%'"
  [n]
  (str n "%"))

(def colors
  {:invalid       "#c70505"
   :invalid-background "#fcc"
   :error-message "#c70505"
   :edit "rgba(128,128,255,0.5)"
   :header-background "lightgray"
   :team {:dark-text {:white "gray"
                      :green "green"
                      :blue "blue"
                      :brown "#923c25"
                      :orange "darkorange"
                      :yellow "#caae18"
                      :red "red"
                      :gray "darkgray"}
          :light-text {:white "white"
                       :green "lightgreen"
                       :blue "#8ddbf5"
                       :brown "#e27e43"
                       :orange "orange"
                       :yellow "yellow"
                       :red "#f9adad"
                       :gray "lightgray"}}})

(defn team-color
  "Returns a color for a team."
  [team type]
  (get-in colors [:team type (mission/team-color team)]))

(def class-for
  "Given a keyword, returns a string safe to use as a css class name."
  (memoize
   (fn [kw]
     (-> kw str (subs 1) (str/replace #"[^a-zA-Z0-9]" "-")))))

(defn class-selector-for
  "Given a keyword, returns a garden class selector usable with class-for."
  [kw]
  (->> kw class-for (str ".") css-sel/selector))

(def registered-styles (atom #{}))

(defn register-styles!
  "Adds styles to the head of the document. If already registered under `key`, does nothing."
  [key garden]
  (when-not (contains? @registered-styles key)
    (let [^js/Element head (aget (.getElementsByTagName js/document "head") 0)
          styles (cell= (css garden))]
      (swap! registered-styles conj key)
      (when-dom head
        #(.appendChild head (style :type "text/css" :debug (str key) styles))))))

(defn register-class!
  "Adds a style to the head of a document for abstract class `key`.
  `key` should be a namespaced keyword that can then be used as the
  `:class` of an element via `class-for`. `garden` is the tail of a
  garden style statement, i.e. everything except the seelctor.

  Example:

  (register-class!
    ::foobar
    [{:background \"blue\"} [:&:hover {:background \"red\"}]])"
  [key garden]
  (register-styles! key (into [(class-selector-for key)] garden)))

(defn contrasting
  "Returns a color that contrasts well with the specified color.
  Optionally, the colors to use for dark and light can be specified."
  ([color] (contrasting color "black" "white"))
  ([color dark light]
   ;; http://stackoverflow.com/questions/3942878/how-to-decide-font-color-in-white-or-black-depending-on-background-color
   (-> tinycolor (.mostReadable color #js [dark light]) (hint-> js/tinycolor) .toHexString)
   #_(let [rgb (-> color tinycolor .toRgb)
         ;; Advanced compilation is somehow screwing up direct field
         ;; access, so we have to go in by name.
         r (aget rgb "r")
         g (aget rgb "g")
         b (aget rgb "b")]
     (if (< 128 (+ (* r 0.299) (* g 0.587) (* b 0.114)))
       dark
       light))))

(defn darken
  "Darkens a color by an amount from 0-100."
  [color amount]
  ;; Don't like writing this way, but not sure how else to get the
  ;; compiler to correctly avoid symbol renaming in advanced
  ;; compilation.
  (-> color tinycolor (hint-> js/tinycolor) (.darken amount) (hint-> js/tinycolor) .toHexString))

(defn lighten
  "Lightens a color by an amount from 0-100."
  [color amount]
  (-> color tinycolor (hint-> js/tinycolor) (.lighten amount) (hint-> js/tinycolor) .toHexString))

(defn spin
  "Rotates a color by an amount from 0 to 360 degrees."
  [color amount]
  (-> color tinycolor (hint-> js/tinycolor) (.spin amount) (hint-> js/tinycolor) .toHexString))

(defn to-hex-str
  "Converts a color to a hex string."
  [color]
  (-> color tinycolor (hint-> js/tinycolor) .toHexString))

(defelem styled
  "Creates an element which is a scope for a set of CSS rules,
  provided via a `:garden` attribute, by adding an element with a
  unique ID and new <style> element to the <head> of the document."
  [attrs content]
  (let [{:keys [garden]} attrs
        attrs (dissoc attrs :garden)
        ^js/Element head (aget (.getElementsByTagName js/document "head") 0)
        id (str (gensym))
        styles (cell= (css [(keyword (str "#" id))
                            garden]))]
    (.appendChild head (style :type "text/css" styles))
    (div
     (merge attrs {:id id})
     content)))

(defelem inl
  [attrs content]
  (let [{:keys [css]} attrs]
    (div
     (update attrs
             :css
             (fn [css-orig]
               (if (cell? css-orig)
                 (formula-of [css-orig]
                   (assoc css-orig :display "inline-block"))
                 (assoc css-orig :display "inline-block"))))
     content)))

(defelem triangle
  [attrs _]
  (let [{:keys [r]} attrs
        r*          (cell= r)
        attrs       (dissoc attrs :r)
        alpha       0.8660254037844387 ; sin 60deg
        beta        0.5                ; sin 30deg
        x           (cell= (* r* alpha))
        y           (cell= (* r* alpha))]
    (svg/path
     :d (formula-of [x y]
          (gstring/format "M%f,%f L%f,%f L%f,%f Z"
                          0 (- y)
                          x y
                          (- x) y))
     attrs)))

(defn pre-cell
  "Pretty-prints the value of cell c and displays it in a pre tag."
  [title c]
  (register-styles!
   ::pre-cell
   [[:.pre-cell {:background "black"
                 :color "green"
                 :font-family "monospace"}]])
  (div
   :class "pre-cell"
   (h4 title)
   (pre
    :css {:white-space "pre-wrap"}
    (cell= (pp/write c :stream nil :pretty true)))))

(defelem control-section
  [attributes children]
  (let [visible (cell (not (:collapsed? attributes)))
        change-visibility #(swap! visible not)]
    (fieldset
     :class "controls"
     (dissoc attributes :title :collapsed? :help-for)
     (legend
      (div
       :click change-visibility
       :class (formula-of [visible]
                          {:toggle true
                           :visible visible})
       "")
      (span
       (:title attributes)))
     (div
      :class "control-visibility-container"
      :toggle visible
      :fade-toggle visible
      (div :class "control-container" children)))))


(defn format-time
  "Formats a campaign time into a string. `opts` is a map of options:

  `:seconds?` - If true, format time including seconds.
  `:omit-day?` - If true, don't include the day in the result"
  ([{:keys [day hour minute second] :as time}] (format-time time {}))
  ([{:keys [day hour minute second] :as time} {:keys [seconds? omit-day?] :as opts}]
   (when time
     (str (if omit-day? "" (gstring/format "%02d/" day))
          (if seconds?
            (gstring/format "%02d:%02d:%02d"
                            hour
                            minute
                            second)
            (gstring/format "%02d:%02d"
                            hour
                            minute))))))

(defn format-heading
  "Formats a heading"
  [^js/Number heading]
  (some-> heading (.toFixed 0)))

(defn format-distance
  "Formats a distance"
  [^js/Number distance]
  (some-> distance (.toFixed 1)))

(defn format-speed
  "Formats a speed."
  [^js/Number speed]
  (some-> speed (math/nearest 5) (.toFixed 0)))

(defn format-mach
  "Formats a Mach number."
  [^js/Number mach]
  (some-> mach (.toFixed 2)))

(defelem color-picker
  [attrs _]
  ;; Because sometimes we want to set the value and not have the
  ;; corresponding change event fire, we override it, and only pass it
  ;; along when the change occurs while the picker is open. If we need
  ;; to, we can add an option or another event for changes that happen
  ;; due to the value cell being updated.
  (let [{:keys [change hide show]} attrs
        attrs* (dissoc attrs :change :hide :show)
        open? (atom false)]
    (with-let [i (input attrs*
                        :class "minicolors"
                        :type "hidden"
                        :change (fn [e]
                                  (when (and change @open?)
                                    (change e))))]
      (add-watch (:value attrs)
                 (-> (gensym) str keyword)
                 (fn [_ _ _ n]
                   (when n
                     (-> i
                         js/jQuery
                         (hint-> js/HTMLInputElement)
                         (.minicolors "value" (to-hex-str n))))))
      (when-dom i
        #(-> i
             js/jQuery
             (hint-> js/HTMLInputElement)
             (.minicolors #js {"theme" "weathergen"
                               "show" (fn []
                                        (reset! open? true)
                                        (when show (show)))
                               "hide" (fn []
                                        (reset! open? false)
                                        (when hide (hide)))}))))))

(defelem side-label
  "Returns UI for the display name of a side."
  [attrs _]
  (let [{:keys [mission side]} attrs
        allies                 (formula-of [mission side]
                                 (let [side-teams (->> mission
                                                       mission/teams
                                                       (filter #(-> % :team :c-team (= side)))
                                                       (map #(-> % :team :who))
                                                       set)]
                                   (disj side-teams side)))]
    (div
     (dissoc attrs :mission :side)
     (for-tpl [elem (formula-of [mission side allies]
                      (interpose {:color "" :name "/"}
                                 (for [team (into [side] allies)]
                                   {:color (team-color team :dark-text)
                                    :name  (mission/team-name mission team)} )))]
       (cell-let [{:keys [color name]} elem]
         (span
          :css (cell= {:color color})
          (cell= name)))))))


(defn image-cache-path
  "Returns a path to where we should cache an image."
  [image-descriptor]
  (fs/path-combine app-dir "cache" "images" (str (im/cache-key image-descriptor) ".png")))

(defn save-blob-async
  "Asynchronously saves `blob` to `path`."
  [blob path]
  ;; While it would seem like there must be a better way to do this, I
  ;; haven't found it
  (let [reader (js/FileReader.)]
    (-> reader
        .-onload
        (set! (fn []
                (->> reader
                     .-result
                     js/Buffer.
                     (fs/save-data path))
                ;; Might need this - no idea what it does.
                ;;   deferred.resolve();
                )))
    (.readAsArrayBuffer reader blob)))

(defn get-image
  "Return a URL for the image identified by `image-descriptor`."
  [mission image-descriptor]
  (let [path (image-cache-path image-descriptor)]
    (if (fs/exists? path)
      path
      (let [^js/HTMLCanvasElement canvas (.createElement js/document "canvas")]
        (with-time
          (str "Loading image " (:image-id image-descriptor))
          (im/read-image
           mission
           image-descriptor
           (fn [width height]
             (-> canvas .-width (set! width))
             (-> canvas .-height (set! height))
             (let [^js/CanvasRenderingContext2D context (.getContext canvas "2d")
                   ^js/ImageData image-data (.getImageData context 0 0 width height)
                   buf (-> image-data .-data .-length js/ArrayBuffer.)
                   buf8 (js/Uint8ClampedArray. buf)
                   data (js/Uint32Array. buf)]
               {:set-pixel! (fn [^long x ^long y ^long argb]
                              (aset data (+ x (* y width)) argb))
                :finalize (fn []
                            (-> image-data .-data (.set buf8))
                            (-> context (.putImageData image-data 0 0)))}))))
        ;; Async - cache for later use
        (.toBlob canvas
                 (fn [blob]
                   (save-blob-async blob path)))
        (.toDataURL canvas)))))

(defelem team-selector
  "Draws a grid of flags and checkboxes to pick teams."
  [attrs _]
  (with-attr-bindings attrs [mission selected-teams selectable-teams]
    (div
     :css {:margin-bottom "5px"}
     attrs
     (for-tpl [team (cell= (mission/teams mission))]
       (inl
        :css (formula-of [team]
               {:margin-right   "3px"
                :padding        "3px"
                :border         (str "2px solid " (team-color team :dark-text))
                :text-align     "center"
                :vertical-align "top"})
        (img :css {:border "solid 1px black"}
             :src (formula-of [mission team]
                    (get-image
                     mission
                     (mission/team-flag mission
                                        team
                                        :big-vert))))
        (div
         :css {:text-align "center"}
         (span :css (cell= {:color (team-color team :dark-text)})
               (->> team :team :who (mission/team-name mission) cell=)))
        (div
         :css {:text-align "center"
               :height     "33px"}
         (let [val      (cell= (contains? selected-teams (mission/team-number team)))
               enabled? (cell= (contains? selectable-teams (mission/team-number team)))]
           (input :css {:margin "auto"}
                  :type "checkbox"
                  :toggle enabled?
                  :value val
                  :change #(swap! selected-teams
                                  (comp set (if @val disj conj))
                                  (mission/team-number @team))))))))))

(defelem side-selector
  "Draws a grid of flags and checkboxes to pick sides."
  [attrs _]
  (with-attr-bindings attrs [mission selected-sides]
    (div
     :css {:margin-bottom "5px"}
     attrs
     (for-tpl [side (cell= (mission/sides mission))]
       (inl
        :css (formula-of [side]
               {:margin-right "3px"
                :padding      "3px"
                :border       (str "2px solid " (team-color side :dark-text))
                :text-align   "center"})
        (for-tpl [team (cell= (mission/teams-for-side mission side))]
          (img :css {:border        "solid 1px black"
                     :padding-right "2px"}
               :src (formula-of [mission team]
                      (get-image
                       mission
                       (mission/team-flag mission
                                          team
                                          :big-vert)))))
        (div
         :css {:text-align "center"}
         (side-label :mission mission :side side))
        (div
         :css {:text-align "center"}
         (let [val (cell= (contains? selected-sides (mission/team-number side)))]
          (input :css {:margin "auto"}
                 :type "checkbox"
                 :value val
                 :change #(swap! selected-sides
                                 (comp set (if @val disj conj))
                                 (mission/team-number @side))))))))))

(defelem dropdown
  "Renders an HTML select. Attrs include :value, a cell or lens
  containing the current choice, which will be updated when the choice
  changes, and :choices, a vector of maps containing :value and :label
  keys."
  [attrs _]
  ;; TODO: Let choices be a cell if we ever need that.
  ;; TODO: Maybe choices should be a map from values to labels, since
  ;; values have to be unique
  (with-attr-bindings attrs [value choices]
    (let [indexed  (map-indexed (fn [i c] [(str i) (assoc c ::index (str i))])
                                choices)
          by-index (into {} indexed)]
      (with-let [s (select)]
        (s
         (assoc attrs
                :value (formula-of [value]
                         (->> indexed
                              vals
                              (filter #(= value (:value %)))
                              first
                              ::index))
                :change (fn [v]
                          (reset! value (-> @v by-index :value))))
         (for [[index choice] indexed]
           (option
            :value index
            :selected (cell= (= value (:value choice)))
            (:label choice))
           #_(with-let [o (option)]
               (o
                {:value    index
                 :selected (formula-of [value]
                             (with-let [selected? (= value (:value choice))]
                               #_(when selected?
                                   (aset o "index" (aget s "selectedIndex")))))}
                (:label choice)))))))))

;; Note that if we ever go back to a default we've used before, we'll
;; pick up whatever the old saved value is. That's a little weird but
;; I'm not sure how else to deal with this.
(defn versioned-local-storage
  "Returns a cell backed by local storage under `key` (a namespaced
  key), where, if the `default` contents change, a new cell will be
  allocated. This allows changing defaults in the code to overwrite
  any stored copies."
  [key default]
  (local-storage
   (cell default)
   (str key "-" (hash default))))

(defn svg-scale
  "Returns an SVG scale string."
  ([s] (gstring/format "scale(%f)" s))
  ([x y] (gstring/format "scale(%f,%f)" x y)))

(defn svg-translate
  "Returns an SVG translate string."
  [x y]
  (gstring/format "translate(%f,%f)" x y))

(defn svg-rotate
  "Returns an SVG rotate string."
  [deg]
  (gstring/format "rotate(%f)" deg))

(defn svg-xform-combine
  "Combines xforms into a single SVG transformation string"
  [& xforms]
  (str/join " " xforms))

(let [interval-value 0.45
      interval       (str interval-value "s")]
  (register-styles!
   ::animations
   [
    ;; A pulsing effect for highlight animation
    [(css-style/at-keyframes (class-for ::pulse-animation)
                             [:from {:opacity 1}]
                             [:to   {:opacity 0}])]
    [(class-selector-for ::pulse) {:animation-duration        interval
                                   :animation-name            (class-for ::pulse-animation)
                                   :animation-iteration-count "infinite"
                                   :animation-timing-function "ease-in-out"
                                   :animation-direction       "alternate"
                                   :animation-delay           interval}]
    ;; A one-time collapsing scale
    [(css-style/at-keyframes (class-for ::collapse-animation)
                             [:from {:transform         (svg-scale 1)
                                     :stroke-dashoffset 0}]
                             [:to   {:transform         (svg-scale 0.02)
                                     :stroke-dashoffset 50}])]
    [(class-selector-for ::collapse) {:animation-duration        interval
                                      :animation-name            (class-for ::collapse-animation)
                                      :animation-iteration-count 1
                                      :animation-timing-function "ease-out"
                                      :animation-direction       "normal"}]
    ;; A delayed fade-out
    [(css-style/at-keyframes (class-for ::delayed-fade-out-animation)
                             [:from {:opacity 0.35}]
                             ["80%" {:opacity 0.35}]
                             [:to   {:opacity 0}])]
    [(class-selector-for ::delayed-fade-out) {:animation-duration        (str (/ interval-value 0.8) "s")
                                              :animation-name            (class-for ::delayed-fade-out-animation)
                                              :animation-iteration-count 1
                                              :animation-timing-function "ease-out"
                                              :animation-direction       "normal"}]]))

(def pulse-class (class-for ::pulse))
(def collapse-class (class-for ::collapse))
(def delayed-fade-out-class (class-for ::delayed-fade-out))

(defn heading
  "Renders a heading - white text on a black background"
  ([content] (heading {} content))
  ([{:keys [margin-top]} content]
   (div
    :css {:color         "white"
          :background    "black"
          :margin-top    (px (or margin-top 15))
          :margin-bottom (px 5)
          :padding       (px 2)}
    content)))

(defn path-lens
  "Returns a lens over a `get-in` style path `p` into cell `c`."
  [c p]
  (lens
   (formula-of
    [c]
    (get-in c p))
   (fn [v]
     (swap! c assoc-in p v))))

