Files
gitea-docker/desktop/src-common/advent/screens/scene.clj

324 lines
18 KiB
Clojure

(ns advent.screens.scene
(:require [play-clj.core :refer :all]
[play-clj.ui :refer :all]
[play-clj.utils :refer :all]
[play-clj.entities :as entities]
[play-clj.g2d :refer :all]
[clojure.zip :as zip]
[clojure.pprint]
[clojure.java.io :as io]
[advent.pathfind]
[advent.actions :as actions]
[advent.zone :as zone]
[advent.utils :as utils]
[advent.screens.rooms :as rooms]
[advent.screens.items :as items]
[advent.screens.rooms.outside-house :as rooms.outside-house]
[advent.screens.rooms.inside-house :as rooms.inside-house]
[advent.screens.rooms.inside-castle :as rooms.inside-castle]
[advent.screens.rooms.inside-cafeteria :as rooms.inside-cafeteria]
[advent.screens.rooms.inside-antique :as rooms.inside-antique]
[advent.screens.rooms.behind-house :as rooms.behind-house]
[advent.screens.rooms.outside-castle :as rooms.outside-castle]
[advent.screens.rooms.cat-tree :as rooms.cat-tree]
[advent.screens.dialogue :refer [talking-screen]]
[advent.screens.inventory :refer [inventory-screen]]
[clojure.core.async :refer [put! <! <!! >! chan go thread take! alts!!]])
(:import [com.badlogic.gdx.graphics Pixmap Pixmap$Filter Texture Texture$TextureFilter GL20 GL30]
[com.badlogic.gdx.graphics.g2d TextureRegion]
[java.lang Object]
[com.badlogic.gdx Gdx]))
(def default-interaction
{:get-script (fn [cursor [x y]] (if (= :main cursor)
(actions/get-script entities
(actions/walk-to entities :ego [x y] :can-skip? true))
(actions/get-script entities
(actions/talk entities :ego "I don't know what to do with that."))))})
(defn find-override [screen entities [x y]]
(first (filter #(and ((:mouse-in? %) entities x y)
(:cursor %))
(get-in entities [:room :interactions]))))
(defn click-inventory [screen entities]
(if (= (get-in entities [:cursor :current] ) :main)
(do
(screen! inventory-screen :show-screen :items (map (entities :all-items) (get-in entities [:state :inventory])))
(assoc-in entities [:state :active?] false))
(assoc-in entities [:cursor :current] :main)))
(defn left-click [screen entities]
(let [{:keys [x y]} (input->screen screen {:x (:input-x screen) :y (:input-y screen)})]
(if ((:mouse-in? (:inventory entities)) x y)
(click-inventory screen entities)
(let [interaction (first (filter #((:mouse-in? %) entities x y)
(get-in entities [:room :interactions])))
interacting-entity (first (sort-by (comp - :baseline) (filter #(and (:mouse-in? %)
(:get-script %)
((:mouse-in? %) entities x y))
(vals (get-in entities [:room :entities])))))
current-action (get-in entities [:actions :current])
;; TODO - hacky way of resetting queue
entities (if (and current-action (actions/can-skip? current-action screen entities))
(let [terminated-entities (actions/terminate current-action screen entities)]
(do (put! (actions/get-channel current-action) terminated-entities)
(-> terminated-entities
(assoc-in [:actions :current] nil)
(assoc-in [:actions :started?] false))))
(assoc-in entities [:actions :channel] (chan)))]
(if current-action
entities
((or (when interaction
((:get-script interaction) (or (when (:cursor interaction) :main)
(get-in entities [:cursor :current]))
[x y]))
(when interacting-entity
((:get-script interacting-entity) (get-in entities [:cursor :current]) [x y]))
((:get-script default-interaction) (get-in entities [:cursor :current]) [x y])) entities))
entities))))
(defn get-ego [screen start-pos]
(let [player-sheet (texture! (texture "player.png") :split 18 36)
talk-sheet (texture! (texture "ego/talk.png") :split 18 36)
stand-sheet (texture! (texture "ego/stand.png") :split 18 36)
squat-sheet (texture! (texture "ego/squat.png") :split 18 36)
reach-sheet (texture! (texture "ego/reach.png") :split 18 36)
grow-sheet (texture! (texture "ego/grow.png") :split 18 36)
cat-toy-sheet (texture! (texture "ego/cat-toy.png") :split 41 50)
fire-sheet (texture! (texture "ego/fire.png") :split 18 36)
walk-right (animation 0.075 (for [i (range 8)]
(texture (aget player-sheet 0 i))))
stand-anim (animation 0.1 (for [i (flatten [(repeat 6 [(repeat 10 0) (repeat 3 1) (repeat 20 0)]) 3 4 5 5 5 6 5 6 5 6 5 4 3 ])]
(texture (aget stand-sheet 0 i))))
talk-anim (animation 0.2 (for [i (range 8)]
(texture (aget talk-sheet 0 i))))
start-squat (animation 0.05 (for [i [0 1 2 3]]
(texture (aget squat-sheet 0 i))))
end-squat (animation 0.05 (for [i [3 2 1 0]]
(texture (aget squat-sheet 0 i))))
squat-anim (animation 0.05 (for [i [0 1 2 3 3 3 3 3 3 3 3 3 3 3 3 2 1] ]
(texture (aget squat-sheet 0 i))))
reach-anim (animation 0.1 (for [i [0 1 2 3 3 3 3 3 3 2 1 0]]
(texture (aget reach-sheet 0 i))))
cat-toy-anim (animation 0.1 (for [i [0 0 1 1 2 2 3 4 3 2 3 4 3 2 3 4 3 2 3 4 3 2 2 1 1 0 0]]
(texture (aget cat-toy-sheet 0 i))))
fire-1-anim (animation 0.1 (for [i [0 1 2 2 2 3 2 3 2 2 2 1 0]]
(texture (aget fire-sheet 0 i))))
fire-2-anim (animation 0.1 (for [i [0 1 2 2 2 2 3 2 3 2 2 2 4 5 6 7 2 2 2 2 2 2 2 2 1 0]]
(texture (aget fire-sheet 0 i))))
fire-3-anim (animation 0.1 (for [i [0 1 2 2 2 2 3 2 3 2 2 2 4 5 6 7 2 2 2 8 9 10 11 2 2 2 2 2 2 2 2 0]]
(texture (aget fire-sheet 0 i))))
grow (animation 0.1 (for [i [0 1 1 1 1 1 1 1 1 1 1 0 0 0 0 3 0 0 0 0 3 0 0 0 3 3 0 0 0 2 2 0 0 2 0 0 2 0 2 0 2 0 2 0 2 0 2 3 2 3 2 3 2 3 2 4 3 4 3 4 3 4]]
(texture (aget grow-sheet 0 i))))
ego {:right {:walk walk-right
:stand stand-anim
:talk talk-anim
:squat squat-anim
:start-squat start-squat
:end-squat end-squat
:reach reach-anim
:cat-toy cat-toy-anim
:grow grow
[:fire 1] fire-1-anim
[:fire 2] fire-2-anim
[:fire 3] fire-3-anim}
:left {:walk (utils/flip walk-right)
:stand (utils/flip stand-anim)
:talk (utils/flip talk-anim)
:start-squat (utils/flip start-squat)
:end-squat (utils/flip end-squat)
:squat (utils/flip squat-anim)
:reach (utils/flip reach-anim)
:cat-toy (utils/flip cat-toy-anim)
:grow (utils/flip grow)
[:fire 1] (utils/flip fire-1-anim)
[:fire 2] (utils/flip fire-2-anim)
[:fire 3] (utils/flip fire-3-anim)}
:baseline (- 240 (last start-pos))
:facing :right
:origin-x 9
:origin-y 0
:scaled true
:mouse-in? (fn [entities x y]
(let [{entity-x :x entity-y :y region :object scale :scale-x} (get-in entities [:room :entities :ego])
half-width (/ (* (.getRegionWidth region) (or scale 1.0)) 2)
height (* (.getRegionHeight region) (or scale 1.0))]
#_(clojure.pprint/pprint [["point" x y]
["entity " (- entity-x half-width) entity-y (+ entity-x half-width) (+ entity-y height)]])
((zone/box (- entity-x half-width) entity-y (+ entity-x half-width) (+ entity-y height)) x y)))
:get-script (fn [cursor [x y]]
(condp = (:value cursor)
:flask-1-with-cream-of-mushroom (actions/get-script entities (actions/talk entities :ego "Blegh! Gross!"))
:flask-1-strength (actions/get-script entities
(actions/talk entities :ego "I'll just take a sip!")
(actions/play-animation entities :ego :grow :stop? false))
:recipe (actions/get-script entities (actions/do-dialogue entities
:ego "The recipe says:"
:ego "'For strength beyond measure,'"
:ego "'you must mix, at your leisure:'"
:ego "'1. Cream of mushroom soup.'"
:ego "'2. Saliva of the creature whose strength you want to match.'"
:ego "'A word of warning, before you go.'"
:ego "'A sip is all it takes to grow.'"
:ego "'Not more than that do drink,'"
:ego "'Or you'll push your body to the brink.'"))
nil))
:x (first start-pos) :y (last start-pos)
:id "ego"}]
(actions/start-animation screen
(merge (animation->texture screen (:stand (:right ego))) ego)
:stand)))
(defn update-from-script [screen {{:keys [current started? channel]} :actions :as 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)
(let [terminated (actions/terminate current screen entities)]
(put! (actions/get-channel current) terminated)
(recur screen (assoc terminated
: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 update-cursor [screen {{:keys [current override last]} :cursor :as entities}]
(let [new-current (or override current)]
(when-not (= new-current
last)
(input! :set-cursor-image (utils/cursor "cursor.png" (or (:cursor new-current) new-current)) 0 0))
(assoc-in entities [:cursor :last] new-current)))
(defn animate [entity screen]
(merge entity (animation->texture (update-in screen [:total-time] #(- % (:anim-start entity)))
(:anim entity))))
(defn play-sound [snd]
(music! snd :play))
(defn stop-sound [snd]
(music! snd :stop))
(defn make-music [r]
(doto (music r) (music! :set-looping true)))
(defn get-state []
(if (.exists (io/file "save.edn"))
(utils/load)
{:object nil
:active? true
:last-room :outside-house
:obtained-items #{}
:inventory []
:clues #{}
:mints-eaten 0}))
(defscreen scene
:on-show
(fn [screen entities]
(let [screen (assoc screen :total-time 0)]
(update! screen :renderer (stage) :camera (orthographic))
(let [_ (input! :set-cursor-image (utils/cursor "cursor.png" :main) 0 0)
rooms {:inside-house (rooms.inside-house/make screen)
:outside-house (rooms.outside-house/make screen)
:behind-house (rooms.behind-house/make screen)
:cat-tree (rooms.cat-tree/make screen)
:inside-castle (rooms.inside-castle/make screen)
:inside-cafeteria (rooms.inside-cafeteria/make screen)
:inside-antique (rooms.inside-antique/make screen)
:outside-castle (rooms.outside-castle/make screen)}
entities {:rooms rooms
:musics {:object nil
:inside-antique (make-music "inside-antique.ogg")
:town-1 (make-music "town-music-1.ogg")
:town-2 (doto (make-music "town-music-2.ogg") play-sound)
:inside-fangald (make-music "inside-fangald.ogg")}
:state (get-state)
:actions {:object nil
:channel (chan)
:current nil
:started? false}
:cursor {:id "cursor"
:current :main
:last :main
:override nil}
:all-items (assoc items/items :object nil)
:room (as-> (get rooms (:last-room (get-state))) room
(assoc-in room [:entities :ego] (get-ego screen (:start-pos room))))
:inventory (assoc (texture "inventory.png") :x 278 :y 0 :baseline 9000
:mouse-in? (zone/box 278 0 320 42))
:fps (assoc (label "0" (color :white) ) :x 5 :baseline 0)}]
(if-let [apply-state (get-in entities [:room :apply-state])]
(apply-state entities)
entities))))
:on-render
(fn [screen [entities]]
(clear!)
(let [entities (update-cursor screen entities)
entities (update-from-script screen entities)
entities (update-in entities [:room :entities] (fn [entities]
(into entities
(for [[id entity] entities]
(if (:anim entity)
[id (animate entity screen)]
[id entity])))))
entities (update-in entities [:room :entities] (fn [entities]
(into entities
(for [[id entity] entities]
(if (:update-fn entity)
[id ((:update-fn entity) screen entities entity)]
[id entity])))))
all-entities (concat (vals entities) (get-in entities [:room :layers]) (vals (get-in entities [:room :entities])))]
(label! (:fps entities) :set-text (str (game :fps)))
(render! screen (sort-by :baseline all-entities))
entities))
:on-resize (fn [screen entities]
(size! screen 320 240))
:on-hide (fn [screen [entities]]
(doseq [snd (->> (get-in entities [:musics])
vals
(filter identity))]
(stop-sound snd)))
:on-mouse-moved
(fn [screen [entities]]
(when (get-in entities [:state :active?])
(let [{:keys [x y]} (input->screen screen {:x (:input-x screen) :y (:input-y screen)})]
(if-let [mouse-override (find-override screen entities [x y])]
(assoc-in entities [:cursor :override] (:cursor mouse-override))
(assoc-in entities [:cursor :override] nil)))))
:on-touch-up (fn [screen [entities]]
(when (get-in entities [:state :active?])
(if (= (button-code :right)
(:button screen))
(assoc-in entities [:cursor :current] :main)
(left-click screen entities))))
:on-deactivate (fn [screen [entities]]
(assoc-in entities [:state :active?] false))
:on-reactivate (fn [screen [entities]]
(assoc-in entities [:state :active?] true))
:on-chose-item (fn [{:keys [item]} [entities]]
(assoc-in entities [:cursor :current] item))
:on-start-script (fn [{:keys [script]} [entities]]
(script entities)
entities))