Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: cc3baeb291
Fetching contributors…

Cannot retrieve contributors at this time

416 lines (351 sloc) 12.608 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 (http://opensource.org/licenses/eclipse-1.0.php)
;; 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.
(ns ^{:author "Zachary Tellman"}
penumbra.opengl
(:use [penumbra.opengl core]
[clojure.contrib.def :only (defn-memo defmacro- defvar)])
(:require [penumbra.opengl.texture :as tex]
[penumbra.data :as data]
[penumbra.opengl.frame-buffer :as fb]
[penumbra.opengl.shader :as shader]
[penumbra.opengl.effects :as fx]
[penumbra.glsl.core :as glsl]
[penumbra.opengl.geometry :as geometry]
[penumbra.opengl.teapot :as t])
(:import (org.lwjgl BufferUtils)
(java.io File ByteArrayOutputStream ByteArrayInputStream)
(javax.imageio ImageIO)
(org.newdawn.slick.opengl InternalTextureLoader Texture TextureImpl)))
;;;
(defmacro- import-fn [sym]
(let [m (meta (eval sym))
m (meta (intern (:ns m) (:name m)))
n (:name m)
arglists (:arglists m)
doc (:doc m)]
(list `def (with-meta n {:doc doc :arglists (list 'quote arglists)}) (eval sym))))
;;;
(gl-import+ glEnable enable)
(gl-import+ glDisable disable)
(gl-import+ glIsEnabled enabled?)
(gl-import+ glGetString get-string)
(gl-import glMatrixMode gl-matrix-mode)
(gl-import glPushMatrix gl-push-matrix)
(gl-import glPopMatrix gl-pop-matrix)
(gl-import glLoadIdentity gl-load-identity-matrix)
;;;
(defmacro with-enabled
"Enables the param(s) within the inner scope. Will subsequently disable field if and only if it was previously disabled."
[param-or-param-seq & body]
`(let [e# (filter
(fn [a#] (not (enabled? (enum a#))))
(if (not (sequential? ~param-or-param-seq)) [~param-or-param-seq] ~param-or-param-seq))]
(doseq [b# e#]
(enable (enum b#)))
(try ~@body
(finally
(doall (map (fn [c#] (disable (enum c#))) e#))))))
(defmacro with-disabled
"Disables the param(s) within the inner scope. Will subsequently enable field if and only if it was previously enabled."
[e & body]
`(let [e# (filter
(fn [a#] (enabled? (enum a#)))
(if (not (sequential? ~e)) [~e] ~e))]
(doseq [b# e#]
(disable (enum b#)))
(try ~@body
(finally
(doall (map (fn [c#] (enable (enum c#))) e#))))))
;;;
(defn get-extensions
"Returns a set of strings representing all supported extensions."
[]
(set (.split (get-string :extensions) " ")))
(defn-memo get-version
"Gets the version of OpenGL that's supported."
[]
(Float/parseFloat (re-find #"\d+\.\d+" (get-string :version))))
(defn-memo frame-buffer-supported? []
(contains? (get-extensions) "GL_EXT_framebuffer_object"))
(defn shaders-supported? []
(>= (get-version) 2.0))
;;;
(gl-import- glClear gl-clear)
(gl-import+ glClearColor clear-color)
(gl-import+ glDepthFunc depth-test)
(defn clear
"Clears the depth and color buffers."
([]
(gl-clear :depth-buffer-bit)
(gl-clear :color-buffer-bit))
([r g b]
(clear r g b 1))
([r g b a]
(clear-color r g b a)
(clear)))
(gl-import- glViewport gl-viewport)
(defn viewport
"Sets the current render window."
([w h] (viewport 0 0 w h))
([x y w h]
(reset! *view* [x y w h])
(gl-viewport x y w h)))
(defmacro with-viewport
"Sets the render window within the inner scope."
[[x y w h] & body]
`(let [[x# y# w# h#] @*view*]
(viewport ~x ~y ~w ~h)
(try
~@body
(finally
(viewport x# y# w# h#)))))
(gl-import- glOrtho gl-ortho)
(gl-import- gluPerspective glu-perspective)
(defmacro with-projection
"Sets the projection matrix within the inner scope. 'projection' must actively set the projection matrix, i.e. call (ortho-view ...)"
[projection & body]
`(do
(gl-matrix-mode :projection) (gl-push-matrix) ~projection (gl-matrix-mode :modelview)
~@body
(gl-matrix-mode :projection) (gl-pop-matrix) (gl-matrix-mode :modelview)))
(defn ortho-view
"Create orthographic view, where distant objects don't get smaller."
[left right bottom top near far]
(gl-matrix-mode :projection)
(gl-load-identity-matrix)
(gl-ortho left right bottom top near far)
(gl-matrix-mode :modelview))
(defn frustum-view [fovx aspect near far]
"Create a standard perspective view."
(gl-matrix-mode :projection)
(gl-load-identity-matrix)
(glu-perspective (double fovx) (double aspect) (double near) (double far))
(gl-matrix-mode :modelview))
;;Geometry
(import-fn geometry/vertex)
(import-fn geometry/normal)
(import-fn geometry/texture)
(import-fn geometry/attribute)
(import-fn geometry/rotate)
(import-fn geometry/scale)
(import-fn geometry/color)
(import-fn geometry/translate)
(import-fn geometry/load-identity)
(import-fn geometry/declare-attributes)
(defmacro push-matrix [& body]
`(geometry/with-transform- *renderer* (fn [] ~@body)))
(geometry/defn-draw :quads)
(geometry/defn-draw :line-strip)
(geometry/defn-draw :lines)
(geometry/defn-draw :triangle-strip)
(geometry/defn-draw :triangle-fan)
(geometry/defn-draw :quad-strip)
(geometry/defn-draw :triangles)
(geometry/defn-draw :polygon)
(geometry/defn-draw :line-loop)
(geometry/defn-draw :points)
;;Display Lists
(gl-import glCallList gl-call-list)
(gl-import glGenLists gl-gen-lists)
(gl-import glNewList gl-new-list)
(gl-import glEndList gl-end-list)
(gl-import- glDeleteLists gl-delete-lists)
(gl-import- glIsList gl-is-list)
(defn- display-list-id [display-list]
(:display-list (meta display-list)))
(defn display-list?
"Returns true if display-list is a valid display list within the render context."
[display-list]
(if (nil? display-list)
false
(gl-is-list (display-list-id display-list))))
(defn delete-display-list
"Deletes display-list"
[display-list]
(gl-delete-lists (display-list-id display-list) 1))
(defn call-display-list
"Executes a display list, which is generated using (get-display-list ...)"
[display-list]
(display-list))
(defmacro create-display-list
"Bounds inner scope in glNewList() ... glEndList(), and returns the display list value."
[& body]
`(let [list# (gl-gen-lists 1)]
(gl-new-list list# :compile)
~@body
(gl-end-list)
(with-meta
#(gl-call-list list#)
{:display-list list#})))
;;Effects
(gl-import+ glCullFace cull-face)
(gl-import+ glLineWidth line-width)
(gl-import+ glPointSize point-size)
(gl-import+ glHint hint)
(gl-import+ glBlendFunc blend-func)
(gl-import+ glShadeModel shade-model)
(import-fn fx/render-mode)
(import-fn fx/render-mode)
(import-fn fx/color)
(import-fn fx/material)
(import-fn fx/fog)
(import-fn fx/light)
(defmacro with-render-mode [mode & body]
`(fx/with-render-mode ~mode (fn [] ~@body)))
;;Shader
(def uniform shader/uniform)
(defn- filter-translate [decl [type source]]
[type
(if (not= :vertex type)
(glsl/translate-shader (remove #(= 'attribute (first %)) decl) source)
(glsl/translate-shader decl source))])
(defn- literal-translate [[type source]]
[type (glsl/translate-shader source)])
(defn create-program
"Creates a program. Possible params are :extensions, :declarations, :fragment, :vertex, :geometry."
[& params]
(let [params (apply hash-map params)
decl (:declarations params)
tuple #(list % (% params))
extend (fn [[k v]] [k (str (:extensions params) "\n" v)])
sources (->> [:vertex :fragment :geometry]
(map tuple)
(apply concat)
(apply hash-map)
(filter second)
(map #(if (:literal params)
(literal-translate %)
(filter-translate decl %)))
(map extend)
(apply concat)
)]
(apply shader/compile-source sources)))
(defmacro with-program [program & body]
`(shader/with-program ~program (fn [] ~@body)))
(defmacro try-with-program
"Calls with-program only if shaders are supported."
[program & body]
`(let [inner# (fn [] ~@body)]
(if (shaders-supported?)
(with-program ~program
(inner#))
(inner#))))
;;Frame Buffers
(defmacro with-frame-buffer [& body]
`(fb/with-frame-buffer (fn [] ~@body)))
;;Texture
(gl-import+ glTexEnvf tex-env)
(gl-import+ glTexParameteri tex-parameter)
(gl-import+ glIsTexture valid-texture-id?)
(import-fn tex/bind-texture)
(import-fn tex/texture)
(import-fn tex/create-texture)
(import-fn tex/build-mip-map)
(defmacro with-texture [tex & body]
`(tex/with-texture ~tex (fn [] ~@body)))
(defmacro with-texture-transform [transform & body]
`(tex/with-texture-transform (fn [] ~transform) (fn [] ~@body)))
(defn create-byte-texture
"Creates a texture with pixel format :unsigned-byte.
Valid targets include [:texture-rectangle :texture-2d]."
([w h]
(create-byte-texture :texture-2d w h))
([target w h]
(create-texture
:target target
:dim [w h]
:internal-format :rgba
:pixel-format :rgba
:internal-type :unsigned-byte)))
(defn load-texture-from-image
"Creates a texture from a BufferedImage.
If subsample is set to true, the texture will have mip-maps.
Possible filters include [:nearest :linear], default is :linear."
([image]
(load-texture-from-image image false))
([image subsample]
(load-texture-from-image image subsample :linear))
([image subsample filter]
(let [output-stream (ByteArrayOutputStream.)]
(ImageIO/write image "png" output-stream)
(.clear (InternalTextureLoader/get))
(let [input-stream (ByteArrayInputStream. (.toByteArray output-stream))
texture (-> (InternalTextureLoader/get)
(.getTexture
input-stream
"png"
false
(enum filter)))]
(let [tex (tex/texture-from-texture-object texture filter)]
(when subsample
(tex/build-mip-map tex))
tex)))))
(defn load-texture-from-file
"Loads a texture from an image file."
([path]
(load-texture-from-file path false))
([path subsample]
(load-texture-from-file path subsample :linear))
([path subsample filter]
(load-texture-from-image (ImageIO/read (File. path)) subsample filter)))
(defn blit
"Blits texture to the screen. Ignores current projection matrix, but honors current transform matrix."
([tex]
(blit tex [0 0 1 1]))
([tex [x y w h]]
(when tex
(let [target (-> tex data/params :target)
[tw th] (if (= :texture-rectangle target)
(tex/dim tex)
[1 1])]
(with-enabled target
(with-texture tex
(try-with-program nil
(push-matrix
(load-identity)
(with-projection (ortho-view 0 1 1 0 -1 1)
(push-matrix
(color 1 1 1)
(draw-quads
(texture 0 0) (vertex x (+ y h))
(texture tw 0) (vertex (+ x w) (+ y h))
(texture tw th) (vertex (+ x w) y)
(texture 0 th) (vertex x y))))))))))))
(defn blit!
"Same as blit, but releases texture after rendering."
([tex]
(blit! tex [0 0 1 1]))
([tex region]
(blit tex region)
(data/release! tex)))
(defn render-to-texture-
[tex f]
{:skip-wiki true}
(let [z-offset (if (sequential? tex) (last tex) nil)
tex (if (sequential? tex) (first tex) tex)
[w h] (tex/dim tex)]
(with-frame-buffer [w h]
(binding [*render-target* tex
*z-offset* z-offset]
(with-viewport [0 0 w h]
(fb/attach-textures [] [tex])
(push-matrix
(fb/with-depth-buffer [w h]
(f))))))))
(defmacro render-to-texture
"Renders a scene defined in the inner scope to 'tex'."
[tex & body]
`(render-to-texture- ~tex (fn [] ~@body)))
(defmacro render-to-layered-rexture
[tex & body]
`(binding [*layered-texture?* true]
(render-to-texture tex ~@body)))
;;
(defn teapot
([] (teapot 20))
([detail] (push-matrix (t/teapot detail 1))))
Jump to Line
Something went wrong with that request. Please try again.