Still nothing works, but I have a feeling that progress is being made.
|
@ -1,13 +1,15 @@
|
|||
(defproject mw-desktop "0.1.0-SNAPSHOT"
|
||||
(defproject mw-desktop "0.3.0-SNAPSHOT"
|
||||
:description "FIXME: write description"
|
||||
:url "http://example.com/FIXME"
|
||||
:license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0"
|
||||
:url "https://www.eclipse.org/legal/epl-2.0/"}
|
||||
:dependencies [[cljfx "1.7.23"]
|
||||
[com.novemberain/pantomime "2.11.0"]
|
||||
[com.taoensso/timbre "6.2.2"]
|
||||
[de.codecentric.centerdevice/javafxsvg "1.3.0"] ;; used by markdown-editor-example
|
||||
[markdown-clj "1.11.4"]
|
||||
[mw-engine "0.2.0-SNAPSHOT"]
|
||||
[mw-parser "0.2.0-SNAPSHOT"]
|
||||
[mw-engine "0.3.0-SNAPSHOT"]
|
||||
[mw-parser "0.3.0-SNAPSHOT"]
|
||||
[net.sourceforge.htmlcleaner/htmlcleaner "2.29"]
|
||||
[org.clojure/clojure "1.10.3"]
|
||||
[org.clojure/core.cache "1.0.225"]
|
||||
|
|
Before Width: | Height: | Size: 169 B After Width: | Height: | Size: 169 B |
Before Width: | Height: | Size: 160 B After Width: | Height: | Size: 160 B |
Before Width: | Height: | Size: 164 B After Width: | Height: | Size: 164 B |
Before Width: | Height: | Size: 605 B After Width: | Height: | Size: 605 B |
Before Width: | Height: | Size: 395 B After Width: | Height: | Size: 395 B |
Before Width: | Height: | Size: 921 B After Width: | Height: | Size: 921 B |
Before Width: | Height: | Size: 641 B After Width: | Height: | Size: 641 B |
Before Width: | Height: | Size: 160 B After Width: | Height: | Size: 160 B |
Before Width: | Height: | Size: 977 B After Width: | Height: | Size: 977 B |
Before Width: | Height: | Size: 937 B After Width: | Height: | Size: 937 B |
Before Width: | Height: | Size: 163 B After Width: | Height: | Size: 163 B |
Before Width: | Height: | Size: 719 B After Width: | Height: | Size: 719 B |
Before Width: | Height: | Size: 855 B After Width: | Height: | Size: 855 B |
Before Width: | Height: | Size: 591 B After Width: | Height: | Size: 591 B |
Before Width: | Height: | Size: 782 B After Width: | Height: | Size: 782 B |
Before Width: | Height: | Size: 587 B After Width: | Height: | Size: 587 B |
Before Width: | Height: | Size: 805 B After Width: | Height: | Size: 805 B |
Before Width: | Height: | Size: 368 B After Width: | Height: | Size: 368 B |
Before Width: | Height: | Size: 160 B After Width: | Height: | Size: 160 B |
Before Width: | Height: | Size: 368 B After Width: | Height: | Size: 368 B |
Before Width: | Height: | Size: 643 B After Width: | Height: | Size: 643 B |
Before Width: | Height: | Size: 718 B After Width: | Height: | Size: 718 B |
Before Width: | Height: | Size: 621 B After Width: | Height: | Size: 621 B |
Before Width: | Height: | Size: 687 B After Width: | Height: | Size: 687 B |
Before Width: | Height: | Size: 621 B After Width: | Height: | Size: 621 B |
Before Width: | Height: | Size: 782 B After Width: | Height: | Size: 782 B |
Before Width: | Height: | Size: 1.1 KiB After Width: | Height: | Size: 1.1 KiB |
Before Width: | Height: | Size: 621 B After Width: | Height: | Size: 621 B |
229
src/e07_extra_props.clj
Normal file
|
@ -0,0 +1,229 @@
|
|||
(ns e07-extra-props
|
||||
(:require [cljfx.api :as fx]))
|
||||
|
||||
(def anchor-pane
|
||||
{:fx/type :anchor-pane
|
||||
:children [{:fx/type :label
|
||||
:anchor-pane/left 10
|
||||
:anchor-pane/bottom 10
|
||||
:text "bottom-left"}
|
||||
{:fx/type :label
|
||||
:anchor-pane/top 10
|
||||
:anchor-pane/right 10
|
||||
:text "top-right"}
|
||||
{:fx/type :label
|
||||
:anchor-pane/left 100
|
||||
:anchor-pane/top 100
|
||||
:anchor-pane/right 100
|
||||
:anchor-pane/bottom 100
|
||||
:style {:-fx-background-color :lightgray
|
||||
:-fx-alignment :center}
|
||||
:text "Try resizing window too!"}]})
|
||||
|
||||
(def border-pane
|
||||
{:fx/type :border-pane
|
||||
:top {:fx/type :label
|
||||
:border-pane/alignment :center
|
||||
:border-pane/margin 10
|
||||
:text "top header"}
|
||||
:left {:fx/type :label
|
||||
:border-pane/margin 10
|
||||
:text "left sidebar"}
|
||||
:right {:fx/type :label
|
||||
:border-pane/margin 10
|
||||
:text "right sidebar"}
|
||||
:center {:fx/type :label
|
||||
:border-pane/margin 10
|
||||
:text "center content"}
|
||||
:bottom {:fx/type :label
|
||||
:border-pane/margin 10
|
||||
:text "bottom footer"}})
|
||||
|
||||
(def flow-pane
|
||||
{:fx/type :flow-pane
|
||||
:vgap 5
|
||||
:hgap 5
|
||||
:padding 5
|
||||
:children (repeat 100 {:fx/type :rectangle :width 25 :height 25})})
|
||||
|
||||
(def grid-pane
|
||||
{:fx/type :grid-pane
|
||||
:children (concat
|
||||
(for [i (range 16)]
|
||||
{:fx/type :label
|
||||
:grid-pane/column i
|
||||
:grid-pane/row i
|
||||
:grid-pane/hgrow :always
|
||||
:grid-pane/vgrow :always
|
||||
:text "boop"})
|
||||
[{:fx/type :label
|
||||
:grid-pane/row 2
|
||||
:grid-pane/column 3
|
||||
:grid-pane/column-span 2
|
||||
:text "I am a long label spanning 2 columns"}])})
|
||||
|
||||
(def h-box
|
||||
{:fx/type :h-box
|
||||
:spacing 5
|
||||
:children [{:fx/type :label
|
||||
:text "just label"}
|
||||
{:fx/type :label
|
||||
:h-box/hgrow :always
|
||||
:max-width Double/MAX_VALUE
|
||||
:style {:-fx-background-color :lightgray}
|
||||
:text "expanded label"}
|
||||
{:fx/type :label
|
||||
:h-box/margin 100
|
||||
:text "label with big margin"}]})
|
||||
|
||||
(def stack-pane
|
||||
{:fx/type :stack-pane
|
||||
:children [{:fx/type :rectangle
|
||||
:width 200
|
||||
:height 200
|
||||
:fill :lightgray}
|
||||
{:fx/type :label
|
||||
:stack-pane/alignment :bottom-left
|
||||
:stack-pane/margin 5
|
||||
:text "stacked label"}
|
||||
{:fx/type :text-field
|
||||
:stack-pane/alignment :top-right
|
||||
:stack-pane/margin 5
|
||||
:max-width 300
|
||||
:text "Text field in top-right corner"}]})
|
||||
|
||||
(defn- tile-image [{:keys [url]}]
|
||||
{:fx/type :image-view
|
||||
:image {:url url
|
||||
:requested-width 310
|
||||
:preserve-ratio true
|
||||
:background-loading true}})
|
||||
|
||||
(def tile-pane
|
||||
{:fx/type :scroll-pane
|
||||
:fit-to-width false
|
||||
:content {:fx/type :tile-pane
|
||||
:pref-columns 3
|
||||
:hgap 5
|
||||
:vgap 5
|
||||
:children [{:fx/type tile-image
|
||||
:tile-pane/alignment :bottom-center
|
||||
:url "https://i.imgur.com/oy91jyx.gif"}
|
||||
{:fx/type tile-image
|
||||
:tile-pane/alignment :bottom-center
|
||||
:url "https://i.imgur.com/B4DdoER.png"}
|
||||
{:fx/type tile-image
|
||||
:tile-pane/alignment :bottom-center
|
||||
:url "https://i.imgur.com/mQOeSe5.png"}
|
||||
{:fx/type tile-image
|
||||
:tile-pane/alignment :bottom-center
|
||||
:url "https://i.redd.it/6906qzxo55711.png"}
|
||||
{:fx/type tile-image
|
||||
:tile-pane/alignment :bottom-center
|
||||
:url "https://i.redd.it/810g0l3sgis01.gif"}
|
||||
{:fx/type tile-image
|
||||
:tile-pane/alignment :bottom-center
|
||||
:url "https://i.redd.it/rpkzzc0awr411.gif"}
|
||||
{:fx/type tile-image
|
||||
:tile-pane/alignment :bottom-center
|
||||
:url "http://i.imgur.com/G3dVZpk.jpg"}
|
||||
{:fx/type tile-image
|
||||
:tile-pane/alignment :bottom-center
|
||||
:url "https://i.redd.it/k4hax2x5yyhy.png"}
|
||||
{:fx/type tile-image
|
||||
:tile-pane/alignment :bottom-center
|
||||
:url "https://i.imgur.com/PRxRkne.png"}
|
||||
{:fx/type tile-image
|
||||
:tile-pane/alignment :bottom-center
|
||||
:url "https://i.redd.it/zusrb3sxsz211.gif"}
|
||||
{:fx/type tile-image
|
||||
:tile-pane/alignment :bottom-center
|
||||
:url "https://i.redd.it/fagm2fhxv1yz.gif"}
|
||||
{:fx/type tile-image
|
||||
:tile-pane/alignment :bottom-center
|
||||
:url "https://i.redd.it/w49wc60kys401.gif"}]}})
|
||||
|
||||
(def v-box
|
||||
{:fx/type :v-box
|
||||
:spacing 5
|
||||
:fill-width true
|
||||
:alignment :top-center
|
||||
:children [{:fx/type :label :text "just label"}
|
||||
{:fx/type :label
|
||||
:v-box/vgrow :always
|
||||
:style {:-fx-background-color :lightgray}
|
||||
:max-height Double/MAX_VALUE
|
||||
:max-width Double/MAX_VALUE
|
||||
:text "expanded label"}]})
|
||||
|
||||
(def button-bar
|
||||
{:fx/type :button-bar
|
||||
:button-min-width 100
|
||||
:buttons [{:fx/type :button
|
||||
:button-bar/button-data :yes
|
||||
:text "Yes"}
|
||||
{:fx/type :button
|
||||
:button-bar/button-data :no
|
||||
:text "No"}]})
|
||||
|
||||
(def split-pane
|
||||
{:fx/type :split-pane
|
||||
:divider-positions [0.5]
|
||||
:items [{:fx/type :label
|
||||
:split-pane/resizable-with-parent false
|
||||
:padding 50
|
||||
:text "This is label that is NOT resizable with parent"}
|
||||
{:fx/type :label
|
||||
:padding 50
|
||||
:text "This is a label resizable with parent"}]})
|
||||
|
||||
|
||||
(fx/on-fx-thread
|
||||
(fx/create-component
|
||||
{:fx/type :stage
|
||||
:showing true
|
||||
:title "Pane examples"
|
||||
:scene {:fx/type :scene
|
||||
:root {:fx/type :tab-pane
|
||||
:pref-width 960
|
||||
:pref-height 540
|
||||
:tabs [{:fx/type :tab
|
||||
:text "Anchor Pane"
|
||||
:closable false
|
||||
:content anchor-pane}
|
||||
{:fx/type :tab
|
||||
:text "Border Pane"
|
||||
:closable false
|
||||
:content border-pane}
|
||||
{:fx/type :tab
|
||||
:text "Flow Pane"
|
||||
:closable false
|
||||
:content flow-pane}
|
||||
{:fx/type :tab
|
||||
:text "Grid Pane"
|
||||
:closable false
|
||||
:content grid-pane}
|
||||
{:fx/type :tab
|
||||
:text "HBox"
|
||||
:closable false
|
||||
:content h-box}
|
||||
{:fx/type :tab
|
||||
:text "Stack Pane"
|
||||
:closable false
|
||||
:content stack-pane}
|
||||
{:fx/type :tab
|
||||
:text "Tile Pane"
|
||||
:closable false
|
||||
:content tile-pane}
|
||||
{:fx/type :tab
|
||||
:text "VBox"
|
||||
:closable false
|
||||
:content v-box}
|
||||
{:fx/type :tab
|
||||
:text "Button Bar"
|
||||
:closable false
|
||||
:content button-bar}
|
||||
{:fx/type :tab
|
||||
:text "SplitPane"
|
||||
:closable false
|
||||
:content split-pane}]}}}))
|
|
@ -1,31 +1,56 @@
|
|||
(ns mw-desktop.core
|
||||
(:require [clojure.java.io :refer [file]]
|
||||
[clojure.tools.cli :refer [parse-opts]])
|
||||
(:require [clojure.string :refer [join]]
|
||||
[clojure.tools.cli :refer [parse-opts]]
|
||||
;; [mw-desktop.fxui :refer [ui]]
|
||||
[mw-desktop.io :refer [load-ruleset! load-world!]])
|
||||
(:gen-class))
|
||||
|
||||
(def defaults
|
||||
"Defaults for command line arguments."
|
||||
{:ruleset "rulesets/basic.txt"
|
||||
:tileset "tilesets/world/"
|
||||
:world "heightmaps/small_hill.png"})
|
||||
|
||||
(def cli-options
|
||||
[["-f FILEPATH" "--file-path FILEPATH"
|
||||
"Set the path to the directory for reading and writing Lisp files."
|
||||
:validate [#(and (.exists (file %))
|
||||
(.isDirectory (file %))
|
||||
(.canRead (file %))
|
||||
(.canWrite (file %)))
|
||||
"File path must exist and must be a directory."]]
|
||||
["-h" "--help"]
|
||||
["-p PROMPT" "--prompt PROMPT" "Set the REPL prompt to PROMPT"
|
||||
:default "Sprecan::"]
|
||||
["-r SYSOUTFILE" "--read SYSOUTFILE" "Read Lisp system from file SYSOUTFILE"
|
||||
:validate [#(and
|
||||
(.exists (file %))
|
||||
(.canRead (file %)))
|
||||
"Could not find sysout file"]]
|
||||
["-s" "--strict" "Strictly interpret the Lisp 1.5 language, without extensions."]
|
||||
["-t" "--time" "Time evaluations."]
|
||||
["-x" "--testing" "Disable the jline reader - useful when piping input."]])
|
||||
[["-h" "--help"]
|
||||
["-r FILEPATH" "--ruleset FILEPATH" "The ruleset to load"]
|
||||
["-t FILEPATH" "--tileset FILEPATH" "The tileset to load"]
|
||||
["-w FILEPATH" "--world FILEPATH" "Choose the world to load"]])
|
||||
|
||||
(defn error-msg [errors]
|
||||
(str "The following errors occurred while parsing your command:\n\n"
|
||||
(join \newline errors)))
|
||||
|
||||
(defn validate-args
|
||||
"Validate command line arguments. Either return a map indicating the program
|
||||
should exit (with an error message, and optional ok status), or a map
|
||||
indicating the action the program should take and the options provided."
|
||||
[args]
|
||||
(let [{:keys [options arguments errors summary]} (parse-opts args cli-options)]
|
||||
(cond
|
||||
(:help options) ; help => exit OK with usage summary
|
||||
{:exit-message (:summary args) :ok? true}
|
||||
errors ; errors => exit with description of errors
|
||||
{:exit-message (error-msg errors)}
|
||||
;; custom validation on arguments
|
||||
(and (= 1 (count arguments))
|
||||
(#{"start" "stop" "status"} (first arguments)))
|
||||
{:action (first arguments) :options options}
|
||||
:else ; failed custom validation => exit with usage summary
|
||||
{:exit-message (:summary args)})))
|
||||
|
||||
(defn -main
|
||||
"Parse options, print the banner, read the init file if any, and enter the
|
||||
read/eval/print loop."
|
||||
[& opts]
|
||||
(let [args (parse-opts opts cli-options)]
|
||||
(println "Hello, World!")))
|
||||
[& opts]
|
||||
(let [args (parse-opts opts cli-options)
|
||||
options (merge defaults (:options args))]
|
||||
|
||||
(load-ruleset! (:ruleset options))
|
||||
(load-tileset! (:tileset options))
|
||||
(load-world! (:world options))
|
||||
|
||||
(when (:help args) (println (:summary args)) (System/exit 0))
|
||||
;;(ui options)
|
||||
(println options)
|
||||
))
|
||||
|
|
|
@ -1,252 +0,0 @@
|
|||
|
||||
;; this file is cribbed entirely from
|
||||
;; https://github.com/cljfx/cljfx/blob/master/examples/e12_interactive_development.clj
|
||||
|
||||
;; This file is supposed to be explored from the REPL, evaluating forms one
|
||||
;; by one from top to bottom.
|
||||
|
||||
(ns e12-interactive-development
|
||||
(:require [cljfx.api :as fx]))
|
||||
|
||||
;; I want to build an interactive chart that shows how bouncing object falls
|
||||
;; on the ground. I want to be able to edit gravity and friction to see how
|
||||
;; it affects object's behavior, so I will put it into state:
|
||||
|
||||
(def *state
|
||||
(atom {:gravity 10
|
||||
:friction 0.4}))
|
||||
|
||||
|
||||
;; I want to have map event handlers extensible during runtime to avoid full app
|
||||
;; restarts. One way is using vars instead of functions to get that kind of
|
||||
;; behavior, but I'll go with another way: multi-methods.
|
||||
|
||||
(defmulti event-handler :event/type)
|
||||
|
||||
;; Now we'll create our app with dummy root view
|
||||
|
||||
(defn root-view [{{:keys [gravity friction]} :state}]
|
||||
{:fx/type :stage
|
||||
:showing true
|
||||
:scene {:fx/type :scene
|
||||
:root {:fx/type :h-box
|
||||
:children [{:fx/type :label
|
||||
:text (str "g = " gravity ", f = " friction)}]}}})
|
||||
|
||||
(def renderer
|
||||
(fx/create-renderer
|
||||
:middleware (fx/wrap-map-desc (fn [state]
|
||||
{:fx/type root-view
|
||||
:state state}))
|
||||
:opts {:fx.opt/map-event-handler event-handler}))
|
||||
|
||||
(fx/mount-renderer *state renderer)
|
||||
|
||||
;; At this point, really tiny window appears that displays current gravity and
|
||||
;; friction. We want to have an ability to change these values, so let's create
|
||||
;; some slider views for them:
|
||||
|
||||
(defn slider-view [{:keys [min max value]}]
|
||||
{:fx/type :slider
|
||||
:min min
|
||||
:max max
|
||||
:value value})
|
||||
|
||||
;; Now we will update our root view to display these sliders:
|
||||
|
||||
(defn root-view [{{:keys [gravity friction]} :state}]
|
||||
{:fx/type :stage
|
||||
:showing true
|
||||
:scene {:fx/type :scene
|
||||
:root {:fx/type :h-box
|
||||
:children [{:fx/type slider-view
|
||||
:min 0
|
||||
:max 100
|
||||
:value gravity}
|
||||
{:fx/type slider-view
|
||||
:min 0
|
||||
:max 1
|
||||
:value friction}]}}})
|
||||
|
||||
;; Now we updated our root function, but window didn't change. It happens
|
||||
;; because cljfx has no way to know if definition of some component functions is
|
||||
;; changed. But we can ask renderer to refresh itself by calling it without any
|
||||
;; arguments:
|
||||
|
||||
(renderer)
|
||||
;; Now small label got replaced with 2 sliders. Problem is, there are no labels
|
||||
;; on them, so users can't really see what these sliders mean, so let's fix it:
|
||||
|
||||
(defn slider-view [{:keys [min max value label]}]
|
||||
{:fx/type :v-box
|
||||
:children [{:fx/type :label
|
||||
:text label}
|
||||
{:fx/type :slider
|
||||
:min min
|
||||
:max max
|
||||
:value value
|
||||
:major-tick-unit max
|
||||
:show-tick-labels true}]})
|
||||
|
||||
(defn root-view [{{:keys [gravity friction]} :state}]
|
||||
{:fx/type :stage
|
||||
:showing true
|
||||
:scene {:fx/type :scene
|
||||
:root {:fx/type :h-box
|
||||
:spacing 10
|
||||
:children [{:fx/type slider-view
|
||||
:min 0
|
||||
:max 100
|
||||
:value gravity
|
||||
:label "Gravity"}
|
||||
{:fx/type slider-view
|
||||
:min 0
|
||||
:max 1
|
||||
:label "Friction"
|
||||
:value friction}]}}})
|
||||
|
||||
(renderer)
|
||||
|
||||
|
||||
;; Great, time to add a chart that uses gravity and friction, but first let's
|
||||
;; try to display something dummy to make sure it works
|
||||
|
||||
(defn chart-view [{:keys [gravity friction]}]
|
||||
{:fx/type :line-chart
|
||||
:x-axis {:fx/type :number-axis
|
||||
:label "Time"}
|
||||
:y-axis {:fx/type :number-axis
|
||||
:label "Y"}
|
||||
:data [{:fx/type :xy-chart-series
|
||||
:name "Position by time"
|
||||
:data (for [t (range 100)]
|
||||
{:fx/type :xy-chart-data
|
||||
:x-value t
|
||||
:y-value t})}]})
|
||||
|
||||
(defn root-view [{{:keys [gravity friction]} :state}]
|
||||
{:fx/type :stage
|
||||
:showing true
|
||||
:scene {:fx/type :scene
|
||||
:root {:fx/type :v-box
|
||||
:spacing 20
|
||||
:children [{:fx/type chart-view
|
||||
:gravity gravity
|
||||
:friction friction}
|
||||
{:fx/type :h-box
|
||||
:spacing 10
|
||||
:alignment :center
|
||||
:children [{:fx/type slider-view
|
||||
:min 0
|
||||
:max 100
|
||||
:value gravity
|
||||
:label "Gravity"}
|
||||
{:fx/type slider-view
|
||||
:min 0
|
||||
:max 1
|
||||
:label "Friction"
|
||||
:value friction}]}]}}})
|
||||
|
||||
(renderer)
|
||||
|
||||
;; Now chart is added to a window. Everything looks fine, time to do some
|
||||
;; simulation:
|
||||
|
||||
(defn simulate-step [{:keys [velocity y]} gravity friction]
|
||||
(let [new-velocity (* (- velocity gravity) (- 1 friction))
|
||||
new-y (+ y new-velocity)]
|
||||
(if (neg? new-y)
|
||||
{:velocity (- new-velocity) :y 0}
|
||||
{:velocity new-velocity :y new-y})))
|
||||
|
||||
(defn chart-view [{:keys [gravity friction]}]
|
||||
{:fx/type :line-chart
|
||||
:x-axis {:fx/type :number-axis
|
||||
:label "Time"}
|
||||
:y-axis {:fx/type :number-axis
|
||||
:label "Y"}
|
||||
:data [{:fx/type :xy-chart-series
|
||||
:name "Position by time"
|
||||
:data (->> {:velocity 0 :y 100}
|
||||
(iterate #(simulate-step % gravity friction))
|
||||
(take 100)
|
||||
(map-indexed (fn [index {:keys [y]}]
|
||||
{:fx/type :xy-chart-data
|
||||
:x-value index
|
||||
:y-value y})))}]})
|
||||
|
||||
(renderer)
|
||||
|
||||
(defmethod event-handler ::set-friction [e]
|
||||
(swap! *state assoc :friction (:fx/event e)))
|
||||
|
||||
(defmethod event-handler ::set-gravity [e]
|
||||
(swap! *state assoc :gravity (:fx/event e)))
|
||||
|
||||
(defn slider-view [{:keys [min max value label event]}] ;; add event as arg
|
||||
{:fx/type :v-box
|
||||
:children [{:fx/type :label
|
||||
:text label}
|
||||
{:fx/type :slider
|
||||
:min min
|
||||
:max max
|
||||
:value value
|
||||
:on-value-changed {:event/type event} ;; fire it on value
|
||||
:major-tick-unit max
|
||||
:show-tick-labels true}]})
|
||||
|
||||
(defn root-view [{{:keys [gravity friction]} :state}]
|
||||
{:fx/type :stage
|
||||
:showing true
|
||||
:scene {:fx/type :scene
|
||||
:root {:fx/type :v-box
|
||||
:spacing 20
|
||||
:children [{:fx/type chart-view
|
||||
:gravity gravity
|
||||
:friction friction}
|
||||
{:fx/type :h-box
|
||||
:spacing 10
|
||||
:alignment :center
|
||||
:children [{:fx/type slider-view
|
||||
:min 0
|
||||
:max 100
|
||||
:value gravity
|
||||
:label "Gravity"
|
||||
:event ::set-gravity} ;; provide events
|
||||
{:fx/type slider-view
|
||||
:min 0
|
||||
:max 1
|
||||
:label "Friction"
|
||||
:value friction
|
||||
:event ::set-friction}]}]}}})
|
||||
|
||||
(renderer)
|
||||
|
||||
(swap! *state assoc :gravity 1)
|
||||
|
||||
(defn root-view [{{:keys [gravity friction]} :state}]
|
||||
{:fx/type :stage
|
||||
:showing true
|
||||
:scene {:fx/type :scene
|
||||
:root {:fx/type :v-box
|
||||
:spacing 20
|
||||
:children [{:fx/type chart-view
|
||||
:gravity gravity
|
||||
:friction friction}
|
||||
{:fx/type :h-box
|
||||
:spacing 10
|
||||
:alignment :center
|
||||
:children [{:fx/type slider-view
|
||||
:min 0
|
||||
:max 5 ;; 100 -> 5
|
||||
:value gravity
|
||||
:label "Gravity"
|
||||
:event ::set-gravity}
|
||||
{:fx/type slider-view
|
||||
:min 0
|
||||
:max 1
|
||||
:label "Friction"
|
||||
:value friction
|
||||
:event ::set-friction}]}]}}})
|
||||
|
||||
(renderer)
|
|
@ -3,12 +3,7 @@
|
|||
[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!]])
|
||||
(:import [java.awt Desktop]
|
||||
[java.io File]
|
||||
[java.net URI]
|
||||
[org.commonmark.node Node]
|
||||
[org.commonmark.parser Parser]))
|
||||
[mw-desktop.state :refer [get-state state update-state!]]))
|
||||
|
||||
;; OK, the basic idea here is we have a window divided vertically
|
||||
;; into two panes. The user can drag the division between the panes
|
||||
|
@ -56,6 +51,7 @@
|
|||
;; 'piechart count group by state'
|
||||
;;
|
||||
;; In which case you probably have one graph page per rule.
|
||||
|
||||
(defn- tile-image [{:keys [url]}]
|
||||
{:fx/type :image-view
|
||||
:image {:url url
|
||||
|
@ -83,8 +79,7 @@
|
|||
:children (map (fn [cell]{:fx/type tile-image
|
||||
:tile-pane/alignment :bottom-center
|
||||
:url (resource (format "%s/%s.png" tileset (:state cell)))})
|
||||
(flatten world))
|
||||
}))
|
||||
(flatten world))}))
|
||||
|
||||
(defn root-view [{{:keys [world rules]} :state}]
|
||||
{:fx/type :stage
|
||||
|
@ -94,6 +89,15 @@
|
|||
:items [{:fx.type :scroll-pane
|
||||
:content {:fx/type world-view}}]}}})
|
||||
|
||||
|
||||
(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 event-handler
|
||||
"Multi-method event handler cribbed from e12-interactive-development"
|
||||
:event/type)
|
||||
|
@ -106,4 +110,13 @@
|
|||
:state state}))
|
||||
:opts {:fx.opt/map-event-handler event-handler}))
|
||||
|
||||
(fx/mount-renderer state renderer)
|
||||
(fx/mount-renderer state renderer)
|
||||
|
||||
;; (defn ui
|
||||
;; [_config]
|
||||
;; (update-state! :ui
|
||||
;; (fx/create-app state
|
||||
;; :event-handler event-handler
|
||||
;; :desc-fn (fn [state]
|
||||
;; {:fx/type root-view
|
||||
;; :state state}))))
|
98
src/mw_desktop/io.clj
Normal file
|
@ -0,0 +1,98 @@
|
|||
(ns mw-desktop.io
|
||||
"Handle loading (and, ultimately, saving) files for the MicroWorld desktop
|
||||
app."
|
||||
(:require [clojure.java.io :refer [as-file file input-stream resource]]
|
||||
[clojure.string :refer [split starts-with?]]
|
||||
[mw-desktop.state :refer [update-state!]]
|
||||
[mw-engine.heightmap :refer [apply-heightmap]]
|
||||
[mw-engine.world :refer [world?]]
|
||||
[mw-parser.declarative :refer [compile]]
|
||||
[pantomime.mime :refer [mime-type-of]])
|
||||
(:import [java.net URL]))
|
||||
|
||||
(defn identify-resource
|
||||
"Identify whether `path` represents a file, a resource (preferring the file
|
||||
if both exist) or URL, identify the MIME type of the content, and return a
|
||||
map with keys `:stream` whose value is an open stream on the content and
|
||||
`type` whose value is the MIME type of the content."
|
||||
[path]
|
||||
(let [f (.exists (file path))
|
||||
r (resource path)
|
||||
u (when-not (or f r) (URL. path))
|
||||
p' (cond (and f r) (file path)
|
||||
r r
|
||||
u u
|
||||
:else path)]
|
||||
{:path p'
|
||||
:stream (input-stream p')
|
||||
:type (mime-type-of p')}))
|
||||
|
||||
(defn load-ruleset!
|
||||
"Load a ruleset from `path`, which may be either a file path or a resource
|
||||
path, and should indicate a text file of valid MicroWorld rules.
|
||||
|
||||
Where a file and resource with this `path` both exist, the file is
|
||||
preferred. Updates global state."
|
||||
[path]
|
||||
(update-state!
|
||||
:rules
|
||||
(doall (compile (slurp (:stream (identify-resource path)))))))
|
||||
|
||||
(defn assemble-tile-set
|
||||
"Return a map of image files in the directory at this `dir-path`, keyed by
|
||||
keywords formed from their basename without extension."
|
||||
[dir-path]
|
||||
(let [tiles (file-seq (as-file dir-path))]
|
||||
(into {}
|
||||
(map
|
||||
#(vector
|
||||
(keyword
|
||||
(first
|
||||
(split (.getName %) #"\.")))
|
||||
%)
|
||||
(filter #(starts-with? (mime-type-of %) "image")
|
||||
(remove #(.isDirectory %) tiles))))))
|
||||
|
||||
(defn load-tileset!
|
||||
"Load a tileset from `path`, which may be either a file path or a resource
|
||||
path, and should indicate a directory containing same-size image files.
|
||||
|
||||
Where a file and resource with this `path` both exist, the file is
|
||||
preferred. Updates global state."
|
||||
[path]
|
||||
(let [{p' :path} (identify-resource path)
|
||||
dir-path (as-file p')]
|
||||
(if (.isDirectory dir-path)
|
||||
(update-state! :tileset (assemble-tile-set dir-path))
|
||||
(throw (ex-info "Tileset should be a directory of image files"
|
||||
{:path path
|
||||
:expanded dir-path}))))
|
||||
|
||||
(update-state!
|
||||
:tileset
|
||||
(doall (compile (slurp (:stream (identify-resource path)))))))
|
||||
|
||||
(defn load-world!
|
||||
"Load a world from `path`, which may be either a file path or a resource
|
||||
path, and may indicate either a world file (EDN) or a heightmap (image).
|
||||
|
||||
Where a file and resource with this `path` both exist, the file is
|
||||
preferred. Updates global state."
|
||||
[path]
|
||||
(let [data (identify-resource path)
|
||||
{type :type stream :stream} data
|
||||
world (try (if (starts-with? type "image/")
|
||||
(apply-heightmap stream)
|
||||
(read-string (slurp stream)))
|
||||
(catch Exception any
|
||||
(throw
|
||||
(ex-info
|
||||
(format
|
||||
"Failed to read `%s` as either EDN or heightmap."
|
||||
path)
|
||||
(merge data {:path path})
|
||||
any))))]
|
||||
(if (world? world) (do (update-state! :world world) world)
|
||||
(throw (ex-info "Invalid world file?"
|
||||
(merge data {:path path
|
||||
:data world}))))))
|
|
@ -1,24 +1,14 @@
|
|||
;; lightly adapted from
|
||||
;; https://github.com/cljfx/cljfx/blob/master/examples/e20_markdown_editor.clj
|
||||
(ns mw-desktop.e20-markdown-editor
|
||||
(: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?]])
|
||||
(ns mw-desktop.markdown
|
||||
(:require [cljfx.api :refer [sub-ctx sub-val swap-context]]
|
||||
[clojure.string :refer [join lower-case starts-with?]])
|
||||
(:import [java.awt Desktop]
|
||||
[java.io File]
|
||||
[java.net URI]
|
||||
[org.commonmark.node Node]
|
||||
[org.commonmark.parser Parser]))
|
||||
|
||||
;; does not work any more :(
|
||||
#_(SvgImageLoaderFactory/install (PrimitiveDimensionProvider.))
|
||||
|
||||
(def *context
|
||||
(atom
|
||||
(fx/create-context {:typed-text (slurp (resource "doc/grammar.md"))}
|
||||
#(lru-cache-factory % :threshold 4096))))
|
||||
|
||||
(defn commonmark->clj [^Node node]
|
||||
(let [tag (->> node
|
||||
.getClass
|
||||
|
@ -49,7 +39,7 @@
|
|||
(defn node-sub [context]
|
||||
(-> (Parser/builder)
|
||||
.build
|
||||
(.parse (fx/sub-val context :typed-text))
|
||||
(.parse (sub-val context :typed-text))
|
||||
commonmark->clj))
|
||||
|
||||
(defmulti handle-event :event/type)
|
||||
|
@ -58,7 +48,7 @@
|
|||
(prn e))
|
||||
|
||||
(defmethod handle-event ::type-text [{:keys [fx/event fx/context]}]
|
||||
{:context (fx/swap-context context assoc :typed-text event)})
|
||||
{:context (swap-context context assoc :typed-text event)})
|
||||
|
||||
(defmulti md->fx :tag)
|
||||
|
||||
|
@ -235,38 +225,8 @@
|
|||
{:fx/type md-view
|
||||
:node node})}]})
|
||||
|
||||
(defn note-input [{:keys [fx/context]}]
|
||||
{:fx/type :text-area
|
||||
:style-class "input"
|
||||
:text (fx/sub-val context :typed-text)
|
||||
:on-text-changed {:event/type ::type-text :fx/sync true}})
|
||||
|
||||
(defn note-preview [{:keys [fx/context]}]
|
||||
(defn markdown-view [{:keys [fx/context]}]
|
||||
{:fx/type :scroll-pane
|
||||
:fit-to-width true
|
||||
:content {:fx/type md-view
|
||||
:node (fx/sub-ctx context node-sub)}})
|
||||
|
||||
(def app
|
||||
(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 :grid-pane
|
||||
:padding 10
|
||||
:hgap 10
|
||||
:column-constraints [{:fx/type :column-constraints
|
||||
:percent-width 100/2}
|
||||
{:fx/type :column-constraints
|
||||
:percent-width 100/2}]
|
||||
:row-constraints [{:fx/type :row-constraints
|
||||
:percent-height 100}]
|
||||
:children [{:fx/type note-input
|
||||
:grid-pane/column 0}
|
||||
{:fx/type note-preview
|
||||
:grid-pane/column 1}]}}})))
|
||||
:node (sub-ctx context node-sub)}})
|
|
@ -1,23 +1,24 @@
|
|||
(ns mw-desktop.state
|
||||
"Global state of the application."
|
||||
(:require [mw-engine.utils :refer [member?]]
|
||||
[mw-engine.world :refer [world?]])
|
||||
(:require [mw-engine.world :refer [world?]]
|
||||
[taoensso.timbre :refer [info]])
|
||||
(:import [clojure.lang Keyword]))
|
||||
|
||||
(def valid-states
|
||||
(def valid-statuses
|
||||
#{:init :halted :halt-requested :running})
|
||||
|
||||
(def state
|
||||
"Global state of the application."
|
||||
(atom {:state :init}))
|
||||
(atom {:status :init}))
|
||||
|
||||
(defn get-state [^Keyword key]
|
||||
(@state key))
|
||||
|
||||
(defn await-state
|
||||
"Pause the current process until the global status is in the state `state-value`."
|
||||
[state-value]
|
||||
(while (not= (@state :state) state-value)
|
||||
(defn await-status
|
||||
"Pause the current process until the global status is in the state `status-value`."
|
||||
[status-value]
|
||||
(while (not= (@state :status) status-value)
|
||||
(info "Awaiting status %s" status-value)
|
||||
(Thread/sleep 10000)))
|
||||
|
||||
(defn update-state!
|
||||
|
@ -34,15 +35,16 @@
|
|||
(when (and (:world deltas) (not (world? (:world deltas))))
|
||||
(throw (ex-info "Attempt to set an invalid world"
|
||||
{:deltas deltas
|
||||
:state @state})))
|
||||
;; you can't change either the world or the rules while the engine is computing
|
||||
;; a new status for the world.
|
||||
(when-not (= (@state :state) :init)
|
||||
(when (or (member? (keys deltas) :world)
|
||||
(member? (keys deltas) :rules))
|
||||
(await-state :halted)) )
|
||||
:status @state})))
|
||||
;; you can't change either the world or the rules while the engine is
|
||||
;; computing a new state for the world.
|
||||
(when (and (#{:world :rules} (keys deltas))
|
||||
(#{:running :halt-requested} (@state :status)))
|
||||
(await-status :halted))
|
||||
(swap! state merge deltas)
|
||||
(when (and (= (@state :state) :init)
|
||||
(:world state)
|
||||
(:rules state))
|
||||
(swap! state merge {:state :halted}))))
|
||||
;; if we've got both a world and rules, and we're in state :init, we
|
||||
;; advance to state :halted
|
||||
(when (and (= (@state :status) :init)
|
||||
(:world @state)
|
||||
(:rules @state))
|
||||
(swap! state merge {:status :halted}))))
|
|
@ -1,157 +0,0 @@
|
|||
(ns mw-desktop.swing-ui
|
||||
(:require [clojure.java.io :refer [resource]]
|
||||
[clojure.string :refer [join]]
|
||||
[markdown.core :refer [md-to-html-string]]
|
||||
[mw-desktop.state :refer [get-state update-state!]]
|
||||
[seesaw.core :refer [border-panel editor-pane frame
|
||||
left-right-split menu menu-item menubar native! pack!
|
||||
scrollable separator show! tabbed-panel table text]])
|
||||
(:import [org.htmlcleaner CleanerProperties HtmlCleaner SimpleHtmlSerializer]))
|
||||
|
||||
;; This is probably a dead end. Its performance is terrible; the fxui version looks
|
||||
;; much more promising.
|
||||
|
||||
;; OK, the basic idea here is we have a window divided vertically
|
||||
;; into two panes. The user can drag the division between the panes
|
||||
;; left and right. In the left pane is always the world; in the right, a
|
||||
;; number of pages can be displayed.
|
||||
;;
|
||||
;; 1. Documentation;
|
||||
;; 2. The rule editor;
|
||||
;; 3. The log;
|
||||
;; 4. Data on what states are in use (and how many of each);
|
||||
;; 5. Some way to get data on other properties (for the mutual aid model, we
|
||||
;; want to see how much food in total there is in the world, how much the
|
||||
;; richest centile has, how much the poorest, and how that's changing over
|
||||
;; time; but whether I have the skill to make that something the user can
|
||||
;; configure is another matter).
|
||||
;;
|
||||
;; There is a File menu with options to:
|
||||
;;
|
||||
;; 1. Save the world as an EDN file;
|
||||
;; 2. Load the world from an EDN file;
|
||||
;; 3. Create a world from a height map;
|
||||
;; 4. Load a rules file;
|
||||
;; 5. Save a rules file;
|
||||
;; 4. Load (? or register?) a tile set (probably as a jar file?);
|
||||
;;
|
||||
;; There is a World menu with options to:
|
||||
;;
|
||||
;; 1. Start the world running;
|
||||
;; 2. Pause/Stop the run;
|
||||
;; 3. Select a tile set;
|
||||
;;
|
||||
;; There is a View menu with options to change the display in the right
|
||||
;; hand pane.
|
||||
;;
|
||||
;; 1. The rule editor;
|
||||
;; 2. The documentation;
|
||||
;; 3. Stats displays (but this needs more thought and experimentation)
|
||||
;;
|
||||
;; One thought is I might define new rule language to create graphs and charts.
|
||||
;;
|
||||
;; 'timeseries total food where state is house group by decile'
|
||||
;; 'timeseries total food where state is house, fertility where state is pasture or crop or fallow'
|
||||
;; 'graph fertility by altitude'
|
||||
;; 'barchart fertility by state'
|
||||
;; 'piechart count group by state'
|
||||
;;
|
||||
;; In which case you probably have one graph page per rule.
|
||||
|
||||
(update-state! :world-view (table :model [:columns [{:key :name, :text "Name"} :likes]
|
||||
:rows '[["Bobby" "Laura Palmer"]
|
||||
["Agent Cooper" "Cherry Pie"]
|
||||
{:likes "Laura Palmer" :name "James"}
|
||||
{:name "Big Ed" :likes "Norma Jennings"}]])
|
||||
:rule-editor (text :editable? true
|
||||
:id :rule-editor
|
||||
:multi-line? true
|
||||
:text ";; This is where you will write your rules.")
|
||||
:error-panel (text :editable? false
|
||||
:id :error-panel
|
||||
:foreground "maroon"
|
||||
:multi-line? true
|
||||
:text ";; Errors will be shown here."))
|
||||
|
||||
(defn markdown->html
|
||||
"`md-to-html-string` returns an HTML fragment that `editor-pane` chokes on.
|
||||
This is an attempt to do better. It sort-of works -- produces nice clean
|
||||
HTML -- but the performance of `editor-pane` is still unacceptably poor"
|
||||
[md-text]
|
||||
(let [props (CleanerProperties.)]
|
||||
(.setOmitDoctypeDeclaration props false)
|
||||
(.setOmitDeprecatedTags props true)
|
||||
(.setOmitUnknownTags props true)
|
||||
(.setOmitXmlDeclaration props true)
|
||||
(.getAsString (SimpleHtmlSerializer. props)
|
||||
(.clean (HtmlCleaner. props) (md-to-html-string md-text)))))
|
||||
|
||||
(defn make-multi-view
|
||||
"Make the right hand multi-view panel."
|
||||
[]
|
||||
(tabbed-panel
|
||||
:tabs [{:title "Rules"
|
||||
:content (border-panel
|
||||
:center (scrollable
|
||||
(border-panel
|
||||
:center (get-state :rule-editor)
|
||||
:west (text :columns 4
|
||||
:editable? false
|
||||
:foreground "cornflowerblue"
|
||||
:id :line-numbers
|
||||
:multi-line? true
|
||||
:text (join "\n"
|
||||
(map str (range 1 1000)))
|
||||
:wrap-lines? false)))
|
||||
:south (scrollable
|
||||
(get-state :error-panel)))}
|
||||
{:title "Grammar"
|
||||
:content (scrollable
|
||||
;; the performance of laying out HTML in an editor-pane
|
||||
;; is painful! RTF is better but not good, and unreliable.
|
||||
(editor-pane :editable? false
|
||||
;; :multi-line? true
|
||||
:content-type "text/plain"
|
||||
:text (slurp
|
||||
(resource "doc/grammar.md"))
|
||||
;; :wrap-lines? true
|
||||
))}]))
|
||||
|
||||
(update-state! :multi-view (make-multi-view))
|
||||
|
||||
(defn create-app-window
|
||||
"Create the app window."
|
||||
[]
|
||||
(native!)
|
||||
(update-state! :app-window
|
||||
(pack!
|
||||
(frame :title "MicroWorld"
|
||||
;; :size [600 :by 600]
|
||||
;; :on-close :exit
|
||||
:menubar (menubar
|
||||
:items
|
||||
[(menu :text "World" :items
|
||||
[(menu-item :text "Run World" :enabled? false)
|
||||
(menu-item :text "Halt Run" :enabled? false)
|
||||
(separator)
|
||||
(menu :text "Create World..." :items
|
||||
[(menu-item :text "From Heightmap...")
|
||||
(menu-item :text "From Coordinates...")])
|
||||
(menu-item :text "Load World File...")
|
||||
(menu-item :text "Save World File As...")
|
||||
(separator)
|
||||
(menu-item :text "Import Tile Set...")])
|
||||
(menu :text "Rules" :items
|
||||
[(menu-item :text "New Rule Set")
|
||||
(menu-item :text "Open Rule Set...")
|
||||
(menu-item :text "Save Rule Set")
|
||||
(menu-item :text "Save Rule Set As...")
|
||||
(separator)
|
||||
(menu-item :text "Compile Rules")])
|
||||
(menu :text "Help" :items
|
||||
[(menu-item :text "About MicroWorld")])])
|
||||
:content (left-right-split (scrollable (get-state :world-view))
|
||||
(scrollable (get-state :multi-view))
|
||||
:divider-location 8/10)))))
|
||||
|
||||
(defn show-app-window [] (show! (get-state :app-window)))
|