Files
gitea-docker/desktop/src-common/advent/actions.clj

153 lines
5.9 KiB
Clojure

(ns advent.actions
(:require [play-clj.core :refer :all]
[play-clj.ui :refer :all]
[play-clj.utils :refer :all]
[play-clj.g2d :refer :all]
[clojure.pprint]
[clojure.string :as s]
[advent.pathfind]
[advent.actions :as actions]
[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]
[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 )))
(defn jump-to [screen entities entity [x y]]
(let [scale-fn (-> entities :background :scale-fn)
entity (assoc entity :x x
:y y
:baseline (- 240 y))]
(if (:scaled entity)
(assoc entity :scale-x (scale-fn y) :scale-y (scale-fn y))
entity)))
(defn stop [screen entities target-id]
(update-in entities [target-id] #(merge %
{:anim nil}
(when (:anim %)
(texture (animation! (:anim %) :get-key-frame 0.25))))))
(defn dist [x1 y1 x2 y2]
(let [dx (- x1 x2)
dy (- y1 y2)]
(Math/sqrt (+ (* dx dx) (* dy dy)))))
(defn walk-to [entities target-id [final-x final-y]]
(let [c (chan)
{start-x :x start-y :y} (entities target-id)
final-x (int final-x)
final-y (int final-y)
path (vec (take-nth 5 (advent.pathfind/visit-all
(:collision (:background entities))
[(int start-x) (int start-y)]
[final-x final-y])))
path (if (seq path)
(conj path [final-x final-y])
[])
targets-left (atom path)]
(if (seq path)
(do
(put! (get-in entities [:actions :channel])
(reify
IAction
(begin [this screen entities]
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] :as target-entity} (entities target-id)
[[target-x target-y] remainder] @targets-left]
(let [delta-x (- target-x from-x)
delta-y (- target-y from-y)
distance (dist from-x from-y target-x target-y)
moved-x (* 1.5 (/ delta-x distance))
moved-y (* 1.5 (/ delta-y distance))]
(if (< distance 1)
(do (swap! targets-left rest)
entities)
(update-in entities [target-id]
#(assoc (jump-to screen entities % [(+ moved-x from-x) (+ moved-y from-y)])
:anim (cond (< delta-x 0) left
(> delta-x 0) right
:else (:anim %))))))))
(done? [this screen entities]
(let [{from-x :x from-y :y :keys [left right anim] :as target-entity} (entities target-id)]
(< (dist final-x final-y from-x from-y) 1)))
(terminate [this screen entities]
(let [entities (stop screen entities target-id)]
(put! c entities)
entities))))
(<!! c))
entities)))
(defn get-text-duration [text]
(* (count (s/split text #" ")) 0.75))
(defn talk [entities target-id text]
(let [c (chan)
initial-time (atom nil)]
(put! (get-in entities [:actions :channel])
(reify
IAction
(begin [this screen entities]
(let [_ (swap! initial-time #(or % (:total-time screen)))
target-y (get-in entities [target-id :y])
scale-fn (get-in entities [:background :scale-fn])
scale (scale-fn target-y)
height (* scale 36)]
(run! dialogue/talking-screen :on-talk :text text
:x (get-in entities [target-id :x]) :y (+ (get-in entities [target-id :y]) height)
:target-id target-id
:scale scale)
(assoc-in entities [target-id :anim] (get-in entities [target-id :talk]))))
(continue [this screen entities] entities)
(done? [this screen entities]
(> (- (:total-time screen)
@initial-time)
(get-text-duration text)))
(terminate [this screen entities]
(put! c entities)
(run! dialogue/talking-screen :stop-talk :target-id target-id)
(stop screen entities target-id))))
(<!! c)))
(defn give [entities target-id item]
(let [c (chan)]
(put! (get-in entities [:actions :channel])
(reify
IAction
(begin [this screen entities]
(sound! (sound "pickup.mp3") :play)
(-> entities
(update-in [target-id :inventory] #(conj % item))
(assoc-in [:cursor :current] item)))
(continue [this screen entities] entities)
(done? [this screen entities]
true)
(terminate [this screen entities]
(put! c entities)
entities)))
(<!! c)))