opengl.lisp

;; Copyright 2010-2011 Christoph Senjak

(in-package :uxul-world)

(defun load-bmp-blob-into-texture (blob)
  (let*
      ((id (car (gl:gen-textures 1)))
       (pix (bmp-pixel-data blob))
       (w (bmp-width blob))
       (h (bmp-height blob)))
    (gl:bind-texture :texture-2d id)
    (gl:tex-image-2d :texture-2d 0 :rgba8 w h 0 :bgra :unsigned-byte pix)
    (gl:tex-parameter :texture-2d :texture-min-filter :linear)
    (gl:tex-parameter :texture-2d :texture-mag-filter :linear)
    (gl:flush)
    id))

(defun load-spritesheet ()
  (let*
      ((id (car (gl:gen-textures 1)))
       (wh (cadr *spritesheet*))
       (pix (car *spritesheet*)))
    (gl:bind-texture :texture-2d id)
    (gl:tex-image-2d :texture-2d 0 :rgba8 wh wh 0 :bgra :unsigned-byte pix)
    (gl:tex-parameter :texture-2d :texture-min-filter :linear)
    (gl:tex-parameter :texture-2d :texture-mag-filter :linear)
    (gl:flush)
    id))

(defun make-quad (imgs x y w h)
  (destructuring-bind (x1 y1 x2 y2 bla blubb) imgs
    (declare (ignore bla blubb))
    (setf x (- x +screen-width+))
    (setf y (- y +screen-height+))
    ;(gl:bind-texture :texture-2d *spritesheet-id*)
    (macrolet ((writedown (&rest vars)
		 `(progn
		    ,@(mapcar #'(lambda (var)
				 `(setf (cffi:mem-aref uxul-world::*ptr* :float (1- (incf uxul-world::*offset*))) (float ,var 0.0))) vars))))
      (writedown x1 y1 x (+ y h)
		 x2 y1 (+ x w) (+ y h)
		 x2 y2 (+ x w) y
		 x1 y2 x y))))