Skip to content

Instantly share code, notes, and snippets.

@selfsame
Created August 8, 2016 02:00
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save selfsame/5fd6ef4876d14d8722cf05ec89c63313 to your computer and use it in GitHub Desktop.
Save selfsame/5fd6ef4876d14d8722cf05ec89c63313 to your computer and use it in GitHub Desktop.
(ns game.core
(:use
arcadia.core
arcadia.linear
tween.core
hard.core
hard.input
pdfn.core))
(declare fire-bullet make-level)
(def orbit-height 2.0)
(def speed 0.5)
(def bullet-speed 2.0)
(defn from-to-rotation [from to]
(UnityEngine.Quaternion/FromToRotation from to))
(defn set-rotation! [a b]
(set! (.rotation (.transform a)) (.rotation (.transform b))))
(defn planet? [o] (re-find #"planet" (.name o)))
(defn ->data-haver [o]
(when o
(try
(or ({{} nil} (state o) o)
(->data-haver (parent o)))
(catch Exception e nil))))
(defn ship-keys [o]
(cond
(key? "a") (rotate! o (v3 0 -1.8 0))
(key? "d") (rotate! o (v3 0 1.8 0))))
(defn constrain-to-planet [o]
(let [o-speed (or (state o :speed) 0.2)
ray (Ray. (->v3 o) (local-direction o (v3 0 -1 0)))
hits (ray-hits ray)
hit (first (filter #(planet? (->go (.collider %))) hits))]
(when hit
(let [pos-lerp-rat (+ 0.05 (* 0.5 0.5 0.5 0.5 0.5 o-speed))
rot-lerp-rat (+ 0.12 (* 0.5 0.5 0.5 0.5 0.5 o-speed))
norm-ray (Ray. (.point hit) (.normal hit))
orbit-point (.GetPoint norm-ray orbit-height)
fwd (.forward (.transform o))
ship-rotation (.rotation (.transform o))
good-quat
(Quaternion/LookRotation
(v3- fwd
(v3* (.normal hit)
(Vector3/Dot fwd (.normal hit))))
(.normal hit))
target-rotation (from-to-rotation (Vector3/up) (.normal hit))]
(set! (.rotation (.transform o))
(Quaternion/Lerp ship-rotation good-quat rot-lerp-rat))
(set! (.position (.transform o))
(lerp o orbit-point pos-lerp-rat)) ))))
(defn move [o]
(let [sp (or (state o :speed) speed)
last-pos (or (state o :last-pos) (->v3 o))
desired (v3+ (->v3 o) (local-direction o (v3 sp 0 0)))
crv-mod (- sp (.magnitude (v3- desired last-pos)))
fixed (v3+ (->v3 o) (local-direction o (v3 (+ sp crv-mod) 0 0)))]
(position! o fixed)
#_(if (= "ship" (.name o))
(log (- sp (.magnitude (v3- desired last-pos)))))
(set-state! o :last-pos (->v3 o))))
(defn update-ship [o]
(constrain-to-planet o)
(ship-keys o)
(move o))
(defn update-bullet [o]
(constrain-to-planet o)
(move o))
(defn splode
([p] (splode p 1))
([p bigness]
(dorun (for [i (range (or bigness 5))
:let [rp (v3+ (->v3 p) (?sphere 2.0))
fire (clone! :fire (->v3 p))]]
(do
(set! (.rotation (.transform fire)) (?rotation))
(set! (.localScale (.transform fire)) (v3 0.2))
(timeline*
(tween {
:local {:scale (v3 2.0 2.0 2.0)
:position rp}
:material {:color (color 1 0 0)}} fire 0.4 :pow3)
;(wait (?f 0 0.2))
(tween {:local {
:scale (v3 0)}} fire 0.4 :pow3)
#(do (destroy! fire) nil)))))))
(defpdfn die)
(pdfn die [a as]
(timeline*
(tween {:local {:scale (v3 0)}} a 0.5)
#(destroy! a)))
(pdfn die [a ^:ship as] (make-level))
(defpdfn trigger-dispatch)
(pdfn trigger-dispatch [a as b bs] (log [as bs]))
(pdfn trigger-dispatch [a ^:damage as b ^:hp bs]
(splode a (int (* 0.1 (state a :damage))))
(update-state! b :hp #(- % (state a :damage)))
(destroy! a)
(if (neg? (state b :hp))
(die b bs)))
(pdfn trigger-dispatch [a ^:ship as b ^:obstacle bs]
(make-level))
(defn on-trigger [o c]
(let [other (.gameObject c)
[a b] (mapv ->data-haver [o other])]
(trigger-dispatch a (state a) b (state b))))
;(set-state! (the obstacle) :obstacle true)
(defn fire-bullet [o]
(let [bullet (clone! :bullet (v3+ (->v3 o) (local-direction o (v3 4 0 0))))]
(set! (.rotation (.transform bullet)) (.rotation (.transform o)))
(set-state! bullet :speed bullet-speed)
(set-state! bullet :bullet true)
(set-state! bullet :damage 20)
(hook+ bullet :update #'game.core/update-bullet)
(hook+ (first (children bullet)) :on-trigger-enter #'game.core/on-trigger)
(timeline*
(wait 10.0)
(tween {:local {:scale (v3 0 0 0)}} bullet 0.6)
#(destroy! bullet))))
(defn update-hud [o]
(let [health-rect-tform (cmpt (the health-bar) UnityEngine.RectTransform)]
(set! (.sizeDelta health-rect-tform) (v2 (state o :hp) 17))))
(defn update-camera [o]
(let [target (the cam-target)]
(position! o (lerp (->v3 o) (->v3 target) 0.1))
(set! (.rotation (.transform o))
(Quaternion/Lerp (.rotation (.transform o))
(.rotation (.transform target))
0.15))))
(defn populate-level []
(let [obstacles (every obstacle-spawn)]
(mapv
#(let [ob (clone! :obstacle (->v3 %))]
(set-rotation! ob %))
obstacles)
nil))
(defn make-level []
(clear-cloned!)
(clone! :sun1)
(clone! :sun2)
(clone! :EventSystem)
(clone! :Canvas)
(let [p (clone! :planet3)
spawn (first (children p))
s (clone! :ship (->v3 spawn))
cam (clone! :camera)]
(set-rotation! s spawn)
(set-state! s :speed speed)
(set-state! s :ship true)
(set-state! s :hp 200)
(set-state! s :max-hp 200)
(timeline* (wait 0.0) #(populate-level))
(timeline* :loop
#(if (key? "space")
(do (fire-bullet s) false)
true)
(wait 0.2))
(hook+ s :update #'game.core/update-ship)
(hook+ s :update #'game.core/update-hud)
(hook+ cam :update #'game.core/update-camera)
(hook+ s :on-trigger-enter #'game.core/on-trigger)))
(make-level)
;TODO
'([x] camera system)
'([x] collisions
([x] collision dispatch pdfn)
([x] generic :hp :bullet method))
'([ ] planetoid spawn points #{:obstacle :enemy}
([ ] generated spawn points?))
'([ ] fix planetoid constraints
([ ] step algo based on speed))
'([ ] enemy types)
'([ ] menu)
'([ ] HUD
([x] lifebar)
([ ] :score :level-time :enemies-left))
'([ ] sfx
([ ] game events)
([ ] music))
@selfsame
Copy link
Author

selfsame commented Aug 9, 2016

(ns game.core
  (:use
    arcadia.core
    arcadia.linear
    tween.core
    hard.core
    hard.input
    hard.mesh
    hard.physics
    pdfn.core
    clojure.pprint))


(def LEVELS 
  (atom (try (read-string (slurp "levels.edn")) 
             (catch Exception e {}))))

(def edit-obj (atom :ball-spawn))

(declare fire-bullet make-level)

(def status (atom "dev"))

(defn status! 
  ([] (status! @status))
  ([s] (when-let [ui (the status)] 
    (set! (.* ui>Text.text) (str "status: " (reset! status s))))))


(def orbit-height 2.0)
(def speed        0.5)
(def bullet-speed 2.0)

(defn from-to-rotation [from to]
  (UnityEngine.Quaternion/FromToRotation from to))

(defn set-rotation! [a b] 
  (set! (.rotation (.transform a)) (.rotation (.transform b))))

(defn planet? [o] (re-find #"planet" (.name o)))

(defn ->data-haver [o]
  (when o 
    (try 
      (or ({{} nil} (state o) o)
          (->data-haver (parent o)))
      (catch Exception e nil))))

(defn ship-keys [o]
  (if (key? "a") (rotate! o (v3 0 -1.8 0)))
  (if (key? "d") (rotate! o (v3 0 1.8 0)))
  (if (key? "w") (update-state! o :speed #(min (state o :max-speed) (+ % 0.1))))
  (if (key? "s") (update-state! o :speed #(max 0 (- % 0.1)))))


(defn constrain-to-planet [o]
  (let [o-speed (or (state o :speed) 0.2)
        ray (Ray. (->v3 o) (local-direction o (v3 0 -1 0)))
        hits (ray-hits ray)
        hit (first (filter #(planet? (->go (.collider %))) hits))]
    (when hit 
      (let [pos-lerp-rat  (+ 0.05 (* 0.5 0.5 0.5 0.5 0.5 o-speed))
            rot-lerp-rat  (+ 0.12 (* 0.5 0.5 0.5 0.5 0.5 o-speed))
            norm-ray      (Ray. (.point hit) (.normal hit))
            orbit-point   (.GetPoint norm-ray orbit-height)
            fwd           (.forward (.transform o))
            ship-rotation (.rotation (.transform o))
            good-quat 
            (Quaternion/LookRotation 
              (v3- fwd 
                   (v3* (.normal hit) 
                        (Vector3/Dot fwd (.normal hit)))) 
              (.normal hit))
            target-rotation (from-to-rotation (Vector3/up) (.normal hit))] 
        (set! (.rotation (.transform o)) 
              (Quaternion/Lerp ship-rotation good-quat rot-lerp-rat))
        (set! (.position (.transform o)) 
              (lerp o orbit-point pos-lerp-rat)) ))))  

(defn move [o]
  (let [sp       (or (state o :speed) speed)
        last-pos (or (state o :last-pos) (->v3 o))
        desired  (v3+ (->v3 o) (local-direction o (v3 sp 0 0)))
        crv-mod  (- sp (.magnitude (v3- desired last-pos)))
        fixed    (v3+ (->v3 o) (local-direction o (v3 (+ sp crv-mod) 0 0)))]
    (position! o fixed)
    #_(if (= "ship" (.name o)) 
      (log (- sp (.magnitude (v3- desired last-pos)))))
    (set-state! o :last-pos (->v3 o))))

(defn update-ship [o]
  (constrain-to-planet o)
  (ship-keys o)
  (move o))

(defn update-bullet [o]
  (constrain-to-planet o)
  (move o))

(defn splode 
  ([p] (splode p 1))
  ([p bigness]
    (dorun (for [i (range (or bigness 5))
                 :let [rp (v3+ (->v3 p) (?sphere 2.0))
                       fire (clone! :fire (->v3 p))]]
      (do 
        (set! (.rotation (.transform fire)) (?rotation))
        (set! (.localScale (.transform fire)) (v3 0.2))
        (timeline* 
          (tween {
            :local {:scale (v3 2.0 2.0 2.0)
                    :position rp}
            :material {:color (color 1 0 0)}} fire 0.4 :pow3)
          ;(wait (?f 0 0.2))
          (tween {:local {
            :scale (v3 0)}}     fire  0.4 :pow3)
          #(do (destroy! fire) nil)))))))

(defpdfn die)
(pdfn die [a as] 
  (timeline* 
    (tween {:local {:scale (v3 0)}} a 0.5)
    #(destroy! a)))
(pdfn die [a ^:ship as] (make-level))


(defpdfn trigger-dispatch)
(pdfn trigger-dispatch [a as b bs] (log [(.name a) (.name b)]))
(pdfn trigger-dispatch [a ^:damage as b ^:hp bs]
  (splode a (int (* 0.1 (state a :damage))))
  (update-state! b :hp #(- % (state a :damage)))
  (destroy! a)
  (if (neg? (state b :hp))
      (die b bs)))

(pdfn trigger-dispatch [a ^:ship as b ^:obstacle bs]
  (make-level))

(defn on-trigger [o c]
  (let [other (.gameObject c)
        [a b] (mapv ->data-haver [o other])]
    (trigger-dispatch a (state a) b (state b))))


;(set-state! (the obstacle) :obstacle true)

(defn fire-bullet [o]
  (let [bullet (clone! :bullet (v3+ (->v3 o) (local-direction o (v3 4 0 0))))]
    (set! (.rotation (.transform bullet)) (.rotation (.transform o)))
    (set-state! bullet :speed bullet-speed)
    (set-state! bullet :bullet true)
    (set-state! bullet :damage 20)
    (hook+ bullet :update #'game.core/update-bullet)
    (hook+ (first (children bullet)) :on-trigger-enter #'game.core/on-trigger)
    (timeline*
      (wait 10.0)
      (tween {:local {:scale (v3 0 0 0)}} bullet 0.6)
      #(destroy! bullet))))

(defn update-hud [o]
  (let [health-rect-tform (cmpt (the health-bar) UnityEngine.RectTransform)]
    (set! (.sizeDelta health-rect-tform)  (v2 (state o :hp) 17))))

(defn update-camera [o]
  (let [target (the cam-target)]
    (position! o (lerp (->v3 o) (->v3 target) 0.2))
    (set! (.rotation (.transform o)) 
          (Quaternion/Lerp (.rotation (.transform o)) 
                           (.rotation (.transform target)) 
                           0.15))))



(defn populate-level []
  (status!)
  (let [planet (the #"planet.*")
        pk (keyword (.name planet))
        level (get @LEVELS pk)]
    (mapv 
      (fn [o]
        (set! 
          (.rotation (.transform 
            (parent! (clone! (:type o) (:position o)) planet))) 
          (:rotation o)))
      level)
    nil))


(defn make-level []
  (clear-cloned!)
  (clone! :sun1)
  (clone! :sun2)
  (clone! :EventSystem)
  (clone! :Canvas)
  (let [p (clone! :planet3)
        spawn (first (children p))
        s (clone! :ship (->v3 spawn))
        cam (clone! :camera)] 
  (set-rotation! s spawn)
  (set-state! s :speed 0.5)
  (set-state! s :max-speed 1.0)
  (set-state! s :ship true)
  (set-state! s :hp 200)
  (set-state! s :max-hp 200)
  (timeline* (wait 0.0) #(populate-level))
  (timeline* :loop 
    #(if (key? "space")
         (do (fire-bullet s) false)
         true)
    (wait 0.2))
  (hook+ s :update #'game.core/update-ship)
  (hook+ s :update #'game.core/update-hud)
  (hook+ cam :update #'game.core/update-camera)
  (hook+ cam :on-draw-gizmos #'game.core/mouse-gizmos)
  (hook+ cam :update #'game.core/update-mouse)
  (hook+ s :on-trigger-enter #'game.core/on-trigger)))





(defn save-planet []
  (let [planet (the #"planet.*")
        pk (keyword (.name planet))]
    (spit "levels.edn" 
      (prn-str
        (swap! LEVELS assoc pk
          (mapv 
            (fn [o] {
              :type (keyword (.name o))
              :position (->v3 o)
              :rotation (.* o>Transform.rotation)})
            (remove 
              (comp #{"spawn"} (prop* name))
              (children planet))))))
    (log ['saved pk (count (get @LEVELS pk))])))

(defn planet-hit [ray]
  (let [hits (ray-hits ray)]
    (first (filter #(planet? (->go (.collider %))) hits))))

(defn update-mouse [o]
  (cond 
    (key-down? "escape") (make-level)
    (key-down? "p") (save-planet))
  (when (mouse-down?) 
    (when-let [hit (planet-hit (mouse-ray))]
      (let [planet (->go (.collider hit))
            spawn (clone! @edit-obj (.point hit))] 
        (set! 
          (.rotation (.transform spawn)) 
          (Quaternion/LookRotation (.normal hit)))
        (rotate! spawn (v3 90 0 0))
        (parent! spawn planet)))))

(defn mouse-gizmos [o]
  (when-let [hit (planet-hit (mouse-ray))]
    (gizmo-color (color 1 0 1))
    (gizmo-point (.point hit) 1.0)
    (gizmo-ray (.point hit) (v3* (.normal hit) 3))))




(status! "alt gravity")

(make-level)

(defn inverse-hit-point+ [a b]
  (.point b))

(def radar-v3s
  (vertices (resource "icosphere42")))

(defn v3->clamped-force! [o v lb ub]
  (apply force! 
    (cons (->rigidbody o)
      (map #(Mathf/Clamp % lb ub)
        [(.x v)(.y v)(.z v)]))))

(defn ball-update [o]
  (let [pos (->v3 o)
    hits 
    (vec (remove nil? 
        (for [v radar-v3s]
          (planet-hit (Ray. pos v)))))
    points (map (prop* point) hits)
    rel-points (map #(v3- % pos ) points)
    inverse-points (map 
      #(v3* (.normalized %) 
            (pow2  (/ 8 (+ 1 (Mathf/Log (.magnitude %)))))) rel-points)

    gravity (v3div (reduce v3+ inverse-points) (count points)) ]
    (set-state! o :gravity gravity)

    (set! (.velocity (->rigidbody o)) 
      (clamp-v3  
        (v3+ (->velocity o)
            gravity) 
        -20 20))
    (torque! (->rigidbody o) 0 0 60 )
    ))

(defn ball-gizmos [o]
  (let [pos (->v3 o)]
    (gizmo-color (color 1 0 0))
    (gizmo-ray pos (v3* (state o :gravity) 10))

    #_(gizmo-color (color 1 1 1 0.1))
    #_(mapv 
      #(gizmo-line pos (.point %))
      sorted-hits)
    ;(gizmo-color (color 1 0 1 0.1))
    #_(mapv 
      #(gizmo-line pos (v3+ pos %))
      (map first (partition 2 inverse-points))) ))

(defn ball-test [v]
  (let [ball (clone! :ball v)]
    (set-state! ball :gravity (v3 0))
    (set-state! ball :gravity (v3 0))
    (hook+ ball :update #'game.core/ball-update)
    ;(hook+ ball :on-draw-gizmos #'game.core/ball-gizmos)
    ball))

(defn init-ball [o]
  (let [sc (?f 2.0 8.0)
        ball (ball-test (v3+ (->v3 o) (local-direction o (->v3 0 (* sc 0.5) 0))))]
    (local-scale! ball (v3 sc))
    (set! (.rotation (.transform ball)) (.rotation (.transform o)))))

(make-level)
'(ball-test)
'done

;(hook+ (the ball-spawn) :start #'game.core/init-ball)

;TODO
'([x] camera system)
'([x] collisions
  ([x] collision dispatch pdfn)
  ([x] generic :hp :bullet method))
'([/] spawn points
  ([x] levels.edn data for planets)
  ([x] in game editor)
  ([ ] cycle spawn type))
'([ ] fix planetoid constraints
  ([ ] step algo based on speed))
'([ ] obstacles)
'([ ] enemies)
'([ ] menu)
'([/] HUD
  ([x] lifebar)
  ([ ] :score :level-time :enemies-left))
'([ ] sfx
  ([ ] game events)
  ([ ] music))

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment