2d sprites
The first thing we need to think about when using OpenGL for 2d is how we want to map OpenGL's 3d space onto our 2d world. We probably want an orthographic projection, so that objects are the same size no matter how far they are from the camera. We usually want to use coordinates with 1 unit approximately equal to 1 pixel on screen. Depending on the application, we might want to keep the amount displayed constant even at higher resolutions, in which case we want the coordinates to always match the original resolution. If we want to show more of the world when resolution increases, we keep the coordinates matching the actual screen resolution.
Let's set up a function to handle setting things up for either case, which we will use later to allow resizing the window as well. We'll also add some variables to allow switching between the behaviors mentioned above.
;; physical size of window in pixels
(defparameter *actual-screen-width* 320)
(defparameter *actual-screen-height* 200)
;; nominal size of window in pixels, in case we just want to scale the
;; scene to match the window instead of showing more of the world
(defparameter *nominal-screen-width* 320)
(defparameter *nominal-screen-height* 200)
;; extents of the window in GL coordinates
(defparameter *screen-width* nil)
(defparameter *screen-height* nil)
;; flag specifying how we want to handle chamging resolution:
;; if T, always show a fixed amount of the world
;; if NIL, keep 1 pixel on screen = 1 unit of world space, so more of the
;; world shows when the window gets larger
(defparameter *use-nominal-size* t)
(defun setup-ortho-projection (width height)
(setf *actual-screen-width* width)
(setf *actual-screen-height* height)
(gl:matrix-mode :projection)
(gl:load-identity)
(gl:viewport 0 0 width height)
(if *use-nominal-size*
(setf *screen-width* *nominal-screen-width*
*screen-height* *nominal-screen-height*)
(setf *screen-width* *actual-screen-width*
*screen-height* *actual-screen-height*))
;; this sets up the world so the screen coordinates go from 0,0 at lower
;; left to width,height at upper right
(gl:ortho 0 *screen-width* *screen-height* 0 0 1)
(gl:matrix-mode :modelview))
The :projection matrix handles part of the transformation of coordinates from world-space to screen-space, the other part is handled by the :modelview matrix. The :modelview matrix is responsible for positioning objects in space, and moving the camera (or moving the scene relative to the camera depending on how you want to interpret it). The :projection matrix maps the world to the screen coordinates, and effectively defines the boundaries of the part of the world that actually gets rendered.
Here we defined a view volume width by height by 1, with 0,0 at the upper left since that matches the mouse coordinates we get from SDL. We could adjust the values to get 0,0 at the lower left with (gl:ortho 0 width 0 height 0 1) or in the center (gl:ortho (/ width -2) (/ width 2) (/ height -2) (/ height 2) 0 1) or wherever we want. We could also change the valid range of depth values, but since we are only using sprites that doesn't matter too much.
To demonstrate 2d rendering, we will build a simple particle system for handling shmup bullets, first using immediate mode, then a version written to make better use of modern graphics cards.
First let's make a simple particle system class and an API for hooking it into the game loop.
(defclass particle-system ()
())
(defgeneric draw-object (object)
(:documentation "draw object to screen")
(:method ((object particle-system))))
(defgeneric update-object (object delta-t)
(:documentation "update state of object by delta-t milliseconds, return NIL if
object is no longer active and should be removed, T otherwise")
(:method ((object particle-system) delta-t) nil))
We will be using a few different types of particle-systems, so let's add a manager class as well:
(defclass particle-manager ()
((systems :initform nil :accessor systems)))
(defmethod draw-object ((object particle-manager))
(mapc 'draw-object (systems object)))
(defmethod update-object ((object particle-manager) delta-t)
(setf (systems object)
(delete-if-not (lambda (x) (update-object x delta-t))
(systems object))))
To make it easier to work interactively, we'll add some helpers for managing textures.
First we wrap up a texture name in a class, add a generic function to actually create and upload the GL data for the texture, one to bind the texture, and one to delete the GL data associated with the texture.
We can define the default behavior for bind-texture and delete-texture now as well, since they should apply to most subclasses.
(defclass managed-texture ()
((name :initform nil :initarg :name :accessor name)
(target :initform :texture-2d :accessor target)))
(defgeneric create-texture (texture)
(:documentation "Create the GL texture name, and upload the texture data"))
(defgeneric bind-texture (texture)
(:documentation "Bind the texture"))
(defgeneric delete-texture (texture)
(:documentation "Release the GL texture name, if previously allocated"))
(defmethod bind-texture ((texture managed-texture))
(gl:bind-texture (target texture) (name texture)))
(defmethod delete-texture ((texture managed-texture))
(when (name texture)
(let ((name (name texture)))
(setf (name texture) nil)
;; newer versions of cl-opengl can automatically check for
;; errors, but this function might legitimately be called
;; after GL is shut down, so ignore that error if applicable
(handler-case
(gl:delete-textures (list name))
;; (putting :cl-opengl-checks-errors on *features* was added
;; after the error checks, so if you get errors anyway, try
;; updating cl-opengl)
#+cl-opengl-checks-errors(%gl::opengl-error (c) (values nil c))))))Next we can define a few simple types of textures, first one that reuses the load-a-texture function from the texture tutorials to load textures from files.
(defclass file-texture (managed-texture)
((filename :initarg filename :accessor filename)))
(defmethod create-texture ((texture file-texture))
;; these could reuse the name if we were sure it was still valid,
;; but just to be safe we recreate it
(when (name texture)
(gl:delete-textures (list (name texture))))
(setf (name texture) (load-a-texture (filename texture))))And another that can be used for textures created with vecto
(defclass sequence-texture (managed-texture)
;; we keep a copy of the image data so we can recreate the texture
;; if needed, for example after recreating the main window
((width :initarg :width :accessor width)
(height :initarg :height :accessor height)
(image-data :initarg :image-data :accessor image-data)))
(defmethod create-texture ((texture sequence-texture))
(when (name texture)
(gl:delete-textures (list (name texture))))
(let ((name (car (gl:gen-textures 1))))
(gl:bind-texture :texture-2d name)
(gl:tex-parameter :texture-2d :texture-mag-filter :linear)
(gl:tex-parameter :texture-2d :generate-mipmap t)
(gl:tex-parameter :texture-2d :texture-min-filter :linear-mipmap-linear)
(gl:tex-image-2d :texture-2d 0 :rgba (width texture) (height texture)
0 :rgba :unsigned-byte
(image-data texture))
(setf (name texture) name)) )Now we define a class to manage a set of textures, so we can reload/unload them all as a group, and bind them by name.
(defclass texture-manager ()
((id-map :initform (make-hash-table) :accessor id-map)))
(defgeneric reload-textures (manager)
(:documentation
"(re)create GL data for all textures managed by this texture manager"))
(defgeneric unload-textures (manager)
(:documentation
"release any GL resources associated with textures managed by this texture manager"))
(defgeneric get-texture-by-id (manager id)
(:documentation
"return the texture corresponding to the (EQL comparable) ID"))
(defgeneric (setf get-texture-by-id) (texture manager id)
(:documentation
"add or replace the texture corresponding tothe specified ID"))
(defmethod reload-textures ((manager texture-manager))
(loop for i being the hash-values of (id-map manager)
do (create-texture i)))
(defmethod unload-textures ((manager texture-manager))
(loop for i being the hash-values of (id-map manager)
do (delete-texture i)))
(defmethod get-texture-by-id ((manager texture-manager) id)
(gethash id (id-map manager)))
(defmethod (setf get-texture-by-id) (texture (manager texture-manager) id)
(let ((old-texture (get-texture-by-id manager id)))
;; if we had a texture with that ID already, and it wasn't listed
;; under any other ID, unload it before replacing it
(when (and old-texture (not (eq texture old-texture))
(loop for v being the hash-values of (id-map manager)
never (eq old-texture v)))
(delete-texture old-texture)))
(setf (gethash id (id-map manager)) texture))
Next we will make a global special variable to store the active texture manager, and add some convenience functions for operating directly on textures by the symbols used to identify them in the texture manager.
(defparameter *texture-manager* nil)
(defmethod bind-texture ((texture symbol))
(let ((tex (get-texture-by-id *texture-manager* texture)))
(when (and tex (not (symbolp tex)))
(bind-texture tex))))
(defmethod create-texture ((texture symbol))
(let ((tex (get-texture-by-id *texture-manager* texture)))
(when (and tex (not (symbolp tex)))
(create-texture tex))))
(defmethod delete-texture ((texture symbol))
(let ((tex (get-texture-by-id *texture-manager* texture)))
(when (and tex (not (symbolp tex)))
(delete-texture tex))))
To finish out the texture helpers, we add a macro to bind *texture-manager* around a block of code and unload the textures when it exits, as well as helpers to load a file texture into the texture manager or create a texture with vecto.
(defmacro with-texture-manager (&body body)
(let ((manager (gensym "MANAGER-")))
`(let* ((,manager (make-instance 'texture-manager))
(*texture-manager* ,manager))
(unwind-protect
(progn
,@body)
(unload-textures ,manager)))))
(defun file-texture (id filename)
(setf (get-texture-by-id *texture-manager* id)
(make-instance 'file-texture :filename filename)))
(defmacro vecto-texture ((id width height) &body body)
`(vecto:with-canvas (:width ,width :height ,height)
;; run some vecto code
,@body
;; and create a texture with (a copy of) the results
(setf (get-texture-by-id *texture-manager* ,id)
(make-instance 'sequence-texture :width ,width :height ,height
:image-data (copy-seq (vecto::image-data vecto::*graphics-state*))))))
Once all that is done, we can rewrite the main loop to use the texture manager, and while we are at it, add some hooks to work around a problem you might run into with threaded slime and OpenGL.
The problem is that slime likes to start new threads for every evaluation, which is usually good since waiting for previous ones to finish (or making people put serve-event in the main loop like I do) would be annoying, but causes problems since you need to do extra work to make OpenGL calls from multiple threads.
To work around this problem, we will add a hook that runs a list of functions at the end of each frame then clears the list, and a macro for adding some code to that hook. Since we are dealing with threads, we will use the bordeaux-threads library for portability.
We have things that need to change every frame, so we'll add an update function in addition to the draw function, and finally, let's add in some handlers for mouse clicks, and also handle window resizes as we mentioned at the beginning of this part. When dealing with mouse coordinate, we need to remember to scale them to world coordinates if we aren't using screen coordinates directly.
;; store the mouse position somewhere easy to get to
(defparameter *mouse-x* 0)
(defparameter *mouse-y* 0)
(defvar *next-frame-hook-mutex* (bt:make-lock "frame-hook-lock"))
(defparameter *next-frame-hook* nil)
(defun key-down (key state mod-key scancode unicode)
(declare (ignore key state mod-key scancode unicode)))
(defun key-up (key state mod-key scancode unicode)
(declare (ignore state mod-key scancode unicode))
(when (eql key :sdl-key-escape) (sdl:push-quit-event)))
(defun mouse-down (button state x y)
(declare (ignore button state x y)))
(defun mouse-up (button state x y)
(declare (ignore button state x y)))
(defun mouse-move (x y delta-x delta-y)
(declare (ignore x y delta-x delta-y)))
(defun init ()
;; nothing here yet, we'll build it incrementally this time
)
(defun draw ()
(gl:clear :color-buffer-bit)
;; we'll update this later too
(sdl:update-display))
(defun update (delta-t)
(declare (ignore delta-t))
;; nothing here yet either
)
(defun main-loop ()
(sdl:with-init ()
(sdl:window *nominal-screen-width* *nominal-screen-height*
:flags (logior sdl:sdl-opengl
sdl:sdl-resizable))
(setf cl-opengl-bindings:*gl-get-proc-address* #'sdl-cffi::sdl-gl-get-proc-address)
(let ((previous-tick (sdl:sdl-get-ticks)))
(flet ((mx (x) ;; adjust mouse coordinates from screen to world
(* x (/ (float *screen-width* 1.0) *actual-screen-width*)))
(my (y) ;; adjust mouse coordinates from screen to world
(* y (/ (float *screen-height* 1.0) *actual-screen-height*))))
(with-texture-manager
(init)
(setup-ortho-projection *nominal-screen-width* *nominal-screen-height*)
(sdl:with-events ()
(:quit-event () t)
(:video-resize-event (:w w :h h)
(sdl:resize-window w h)
(reload-textures *texture-manager*)
(restartable (setup-ortho-projection w h)))
(:key-down-event (:state state :scancode scancode :key key
:mod-key mod-key :unicode unicode)
(restartable (key-down key state mod-key scancode unicode)))
(:key-up-event (:state state :scancode scancode :key key
:mod-key mod-key :unicode unicode)
(restartable (key-up key state mod-key scancode unicode)))
(:mouse-button-up-event (:button button :state state :x x :y y)
(restartable (mouse-up button state (mx x) (my y))))
(:mouse-button-down-event (:button button :state state :x x :y y)
(restartable (mouse-down button state (mx x) (my y))))
(:mouse-motion-event (:x x :y y :x-rel delta-x :y-rel delta-y)
(setf *mouse-x* (mx x)
*mouse-y* (my y))
(restartable (mouse-move (mx x) (my y) (mx delta-x) (my delta-y))))
(:idle ()
#+(and sbcl (not sb-thread)) (restartable
(sb-sys:serve-all-events 0))
(let ((delta-t (- (sdl:sdl-get-ticks) previous-tick)))
(setf previous-tick (sdl:sdl-get-ticks))
;; we check for negative delta-t in case sdl's timer wraps
;; after some amount of time, 0 for a frame is better
;; a large negative number
(restartable (update (if (minusp delta-t) 0 delta-t))))
(restartable (draw))
(restartable
(bt:with-lock-held (*next-frame-hook-mutex*)
(loop for i in *next-frame-hook*
do (funcall i))
(setf *next-frame-hook* nil))))))))))
(main-loop)
;; and the wrapper macro for setting up something to run next frame
(defmacro next-frame (&body body)
`(bt:with-lock-held (*next-frame-hook-mutex*)
(progn (push (lambda () ,@body) *next-frame-hook*))))
We can try out the next-frame hook with something like
;; change the background color
(next-frame
(format t "got to next frame ...~%") (finish-output)
(gl:clear-color 0 1 0 1))
;; and to put it back
(next-frame
(gl:clear-color 0 0 0 1))We'll finish off for this part with a simple particle system, a ring of dots that expands from the position of a mouse click.
First we need the particle, which we can draw with vecto:
(defun init ()
(vecto-texture (:click-particle 64 64)
(vecto:set-rgba-fill 1 0 0 0)
(vecto:clear-canvas)
(vecto:set-rgba-stroke 1 0 0 0.75)
(vecto:set-line-width 10)
(vecto:centered-circle-path 32 32 20)
(vecto:stroke))
(reload-textures *texture-manager*))
;; and then run the init function in the GL thread to create the texture
(next-frame
(init))
Now let's add a particle-manager to work with, and define our simple particle system, it needs to remember a position and velocity for each particle, and initialize the particles when instantiated. It also needs to remember how old it is, so we can deactivate it after a few seconds. Eventually we will need to also add some way to deactivate individual particles, once there is something for them to hit.
We'll also set some default parameters for the particle-system.
(defparameter *particle-manager* (make-instance 'particle-manager))
(defparameter *click-particles-lifetime-ms* 3000)
(defparameter *click-particles-count* 24)
(defparameter *click-particles-speed* 50) ;; pixels per second
(defclass click-particles (particle-system)
(;; we store the particles in a flat array of N * x,y for position,
;; and another for velocity
;; *note: premature optimization, don't try this at home kids!
(age :initform 0 :accessor age)
(positions :accessor positions)
(velocities :accessor velocities))
(:default-initargs :count *click-particles-count*
:speed *click-particles-speed*))
(defmethod initialize-instance :after ((o click-particles) &key count speed &allow-other-keys)
(let ((positions
(make-array (list (* 2 count)) :element-type 'single-float :initial-element 0.0))
(velocities
(make-array (list (* 2 count)) :element-type 'single-float :initial-element 0.0)))
(loop
for i below count
for j = (* i 2)
do (setf (aref positions (+ j 0)) (float *mouse-x* 1.0))
do (setf (aref positions (+ j 1)) (float *mouse-y* 1.0))
do (setf (aref velocities (+ j 0))
(float (* speed (sin (* i (/ (* 2 pi) count)))) 1.0))
do (setf (aref velocities (+ j 1))
(float (* speed (cos (* i (/ (* 2 pi) count)))) 1.0)))
(setf (positions o) positions)
(setf (velocities o) velocities)))It also need to know how to update the particles and draw them. We'll use a modified version of rectangle that draws at specified coordinates and size.
(defun rectangle (x y width height &optional (u1 0) (v1 0) (u2 1) (v2 1))
(let* ((w/2 (/ width 2.0))
(h/2 (/ height 2.0))
(x1 (- x w/2))
(x2 (+ x w/2))
(y1 (- y h/2))
(y2 (+ y h/2)))
(gl:tex-coord u1 v2)
(gl:vertex x1 y1 0)
(gl:tex-coord u2 v2)
(gl:vertex x2 y1 0)
(gl:tex-coord u2 v1)
(gl:vertex x2 y2 0)
(gl:tex-coord u1 v1)
(gl:vertex x1 y2 0)))
(defmethod draw-object ((o click-particles))
(bind-texture :click-particle)
(gl:with-primitive :quads
(loop with positions = (positions o)
for i below (length positions) by 2
for x = (aref positions i)
for y = (aref positions (1+ i))
do (rectangle x y 32 32))))
(defmethod update-object ((o click-particles) delta-t)
(incf (age o) delta-t)
(setf delta-t (float delta-t 1.0))
(if (< (age o) *click-particles-lifetime-ms*)
;; not done, update particles, and return a non-nil value
(map-into (positions o) (lambda (p v)
(+ p (* v delta-t 0.001)))
(positions o) (velocities o))
;; particle system is done, remove it
nil))
Finally, we can modify the click handler to create a particle system, add the manager to the draw and update functions, then click on the window and see it work:
(defun draw ()
(gl:clear :color-buffer-bit)
(gl:enable :texture-2d :blend)
(gl:blend-func :src-alpha :one-minus-src-alpha)
(draw-object *particle-manager*)
(sdl:update-display))
(defun update (delta-t)
(update-object *particle-manager* delta-t))
(defun mouse-down (button state x y)
(declare (ignore button state x y))
(push (make-instance 'click-particles) (systems *particle-manager*)))
Next time, more efficient drawing with VBOs