From 826c675e8a8c17a6bbddcfa71f357104b306bcca Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sun, 30 Jul 2023 16:24:47 +0100
Subject: [PATCH] OK, we have a working documentation browser.
That's a small win, but *something* works.
---
resources/doc/markdown.css | 4 +-
resources/doc/mw-parser.md | 6 +-
src/mw_desktop/fxui.clj | 68 ++---
src/mw_desktop/io.clj | 7 +-
.../ui_components/documentation_browser.clj | 260 ++++++++++++++++++
src/mw_desktop/ui_components/rule_editor.clj | 34 +++
src/mw_desktop/ui_components/world_view.clj | 72 +++++
7 files changed, 406 insertions(+), 45 deletions(-)
create mode 100644 src/mw_desktop/ui_components/documentation_browser.clj
create mode 100644 src/mw_desktop/ui_components/rule_editor.clj
create mode 100644 src/mw_desktop/ui_components/world_view.clj
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.
-### <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)
+
+-----
\ 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