Works again.

[uxul-world.git] / opengl.lisp

diff --git a/opengl.lisp b/opengl.lisp
index 5337ae7..381246d 100644 (file)
--- a/opengl.lisp
+++ b/opengl.lisp
@@ -15,13 +15,29 @@
     (gl:flush)\r
     id))\r
 \r
-(defun make-quad (id x y w h)\r
-  (setf x (- x +screen-width+ ))\r
-  (setf y (- y +screen-height+))\r
-  (gl:bind-texture :texture-2d id)\r
-  (gl:with-primitive :quads\r
-    (gl:tex-coord 0 0) (gl:vertex x (+ y h))\r
-    (gl:tex-coord 1 0) (gl:vertex  (+ x w) (+ y h))\r
-    (gl:tex-coord 1 1) (gl:vertex (+ x w) y)\r
-    (gl:tex-coord 0 1) (gl:vertex x y)))\r
+(defun load-spritesheet ()\r
+  (let*\r
+      ((id (car (gl:gen-textures 1)))\r
+       (wh (cadr *spritesheet*))\r
+       (pix (car *spritesheet*)))\r
+    (gl:bind-texture :texture-2d id)\r
+    (gl:tex-image-2d :texture-2d 0 :rgba8 wh wh 0 :bgra :unsigned-byte pix)\r
+    (gl:tex-parameter :texture-2d :texture-min-filter :linear)\r
+    (gl:tex-parameter :texture-2d :texture-mag-filter :linear)\r
+    (gl:flush)\r
+    id))\r
 \r
+(defun make-quad (imgs x y w h)\r
+  (destructuring-bind (x1 y1 x2 y2 bla blubb) imgs\r
+    (declare (ignore bla blubb))\r
+    (setf x (- x +screen-width+))\r
+    (setf y (- y +screen-height+))\r
+    ;(gl:bind-texture :texture-2d *spritesheet-id*)\r
+    (macrolet ((writedown (&rest vars)\r
+                `(progn\r
+                   ,@(mapcar #'(lambda (var)\r
+                                `(setf (cffi:mem-aref uxul-world::*ptr* :float (1- (incf uxul-world::*offset*))) (float ,var 0.0))) vars))))\r
+      (writedown x1 y1 x (+ y h)\r
+                x2 y1 (+ x w) (+ y h)\r
+                x2 y2 (+ x w) y\r
+                x1 y2 x y))))
\ No newline at end of file