(ns dmr.views (:require [re-frame.core :as re-frame] [clojure.string :as string] [goog.string :as gstr] [dmr.config :as config] [dmr.styles :as styles] [dmr.subs :as subs] [dmr.events :as events])) ; TODO: move this functionto a separate 'utils' module (defn ordinal [n] (let [final-digit (mod n 10) suffix (case final-digit 0 "th" 1 "st" 2 "nd" 3 "rd" "th")] (str n suffix))) (defn- join-lines [coll] (string/join \newline coll)) (defn- comma-separated [coll] (string/join ", " coll)) (defn- parenthesize [s] (when s (str "(" s ")"))) (defn- spaced [& elements] (string/join " " (filter identity elements))) (defn- with-default [default x] (if (nil? x) default x)) (defn- third [coll] (nth coll 2)) (defn- zip [& colls] (apply map vector colls)) (defn- enumerated [& colls] (apply zip (range) colls)) (defn prompt [] (let [cmdline (re-frame/subscribe [::subs/cmdline]) suggestions (re-frame/subscribe [::subs/cmdline-suggestions]) update-cmdline #(re-frame/dispatch-sync [::events/update-cmdline (-> % .-target .-value)]) key-pressed #(re-frame/dispatch-sync [::events/prompt-keypress %]) submit-cmd #(do (.preventDefault %) (re-frame/dispatch [::events/submit-cmd (-> % .-target)]))] [:form {:class (styles/prompt-style) :on-submit submit-cmd} [:input {:value @cmdline :on-change update-cmdline :on-keyDown key-pressed :type "text"}] [:ul.suggestions (let [{:keys [options selected]} @suggestions] (for [[idx x] (enumerated options)] ^{:key x} [:li {:class (when (= idx selected) :selected) :on-mouse-enter #(re-frame/dispatch [::events/hover-suggestion idx]) :on-click #(do (.preventDefault %) (re-frame/dispatch [::events/click-suggestion (-> % .-target .-parentElement .-parentElement) x]))} x]))]])) (defn title [] (let [name (re-frame/subscribe [::subs/name])] [:h1 "Welcome to " @name])) (defn- property-list [& props] (into [:ul {:class (styles/property-list)}] (for [[index [prop v]] (->> props (partition 2) (filter second) enumerated)] ^{:key index} [:li [:span prop] [:span v]]))) (defn- property-table [items & props] (let [pprops (partition 3 props) headings (map first pprops) attrs (map second pprops) getters (map third pprops)] [:table {:class (styles/property-table)} [:thead [:tr (for [[index attr heading] (enumerated attrs headings)] ^{:key index} [:th attr heading])]] [:tbody (for [[row-index item] (enumerated items)] ^{:key row-index} [:tr (for [[col-index attr f] (enumerated attrs getters)] ^{:key col-index} [:td attr (->> item f (with-default "-"))])])]])) (defn- license-notice [x] (let [l (x :license-notice)] (when l [:section.license-notice (spaced (x :name) "is" (l :content-kind) "subject to the" (l :license-name))]))) (defn- listing-license-notice [listing] [license-notice {:name "This listing" :license-notice (-> listing first :license-notice)}]) (defn- description [x] (some->> x :desc (map #(vector :p %)) (into [:section.description]))) (defn- heading [x] [:h1 (get x :name (str x))]) (defn- pounds [w] (if (= w 1) (spaced w "lb") (spaced w "lbs"))) (defn- cost [x] (when (x :cost) (spaced (-> x :cost :quantity) (-> x :cost :unit)))) (defn- speed [x] (when (x :speed) (spaced (-> x :speed :quantity) (-> x :speed :unit)))) (defn- weight [x & {:keys [no-quantity unit] :or {no-quantity false unit pounds}}] (let [unit (if (string? unit) #(spaced % unit) unit)] (when (x :weight) (spaced (-> x :weight unit) (when (not no-quantity) (some->> x :quantity (str "for ") parenthesize)))))) (defn- capacity [x] (some-> x :capacity)) (defn- short-spell-description [spell] (spaced (-> spell :level ordinal) "level" (-> spell :school :name string/lower-case) "spell")) (defn license-panel [license] [:article {:class (styles/license-panel)} [:h1 (license :license-name)] [:p (license :preamble)] [:ol.clauses (for [[index clause] (enumerated (license :clauses))] ^{:key index} [:li clause])] [:div.copyright-notice (for [[index text] (enumerated (license :copyright-notice))] ^{:key index} [:p text])]]) (defn spell-panel [spell] [:article {:class (styles/spell-panel)} [heading spell] [:div [:span.kind (short-spell-description spell)]] [property-list ; Refactor these so that we get the "name" from the keyword by replacing ; '-' and '_' and capitalizing :Damage (let [level (-> spell :level str keyword) damage (some-> spell :damage :damage_at_slot_level level) damage-type (some-> spell :damage :damage_type :name string/lower-case)] (when damage (str damage ", " damage-type))) "Casting Time" (-> spell :casting_time) :Range (some-> spell :range string/lower-case (string/replace " feet" "'")) :Components (spaced (comma-separated (spell :components)) (when (spell :material) (parenthesize (spell :material)))) :Duration (spaced (-> spell :duration string/lower-case) (when (spell :concentration) "(requires concentration)"))] [description spell] (let [at-higher-levels (some-> spell :higher_level join-lines)] (when at-higher-levels [:section.higher-level [:span "At higher levels"] [:span at-higher-levels]])) [license-notice spell]]) (defn equipment-panel [item] [:article {:class (styles/equipment-panel)} [heading item] [:span.kind (spaced (-> item :equipment_category :name) (cond (item :gear_category) (-> item :gear_category :name string/lower-case parenthesize) (item :vehicle_category) (-> item :vehicle_category string/lower-case parenthesize)))] [property-list :Speed (speed item) "Carrying Capacity" (capacity item) :Weight (weight item) :Cost (spaced (cost item) (some->> item :quantity (str "for ") parenthesize))] [description item] [license-notice item]]) (defn weapon-panel [weapon] (let [weapon-kind (-> weapon :weapon_range string/lower-case) weapon-category (-> weapon :weapon_category string/lower-case)] [:article {:class (styles/weapon-panel)} [heading weapon] [:span.kind (spaced weapon-category weapon-kind "weapon")] [property-list ; 'two-handed-damage' is defined for *single-handed* weapons with the "versatile" ; property. Actual two-handed weapons have 'damage' only. :Damage (let [damage-type (-> weapon :damage :damage_type :name string/lower-case) damage (-> weapon :damage :damage_dice) two-handed-damage (some-> weapon :two_handed_damage :damage_dice)] (if two-handed-damage (spaced damage (parenthesize two-handed-damage) damage-type) (spaced damage damage-type))) :Range (when (= weapon-kind "ranged") (gstr/format "%d' (%d')" (-> weapon :range :normal) (-> weapon :range :long))) :Properties (some->> weapon :properties (map :name) (map string/lower-case) comma-separated) :Weight (weight weapon) :Cost (cost weapon)] [license-notice weapon]])) (defn spell-list-panel [spells] [:article {:class (styles/spell-list-panel)} [heading "Spells"] [:ul (for [[index spell] (enumerated (sort-by :name spells))] ^{:key index} [:li [:span (spell :name)] [:span (-> spell short-spell-description parenthesize)]])] [listing-license-notice spells]]) (defn equipment-list-panel [items] [:article {:class (styles/item-list-panel)} [heading "Items"] [property-table items :Name {} :name :Cost {:align :right} cost :Weight {:align :right} #(weight % :unit "lb" :no-quantity true)] [listing-license-notice items]]) (defn error-message [{e :err}] [:div {:class (styles/error-message)} e]) (defn input [x] [:div.input x]) (def is-license? :license-name) (def is-spell? #(some-> % :url (string/starts-with? "/api/spells"))) (def is-spell-list? #(some-> % first is-spell?)) (def is-equipment? #(some-> % :url (string/starts-with? "/api/equipment"))) (def is-equipment-list? #(some-> % first is-equipment?)) (def is-weapon? #(and (is-equipment? %) (-> % :equipment_category :index (= "weapon")))) (def is-error? #(contains? % :err)) ; TODO: refactor this to avoid repetition of 'x' (defn output [x] [:div.output (cond (is-license? x) [license-panel x] (is-equipment-list? x) [equipment-list-panel x] (is-spell-list? x) [spell-list-panel x] (is-spell? x) (spell-panel x) (is-equipment? x) (cond (is-weapon? x) [weapon-panel x] :else [equipment-panel x]) (is-error? x) [error-message x])]) (defn history [] (let [history (re-frame/subscribe [::subs/cmd-history])] [:ul {:class (styles/history-style)} (for [[index item] (enumerated @history)] ^{:key index} [:li [input (item :input)] [output (item :output)]])])) (defn- link-to [href & content] [:a {:href href} content]) (def agpl-link (link-to "https://www.gnu.org/licenses/agpl-3.0.html" "GNU Affero Public License")) (def uberspace-link (link-to "https://uberspace.de/" "Uberspace")) (defn footer [] [:footer {:class (styles/footer)} [:span.license agpl-link] [:span.version (spaced "version:" config/version)] [:span.host "Hosted by " uberspace-link]]) (defn main-panel [] [:div {:class (styles/screen)} [:div {:class (styles/main-panel)} [title] [history] [prompt] [footer]]])