(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)))
: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)
(let ((id-texture (getf (get-resource texture) :id-texture)))