Skip to content

Instantly share code, notes, and snippets.

@ympbyc
Last active January 27, 2023 04:50
Show Gist options
  • Save ympbyc/ab11313b4869c0b9039df274eee1dc0b to your computer and use it in GitHub Desktop.
Save ympbyc/ab11313b4869c0b9039df274eee1dc0b to your computer and use it in GitHub Desktop.
Load and draw image with CL-SDL2
;; 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))))))
;;鳳凰
;;中千畳
(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)
(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")))
(defpackage #:mini-example
(:use #:cl)
(:export #:main))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment