This repository has been archived by the owner. It is now read-only.
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
388 lines (337 sloc) 11.3 KB
;; Copyright (c) Zachary Tellman. All rights reserved.
;; The use and distribution terms for this software are covered by the
;; Eclipse Public License 1.0 (
;; which can be found in the file epl-v10.html at the root of this distribution.
;; By using this software in any fashion, you are agreeing to be bound by
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.
(:use [penumbra opengl]
[penumbra.seq :only (separate)] ;;modified to drop contrib.
(:require [ :as app]
[penumbra.text :as text]
[penumbra.time :as time]
[ :as data]))
(def *dim* (vec2 10 10))
(defn wrap
"Makes the position wrap around from right to left, bottom to top"
(add pos *dim*)
(mul *dim* 2))
(defn expired? [x]
((:expired? x)))
(defn render [x]
((:render x)))
(defn radius [x]
(if (number? (:radius x))
(:radius x)
((:radius x))))
(defn position [x]
(if (cartesian? (:position x))
(:position x)
((:position x))))
(defn intersects? [a b]
(let [min-dist (+ (radius a) (radius b))
dist (sub (position a) (position b))]
(>= (* min-dist min-dist) (length-squared dist))))
(defn rand-color [a b]
(map #(+ %1 (rand (- %2 %1))) a b))
(defn sphere-vertices
(for [theta (range 0 361 (/ 360 lod))]
(for [phi (range -90 91 (/ 180 (/ lod 2)))]
(cartesian (polar3 theta phi)))))
(defn rand-vector []
(normalize (cartesian (polar3 (rand 360) (rand 360)))))
(defn offset-vertex
"Expand if on one side of a plane, contract if on the other"
[v vertex]
(if (neg? (dot v (normalize vertex)))
(mul vertex 1.01)
(mul vertex 0.99)))
(defn offset-sphere [v vertices]
(map (fn [arc] (map #(offset-vertex v %) arc)) vertices))
(defn gen-asteroid-vertices
"Procedurally generate perturbed sphere"
[lod iterations]
(let [s (iterate #(offset-sphere (rand-vector) %) (sphere-vertices lod))]
(nth s iterations)))
(defn draw-asteroid [vertices]
(doseq [arcs (partition 2 1 vertices)]
(doseq [[a b] (map list (first arcs) (second arcs))]
(vertex a) (vertex b)))))
(defn gen-asteroid-geometry [lod iterations]
(create-display-list (draw-asteroid (gen-asteroid-vertices lod iterations))))
(defn init-asteroids []
(def asteroid-meshes (doall (take 20 (repeatedly #(gen-asteroid-geometry 12 100))))))
(defn gen-asteroid [& args]
(let [params (merge
{:position (vec2 0 0)
:radius 1
:theta (rand 360)
:speed 1}
(apply hash-map args))
birth (app/now)
elapsed #(- (app/now) birth)
asteroid (nth asteroid-meshes (rand-int 20))
velocity (mul (cartesian (:theta params)) (:speed params))
position #(wrap (add (:position params) (mul velocity (elapsed))))]
{:expired? #(< (:radius params) 0.25)
:position position
:radius (:radius params)
:render #(push-matrix
(translate (position))
(rotate (* (:speed params) (elapsed) -50) 1 0 0)
(rotate (:theta params) 0 1 0)
(apply scale (->> params :radius repeat (take 3)))
(color 0.6 0.6 0.6)
(call-display-list asteroid))}))
(defn textured-quad []
(texture 0 0) (vertex -1 -1)
(texture 1 0) (vertex 1 -1)
(texture 1 1) (vertex 1 1)
(texture 0 1) (vertex -1 1)))
(defn init-particles []
(def particle-tex
(let [[w h] [32 32]
dim (vec2 w h)
tex (create-byte-texture w h)]
(apply concat
(for [x (range w) y (range h)]
(let [pos (div (vec2 x y) dim)
i (Math/exp (* 16 (- (length-squared (sub pos (vec2 0.5 0.5))))))]
[1 1 1 i]))))
(def particle-quad
(create-display-list (textured-quad))))
(defn draw-particle [position radius tint]
(apply color tint)
(translate position)
(scale radius radius)
(call-display-list particle-quad)))
(defn gen-particle [& args]
(let [params (merge
{:position (vec2 0 0)
:theta (rand 360)
:speed 1
:radius (+ 0.25 (rand 0.5))
:color [1 1 1]
:lifespan 1}
(apply hash-map args))
birth (app/now)
velocity (mul (cartesian (polar2 (:theta params))) (:speed params))
elapsed #(- (app/now) birth)
position #(wrap (add (:position params) (mul velocity (elapsed))))]
{:expired? #(> (- (app/now) birth) (:lifespan params))
:position position
:radius (:radius params)
:render #(draw-particle
(:radius params)
(concat (:color params) [(max 0 (- 1 (Math/pow (/ (elapsed) (:lifespan params)) 3)))]))}))
(defn draw-fuselage [] ;;should be hung in the Louvre
(color 1 1 1)
(vertex -0.4 -0.5) (vertex 0 -0.4) (vertex 0 0.5)
(vertex 0.4 -0.5) (vertex 0 -0.4) (vertex 0 0.5)))
(defn init-spaceship []
(def fuselage (create-display-list (draw-fuselage))))
(defn fire-bullet [state]
(let [ship (:spaceship state)]
(assoc state
(:bullets state)
:position (:position ship)
:theta (:theta ship)
:speed 15
:radius 0.25
:color [0 0 1]
:lifespan 2)))))
(defn emit-flame [state]
(when (app/key-pressed? :up)
(let [ship (:spaceship state)
offset (- (rand 30) 15)
theta (+ 180 (:theta ship) offset)
particles (:particles state)
position (add (:position ship) (cartesian (polar2 theta 0.3)))
velocity (polar (add (:velocity ship) (cartesian theta)))]
(assoc state
:particles (conj particles
:position position
:theta (.theta velocity)
:speed (.r velocity)
:radius 0.25
:color (rand-color [1 0.5 0.7] [1 1 1])
:lifespan (/ (Math/cos (radians (* 3 offset))) 2.5)))))))
(defn update-spaceship [dt ship]
(let [p (:position ship)
v (:velocity ship)
theta (:theta ship)
theta (condp (fn [x _] (app/key-pressed? x)) nil
:left (rem (+ theta (* 360 dt)) 360)
:right (rem (- theta (* 360 dt)) 360)
a (if (app/key-pressed? :up)
(mul (cartesian theta) 3)
(vec2 0 0))
v (add v (mul a dt))
p (wrap (add p (mul v dt)))]
(assoc ship
:theta theta
:position p
:velocity v)))
(defn draw-spaceship [ship]
(translate (:position ship))
(rotate (- (:theta ship) 90) 0 0 1)
(call-display-list fuselage)))
(defn gen-spaceship []
{:position (vec2 0 0)
:radius 0.5
:velocity (vec2 0 0)
:theta 0
:birth (app/now)})
;;game state
(defn reset
"Reset to initial game state."
(assoc state
:spaceship (gen-spaceship)
:asteroids (take 4 (repeatedly
#(let [theta (rand 360)
pos (cartesian (polar2 theta 2))]
(gen-asteroid :position pos :theta theta :speed (rand)))))))
(defn split-asteroid
"Turn asteroid into four sub-asteroids."
(when (< 0.25 (radius asteroid))
(take 4
:position (position asteroid)
:radius (/ (radius asteroid) 2)
:speed (/ 1.5 (radius asteroid)))))))
(defn gen-explosion
"Create particles within a given color range."
[num object [lo-color hi-color] speed]
(take num
:position (position object)
:speed (rand speed)
:color (rand-color lo-color hi-color)
:lifespan 2))))
(defn explode-asteroids
"Turn asteroid into sub-asteroids and explosion particles."
[asteroids state]
(assoc state
:asteroids (concat
(:asteroids state)
(mapcat split-asteroid asteroids))
:particles (concat
(:particles state)
(mapcat #(gen-explosion (* (radius %) 100) % [[1 0.5 0] [1 1 0.2]] 2) asteroids))))
(defn check-complete
"Are all the asteroids gone?"
(if (zero? (count (:asteroids state)))
(reset state)
(defn check-ship
"Has the ship collided with any asteroids?"
(let [ship (:spaceship state)
asteroids (:asteroids state)
[hit missed] (separate #(intersects? ship %) asteroids)]
(if (some #(intersects? ship %) asteroids)
(assoc state
:asteroids (concat missed (mapcat split-asteroid hit))
:spaceship (gen-spaceship)
:particles (concat (:particles state) (gen-explosion 300 ship [[0 0 0.6] [0.5 0.5 1]] 7)))
(defn check-asteroids
"Have the asteroids collided with any bullets?"
(let [bullets (:bullets state)
asteroids (:asteroids state)
collisions (for [a asteroids, b bullets :when (intersects? a b)] [a b])
[hit missed] (separate (set (map first collisions)) asteroids)
bullets (remove (set (map second collisions)) bullets)
particles (:particles state)]
(assoc state
:particles (remove expired? particles)
:bullets (remove expired? bullets)
:asteroids missed))))
(defn update-collisions [state]
(binding [*dim* (:dim state)]
(-> state check-asteroids check-ship check-complete)))
;;game loop
(defn init [state]
(app/title! "Asteroids")
(app/vsync! true)
(app/key-repeat! false)
(enable :blend)
(blend-func :src-alpha :one-minus-src-alpha)
(app/periodic-update! 25 update-collisions)
(app/periodic-update! 50 emit-flame)
(reset state))
(defn reshape [[x y w h] state]
(let [dim (vec2 (* (/ w h) 10) 10)]
(frustum-view 45 (/ w h) 0.1 100)
(translate 0 0 (- (* 2.165 (.y dim))))
(assoc state
:dim dim)))
(defn key-press [key state]
(= key " ") (fire-bullet state)
(= key :escape) (app/pause!)
(= key "1") (app/speed! 0.5)
(= key "2") (app/speed! 1)
(= key "3") (app/speed! 2)
:else state))
(defn update [[dt time] state]
(binding [*dim* (:dim state)]
(assoc state
:spaceship (update-spaceship dt (:spaceship state)))))
(defn display [[dt time] state]
(text/write-to-screen (str (int (/ 1 dt)) " fps") 0 0)
(binding [*dim* (:dim state)]
(with-enabled :texture-2d
(with-texture particle-tex
(doseq [p (concat (:particles state) (:bullets state))]
(render p))))
(with-disabled :texture-2d
(with-render-mode :wireframe
(doseq [a (:asteroids state)]
(render a)))
(draw-spaceship (:spaceship state)))
;;Doesn't work for me, probably not supported shader stuff on my hardware.
(defn start []
{:reshape reshape, :init init, :key-press key-press, :update update, :display display}
{:dim *dim*}))