Files
gitea-docker/desktop/src-common/advent/screens/title.clj
2015-10-07 08:18:11 -07:00

346 lines
15 KiB
Clojure

(ns advent.screens.title
(:require [play-clj.core :refer :all]
[play-clj.math :refer :all]
[play-clj.ui :refer :all]
[play-clj.utils :refer :all]
[play-clj.g2d :refer :all]
[advent.utils :as utils]
[advent.saves :as saves]
[advent.tween :as tween]
[advent.screens.scene :as scene]
[advent.screens.dialogue :as dialogue]
[advent.screens.title :as title]
[advent.screens.inventory :as inventory]
[advent.screens.safe :as safe]
[advent.screens.fade :as fade]
)
(:import [com.badlogic.gdx.graphics Pixmap Pixmap$Filter Texture Texture$TextureFilter]
[com.badlogic.gdx.graphics.g2d TextureRegion]
[com.badlogic.gdx.utils.viewport FitViewport]
[com.badlogic.gdx.scenes.scene2d.ui Slider$SliderStyle]
[com.badlogic.gdx.scenes.scene2d.utils Align]
[com.badlogic.gdx Application Audio Files Game Gdx Graphics Input
InputMultiplexer InputProcessor Net Preferences Screen]))
(defn get-color [e mouse-pos]
(if (utils/intersects? e mouse-pos)
(color :yellow)
(color 1.0 0.3 0.3 1.0)))
(defn style-label [e font mouse-pos]
(when (:interactable e)
(label! e :set-style (style :label font (get-color e mouse-pos))))
e)
(defn style-slider [s mouse-pos]
(if (utils/intersects? s mouse-pos)
(slider! s :set-style (:hover s))
(slider! s :set-style (:default s)))
s)
(defn center [e]
(assoc e :x (- (/ 1280 2) (/ (or (:width e) (.getWidth (:object e))) 2))))
(defn get-dir [old-x new-x]
(if (< old-x new-x)
:right
:left))
(def do-once (atom false))
(defn quit [screen entities]
(do (input! :set-cursor-image (utils/cursor "cursor.png" :hourglass) 0 0)
(-> entities
(assoc-in [:tweens :fade-out]
(tween/tween :fade-out screen [:fade :opacity] 0.0 1.0 1.0
:finish (fn [entities]
(System/exit 0)
entities)
:ease tween/ease-in-cubic)))))
(defn fly-balloon [screen entities]
(let [speed 0.03
pos-f (- (* (:total-time screen) speed) (int (* (:total-time screen) speed)))
v (vector-2 0 0)
a (catmull-rom-spline! (:path (:balloon entities)) :value-at v pos-f)]
(-> entities
(update-in [:balloon]
merge {:x (vector-2! v :x)
:y (vector-2! v :y)}))))
(defn fly-ego [screen entities]
(let [speed 0.07
pos-f (- (* (:total-time screen) speed) (int (* (:total-time screen) speed)))
v (vector-2 0 0)
a (catmull-rom-spline! (:path (:flying-ego entities)) :value-at v pos-f)
direction (get-dir (get-in entities [:flying-ego :x]) (vector-2! v :x))]
(-> entities
(update-in [:flying-ego]
merge {:x (vector-2! v :x)
:y (vector-2! v :y)}
(get-in entities [:flying-ego direction]))
(update-in [:ego-jet]
merge {:x (+ 40 (vector-2! v :x))
:y (vector-2! v :y)}))))
(defn flip [t]
(let [flipped (texture t)]
(texture! flipped :flip true false)
flipped))
(defn quest-label []
(if (:seen-intro? (utils/load-snapshot :autosave))
"Continue quest"
"Begin quest"))
(defn start-playing [screen entities save]
(do (input! :set-cursor-image (utils/cursor "cursor.png" :hourglass) 0 0)
(-> entities
(assoc-in [:tweens :fade-out]
(tween/tween :fade-out screen [:fade :opacity] 0.0 1.0 1.0
:finish (fn [entities]
(utils/stop-sound (:music entities))
(reset! utils/selected-save save)
(set-screen! @(resolve 'advent.core/advent) scene/scene scene/demo scene/hud dialogue/talking-screen dialogue/choice-screen inventory/inventory-screen safe/safe-screen fade/fade-screen
)
entities)
:ease tween/ease-in-cubic))
(assoc-in [:tweens :fade-out-music]
(tween/tween :fade-out-music screen [:volume] 1.0 0.0 1.0)))))
(defn make-label
([msg]
(make-label msg nil))
([msg col]
(let [font (utils/get-font "ego/font.fnt")]
(-> msg
(label (style :label font (or col (color 1.0 0.3 0.3 1.0))))
(assoc :x 0 :y 0 :height 32 :origin-x 0 :origin-y 0 :z 8)
center
(doto (label! :set-alignment Align/center))))))
(defn make-slider [initial-value]
(let [ui-skin (skin "ui/ui.json")]
(->
(slider {:min 0 :max 100 :step 1} ui-skin :set-value initial-value)
(assoc :width 305
:hover (skin! ui-skin :get "default-horizontal-hover" Slider$SliderStyle)
:default (skin! ui-skin :get "default-horizontal" Slider$SliderStyle)
:z 8))))
(defn stack-y [label base index]
(assoc label :y (- base (* 32 index))))
(defn main-menu []
(let [start-playing-label (quest-label)
is-starting? (= "Begin quest" start-playing-label)]
{:start-playing (-> (make-label start-playing-label)
(stack-y 305 0)
(assoc :z 8
:interactable true))
:rewind (-> (make-label "Previous chapter" (when is-starting? (color :white)))
(stack-y 305 1)
(assoc :z 8
:interactable (not is-starting?)))
:music-label (-> (make-label "Music" (color :white))
(stack-y 305 2)
(assoc :z 8))
:music-volume-slider (-> (make-slider (:music-volume @utils/settings))
center
(stack-y 305 3)
(assoc :z 8))
:sound-label (-> (make-label "FX" (color :white))
(stack-y 305 4)
(assoc :z 8))
:sound-volume-slider (-> (make-slider (:sound-volume @utils/settings))
center
(stack-y 305 5)
(assoc :z 8))
:fullscreen (-> (make-label "Fullscreen")
(stack-y 305 6)
(assoc :z 8 :interactable true))
:quit (-> (make-label "End quest")
(stack-y 305 7)
(assoc :z 8 :interactable true))}))
(defn get-selected-save [entities [x y]]
(first (filter
(every-pred :save #(utils/intersects? % [x y]))
(vals entities))))
(defn saves-menu []
(into {:back (-> (make-label "Back")
(stack-y 305 7)
(assoc :z 8
:interactable true))}
(for [[name index] (map #(vector %1 %2)
(utils/snapshot-list) (range))]
[name (-> (make-label name)
(stack-y 305 index)
(assoc :z 8
:interactable true
:save (saves/name->save name)))])))
(defn style-ui [entities]
(doseq [entity (vals entities)
:let [[x y] (:last-pos entities)]
:when (and (:object entity) x y)]
(cond (label? entity)
(style-label entity (get-in entities [:font]) [x y])
(slider? entity)
(style-slider entity [x y])))
entities)
(defscreen title-screen
:on-show
(fn [screen entities]
(utils/setup-viewport screen 1280 960)
(when (utils/has-saved-settings?)
(utils/load-settings!))
(let [font (utils/get-font "ego/font.fnt")
music (utils/make-music "music/intro.ogg")
balloon (utils/make-anim "title/balloon.png" [15 30] 0.45 (range 4))]
(input! :set-cursor-image (utils/cursor "cursor.png" :hourglass) 0 0)
(let [entities {:background (assoc (utils/get-texture "title/background.png" ) :x 0 :y 0 :scale-x 4 :scale-y 4 :origin-x 0 :origin-y 0 :z 0)
:cloud-background (assoc (utils/get-texture "title/clouds.png" ) :x 0 :y 0 :scale-x 4 :scale-y 4 :origin-x 0 :origin-y 0 :z 2)
:logo (assoc (utils/get-texture "title/logo.png" ) :x 0 :y 0 :scale-x 4 :scale-y 4 :origin-x 0 :origin-y 0 :z 6)
:fade (assoc (utils/get-texture "black.png")
:scale-x 80
:scale-y 80
:opacity 1.0
:origin-x 0
:origin-y 0
:z 100)
:flying-ego (assoc (utils/get-texture "ego/flying.png")
:left (flip (utils/get-texture "ego/flying.png"))
:right (utils/get-texture "ego/flying.png")
:scale-x 5
:scale-y 5
:origin-x 2
:origin-y 0
:path (catmull-rom-spline (map #(apply vector-2* %) [[-800 450] [1280 450] [2000 100] [0 100] [-800 300] [1280 300] [2000 450]]) true)
:x 450
:y 650
:z 5)
:balloon (assoc (animation->texture (assoc screen :total-time 0.0) balloon) :x 100 :y 100 :scale-x 4 :scale-y 4
:anim balloon
:path (catmull-rom-spline (map #(apply vector-2* %)
[[50 50] [70 100] [100 200] [151 206] [300 225]
[480 300] [560 400] [650 440] [700 550] [750 600]
[860 650] [950 700] [1030 800] [1280 960] [1300 1000]
[-50 1000] [-50 -50]]) true)
:z 3)
:particle-clouds (assoc (particle-effect "particles/particle-clouds" :reset :start) :x 640 :y 480 :z 1)
:ego-jet (assoc (particle-effect "particles/jet" :reset :start) :x 450 :y 650 :z 4)
:toolbox (-> (assoc (nine-patch {:region (:object (utils/get-texture "talk-bg-2.png")) :left 9 :top 9 :right 9 :bottom 9})
:y 58 :width 500 :height 297
:z 7)
center)
:main-menu (main-menu)
:saves-menu (saves-menu)
:font font
:music music
:volume 1.0
:copyright (make-label "DEMO - Copyright Bryce Covert - Not for distribution")
:tweens {:fade-in (tween/tween :fade-in screen [:fade :opacity] 1.0 0.0 1.0
:finish #(do
(input! :set-cursor-image (utils/cursor "cursor.png" :main) 0 0)
(utils/play-sound (:music %)) %)
:ease tween/ease-in-quadratic)}}
]
(merge entities (:main-menu entities)))))
:on-render
(fn [{:keys [^FitViewport viewport] :as screen} [entities]]
(.apply viewport)
(clear!)
(let [entities (utils/apply-tweens screen entities (:tweens entities))
entities (fly-ego screen entities)
entities (fly-balloon screen entities)
entities (update-in entities [:balloon] merge (animation->texture screen (:anim (:balloon entities))))
entities (style-ui entities)]
(when (:fullscreen entities)
(label! (:fullscreen entities) :set-text (if (.isFullscreen Gdx/graphics)
"Fullscreen"
"Windowed")))
(music! (:music entities) :set-volume (utils/current-music-volume (:volume entities)))
(render! screen (sort-by :z (filter :object (vals entities))) )
entities))
:show-screen (fn [entities]
entities)
:on-mouse-moved (fn [screen [entities]]
(let [[x y] (utils/unproject screen)]
(assoc entities :last-pos [x y])))
:on-touch-dragged (fn [screen [entities]]
(let [[x y] (utils/unproject screen)]
(assoc entities :last-pos [x y])))
:on-key-up
(fn [screen entities]
(when (= (key-code :escape) (:key screen))
(utils/toggle-fullscreen!))
nil)
:on-ui-changed
(fn [screen [entities]]
(swap! utils/settings
assoc
:music-volume (slider! (:music-volume-slider entities) :get-value)
:sound-volume (slider! (:sound-volume-slider entities) :get-value))
(utils/save-settings!)
entities)
:on-touch-up (fn [screen [entities]]
(when-not (get-in entities [:tweens :fade-out])
(let [[x y] (utils/unproject screen)
selected-save (get-selected-save entities [x y])]
(cond
(utils/intersects? (:start-playing entities) [x y])
(start-playing screen entities (if (= "Begin quest" (quest-label))
nil
:autosave))
(and (utils/intersects? (:rewind entities) [x y])
(-> entities :rewind :interactable))
(-> (apply dissoc entities (keys (:main-menu entities)))
(merge (:saves-menu entities)))
(utils/intersects? (:quit entities) [x y])
(quit screen entities)
(utils/intersects? (:fullscreen entities) [x y])
(utils/toggle-fullscreen!)
(and (:back entities) (utils/intersects? (:back entities) [x y]))
(-> (apply dissoc entities (keys (:saves-menu entities)))
(merge (:main-menu entities)))
selected-save
(start-playing screen entities (:save selected-save))
:else
nil))))
:on-resize (fn [{:keys [viewport width height]} [entities]]
(.update viewport width height false)
nil))