Merge pull request #4 from TatriX/refactor

Refactor

.github/workflows/ci.yml

@@ -0,0 +1,29 @@
+name: CI
+
+on: [push]
+
+jobs:
+  test:
+    name: ${{ matrix.lisp }} on ${{ matrix.os }}
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        lisp: [sbcl-bin]
+        os: [ubuntu-latest] # , macOS-latest
+
+    steps:
+      - uses: actions/checkout@v2
+
+      - name: Install SDL2
+        run: |
+          sudo apt install libsdl2-dev libsdl2-image-dev libsdl2-ttf-dev
+
+      - name: Install Roswell
+        env:
+          LISP: ${{ matrix.lisp }}
+        run: |
+          curl -L https://raw.githubusercontent.com/roswell/roswell/master/scripts/install-for-ci.sh | sh
+
+      - name: Run tests
+        run: |
+          ./tests/test.ros

01-hello-sdl.lisp

@@ -0,0 +1,21 @@
+(defpackage #:sdl2-tutorial-01-hello-sdl
+  (:use :cl)
+  (:export :run))
+
+(in-package :sdl2-tutorial-01-hello-sdl)
+
+(defparameter *screen-width* 640)
+(defparameter *screen-height* 480)
+
+(defun run()
+  (sdl2:with-init (:video)
+    (sdl2:with-window (window :title "SDL2 Tutorial 01"
+                              :w *screen-width*
+                              :h *screen-height*
+                              :flags '(:shown))
+      (let ((screen-surface (sdl2:get-window-surface window)))
+        (sdl2:fill-rect screen-surface
+                        nil
+                        (sdl2:map-rgb (sdl2:surface-format screen-surface) 255 255 255))
+        (sdl2:update-window window)
+        (sdl2:delay 2000)))))

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

@@ -0,0 +1,34 @@
+(defpackage #:sdl2-tutorial-02-getting-an-image-on-the-screen
+  (:use :cl)
+  (:export :run)
+  (:import-from :sdl2-tutorial-utils :asset-pathname))
+
+(in-package :sdl2-tutorial-02-getting-an-image-on-the-screen)
+
+(defparameter *screen-width* 640)
+(defparameter *screen-height* 480)
+
+(defmacro with-window-surface ((window surface) &body body)
+  `(sdl2:with-init (:video)
+     (sdl2:with-window (,window
+                        :title "SDL2 Tutorial 02"
+                        :w *screen-width*
+                        :h *screen-height*
+                        :flags '(:shown))
+       (let ((,surface (sdl2:get-window-surface ,window)))
+         ,@body))))
+
+(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)" filename)
+        image)))
+
+(defun run()
+  (with-window-surface (window screen-surface)
+    (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)
+      ;; clean up
+      (sdl2:free-surface image))))

03-event-driven-programming.lisp

@@ -0,0 +1,38 @@
+(defpackage #:sdl2-tutorial-03-event-driven-programming
+  (:use :cl)
+  (:export :run)
+  (:import-from :sdl2-tutorial-utils :asset-pathname))
+
+(in-package :sdl2-tutorial-03-event-driven-programming)
+
+(defparameter *screen-width* 640)
+(defparameter *screen-height* 480)
+
+(defmacro with-window-surface ((window surface) &body body)
+  `(sdl2:with-init (:video)
+     (sdl2:with-window (,window
+                        :title "SDL2 Tutorial 03"
+                        :w *screen-width*
+                        :h *screen-height*
+                        :flags '(:shown))
+       (let ((,surface (sdl2:get-window-surface ,window)))
+         ,@body))))
+
+(defun load-image (pathname)
+  (let ((image (sdl2:load-bmp pathname)))
+    (if (autowrap:wrapper-null-p image)
+        (error "cannot load image ~a (check that file exists)" pathname)
+        image)))
+
+(defun run ()
+  (with-window-surface (window screen-surface)
+    (let ((image (load-image (asset-pathname #P"./assets/03/exit.bmp"))))
+      (sdl2:with-event-loop (:method :poll)
+        (:quit () t)
+        (:idle ()
+               (sdl2:blit-surface image nil screen-surface nil)
+               (sdl2:update-window window)
+               ;; reduce cpu usage
+               (sdl2:delay 100)))
+      ;; clean up
+      (sdl2:free-surface image))))

04-key-presses.lisp

@@ -0,0 +1,53 @@
+(defpackage #:sdl2-tutorial-04-key-presses
+  (:use :cl)
+  (:export :run)
+  (:import-from :sdl2-tutorial-utils :asset-pathname))
+
+(in-package :sdl2-tutorial-04-key-presses)
+
+(defparameter *screen-width* 640)
+(defparameter *screen-height* 480)
+
+(defmacro with-window-surface ((window surface) &body body)
+  `(sdl2:with-init (:video)
+     (sdl2:with-window (,window
+                        :title "SDL2 Tutorial 04"
+                        :w *screen-width*
+                        :h *screen-height*
+                        :flags '(:shown))
+       (let ((,surface (sdl2:get-window-surface ,window)))
+         ,@body))))
+
+(defun load-image (pathname)
+  (let ((image (sdl2:load-bmp pathname)))
+    (if (autowrap:wrapper-null-p image)
+        (error "cannot load image ~a (check that file exists)" pathname)
+        image)))
+
+(defun load-media ()
+  (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)
+    (let* ((images (load-media))
+           (image (getf images :default)))
+      (sdl2:with-event-loop (:method :poll)
+        (:quit () t)
+        (:keydown (:keysym keysym)
+                  (setf image (getf images (case (sdl2:scancode keysym)
+                                             (:scancode-up :up)
+                                             (:scancode-down :down)
+                                             (:scancode-left :left)
+                                             (:scancode-right :right)
+                                             (t :default)))))
+        (:idle ()
+               (sdl2:blit-surface image nil screen-surface nil)
+               (sdl2:update-window window)
+               ;; reduce cpu usage
+               (sdl2:delay 100)))
+      ;; clean up
+      (mapc #'sdl2:free-surface (remove-if #'symbolp images)))))

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

@@ -0,0 +1,41 @@
+(defpackage #:sdl2-tutorial-05-optimized-surface-loading-and-soft-stretching
+  (:use :cl)
+  (:export :run)
+  (:import-from :sdl2-tutorial-utils :asset-pathname))
+
+(in-package :sdl2-tutorial-05-optimized-surface-loading-and-soft-stretching)
+
+(defparameter *screen-width* 640)
+(defparameter *screen-height* 480)
+
+(defmacro with-window-surface ((window surface) &body body)
+  `(sdl2:with-init (:video)
+     (sdl2:with-window (,window
+                        :title "SDL2 Tutorial 05"
+                        :w *screen-width*
+                        :h *screen-height*
+                        :flags '(:shown))
+       (let ((,surface (sdl2:get-window-surface ,window)))
+         ,@body))))
+
+(defun load-surface (pathname pixel-format)
+  (let ((image (sdl2:load-bmp pathname)))
+    (if (autowrap:wrapper-null-p image)
+        (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 (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)
+        (:idle ()
+               (sdl2:blit-scaled image-surface
+                                 nil
+                                 screen-surface
+                                 rect)
+               (sdl2:update-window window)))
+      ;; clean up
+      (sdl2:free-surface image-surface))))

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

@@ -0,0 +1,40 @@
+(defpackage #:sdl2-tutorial-06-extension-libraries-and-loading-other-image-formats
+  (:use :cl)
+  (:export :run)
+  (:import-from :sdl2-tutorial-utils :asset-pathname))
+
+(in-package :sdl2-tutorial-06-extension-libraries-and-loading-other-image-formats)
+
+(defparameter *screen-width* 640)
+(defparameter *screen-height* 480)
+
+(defmacro with-window-surface ((window surface) &body body)
+  `(sdl2:with-init (:video)
+     (sdl2:with-window (,window
+                        :title "SDL2 Tutorial 06"
+                        :w *screen-width*
+                        :h *screen-height*
+                        :flags '(:shown))
+       (let ((,surface (sdl2:get-window-surface ,window)))
+         (sdl2-image:init '(:png))
+         ,@body
+         (sdl2-image:quit)))))
+
+(defun load-surface (pathname 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 (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)))
+
+      ;; cleanup
+      (sdl2:free-surface image-surface))))

7/main.lisp → 07-texture-loading-and-rendering.lisp

@@ -1,33 +1,40 @@
-(defpackage #:sdl2-tutorial-7
-  (:use :common-lisp)
-  (:export :main))
+(defpackage #:sdl2-tutorial-07-texture-loading-and-rendering
+  (:use :cl)
+  (:export :run)
+  (:import-from :sdl2-tutorial-utils :asset-pathname))
 
-(in-package :sdl2-tutorial-7)
+(in-package :sdl2-tutorial-07-texture-loading-and-rendering)
 
 (defparameter *screen-width* 640)
 (defparameter *screen-height* 480)
 
 (defmacro with-window-renderer ((window renderer) &body body)
   `(sdl2:with-init (:video)
      (sdl2:with-window (,window
-                        :title "SDL2 Tutorial"
+                        :title "SDL2 Tutorial 07"
                         :w *screen-width*
                         :h *screen-height*
                         :flags '(:shown))
        (sdl2:with-renderer (,renderer ,window :index -1 :flags '(:accelerated))
-                           ,@body))))
+         ,@body))))
 
-(defun load-texture (renderer filename)
-  (sdl2:create-texture-from-surface renderer (sdl2-image:load-image filename)))
 
-(defun main()
+(defun load-texture (renderer pathname)
+  (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))
     (sdl2:set-render-draw-color renderer #xFF #xFF #xFF #xFF)
-    (let ((texture (load-texture renderer "7/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))))

08-geometry-rendering.lisp

@@ -0,0 +1,60 @@
+(defpackage #:sdl2-tutorial-08-geometry-rendering
+  (:use :cl)
+  (:export :run))
+
+(in-package :sdl2-tutorial-08-geometry-rendering)
+
+(defparameter *screen-width* 640)
+(defparameter *screen-height* 480)
+
+(defmacro with-window-renderer ((window renderer) &body body)
+  `(sdl2:with-init (:video)
+     (sdl2:with-window (,window
+                        :title "SDL2 Tutorial 08"
+                        :w *screen-width*
+                        :h *screen-height*
+                        :flags '(:shown))
+       (sdl2:with-renderer (,renderer ,window :index -1 :flags '(:accelerated))
+         ,@body))))
+
+(defun run ()
+  (with-window-renderer (window renderer)
+    (sdl2-image:init '(:png))
+    (sdl2:with-event-loop (:method :poll)
+      (:quit () t)
+      (:idle ()
+             ;; Clear screen
+             (sdl2:set-render-draw-color renderer #xFF #xFF #xFF #xFF)
+             (sdl2:render-clear renderer)
+
+             ;; Render red filled quad
+             (sdl2:with-rects ((fill-rect (/ *screen-width* 4)
+                                          (/ *screen-height* 4)
+                                          (/ *screen-width* 2)
+                                          (/ *screen-height* 2)))
+               (sdl2:set-render-draw-color renderer #xFF #x00 #x00 #xFF)
+               (sdl2:render-fill-rect renderer fill-rect))
+
+             ;; Render green outlined quad
+             (sdl2:with-rects ((outline-rect (round (/ *screen-width* 6))
+                                             (round (/ *screen-height* 8))
+                                             (round (* 2/3 *screen-width*))
+                                             (round (* 2/3 *screen-height*))))
+               (sdl2:set-render-draw-color renderer #x00 #xFF #x00 #xFF)
+               (sdl2:render-draw-rect renderer outline-rect))
+
+             ;; Draw blue horizontal line
+             (sdl2:set-render-draw-color renderer #x00 #x00 #xFF #xFF)
+             (sdl2:render-draw-line renderer
+                                    0
+                                    (/ *screen-height* 2)
+                                    *screen-width*
+                                    (/ *screen-height* 2))
+
+             ;; Draw vertical line of yellow dots
+             (sdl2:set-render-draw-color renderer #xFF #xFF #x00 #xFF)
+             (loop for i from 0 below *screen-height* by 4
+                   do (sdl2::render-draw-point renderer (/ *screen-width* 2) i))
+
+             ;; Update screen
+             (sdl2:render-present renderer)))))