OK, we have a working documentation browser.
That's a small win, but *something* works.
This commit is contained in:
parent
272de653d8
commit
826c675e8a
|
|
@ -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 {
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
### <a name="grammar"></a>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)
|
||||
|
||||
-----
|
||||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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}))))))
|
||||
|
|
|
|||
260
src/mw_desktop/ui_components/documentation_browser.clj
Normal file
260
src/mw_desktop/ui_components/documentation_browser.clj
Normal file
|
|
@ -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}}})))
|
||||
34
src/mw_desktop/ui_components/rule_editor.clj
Normal file
34
src/mw_desktop/ui_components/rule_editor.clj
Normal file
|
|
@ -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.")}}
|
||||
}
|
||||
)
|
||||
72
src/mw_desktop/ui_components/world_view.clj
Normal file
72
src/mw_desktop/ui_components/world_view.clj
Normal file
|
|
@ -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}}})))
|
||||
Loading…
Reference in a new issue