From ae593ad31e46905a1734e7936e7c9438ed977f2e Mon Sep 17 00:00:00 2001 From: TatriX Date: Thu, 29 Jul 2021 22:21:38 +0200 Subject: [PATCH] Refactor tutorial 10 --- 10/tutorial-10.lisp => 10-color-keying.lisp | 53 +++++++++++--------- {10 => assets/10}/background.png | Bin {10 => assets/10}/player.png | Bin 3 files changed, 29 insertions(+), 24 deletions(-) rename 10/tutorial-10.lisp => 10-color-keying.lisp (54%) rename {10 => assets/10}/background.png (100%) rename {10 => assets/10}/player.png (100%) diff --git a/10/tutorial-10.lisp b/10-color-keying.lisp similarity index 54% rename from 10/tutorial-10.lisp rename to 10-color-keying.lisp index 4c9d341..dac4510 100644 --- a/10/tutorial-10.lisp +++ b/10-color-keying.lisp @@ -1,8 +1,9 @@ -(defpackage #:sdl2-tutorial-10 - (:use :common-lisp) - (:export :main)) +(defpackage #:sdl2-tutorial-10-color-keying + (:use :cl) + (:export :run) + (:import-from :sdl2-tutorial-utils :asset-pathname)) -(in-package :sdl2-tutorial-10) +(in-package :sdl2-tutorial-10-color-keying) (defparameter *screen-width* 640) (defparameter *screen-height* 480) @@ -18,18 +19,22 @@ :accessor tex-height :initform 0) (texture - :accessor tex-texture :initform nil))) -(defun load-texture-from-file (renderer filename) +(defun free-tex (tex) + (with-slots (texture) tex + (sdl2:destroy-texture texture))) + +(defun load-texture-from-file (renderer pathname) (let ((tex (make-instance 'tex :renderer renderer))) (with-slots (renderer texture width height) tex - (let ((surface (sdl2-image:load-image filename))) + (let ((surface (sdl2-image:load-image pathname))) (setf width (sdl2:surface-width surface)) (setf height (sdl2:surface-height surface)) (sdl2:set-color-key surface :true (sdl2:map-rgb (sdl2:surface-format surface) 0 #xFF #xFF)) - (setf texture (sdl2:create-texture-from-surface renderer surface)))) + (setf texture (sdl2:create-texture-from-surface renderer surface)) + (sdl2:free-surface surface))) tex)) (defun render (tex x y) @@ -39,28 +44,28 @@ (defmacro with-window-renderer ((window renderer) &body body) `(sdl2:with-init (:video) (sdl2:with-window (,window - :title "SDL2 Tutorial" + :title "SDL2 Tutorial 10" :w *screen-width* :h *screen-height* :flags '(:shown)) (sdl2:with-renderer (,renderer ,window :index -1 :flags '(:accelerated)) - ,@body)))) - -(defun load-texture (renderer filename) - (sdl2:create-texture-from-surface renderer (sdl2-image:load-image filename))) + ,@body)))) -(defun main() +(defun run() (with-window-renderer (window renderer) (sdl2-image:init '(:png)) - (let ((background-tex (load-texture-from-file renderer "10/background.png")) - (player-tex (load-texture-from-file renderer "10/player.png"))) - (sdl2:with-event-loop (:method :poll) - (:quit () t) - (:idle () - (sdl2:set-render-draw-color renderer #xFF #xFF #xFF #xFF) - (sdl2:render-clear renderer) + (let ((background-tex (load-texture-from-file renderer (asset-pathname #P"assets/10/background.png"))) + (player-tex (load-texture-from-file renderer (asset-pathname #P"assets/10/player.png")))) + (sdl2:with-event-loop () + (:quit () t) + (:idle () + (sdl2:set-render-draw-color renderer #xFF #xFF #xFF #xFF) + (sdl2:render-clear renderer) - (render background-tex 0 0) - (render player-tex 240 190) + (render background-tex 0 0) + (render player-tex 240 190) - (sdl2:render-present renderer)))))) + (sdl2:render-present renderer))) + ;; clean up + (free-tex background-tex) + (free-tex player-tex)))) diff --git a/10/background.png b/assets/10/background.png similarity index 100% rename from 10/background.png rename to assets/10/background.png diff --git a/10/player.png b/assets/10/player.png similarity index 100% rename from 10/player.png rename to assets/10/player.png