Ported to OpenGL
[uxul-world.git] / opengl.lisp
1 ;; Copyright 2010-2011 Christoph Senjak\r
2 \r
3 (in-package :uxul-world)\r
4 \r
5 (defun load-bmp-blob-into-texture (blob)\r
6   (let*\r
7       ((id (car (gl:gen-textures 1)))\r
8        (pix (bmp-pixel-data blob))\r
9        (w (bmp-width blob))\r
10        (h (bmp-height blob)))\r
11     (gl:bind-texture :texture-2d id)\r
12     (gl:tex-image-2d :texture-2d 0 :rgba8 w h 0 :bgra :unsigned-byte pix)\r
13     (gl:tex-parameter :texture-2d :texture-min-filter :linear)\r
14     (gl:tex-parameter :texture-2d :texture-mag-filter :linear)\r
15     (gl:flush)\r
16     id))\r
17 \r
18 (defun make-quad (id x y w h)\r
19   (setf x (- (+ x x) +screen-width+ ))\r
20   (setf y (- (+ y y)  +screen-height+))\r
21   (gl:bind-texture :texture-2d id)\r
22   (gl:with-primitive :quads\r
23     (gl:tex-coord 0 0) (gl:vertex x (+ y h))\r
24     (gl:tex-coord 1 0) (gl:vertex  (+ x w) (+ y h))\r
25     (gl:tex-coord 1 1) (gl:vertex (+ x w) y)\r
26     (gl:tex-coord 0 1) (gl:vertex x y)))\r
27 \r