;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-(in-package :gacela)
+
+(eval-when (compile load eval)
+ (when (not (find-package 'gacela)) (make-package 'gacela :nicknames '(gg) :use '(lisp)))
+ (in-package 'gacela :nicknames '(gg) :use '(lisp)))
+
(defmacro with-color (color &body code)
(cond (color
- `(let ((original-color (get-current-color)))
+ `(let ((original-color (get-current-color))
+ result)
(apply #'set-current-color ,color)
- ,@code
- (apply #'set-current-color original-color)))
+ (setq result ,@code)
+ (apply #'set-current-color original-color)
+ result))
(t
`(progn
,@code))))
(cond ((/= image 0)
(let* ((width (surface-w image)) (height (surface-h image))
(power-2 (nearest-power-of-two (min width height)))
- (zoomx (/ power-2 width)) (zoomy (/ power-2 height))
- zoomed-image)
- (cond ((and (= zoomx 1) (= zoomy 1)) (values image width height))
- (t (setq zoomed-image (zoomSurface image zoomx zoomy 0))
+ resized-image)
+ (cond ((and (= width power-2) (= height power-2)) (values image width height))
+ (t (setq resized-image (resize-surface image power-2 power-2))
(SDL_FreeSurface image)
- (cond ((/= zoomed-image 0) (values zoomed-image width height))))))))))
+ (cond ((/= resized-image 0) (values resized-image width height))))))))))
+
+(defun resize-surface (surface width height)
+ (let ((old-width (surface-w surface)) (old-height (surface-h surface)))
+ (cond ((and (= width old-width) (= height old-height)) surface)
+ (t (let ((zoomx (/ (+ width 0.5) old-width)) (zoomy (/ (+ height 0.5) old-height)))
+ (zoomSurface surface zoomx zoomy 0))))))
(defun load-texture (filename &key (min-filter GL_LINEAR) (mag-filter GL_LINEAR) static)
(let ((key (make-resource-texture :filename filename :min-filter min-filter :mag-filter mag-filter)))
(cond (image
(let ((width (surface-w image)) (height (surface-h image))
(byteorder (if (= (SDL_ByteOrder) SDL_LIL_ENDIAN)
- (if (= (surface-format-BytesPerPixel image) 3) GL_RGB GL_RGBA)
- (if (= (surface-format-BytesPerPixel image) 3) GL_BGR GL_BGRA)))
+ (if (= (surface-format-BytesPerPixel image) 3) GL_BGR GL_BGRA)
+ (if (= (surface-format-BytesPerPixel image) 3) GL_RGB GL_RGBA)))
(texture (car (glGenTextures 1))))
+
(glBindTexture GL_TEXTURE_2D texture)
(glTexImage2D GL_TEXTURE_2D 0 3 width height 0 byteorder GL_UNSIGNED_BYTE (surface-pixels image))
(glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER min-filter)
:static static)
key)))))))
-(defun draw-image-function (filename)
+(defun draw-image (filename &ptional (zoom 1))
(let ((texture (load-texture filename)))
- (lambda (&optional (f 1))
- (cond (texture
- (let ((width (getf (get-resource texture) :width))
- (height (getf (get-resource texture) :height)))
- (draw-rectangle (* f width) (* f height) :texture texture)))))))
+ (cond (texture (draw-texture texture zoom)))))
+
+(defun draw-texture (texture &optional (zoom 1))
+ (cond (texture
+ (let ((width (getf (get-resource texture) :width))
+ (height (getf (get-resource texture) :height)))
+ (draw-rectangle (* zoom width) (* zoom height) :texture texture)))))
(defun draw-quad (v1 v2 v3 v4 &key texture)
- (cond ((consp texture) (with-color texture (draw v1 v2 v3 v4)))
- (texture
- (progn-textures
- (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))
- (draw-vertex v3 :texture-coord '(1 1))
- (draw-vertex v4 :texture-coord '(0 1))
- (glEnd)))
- (t (draw v1 v2 v3 v4))))
+ (let ((id-texture (getf (get-resource texture) :id-texture)))
+ (cond (id-texture
+ (progn-textures
+ (glBindTexture GL_TEXTURE_2D id-texture)
+ (begin-draw 4)
+ (draw-vertex v1 :texture-coord '(0 0))
+ (draw-vertex v2 :texture-coord '(1 0))
+ (draw-vertex v3 :texture-coord '(1 1))
+ (draw-vertex v4 :texture-coord '(0 1))
+ (glEnd)))
+ ((consp texture) (with-color texture (draw v1 v2 v3 v4)))
+ (t (draw v1 v2 v3 v4)))))
(defun draw-rectangle (width height &key texture)
(let* ((w (/ width 2)) (-w (neg w)) (h (/ height 2)) (-h (neg h)))
(glRotatef rot 0 0 1))
(defun to-origin ()
- (glLoadIdentity))
+ (glLoadIdentity)
+ (cond ((3d-mode?) (camera-look))))
+
+(let ((camera-eye '(0 0 0)) (camera-center '(0 0 -100)) (camera-up '(0 1 0)))
+ (defun set-camera (&key eye center up)
+ (cond (eye (setq camera-eye eye)))
+ (cond (center (setq camera-center center)))
+ (cond (up (setq camera-up up))))
+
+ (defun camera-look ()
+ (apply #'gluLookAt (concatenate 'list camera-eye camera-center camera-up))))