Add utils package with asset-pathname function

02-getting-an-image-on-the-screen.lisp

@@ -1,6 +1,7 @@
 (defpackage #:sdl2-tutorial-02-getting-an-image-on-the-screen
   (:use :cl)
-  (:export :run))
+  (:export :run)
+  (:import-from :sdl2-tutorial-utils :asset-pathname))
 
 (in-package :sdl2-tutorial-02-getting-an-image-on-the-screen)
 
@@ -17,16 +18,15 @@
        (let ((,surface (sdl2:get-window-surface ,window)))
          ,@body))))
 
-(defun load-image (pathname)
-  (let* ((fullpath (merge-pathnames pathname (asdf:system-source-directory :sdl2-tutorial)))
-         (image (sdl2:load-bmp fullpath)))
+(defun load-image (filename)
+  (let ((image (sdl2:load-bmp filename)))
     (if (autowrap:wrapper-null-p image)
-        (error "cannot load image ~a (check that file exists)" fullpath)
+        (error "cannot load image ~a (check that file exists)" filename)
         image)))
 
 (defun run()
   (with-window-surface (window screen-surface)
-    (let ((image (load-image #p"./assets/02/hello_world.bmp")))
+    (let ((image (load-image (asset-pathname #P"./assets/02/hello_world.bmp"))))
       (sdl2:blit-surface image nil screen-surface nil)
       (sdl2:update-window window)
       (sdl2:delay 2000)

03-event-driven-programming.lisp

@@ -1,6 +1,7 @@
 (defpackage #:sdl2-tutorial-03-event-driven-programming
   (:use :cl)
-  (:export :run))
+  (:export :run)
+  (:import-from :sdl2-tutorial-utils :asset-pathname))
 
 (in-package :sdl2-tutorial-03-event-driven-programming)
 
@@ -18,15 +19,14 @@
          ,@body))))
 
 (defun load-image (pathname)
-  (let* ((fullpath (merge-pathnames pathname (asdf:system-source-directory :sdl2-tutorial)))
-         (image (sdl2:load-bmp fullpath)))
+  (let ((image (sdl2:load-bmp pathname)))
     (if (autowrap:wrapper-null-p image)
-        (error "cannot load image ~a (check that file exists)" fullpath)
+        (error "cannot load image ~a (check that file exists)" pathname)
         image)))
 
 (defun run ()
   (with-window-surface (window screen-surface)
-    (let ((image (load-image "./assets/03/exit.bmp")))
+    (let ((image (load-image (asset-pathname #P"./assets/03/exit.bmp"))))
       (sdl2:with-event-loop (:method :poll)
         (:quit () t)
         (:idle ()

04-key-presses.lisp

@@ -1,6 +1,7 @@
 (defpackage #:sdl2-tutorial-04-key-presses
   (:use :cl)
-  (:export :run))
+  (:export :run)
+  (:import-from :sdl2-tutorial-utils :asset-pathname))
 
 (in-package :sdl2-tutorial-04-key-presses)
 
@@ -18,18 +19,17 @@
          ,@body))))
 
 (defun load-image (pathname)
-  (let* ((fullpath (merge-pathnames pathname (asdf:system-source-directory :sdl2-tutorial)))
-         (image (sdl2:load-bmp fullpath)))
+  (let ((image (sdl2:load-bmp pathname)))
     (if (autowrap:wrapper-null-p image)
-        (error "cannot load image ~a (check that file exists)" fullpath)
+        (error "cannot load image ~a (check that file exists)" pathname)
         image)))
 
 (defun load-media ()
-  (list :default (load-image "assets/04/press.bmp")
-        :up (load-image "assets/04/up.bmp")
-        :down (load-image "assets/04/down.bmp")
-        :left (load-image "assets/04/left.bmp")
-        :right (load-image "assets/04/right.bmp")))
+  (list :default (load-image (asset-Pathname #P"./assets/04/press.bmp"))
+        :up (load-image (asset-pathname #P"./assets/04/up.bmp"))
+        :down (load-image (asset-pathname #P"./assets/04/down.bmp"))
+        :left (load-image (asset-pathname #P"./assets/04/left.bmp"))
+        :right (load-image (asset-pathname #P"./assets/04/right.bmp"))))
 
 (defun run ()
   (with-window-surface (window screen-surface)

05-optimized-surface-loading-and-soft-stretching.lisp

@@ -1,6 +1,7 @@
 (defpackage #:sdl2-tutorial-05-optimized-surface-loading-and-soft-stretching
   (:use :cl)
-  (:export :run))
+  (:export :run)
+  (:import-from :sdl2-tutorial-utils :asset-pathname))
 
 (in-package :sdl2-tutorial-05-optimized-surface-loading-and-soft-stretching)
 
@@ -18,15 +19,15 @@
          ,@body))))
 
 (defun load-surface (pathname pixel-format)
-  (let* ((fullpath (merge-pathnames pathname (asdf:system-source-directory :sdl2-tutorial)))
-         (image (sdl2:load-bmp fullpath)))
+  (let ((image (sdl2:load-bmp pathname)))
     (if (autowrap:wrapper-null-p image)
-        (error "cannot load image ~a (check that file exists)" fullpath)
+        (error "cannot load image ~a (check that file exists)" pathname)
         (sdl2:convert-surface-format image pixel-format))))
 
 (defun run ()
   (with-window-surface (window screen-surface)
-    (let ((image-surface (load-surface "assets/05/stretch.bmp" (sdl2:surface-format-format screen-surface)))
+    (let ((image-surface (load-surface (asset-pathname #P"./assets/05/stretch.bmp")
+                                       (sdl2:surface-format-format screen-surface)))
           (rect (sdl2:make-rect 0 0 *screen-width* *screen-height*)))
       (sdl2:with-event-loop (:method :poll)
         (:quit () t)
@@ -35,4 +36,6 @@
                                  nil
                                  screen-surface
                                  rect)
-               (sdl2:update-window window))))))
+               (sdl2:update-window window)))
+      ;; clean up
+      (sdl2:free-surface image-surface))))

06-extension-libraries-and-loading-other-image-formats.lisp

@@ -1,6 +1,7 @@
 (defpackage #:sdl2-tutorial-06-extension-libraries-and-loading-other-image-formats
   (:use :cl)
-  (:export :run))
+  (:export :run)
+  (:import-from :sdl2-tutorial-utils :asset-pathname))
 
 (in-package :sdl2-tutorial-06-extension-libraries-and-loading-other-image-formats)
 
@@ -20,18 +21,20 @@
          (sdl2-image:quit)))))
 
 (defun load-surface (pathname pixel-format)
-  (let ((fullpath (merge-pathnames pathname (asdf:system-source-directory :sdl2-tutorial))))
-    (sdl2:convert-surface-format (sdl2-image:load-image fullpath) pixel-format)))
+  (let ((surface (sdl2-image:load-image pathname)))
+    (prog1 (sdl2:convert-surface-format surface pixel-format)
+      (sdl2:free-surface surface))))
 
 (defun run ()
   (with-window-surface (window screen-surface)
-    (let ((image-surface (load-surface "assets/06/loaded.png" (sdl2:surface-format-format screen-surface)))
+    (let ((image-surface (load-surface (asset-pathname #P"assets/06/loaded.png")
+                                       (sdl2:surface-format-format screen-surface)))
           (rect (sdl2:make-rect 0 0 *screen-width* *screen-height*)))
       (sdl2:with-event-loop (:method :poll)
         (:quit () t)
         (:idle ()
-               (sdl2:blit-scaled image-surface
-                                 nil
-                                 screen-surface
-                                 rect)
-               (sdl2:update-window window))))))
+               (sdl2:blit-scaled image-surface nil screen-surface rect)
+               (sdl2:update-window window)))
+
+      ;; cleanup
+      (sdl2:free-surface image-surface))))

07-texture-loading-and-rendering.lisp

@@ -1,6 +1,7 @@
 (defpackage #:sdl2-tutorial-07-texture-loading-and-rendering
   (:use :cl)
-  (:export :run))
+  (:export :run)
+  (:import-from :sdl2-tutorial-utils :asset-pathname))
 
 (in-package :sdl2-tutorial-07-texture-loading-and-rendering)
 
@@ -17,18 +18,23 @@
        (sdl2:with-renderer (,renderer ,window :index -1 :flags '(:accelerated))
          ,@body))))
 
+
 (defun load-texture (renderer pathname)
-  (let ((fullpath (merge-pathnames pathname (asdf:system-source-directory :sdl2-tutorial))))
-    (sdl2:create-texture-from-surface renderer (sdl2-image:load-image fullpath))))
+  (let ((surface (sdl2-image:load-image pathname)))
+    (prog1 (sdl2:create-texture-from-surface renderer surface)
+      (sdl2:free-surface surface))))
 
-(defun run()
+(defun run ()
   (with-window-renderer (window renderer)
     (sdl2-image:init '(:png))
     (sdl2:set-render-draw-color renderer #xFF #xFF #xFF #xFF)
-    (let ((texture (load-texture renderer "assets/07/texture.png")))
+    (let ((texture (load-texture renderer (asset-pathname #P"./assets/07/texture.png"))))
       (sdl2:with-event-loop (:method :poll)
         (:quit () t)
         (:idle ()
                (sdl2:render-clear renderer)
                (sdl2:render-copy renderer texture)
-               (sdl2:render-present renderer))))))
+               (sdl2:render-present renderer)))
+
+      ;; clean up
+      (sdl2:destroy-texture texture))))

09-the-viewport.lisp

@@ -1,6 +1,7 @@
 (defpackage #:sdl2-tutorial-09-the-viewport
   (:use :cl)
-  (:export :run))
+  (:export :run)
+  (:import-from :sdl2-tutorial-utils :asset-pathname))
 
 (in-package :sdl2-tutorial-09-the-viewport)
 
@@ -18,14 +19,15 @@
          ,@body))))
 
 (defun load-texture (renderer pathname)
-  (let ((fullpath (merge-pathnames pathname (asdf:system-source-directory :sdl2-tutorial))))
-    (sdl2:create-texture-from-surface renderer (sdl2-image:load-image fullpath))))
+  (let ((surface (sdl2-image:load-image pathname)))
+    (prog1 (sdl2:create-texture-from-surface renderer surface)
+      (sdl2:free-surface surface))))
 
 (defun run ()
   (with-window-renderer (window renderer)
     (sdl2-image:init '(:png))
 
-    (let ((texture (load-texture renderer "assets/09/texture.png")))
+    (let ((texture (load-texture renderer (asset-pathname #P"assets/09/texture.png"))))
       (sdl2:with-event-loop (:method :poll)
         (:quit () t)
         (:idle ()
@@ -55,4 +57,6 @@
                  (sdl2:render-set-viewport renderer bottom-viewport)
                  (sdl2:render-copy renderer texture))
 
-               (sdl2:render-present renderer))))))
+               (sdl2:render-present renderer)))
+      ;; cleanup
+      (sdl2:destroy-texture texture))))

sdl2-tutorial.asd

@@ -3,7 +3,8 @@
   :version "0.0.1"
   :licence "Public Domain"
   :depends-on ("bordeaux-threads" "sdl2" "sdl2-image" "sdl2-ttf")
-  :components ((:file "01-hello-sdl")
+  :components ((:file "utils")
+               (:file "01-hello-sdl")
                (:file "02-getting-an-image-on-the-screen")
                (:file "03-event-driven-programming")
                (:file "04-key-presses")

utils.lisp

@@ -0,0 +1,13 @@
+(defpackage #:sdl2-tutorial-utils
+  (:use :cl)
+  (:export :asset-path))
+
+(in-package #:sdl2-tutorial-utils)
+
+(defun asset-pathname (pathname)
+  "Return an absolute filename for a given PATHNAME relative to
+`:sdl2-tutorial' asdf system directory.
+
+This function doesn't prepend 'assets/' to the PATHNAME to not
+interfere with your editor filename completion."
+  (merge-pathnames pathname (asdf:system-source-directory :sdl2-tutorial)))