not stable yet, but you can use core.async for scripting.

This commit is contained in:
=
2014-09-15 16:26:14 -07:00
parent cf44afc6df
commit a9b5876d1f
3 changed files with 150 additions and 103 deletions

View File

@@ -8,11 +8,6 @@
(terminate [this state])) (terminate [this state]))
(defmacro do-actions [name & forms]
`(vector ~@(for [form forms]
`(fn [~name]
~form))))
(defn talk [action-channel who text] (defn talk [action-channel who text]
(let [c (chan)] (let [c (chan)]
@@ -86,8 +81,7 @@
(defn test-run [] (defn test-run []
(let [state {:x 0 :y 0 :time 0 :items #{} :current-action nil} (let [state {:x 0 :y 0 :time 0 :items #{} :current-action nil}
action-channel (chan) action-channel (chan)
script (run-script state action-channel) script (run-script state action-channel)]
]
(script action-channel) (script action-channel)
(loop [state state (loop [state state
current-action nil current-action nil

View File

@@ -7,10 +7,21 @@
[clojure.string :as s] [clojure.string :as s]
[advent.pathfind] [advent.pathfind]
[advent.actions :as actions] [advent.actions :as actions]
[advent.screens.dialogue :as dialogue]) [advent.screens.dialogue :as dialogue]
[clojure.core.async :refer [put! <! <!! >! >!! chan go thread take! alts!!]])
(:import [com.badlogic.gdx.graphics Pixmap Pixmap$Filter Texture Texture$TextureFilter] (:import [com.badlogic.gdx.graphics Pixmap Pixmap$Filter Texture Texture$TextureFilter]
[com.badlogic.gdx.graphics.g2d TextureRegion])) [com.badlogic.gdx.graphics.g2d TextureRegion]))
(defprotocol IAction
(begin [this screen entities])
(done? [this screen entities])
(continue [this screen entities])
(terminate [this screen entities]))
(defmacro get-script [& forms]
`(fn [action-channel#] (thread ~@forms (put! action-channel# :end))))
(defn jump-to [screen entities entity [x y]] (defn jump-to [screen entities entity [x y]]
(let [scale-fn (-> entities :background :scale-fn) (let [scale-fn (-> entities :background :scale-fn)
entity (assoc entity :x x entity (assoc entity :x x
@@ -34,58 +45,81 @@
(assoc (jump-to screen entities target-entity [(+ moved-x from-x) (+ moved-y from-y)]) (assoc (jump-to screen entities target-entity [(+ moved-x from-x) (+ moved-y from-y)])
:anim (if (< moved-x 0) left right)))))))) :anim (if (< moved-x 0) left right))))))))
(defn stop [target-id] (defn stop [screen entities target-id]
(fn [screen entities] (update-in entities [target-id] #(merge %
(let [target (target-id entities)] {:anim nil}
(run! dialogue/talking-screen :stop-talk :target-id target-id) (when (:anim %)
(assoc-in entities [target-id] (merge target (texture (animation! (:anim %) :get-key-frame 0.25))))))
{:anim nil
:actions (rest (:actions target))}
(when (:anim target)
(texture (animation! (:anim target) :get-key-frame 0.25))))))))
(defn from-path [screen entities target-id [x y]]
(let [entity (target-id entities) (defn walk-to [entities target-id [x y]]
path (vec (take-nth 5 (advent.pathfind/visit-all (let [c (chan)
(:collision (:background entities)) entity (entities target-id)
[(int (:x entity)) (int (:y entity))] path (take-nth 5 (advent.pathfind/visit-all
[(int x) (int y)]))) (:collision (:background entities))
actions (when (seq path) [(int (:x entity)) (int (:y entity))]
(concat [(int x) (int y)]))]
[(stop target-id)] (doseq [[target-x target-y] path]
(map #(walk-to % target-id) (conj path [x y])) (put! (get-in entities [:actions :channel])
[(stop target-id)]))] (reify
actions)) IAction
(begin [this screen entities]
(let [{from-x :x from-y :y :keys [left right anim]} (entities target-id)]
(let [delta-x (- target-x from-x)]
(assoc-in entities [target-id :anim] (if (< delta-x 0) left right)))))
(continue [this screen entities]
(let [{from-x :x from-y :y :keys [left right anim] :as target-entity} (entities target-id)]
(let [delta-x (- target-x from-x)
delta-y (- target-y from-y)
mag (Math/sqrt (+ (* delta-x delta-x) (* delta-y delta-y)))
moved-x (* 1.5 (/ delta-x mag))
moved-y (* 1.5 (/ delta-y mag))]
(assoc entities target-id
(jump-to screen entities target-entity [(+ moved-x from-x) (+ moved-y from-y)])))))
(done? [this screen entities]
(let [{from-x :x from-y :y :keys [left right anim] :as target-entity} (entities target-id)]
(let [delta-x (- target-x from-x)
delta-y (- target-y from-y)
mag (Math/sqrt (+ (* delta-x delta-x) (* delta-y delta-y)))]
(< mag 1))))
(terminate [this screen entities]
(put! c entities)
(stop screen entities target-id)))))
(<!! c)))
(defn get-text-duration [text] (defn get-text-duration [text]
(* (count (s/split text #" ")) 0.75)) (* (count (s/split text #" ")) 0.75))
(defn talk [target-id text] (defn talk [entities target-id text]
;; instead of tracking initial-time in an atom to determine when (let [c (chan)
;; this is done, this should probably be moved into a start and done? initial-time (atom nil)]
;; function for an action (put! (get-in entities [:actions :channel])
(let [initial-time (atom nil)] (reify
(fn [screen entities] IAction
(begin [this screen entities]
(let [_ (swap! initial-time #(or % (:total-time screen)))
(let [ target-y (get-in entities [target-id :y])
begin? (not@initial-time) scale-fn (get-in entities [:background :scale-fn])
_ (swap! initial-time #(or % (:total-time screen))) scale (scale-fn target-y)
target-y (get-in entities [target-id :y]) height (* scale 36)]
scale-fn (get-in entities [:background :scale-fn]) (run! dialogue/talking-screen :on-talk :text text
scale (scale-fn target-y) :x (get-in entities [target-id :x]) :y (+ (get-in entities [target-id :y]) height)
height (* scale 36) :target-id target-id
done? (> (- (:total-time screen) :scale scale)
@initial-time) (assoc-in entities [target-id :anim] (get-in entities [target-id :talk]))))
(get-text-duration text))]
(if done? (continue [this screen entities] entities)
(do
(run! dialogue/talking-screen :stop-talk :target-id target-id) (done? [this screen entities]
(update-in entities [target-id :actions] rest)) (> (- (:total-time screen)
(do @initial-time)
(when begin? (get-text-duration text)))
(run! dialogue/talking-screen :on-talk :text text
:x (get-in entities [target-id :x]) :y (+ (get-in entities [target-id :y]) height) (terminate [this screen entities]
:target-id target-id (put! c entities)
:scale scale)) (run! dialogue/talking-screen :stop-talk :target-id target-id)
(assoc-in entities [target-id :anim] (get-in entities [target-id :talk])))))))) (stop screen entities target-id))))
(<!! c)))

View File

@@ -7,7 +7,8 @@
[advent.pathfind] [advent.pathfind]
[advent.actions :as actions] [advent.actions :as actions]
[advent.zone :as zone] [advent.zone :as zone]
[advent.screens.dialogue :refer [talking-screen]]) [advent.screens.dialogue :refer [talking-screen]]
[clojure.core.async :refer [put! <! <!! >! chan go thread take! alts!!]])
(:import [com.badlogic.gdx.graphics Pixmap Pixmap$Filter Texture Texture$TextureFilter] (:import [com.badlogic.gdx.graphics Pixmap Pixmap$Filter Texture Texture$TextureFilter]
[com.badlogic.gdx.graphics.g2d TextureRegion] [com.badlogic.gdx.graphics.g2d TextureRegion]
[java.lang Object])) [java.lang Object]))
@@ -30,16 +31,18 @@
IInteractable IInteractable
(interact [_ screen entities cursor [x y] ] (interact [_ screen entities cursor [x y] ]
(case cursor (case cursor
:walk (assoc-in entities [:ego :actions] (actions/from-path screen entities :ego [x y])) :walk (actions/get-script
:look (assoc-in entities [:ego :actions] [(actions/stop :ego) (actions/walk-to entities :ego [x y]))
(actions/talk :ego "Looks pretty uninteresting to me.") :look (actions/get-script
(actions/stop :ego)]) (actions/talk entities
:touch (assoc-in entities [:ego :actions] [(actions/stop :ego) :ego
(actions/talk :ego "Can't do anything with it.") "Looks pretty uninteresting to me."))
(actions/stop :ego)]) :touch (actions/get-script
:talk (assoc-in entities [:ego :actions] [(actions/stop :ego) (actions/talk entities :ego
(actions/talk :ego "It's not much of a conversationalist.") "Can't do anything with it."))
(actions/stop :ego)]))))) :talk (actions/get-script
(actions/talk entities :ego
"It's not much of a conversationalist."))))))
(def +next-cursor+ (into {} (map vector [:walk :touch :look :talk] (drop 1 (cycle [:walk :touch :look :talk]))))) (def +next-cursor+ (into {} (map vector [:walk :touch :look :talk] (drop 1 (cycle [:walk :touch :look :talk])))))
@@ -70,12 +73,17 @@
(get-in entities [:background :interactions]))) (get-in entities [:background :interactions])))
current-cursor (get-in entities [:cursor :current]) current-cursor (get-in entities [:cursor :current])
cursor-override (get-in entities [:cursor :override]) cursor-override (get-in entities [:cursor :override])
interacted (or (when cursor-override script (or (when cursor-override
(interact cursor-override screen entities current-cursor [x y])) (interact cursor-override screen entities current-cursor [x y]))
(when interaction (when interaction
(interact interaction screen entities current-cursor [x y])) (interact interaction screen entities current-cursor [x y]))
(interact default-interaction screen entities current-cursor [x y]))] (interact default-interaction screen entities current-cursor [x y]))
interacted)) entities (if-let [current-action (get-in entities [:actions :current])]
(actions/terminate current-action screen entities)
entities)]
(script (get-in entities [:actions :channel]))
entities))
(defn get-ego [screen] (defn get-ego [screen]
(let [player-sheet (texture! (texture "player.png") :split 18 36) (let [player-sheet (texture! (texture "player.png") :split 18 36)
@@ -91,15 +99,22 @@
:origin-x 9 :origin-x 9
:origin-y 0 :origin-y 0
:scaled true :scaled true
:actions []
:x 150 :y 95 :x 150 :y 95
:id "ego"}] :id "ego"}]
(merge (texture (animation! (:right ego) :get-key-frame 0.25)) ego))) (merge (texture (animation! (:right ego) :get-key-frame 0.25)) ego)))
(defn update-ego [screen entities ego] (defn update-from-script [screen {{:keys [current started? channel]} :actions :as entities}]
(if-let [action (first (:actions ego))] (if (= :end current)
(action screen entities) (assoc entities :actions {:channel channel :current nil :started? false})
entities)) (if current
(let [entities (if started? entities (actions/begin current screen entities))
entities (actions/continue current screen entities)]
(if (actions/done? current screen entities)
(assoc (actions/terminate current screen entities)
:actions {:channel channel :current nil :started? false})
(assoc-in entities [:actions :started?] true)))
(let [[current _] (alts!! [channel] :default nil)]
(assoc entities :actions {:channel channel :current current :started? false})))))
(defn scaler-fn-with-baseline [baseline minimum-size & [maximum-size]] (defn scaler-fn-with-baseline [baseline minimum-size & [maximum-size]]
(let [maximum-size (or maximum-size 1.0)] (let [maximum-size (or maximum-size 1.0)]
@@ -126,6 +141,10 @@
;;_ (sound! music :loop) ;;_ (sound! music :loop)
] ]
{ {
:actions {:object nil
:channel (chan)
:current nil
:started? false}
:cursor {:id "cursor" :current :walk } :cursor {:id "cursor" :current :walk }
:sheep (assoc (animation->texture screen sheep) :x 38 :y 160 :baseline 160 :anim sheep) :sheep (assoc (animation->texture screen sheep) :x 38 :y 160 :baseline 160 :anim sheep)
:background (assoc {} :background (assoc {}
@@ -136,8 +155,9 @@
(mouse-in? [_ location] (mouse-in? [_ location]
(apply (zone/box 300 131 320 224) location)) (apply (zone/box 300 131 320 224) location))
IInteractable IInteractable
(interact [_ screen entities _ location] (interact [_ _ entities _ _]
(assoc-in entities [:ego :actions] (actions/from-path screen entities :ego [319 160]))) (actions/get-script
(actions/walk-to entities :ego [319 160])))
ICursorOverridable ICursorOverridable
(cursor-override [_] :right)) (cursor-override [_] :right))
(reify (reify
@@ -145,8 +165,9 @@
(mouse-in? [_ location] (mouse-in? [_ location]
(apply (zone/box 60 180 224 240) location)) (apply (zone/box 60 180 224 240) location))
IInteractable IInteractable
(interact [_ screen entities _ location] (interact [_ _ entities _ _]
(assoc-in entities [:ego :actions] (actions/from-path screen entities :ego [137 204]))) (actions/get-script
(actions/walk-to entities :ego [137 204])))
ICursorOverridable ICursorOverridable
(cursor-override [_] :up)) (cursor-override [_] :up))
(reify (reify
@@ -154,8 +175,9 @@
(mouse-in? [_ location] (mouse-in? [_ location]
(apply (zone/box 0 40 20 140) location)) (apply (zone/box 0 40 20 140) location))
IInteractable IInteractable
(interact [_ screen entities _ location] (interact [_ _ entities _ _]
(assoc-in entities [:ego :actions] (actions/from-path screen entities :ego [0 80]))) (actions/get-script
(actions/walk-to entities :ego [0 80])))
ICursorOverridable ICursorOverridable
(cursor-override [_] :left))] (cursor-override [_] :left))]
:interactions [(reify :interactions [(reify
@@ -163,18 +185,16 @@
(mouse-in? [_ location] (mouse-in? [_ location]
(apply (zone/box 258 100 281 160) location)) (apply (zone/box 258 100 281 160) location))
IInteractable IInteractable
(interact [_ screen entities cursor _] (interact [_ _ entities cursor _]
(case cursor (case cursor
:look :look
(assoc-in entities [:ego :actions] (actions/get-script
[(actions/stop :ego) (actions/talk entities :ego (str "The last time I went through that door, Fangald turned me into a frog.")))
(actions/talk :ego (str "The last time I went through that door, Fangald turned me into a frog."))
(actions/stop :ego)])
:touch :touch
(assoc-in entities [:ego :actions] (concat (actions/get-script
(actions/from-path screen entities :ego [262 88]) (actions/walk-to entities :ego [262 88])
[(actions/talk :ego (str "Anyone home?")) (actions/talk entities :ego (str "Anyone home?")))
(actions/stop :ego)]))
nil))) nil)))
(reify (reify
IMouseIn IMouseIn
@@ -184,14 +204,12 @@
(interact [_ screen entities cursor _] (interact [_ screen entities cursor _]
(case cursor (case cursor
:look :look
(assoc-in entities [:ego :actions] [(actions/stop :ego) (actions/get-script
(actions/talk :ego (str "It's the coolest sword I've ever seen!")) (actions/talk entities :ego (str "It's the coolest sword I've ever seen!")))
(actions/stop :ego)])
:touch :touch
(assoc-in entities [:ego :actions] (concat (actions/get-script
(actions/from-path screen entities :ego [290 66]) (actions/walk-to entities :ego [290 66])
[(actions/talk :ego (str "Maybe I can pull it out.")) (actions/talk entities :ego "Maybe I can pull it out."))
(actions/stop :ego)]))
nil)))] nil)))]
:scale-fn (scaler-fn-with-baseline 110 0.10 1.00) :scale-fn (scaler-fn-with-baseline 110 0.10 1.00)
:layers [(assoc background :x 0 :y 0 :baseline 0) :layers [(assoc background :x 0 :y 0 :baseline 0)
@@ -205,7 +223,8 @@
:on-render :on-render
(fn [screen [entities]] (fn [screen [entities]]
(clear!) (clear!)
(let [entities (update-ego screen entities (:ego entities)) (let [entities (update-from-script screen entities)
_ (label! (:fps entities) :set-text (str (game :fps))) _ (label! (:fps entities) :set-text (str (game :fps)))
entities (if (get-in entities [:sheep :anim]) entities (if (get-in entities [:sheep :anim])