diff --git a/resources/doc/markdown.css b/resources/doc/markdown.css index 39629d1..3ddc079 100644 --- a/resources/doc/markdown.css +++ b/resources/doc/markdown.css @@ -2,8 +2,8 @@ -fx-line-spacing: 4; -fx-font-family: Ubuntu; -fx-font-size: 14; - -fx-text-fill: #ddd; - -fx-fill: #ddd; + -fx-text-fill: black; + -fx-fill: black; } .root { diff --git a/resources/doc/mw-parser.md b/resources/doc/mw-parser.md index 76f662d..29be2ae 100644 --- a/resources/doc/mw-parser.md +++ b/resources/doc/mw-parser.md @@ -54,7 +54,7 @@ all cells have x more than -1. If you are having problems because one of your rules isn't working, look to see whether there is another rule above it which is 'blocking' it. -### Grammar +### Grammar #### Comments @@ -77,7 +77,7 @@ In rules, _conditions_ is one of: + _condition_ and _conditions_ + _condition_ or _conditions_ -Note that 'and' takes precedence over or, so +Note that `and` takes precedence over `or`, so conditionA and conditionB or conditionC and conditionD @@ -214,3 +214,5 @@ Copyright © 2014 [Simon Brooke](mailto:simon@journeyman.cc) Distributed under the terms of the [GNU General Public License v2](http://www.gnu.org/licenses/gpl-2.0.html) + +----- \ No newline at end of file diff --git a/src/mw_desktop/fxui.clj b/src/mw_desktop/fxui.clj index f12fb97..ba03f66 100644 --- a/src/mw_desktop/fxui.clj +++ b/src/mw_desktop/fxui.clj @@ -1,9 +1,9 @@ (ns mw-desktop.fxui (:require [cljfx.api :as fx] - [clojure.core.cache :refer [lru-cache-factory]] - [clojure.java.io :refer [resource]] - [clojure.string :refer [join lower-case starts-with?]] - [mw-desktop.state :refer [get-state state update-state!]])) + [mw-desktop.state :refer [state]] + [mw-desktop.ui-components.documentation-browser :refer [doc-browser]] + [mw-desktop.ui-components.rule-editor :refer [rule-editor]] + [mw-desktop.ui-components.world-view :refer [world-view]])) ;; OK, the basic idea here is we have a window divided vertically ;; into two panes. The user can drag the division between the panes @@ -52,43 +52,35 @@ ;; ;; In which case you probably have one graph page per rule. -(defn- tile-image [{:keys [url]}] - {:fx/type :image-view - :image {:url url - :requested-width 20 - :preserve-ratio true - :background-loading true}}) - -(defn world-view [{:keys [world tileset]}] - ;; assumes that by the time we get here, a tileset is a clojure map - ;; in which the keys are the names of the tiles, without file extension, as - ;; keywords (i.e. they're states, from the point of view of the world), and - ;; in which the values are just java images (bitmaps), or else maps which - ;; wrap java images with some other related data for example dimensions. - (let [th (or (:height (first tileset)) 20) - tw (or (:width (first tileset)) 20) - cols (count (first world)) - rows (count world)] - {:fx/type :tile-pane - :hgap 0 - :pref-columns cols - :pref-rows rows - :pref-tile-height th - :pref-tile-width tw - :vgap 0 - :children (map (fn [cell]{:fx/type tile-image - :tile-pane/alignment :bottom-center - :url (resource (format "%s/%s.png" tileset (:state cell)))}) - (flatten world))})) - -(defn root-view [{{:keys [world rules]} :state}] +(defn root-view [{{:keys []} :state}] {:fx/type :stage :showing true + :title "MicroWorld" :scene {:fx/type :scene + :stylesheets #{"doc/markdown.css"} :root {:fx/type :split-pane - :items [{:fx.type :scroll-pane - :content {:fx/type world-view}}]}}}) - + :items [{:fx/type :stack-pane + :children [{:fx/type :scroll-pane + :content {:fx/type world-view}} + {:fx/type :label + :stack-pane/alignment :top-right + :stack-pane/margin 5 + :max-width 300 + ;; :text status + }]} + {:fx/type :tab-pane + :tabs [;; {:fx/type :tab + ;; :text "Rule Editor" + ;; :closable false + ;; :content rule-editor + ;; :parse-errors (or parse-errors "No errors found") + ;; :rules-file (or rules-file "Unnamed file") + ;; :rules-src (or rules-src ";; enter your rules here") + ;; } + {:fx/type :tab + :text "Help" + :closable false + :content doc-browser}]}]}}}) (defmulti handle-event :event/type) @@ -98,7 +90,7 @@ (defmethod handle-event ::type-text [{:keys [fx/event fx/context]}] {:context (fx/swap-context context assoc :typed-text event)}) -(defmulti event-handler +(defmulti event-handler "Multi-method event handler cribbed from e12-interactive-development" :event/type) diff --git a/src/mw_desktop/io.clj b/src/mw_desktop/io.clj index 69c960d..5111984 100644 --- a/src/mw_desktop/io.clj +++ b/src/mw_desktop/io.clj @@ -34,8 +34,9 @@ Where a file and resource with this `path` both exist, the file is preferred. Updates global state. Returns the ruleset loaded." [path] - (let [rules (doall (compile (slurp (:stream (identify-resource path)))))] - (update-state! :rules rules) + (let [src (slurp (:stream (identify-resource path))) + rules (doall (compile src))] + (update-state! :rules rules :rules-file path :rules-src src) rules)) (defn assemble-tile-set @@ -93,7 +94,7 @@ path) (merge data {:path path}) any))))] - (if (world? world) (do (update-state! :world world) world) + (if (world? world) (do (update-state! :world world :world-file path) world) (throw (ex-info "Invalid world file?" (merge data {:path path :data world})))))) diff --git a/src/mw_desktop/ui_components/documentation_browser.clj b/src/mw_desktop/ui_components/documentation_browser.clj new file mode 100644 index 0000000..a19565d --- /dev/null +++ b/src/mw_desktop/ui_components/documentation_browser.clj @@ -0,0 +1,260 @@ +(ns mw-desktop.ui-components.documentation-browser + "A tab in which documentation can be presented. Cribbed pretty much in + entirety from the cljfx example `e20-markdown-editor`." + (:require [cljfx.api :as fx] + [clojure.core.cache :refer [lru-cache-factory]] + [clojure.java.io :refer [resource]] + [clojure.string :as str] + [mw-desktop.state :refer [state]]) + (:import [java.awt Desktop] + [java.io File] + [java.net URI] + [org.commonmark.node Node] + [org.commonmark.parser Parser])) + +(defn commonmark->clj [^Node node] + (let [tag (->> node + .getClass + .getSimpleName + (re-seq #"[A-Z][a-z]+") + (map str/lower-case) + (str/join "-") + keyword) + all-attrs (->> node + bean + (map (fn [[k v]] + [(->> k + name + (re-seq #"[A-Z]?[a-z]+") + (map str/lower-case) + (str/join "-") + keyword) + v])) + (into {}))] + {:tag tag + :attrs (dissoc all-attrs :next :previous :class :first-child :last-child :parent) + :children (->> node + .getFirstChild + (iterate #(.getNext ^Node %)) + (take-while some?) + (mapv commonmark->clj))})) + +(defn node-sub [context] + (-> (Parser/builder) + .build + (.parse (fx/sub-val context :typed-text)) + commonmark->clj)) + +(defmulti handle-event :event/type) + +(defmethod handle-event :default [e] + (prn e)) + +(defmethod handle-event ::type-text [{:keys [fx/event fx/context]}] + {:context (fx/swap-context context assoc :typed-text event)}) + +(defmulti md->fx :tag) + +(defn md-view [{:keys [node]}] + (md->fx node)) + +(defmethod md->fx :heading [{children :children {:keys [level]} :attrs}] + {:fx/type :text-flow + :style-class ["heading" (str "level-" level)] + :children (for [node children] + {:fx/type md-view + :node node})}) + +(defmethod md->fx :paragraph [{children :children}] + {:fx/type :text-flow + :style-class "paragraph" + :children (for [node children] + {:fx/type md-view + :node node})}) + +(defmethod md->fx :text [{{:keys [literal]} :attrs}] + {:fx/type :text + :cache true + :cache-hint :speed + :text literal}) + +(defmethod md->fx :code [{{:keys [literal]} :attrs}] + {:fx/type :label + :cache true + :cache-hint :speed + :style-class "code" + :text literal}) + +(defmethod md->fx :fenced-code-block [{{:keys [literal]} :attrs}] + {:fx/type :v-box + :padding {:top 9} + :children [{:fx/type :scroll-pane + :style-class ["scroll-pane" "code-block"] + :fit-to-width true + :content {:fx/type :label + :cache true + :cache-hint :speed + :max-width ##Inf + :min-width :use-pref-size + :text literal}}]}) + +(defmethod md->fx :indented-code-block [{{:keys [literal]} :attrs}] + {:fx/type :v-box + :padding {:top 9} + :children [{:fx/type :scroll-pane + :style-class ["scroll-pane" "code-block"] + :fit-to-width true + :content {:fx/type :label + :cache true + :cache-hint :speed + :max-width ##Inf + :min-width :use-pref-size + :text literal}}]}) + +(defmethod md->fx :link [{{:keys [^String destination]} :attrs children :children}] + (let [link {:fx/type :hyperlink + :on-action (fn [_] + (future + (try + (if (str/starts-with? destination "http") + (.browse (Desktop/getDesktop) (URI. destination)) + (.open (Desktop/getDesktop) (File. destination))) + (catch Exception e + (.printStackTrace e)))))}] + (if (and (= 1 (count children)) + (= :text (:tag (first children)))) + (assoc link :text (-> children first :attrs :literal)) + (assoc link :graphic {:fx/type :h-box + :children (for [node children] + {:fx/type md-view + :node node})})))) + +(defmethod md->fx :strong-emphasis [{:keys [children]}] + (if (and (= 1 (count children)) + (= :text (:tag (first children)))) + {:fx/type :text + :cache true + :cache-hint :speed + :style-class "strong-emphasis" + :text (-> children first :attrs :literal)} + {:fx/type :h-box + :cache true + :style-class "strong-emphasis" + :children (for [node children] + {:fx/type md-view + :node node})})) + +(defmethod md->fx :emphasis [{:keys [children]}] + (if (and (= 1 (count children)) + (= :text (:tag (first children)))) + {:fx/type :text + :cache true + :cache-hint :speed + :style-class "emphasis" + :text (-> children first :attrs :literal)} + {:fx/type :h-box + :style-class "emphasis" + :children (for [node children] + {:fx/type md-view + :node node})})) + +(defmethod md->fx :soft-line-break [_] + {:fx/type :text + :text " "}) + +(defmethod md->fx :document [{:keys [children]}] + {:fx/type :v-box + :style-class "document" + :children (for [node children] + {:fx/type md-view + :node node})}) + +(defmethod md->fx :image [{{:keys [destination]} :attrs}] + {:fx/type :image-view + :image {:url (if (str/starts-with? destination "http") + destination + (str "file:" destination)) + :background-loading true}}) + +(defmethod md->fx :bullet-list [{{:keys [bullet-marker]} :attrs children :children}] + {:fx/type :v-box + :style-class "md-list" + :children (for [node children] + {:fx/type :h-box + :alignment :baseline-left + :spacing 4 + :children [{:fx/type :label + :min-width :use-pref-size + :cache true + :cache-hint :speed + :text (str bullet-marker)} + {:fx/type md-view + :node node}]})}) + +(defmethod md->fx :ordered-list [{{:keys [delimiter start-number]} :attrs + children :children}] + {:fx/type :v-box + :style-class "md-list" + :children (map (fn [child number] + {:fx/type :h-box + :alignment :baseline-left + :spacing 4 + :children [{:fx/type :label + :cache true + :cache-hint :speed + :min-width :use-pref-size + :text (str number delimiter)} + (assoc (md->fx child) + :h-box/hgrow :always)]}) + children + (range start-number ##Inf))}) + +(defmethod md->fx :list-item [{:keys [children]}] + {:fx/type :v-box + :children (for [node children] + {:fx/type md-view + :node node})}) + +(defmethod md->fx :default [{:keys [tag attrs children]}] + {:fx/type :v-box + :children [{:fx/type :label + :cache true + :cache-hint :speed + :style {:-fx-background-color :red} + :text (str tag " " attrs)} + {:fx/type :v-box + :padding {:left 10} + :children (for [node children] + {:fx/type md-view + :node node})}]}) + +(def *context + (atom + (fx/create-context + {:typed-text (subs (slurp (resource "doc/mw-parser.md")) 0 10000)} + #(lru-cache-factory % :threshold 498)))) + +(defn doc-browser + [{:keys [fx/context]}] + {:fx/type :scroll-pane + :fit-to-width true + :content {:fx/type md-view + :node (fx/sub-ctx context node-sub)}}) + +(defmulti handle-event :event/type) + +(defmethod handle-event :default [e] + (prn e)) + +(def app + "Test purposes only" + (fx/create-app *context + :event-handler handle-event + :desc-fn (fn [_] + {:fx/type :stage + :showing true + :width 960 + :height 540 + :scene {:fx/type :scene + :stylesheets #{"doc/markdown.css"} + :root {:fx/type doc-browser}}}))) \ No newline at end of file diff --git a/src/mw_desktop/ui_components/rule_editor.clj b/src/mw_desktop/ui_components/rule_editor.clj new file mode 100644 index 0000000..3d8f396 --- /dev/null +++ b/src/mw_desktop/ui_components/rule_editor.clj @@ -0,0 +1,34 @@ +(ns mw-desktop.ui-components.rule-editor + (:require [cljfx.api :as fx] + [clojure.string :refer [join]] + [mw-desktop.state :refer :all])) + +(defn rule-editor + "Rule editor comprises a scrolling container, with within it, + + 1. name of loaded rule file (non editable, visually distinguished) at the + top; + 2. line numbers in a column on the left; + 3. editable rules source text in the middle; + 4. parser/compiler errors in a panel as the bottom." + [{{:keys [rules-file rules-src parse-errors]} :state}] + {:fx/type :scroll-pane + :content {:fx/type :border-pane + :top {:fx/type :label + :border-pane/alignment :center + :border-pane/margin 2 + :text rules-file} + :left {:fx/type :label + :border-pane/margin 2 + :text (join "\n" + (map #(format "%5d" %) + (range 1 (inc (count (re-seq #"\n" rules-src))))))} + :center {:fx/type :text-area + :style-class "input" + :text (fx/sub-val rules-src :typed-text) + :on-text-changed {:event/type ::type-text :fx/sync true}} + :bottom {:fx/type :label + :border-pane/margin 2 + :text (or parse-errors "error messages will appear here.")}} + } + ) diff --git a/src/mw_desktop/ui_components/world_view.clj b/src/mw_desktop/ui_components/world_view.clj new file mode 100644 index 0000000..66dd24c --- /dev/null +++ b/src/mw_desktop/ui_components/world_view.clj @@ -0,0 +1,72 @@ +(ns mw-desktop.ui-components.world-view + "View of the world" + (:require [cljfx.api :as fx] + [clojure.java.io :refer [as-url resource]] + [mw-desktop.io :refer [load-world!]] + [mw-desktop.state :refer [state]])) + +;; World view is essentially a grid of tiles, one per cell. In the long term +;; I want a context menu, allowing the user to +;; +;; 1. inspect cell properties; +;; 2. change non-protected properties, including state; +;; 3. browse cell history in a user-friendly presentation. +;; +;; In the short term, just being able to scroll around the grid is enough. + +(defn- tile-image [{:keys [url]}] + {:fx/type :image-view + :image {:url url + :requested-width 20 + :preserve-ratio true + :background-loading true}}) + +(defn assemble-tiles + [world tiles] + (map (fn [cell] + {:fx/type tile-image + :tile-pane/alignment :bottom-center + :url (as-url (or (tiles (:state cell)) + (resource "tilesets/world/error.png")))}) + (flatten world))) + +(defn world-view + [{{:keys [world tileset]} :state}] + ;; assumes that by the time we get here, a tileset is a clojure map + ;; in which the keys are the names of the tiles, without file extension, as + ;; keywords (i.e. they're states, from the point of view of the world), and + ;; in which the values are URLs which point to image files. + (let [th (or (:height (first tileset)) 20) + tw (or (:width (first tileset)) 20) + cols 48 ;; (count (first world)) + rows 47;; (count world) + children (assemble-tiles world tileset)] + {:fx/type :tile-pane + :hgap 0 + :pref-columns cols + :pref-rows rows + :pref-tile-height th + :pref-tile-width tw + :vgap 0 + :children children})) + + +;;; From this point on we're just constructing a test harness to launch the +;;; component in isolation. +(load-world! "init-state/world.edn") +(defmulti handle-event :event/type) + +(defmethod handle-event :default [e] + (prn e)) + +(def app + "Test purposes only" + (fx/create-app state + :event-handler handle-event + :desc-fn (fn [_] + {:fx/type :stage + :showing true + :width 960 + :height 540 + :scene {:fx/type :scene + :root {:fx/type world-view}}}))) \ No newline at end of file