UI modifications, better use of binding
This commit is contained in:
		| @@ -1,16 +1,17 @@ | ||||
| ;; you should be in age-of-sail.core> | ||||
|  | ||||
| (def my-ship (ref {:position [0. 0.] | ||||
|                    :name "Virginia Woolfe" | ||||
| (def virginia-woolfe (ref {:position [0. 0.] | ||||
|                            :name "Virginia Woolfe" | ||||
|                            :heading (normalize [1.0 1.0]) | ||||
|                            :slots [{:type :downwind-sail :length 2 :furl 1.0}] | ||||
|                            :velocity [1. 0.]})) | ||||
|  | ||||
| (def revenge (ref {:position [0. 0.] | ||||
|                    :name "Revenge" | ||||
|                    :heading (normalize [1.0 1.0]) | ||||
|                    :slots [{:type :downwind-sail :length 2 :furl 1.0}] | ||||
|                    :velocity [1. 0.]})) | ||||
|  | ||||
| (reset! ships [my-ship]) | ||||
| (reset! ships [virginia-woolfe revenge]) | ||||
|  | ||||
| (start-program) | ||||
| @my-ship | ||||
| (stop-program) | ||||
|  | ||||
| (show-ui) | ||||
| @tracked-ship | ||||
|   | ||||
| @@ -7,8 +7,10 @@ | ||||
| (def tickrate 100) | ||||
| (def hardcoded-wind [0.1 3.0]) ;; A strong easternly wind! | ||||
| (defonce ships (atom [])) | ||||
| (defonce program (atom nil)) | ||||
|  | ||||
| (defn list-ships | ||||
|   [ships] | ||||
|   (map #(:name @%) ships)) | ||||
| (defn find-ship | ||||
|   [ships name] | ||||
|   (some #(when (= name (:name @%)) %) ships)) | ||||
| @@ -44,39 +46,60 @@ | ||||
|   (doseq [ship ships] | ||||
|     (-> ship (physics-step hardcoded-wind)))) | ||||
|  | ||||
| (defn stop-program | ||||
| ;; Simulation controls | ||||
| (defonce program (atom :stopped)) | ||||
| (defn game-loop | ||||
|   [] | ||||
|   (when @program | ||||
|     (reset! @program false))) | ||||
|   (while (#{:running :paused} @program) | ||||
|     (when (= :running @program) | ||||
|       (tick @ships)) | ||||
|     (Thread/sleep (quot 1000 tickrate))) | ||||
|   (when-not (compare-and-set! program :killed :stopped) | ||||
|     (throw "Error: tried to stop a program that wasn't killed!"))) | ||||
|  | ||||
| (defn pause-program | ||||
|   [] | ||||
|   (compare-and-set! program :running :paused)) | ||||
|  | ||||
| (defn kill-program | ||||
|   [] | ||||
|   (compare-and-set! program :running :paused) | ||||
|   (compare-and-set! program :paused :killed)) | ||||
|  | ||||
| (defn start-program | ||||
|   [] | ||||
|   (stop-program) | ||||
|   (let [thread-continue (atom true)] | ||||
|     (.start | ||||
|      (Thread. | ||||
|       (fn [] | ||||
|         (while @thread-continue | ||||
|           (tick @ships) | ||||
|           (Thread/sleep (quot 1000 tickrate)))))) | ||||
|     (reset! program thread-continue))) | ||||
|   (when (= (first (reset-vals! program :running)) :stopped) | ||||
|     (.start (Thread. game-loop)))) | ||||
|  | ||||
| ;; UI | ||||
| (defn ignore-args | ||||
|   [f] | ||||
|   (fn [& _] (f))) | ||||
|  | ||||
| (def tracked-ship (atom nil)) | ||||
|  | ||||
| (defn ship-start-stop | ||||
| (defn simulation-controls | ||||
|   [] | ||||
|   (letfn [(indicator [running] (if running "Stop" "Start")) | ||||
|           (toggle-prgm [_] (if @@program (stop-program) (start-program)))] | ||||
|     (let [btn (button :text (indicator @@program))] | ||||
|       (b/bind @program (b/transform indicator) (b/property btn :text)) | ||||
|       (listen btn :mouse-clicked toggle-prgm) | ||||
|       btn))) | ||||
|   (let [start-button (button :text "Start" :listen [:mouse-clicked (ignore-args start-program)]) | ||||
|         pause-button (button :text "Pause" :listen [:mouse-clicked (ignore-args pause-program)]) | ||||
|         kill-button (button :text "Kill" :listen [:mouse-clicked (ignore-args kill-program)])] | ||||
|     (letfn [(start-enabled? [state] (contains? #{:stopped :paused} state)) | ||||
|             (pause-enabled? [state] (= :running state)) | ||||
|             (kill-enabled? [state] (contains? #{:running :paused} state))] | ||||
|       (b/bind program (b/tee | ||||
|                        (b/bind (b/transform start-enabled?) (b/property start-button :enabled?)) | ||||
|                        (b/bind (b/transform pause-enabled?) (b/property pause-button :enabled?)) | ||||
|                        (b/bind (b/transform kill-enabled?) (b/property kill-button :enabled?)))) | ||||
|       (config! start-button :enabled? (start-enabled? @program)) | ||||
|       (config! pause-button :enabled? (pause-enabled? @program)) | ||||
|       (config! kill-button :enabled? (kill-enabled? @program)) | ||||
|       (horizontal-panel :items [start-button pause-button kill-button])))) | ||||
|  | ||||
| (defn ship-chooser | ||||
|   [] | ||||
|   (let [name (text :columns 20)] | ||||
|     (b/bind (.getDocument name) (b/transform #(find-ship @ships %)) tracked-ship) | ||||
|   (let [name (combobox :model (list-ships @ships))] | ||||
|     (b/bind ships (b/transform list-ships) (b/property name :model)) | ||||
|     (b/bind (b/selection name) (b/transform #(find-ship @ships %)) tracked-ship) | ||||
|     (flow-panel :items ["Ship Name" name]))) | ||||
|  | ||||
| (defn format-position | ||||
| @@ -96,13 +119,12 @@ | ||||
| (defn show-ui | ||||
|   [] | ||||
|   (let [root (frame :title "Age of Sail" :content (vertical-panel)) | ||||
|         start-stop (ship-start-stop) | ||||
|         chooser (ship-chooser) | ||||
|         info (ship-info)] | ||||
|     (b/bind tracked-ship (b/transform boolean) (b/tee (b/property info :visible?) | ||||
|                                                       (b/b-do [_] (pack! root)))) | ||||
|     (doto root | ||||
|       (add! start-stop) | ||||
|       (add! (simulation-controls)) | ||||
|       (add! chooser) | ||||
|       (add! info) | ||||
|       pack! | ||||
|   | ||||
		Reference in New Issue
	
	Block a user