(glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST)
t)
-(defmacro progn-textures (&body code)
- `(let (values)
- (init-video-mode)
- (glEnable GL_TEXTURE_2D)
- (setq values (multiple-value-list (progn ,@code)))
- (glDisable GL_TEXTURE_2D)
- (apply #'values values)))
-
(defun init-lighting ()
(init-video-mode)
(glEnable GL_LIGHTING))
(make-resource :plist plist
:constructor constructor
:destructor destructor
- :free-function free-function
:time (if static t (SDL_GetTicks)))))
(defun get-resource (key)
(in-package :gacela)
+(defmacro mapcconst (type c-type name)
+ (let ((c-header (concatenate 'string c-type " gacela_" name " (void)"))
+ (c-body (concatenate 'string "return " name ";"))
+ (c-name (concatenate 'string "gacela_" name))
+ (lisp-name (intern (string-upcase name))))
+ `(progn
+ (defcfun ,c-header 0 ,c-body)
+ (defentry ,lisp-name () (,type ,c-name))
+ (eval-when (load) (defconstant ,lisp-name (,lisp-name))))))
+
(clines "#include <FTGL/ftgl.h>")
(mapcconst int "int" "ft_encoding_unicode")
(in-package :gacela)
+(defmacro mapcconst (type c-type name)
+ (let ((c-header (concatenate 'string c-type " gacela_" name " (void)"))
+ (c-body (concatenate 'string "return " name ";"))
+ (c-name (concatenate 'string "gacela_" name))
+ (lisp-name (intern (string-upcase name))))
+ `(progn
+ (defcfun ,c-header 0 ,c-body)
+ (defentry ,lisp-name () (,type ,c-name))
+ (eval-when (load) (defconstant ,lisp-name (,lisp-name))))))
+
(clines "#include <GL/gl.h>")
(clines "#include <GL/glu.h>")
(in-package :gacela)
+(defmacro mapcconst (type c-type name)
+ (let ((c-header (concatenate 'string c-type " gacela_" name " (void)"))
+ (c-body (concatenate 'string "return " name ";"))
+ (c-name (concatenate 'string "gacela_" name))
+ (lisp-name (intern (string-upcase name))))
+ `(progn
+ (defcfun ,c-header 0 ,c-body)
+ (defentry ,lisp-name () (,type ,c-name))
+ (eval-when (load) (defconstant ,lisp-name (,lisp-name))))))
+
(clines "#include <SDL/SDL.h>")
(clines "#include <SDL/SDL_image.h>")
(clines "#include <SDL/SDL_ttf.h>")
,@code
(apply #'set-current-color original-color)))
+(defmacro progn-textures (&body code)
+ `(let (values)
+ (init-video-mode)
+ (glEnable GL_TEXTURE_2D)
+ (setq values (multiple-value-list (progn ,@code)))
+ (glDisable GL_TEXTURE_2D)
+ (apply #'values values)))
+
(defun draw (&rest vertexes)
(begin-draw (length vertexes))
(draw-vertexes vertexes)
key)))))))
(defun draw-image-function (filename)
- (multiple-value-bind
- (texture width height) (load-texture filename)
- (lambda (&optional (f 1))
- (cond (texture
- (draw-rectangle (* f width) (* f height) :texture texture))))))
+ (let ((texture (load-texture filename)))
+ (lambda (&optional (f 1))
+ (cond (texture
+ (let ((width (getf (get-resource texture) :width))
+ (height (getf (get-resource texture) :height)))
+(print texture)
+ (draw-rectangle (* f width) (* f height) :texture texture)))))))
(defun draw-quad (v1 v2 v3 v4 &key texture)
(cond (texture (progn-textures
- (glBindTexture GL_TEXTURE_2D (getf texture :id-texture))
+ (glBindTexture GL_TEXTURE_2D (getf (get-resource texture) :id-texture))
(begin-draw 4)
(draw-vertex v1 :texture-coord '(0 0))
(draw-vertex v2 :texture-coord '(1 0))
(t (power (* p 2) n)))))
(power 1 n)))
-(defmacro mapcconst (type c-type name)
- (let ((c-header (concatenate 'string c-type " gacela_" name " (void)"))
- (c-body (concatenate 'string "return " name ";"))
- (c-name (concatenate 'string "gacela_" name))
- (lisp-name (intern (string-upcase name))))
- `(progn
- (defcfun ,c-header 0 ,c-body)
- (defentry ,lisp-name () (,type ,c-name))
- (eval-when (load) (defconstant ,lisp-name (,lisp-name))))))
-
;Geometry
(defun dotp (dot)
(match-pattern dot '(0 0)))
(timer (make-timer))
(grid (make-list 20 :initial-element (make-list 14)))
(background (draw-image-function "fondo_tetris.png"))
- (font (open-font "lazy.ttf")))
+ (font (load-font "lazy.ttf")))
(defun tetramine ()
(cond ((eq (timer-state timer) 'stopped) (start-timer timer)))
key))))
(defun render-text (text font)
- (ftglRenderFont (getf font :id-font) text FTGL_RENDER_ALL))
+ (ftglRenderFont (getf (get-resource font) :id-font) text FTGL_RENDER_ALL))