Load and draw image with CL-SDL2

cl-sdl2-render-image.lisp

;; Example use of CL-SDL2
;; Loads Sequentially named PNG image files in "(project-folder)/resources/images" and lay them out

(in-package #:mini-example)

(require :sdl2)

(defun collect-textures (renderer directory)
  (loop for i from 10 downto 1
	collect
	(with-texture (tex-image rect img
		       :img-src (format nil "~A/~2,'0d.png" directory i)
		       :renderer renderer
		       :protect  nil)
	  (list tex-image rect img))))


(defun main ()
  (with-many
      ((sdl2:with-init (:everything))
       (sdl2:with-window (win :flags '(:shown)
			      :w 1800 :h 600
			      :title "False Perspective"))
       (sdl2:with-renderer (renderer win :flags '(:ACCELERATED)))
       (let1 texs (collect-textures renderer
				    "resources/images/")))
    (sdl2:with-event-loop (:method :poll)
      (:idle ()
	     (sdl2:render-clear renderer)
	     (loop for tex in texs
		   for i from 0 upto 10
		   for rect = (cadr tex)
		   for w = (sdl2:rect-width rect)
		   for h = (sdl2:rect-height rect)
		   for x = (center-x win (- (* i w) (* w 5)))
		   for drect = (sdl2:make-rect x 0 w h)
		   do (sdl2:render-copy renderer (car tex)
					:source-rect rect
					:dest-rect drect))
	     (sdl2:render-present renderer))
      (:quit ()
	     (loop for tex in texs
		   do (mapcar #'free tex))))))

;;鳳凰
;;中千畳

helper.lisp

(in-package #:mini-example)

(defun project-local-pathname (partial-path)
  (merge-pathnames partial-path
		   (asdf:system-source-directory
		    (asdf:find-system :false-perspective))))

(defmacro let1 (var form &body body)
  `(let ((,var ,form))
     ,@body))

(defmacro with-many (w-clauses &body body)
  "Write multiple with statement in flat manner
   (with-many 
     ((with-init (:everything))
      (with-window (win))
      (with-renderer (renderer win)))
     ...)"
  (if (null w-clauses)
      `(progn ,@body)
      (append (car w-clauses)
	      `((with-many ,(cdr w-clauses) ,@body)))))

;; SDL2

(defun center-x (window x-coord)
  (multiple-value-bind (w h)
      (sdl2:get-window-size window)
    (+ (/ w 2) x-coord)))

(defmacro with-texture
    ((tex-image rect img 
      &key (img-src "") (renderer nil) (protect t)) 
      &body body)
  `(let* ((,img (sdl2-image:load-image
		 (project-local-pathname ,img-src)))
	  (,rect (sdl2:make-rect 0 0
				 (sdl2:surface-width ,img)
				 (sdl2:surface-height ,img)))
	  (,tex-image (sdl2:create-texture-from-surface ,renderer ,img)))
     (unwind-protect
	  (progn ,@body)
       (when ,protect
	 (sdl2:free-surface ,img)
	 (sdl2:free-rect ,rect)
	 (sdl2:destroy-texture ,tex-image)))))

(defgeneric free (sdl-obj))
(defmethod free ((rect sdl2-ffi:sdl-rect))
  (sdl2:free-rect rect))
(defmethod free ((texture sdl2-ffi:sdl-texture))
  (sdl2:destroy-texture texture))
(defmethod free ((surface sdl2-ffi:sdl-surface))
  (sdl2:free-surface surface))
(defmethod free (x) nil)

mini-example.asd

(asdf:defsystem #:mini-example
  :description "Starting point for SDL2 based graphics"
  :author "Minori Yamashita"
  :license "MIT"
  :depends-on (:sdl2 :sdl2-image)
  :pathname "src"
  :serial t
  :components ((:file "package")
	       (:file "helper")
	       (:file "core")))

package.lisp

(defpackage #:mini-example
  (:use #:cl)
  (:export #:main))