~octaspire/cl-octaspire-sdl2

1071250aa22c890ce5ec86429539c45c38fd0b67 — octaspire 9 months ago a2fdf5e main
Add, export, and test multiple functions, structs and constants
M .gitignore => .gitignore +1 -0
@@ 1,2 1,3 @@
*.fasl
test/assets.lisp
test-render-save-screenshot.bmp

M Makefile => Makefile +2 -1
@@ 35,7 35,8 @@ swank:
	@$(LISP) $(LOAD) etc/swank.lisp

clean:
	@rm -f src/*.fasl test/*.fasl test/assets.lisp
	@rm -f src/*.fasl test/*.fasl test/assets.lisp \
          test-render-save-screenshot.bmp

help:
	@echo ""

M cl-octaspire-sdl2.asd => cl-octaspire-sdl2.asd +5 -1
@@ 22,9 22,12 @@
    :pathname "src/"
  :serial t
  :components ((:file "package")
               (:file "utils")
               (:file "sdl2")
               (:file "sdl2-rwops")
               (:file "sdl2-rect")
               (:file "sdl2-pixels")
               (:file "sdl2-surface")
               (:file "utils")
               (:file "sdl2-render")
               (:file "sdl2-video")
               (:file "sdl2-image")


@@ 38,6 41,7 @@
  :components ((:file "package")
               (:file "assets") ; Autogenerated with `make test/assets.lisp`
               (:file "sdl2-test")
               (:file "utils-test")
               (:file "sdl2-image-test")
               (:file "sdl2-render-test")
               (:file "sdl2-mixer-test"))

M src/package.lisp => src/package.lisp +20 -0
@@ 38,14 38,33 @@
   :with-renderer
   :with-everything :ri :rf :wt :wx :wy :ww :wh :wi :flags
   ; Surface
   :sdl-surface
   :freesurface
   :blitsurface
   :creatergbsurfacewithformat
   ; Video
   :getwindowsurface
   ; Render
   :rendercopy
   :renderpresent
   :renderclear
   :setrenderdrawcolor
   :renderreadpixels
   :render-save-screenshot
   ; Rect
   :sdl-rect
   ; Pixels
   +PIXELTYPE-UNKNOWN+ +PIXELTYPE-INDEX1+ +PIXELTYPE-INDEX4+ +PIXELTYPE-INDEX8+
     +PIXELTYPE-PACKED8+ +PIXELTYPE-PACKED16+ +PIXELTYPE-PACKED32+ +PIXELTYPE-ARRAYU8+
     +PIXELTYPE-ARRAYU16+ +PIXELTYPE-ARRAYU32+ +PIXELTYPE-ARRAYF16+ +PIXELTYPE-ARRAYF32+
   +PACKEDORDER-NONE+ +PACKEDORDER-XRGB+ +PACKEDORDER-RGBX+ +PACKEDORDER-ARGB+
     +PACKEDORDER-RGBA+ +PACKEDORDER-XBGR+ +PACKEDORDER-BGRX+ +PACKEDORDER-ABGR+
     +PACKEDORDER-BGRA+
   +PACKEDLAYOUT-NONE+ +PACKEDLAYOUT-332+ +PACKEDLAYOUT-4444+ +PACKEDLAYOUT-1555+
     +PACKEDLAYOUT-5551+ +PACKEDLAYOUT-565+ +PACKEDLAYOUT-8888+ +PACKEDLAYOUT-2101010+
     +PACKEDLAYOUT-1010102+
   :define-pixelformat
   +PIXELFORMAT-ARGB8888+
   ; Game
   :game
   :game-running-p


@@ 59,6 78,7 @@
   :with-gameloop
   ; RWops
   :rwfromconstmem
   :rwfromfile
   ; SDL_Mixer
   :mix-init
   :mix-initflags :MIX-INIT-FLAC :MIX-INIT-MOD :MIX-INIT-MP3 :MIX-INIT-OGG

A src/sdl2-pixels.lisp => src/sdl2-pixels.lisp +94 -0
@@ 0,0 1,94 @@
;; Copyright (c) 2020, 2021, 2022 octaspire.com
;;
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:

;; The above copyright notice and this permission notice shall be included in all
;; copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.
(in-package :cl-octaspire-sdl2)

#+sbcl
(eval-when (:compile-toplevel :load-toplevel :execute)
  (sb-int:set-floating-point-modes :traps nil))

#+ecl
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ext:trap-fpe t nil))

;; Pixel type. In C this is enum SDL_PixelType that is
;; defined in file SDL2/SDL_pixels.h.
(defconstant +PIXELTYPE-UNKNOWN+  0)
(defconstant +PIXELTYPE-INDEX1+   1)
(defconstant +PIXELTYPE-INDEX4+   2)
(defconstant +PIXELTYPE-INDEX8+   3)
(defconstant +PIXELTYPE-PACKED8+  4)
(defconstant +PIXELTYPE-PACKED16+ 5)
(defconstant +PIXELTYPE-PACKED32+ 6)
(defconstant +PIXELTYPE-ARRAYU8+  7)
(defconstant +PIXELTYPE-ARRAYU16+ 8)
(defconstant +PIXELTYPE-ARRAYU32+ 9)
(defconstant +PIXELTYPE-ARRAYF16+ 10)
(defconstant +PIXELTYPE-ARRAYF32+ 11)

;; Packed component order, from high to low bit. In C this
;; is enum SDL_PackedOrder that is defined in file
;; SDL2/SDL_pixels.h.
(defconstant +PACKEDORDER-NONE+ 0)
(defconstant +PACKEDORDER-XRGB+ 1)
(defconstant +PACKEDORDER-RGBX+ 2)
(defconstant +PACKEDORDER-ARGB+ 3)
(defconstant +PACKEDORDER-RGBA+ 4)
(defconstant +PACKEDORDER-XBGR+ 5)
(defconstant +PACKEDORDER-BGRX+ 6)
(defconstant +PACKEDORDER-ABGR+ 7)
(defconstant +PACKEDORDER-BGRA+ 8)

;; Packed component layout.
(defconstant +PACKEDLAYOUT-NONE+    0
  "In C this is part of enum SDL_PackedLayout, defined in SDL2/SDL_pixels.h.")
(defconstant +PACKEDLAYOUT-332+     1
  "In C this is part of enum SDL_PackedLayout, defined in SDL2/SDL_pixels.h.")
(defconstant +PACKEDLAYOUT-4444+    2
  "In C this is part of enum SDL_PackedLayout, defined in SDL2/SDL_pixels.h.")
(defconstant +PACKEDLAYOUT-1555+    3
  "In C this is part of enum SDL_PackedLayout, defined in SDL2/SDL_pixels.h.")
(defconstant +PACKEDLAYOUT-5551+    4
  "In C this is part of enum SDL_PackedLayout, defined in SDL2/SDL_pixels.h.")
(defconstant +PACKEDLAYOUT-565+     5
  "In C this is part of enum SDL_PackedLayout, defined in SDL2/SDL_pixels.h.")
(defconstant +PACKEDLAYOUT-8888+    6
  "In C this is part of enum SDL_PackedLayout, defined in SDL2/SDL_pixels.h.")
(defconstant +PACKEDLAYOUT-2101010+ 7
  "In C this is part of enum SDL_PackedLayout, defined in SDL2/SDL_pixels.h.")
(defconstant +PACKEDLAYOUT-1010102+ 8
  "In C this is part of enum SDL_PackedLayout, defined in SDL2/SDL_pixels.h.")

(eval-when (:compile-toplevel :load-toplevel :execute)
  ;; EVAL-WHEN needed because this function is used in DEFCONSTANT
  ;; forms below. Another option would be to put this to function
  ;; into separate file that this file depends on (or to use variables
  ;; instead of constants).
  (defun define-pixelformat (type order layout bits bytes)
    "Defined in SDL2/SDL_pixels.h."
    (logior (ash 1      28)
            (ash type   24)
            (ash order  20)
            (ash layout 16)
            (ash bits   8)
            (ash bytes  0))))

(defconstant +PIXELFORMAT-ARGB8888+
  (define-pixelformat +PIXELTYPE-PACKED32+ +PACKEDORDER-ARGB+ +PACKEDLAYOUT-8888+ 32 4)
  "In C this is part of enum SDL_PixelFormatEnum, defined in file SDL2/SDL_pixels.h.")

A src/sdl2-rect.lisp => src/sdl2-rect.lisp +36 -0
@@ 0,0 1,36 @@
;; Copyright (c) 2020, 2021, 2022 octaspire.com
;;
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:

;; The above copyright notice and this permission notice shall be included in all
;; copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.
(in-package :cl-octaspire-sdl2)

#+sbcl
(eval-when (:compile-toplevel :load-toplevel :execute)
  (sb-int:set-floating-point-modes :traps nil))

#+ecl
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ext:trap-fpe t nil))

(defcstruct sdl-rect
  "Rectangle, with integer components, and origin in the upper left.
Defined in SDL2/SDL_rect.h."
  (x :int)
  (y :int)
  (w :int)
  (h :int))

M src/sdl2-render.lisp => src/sdl2-render.lisp +18 -0
@@ 49,3 49,21 @@ Returns 0 on success and negative error code on failure.
In case of error function GETERROR gives more information.
Declared in SDL2/SDL_render.h."
  (renderer :pointer))

(defcfun ("SDL_SetRenderDrawColor" setrenderdrawcolor) :int
  "Set color used for drawing (rect, line, and clear) operations.
Declared in SDL2/SDL_render.h."
  (renderer :pointer)
  (r        :uint8)
  (g        :uint8)
  (b        :uint8)
  (a        :uint8))

(defcfun ("SDL_RenderReadPixels" renderreadpixels) :int
  "Read an array of PIXELS from current rendering target.
Declared in SDL2/SDL_render.h."
  (renderer :pointer)
  (rect     :pointer)
  (format   :uint32)
  (pixels   :pointer)
  (pitch    :int))

A src/sdl2-rwops.lisp => src/sdl2-rwops.lisp +45 -0
@@ 0,0 1,45 @@
;; Copyright (c) 2020, 2021, 2022 octaspire.com
;;
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:

;; The above copyright notice and this permission notice shall be included in all
;; copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.
(in-package :cl-octaspire-sdl2)

#+sbcl
(eval-when (:compile-toplevel :load-toplevel :execute)
  (sb-int:set-floating-point-modes :traps nil))

#+ecl
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ext:trap-fpe t nil))

(defcfun ("SDL_RWFromConstMem" rwfromconstmem) :pointer
  "Prepare a read-only memory buffer, for use with RWops. Use contents of memory
pointed by MEM and of SIZE bytes. Declared in file SDL/SDL_rwops.h."
  (mem  :pointer)
  (size :int))

(defcfun ("SDL_RWFromFile" rwfromfile) :pointer
  "This function can be used to create a new SDL_RWops structure for reading from
and/or writing to the given FILE using given MODE. Declared in file SDL/SDL_rwops.h.
Parameters:
  FILE  UTF-8 string representing the filename to open.
  MODE  ASCII string representing the mode used when opening.
Returns:
  :pointer to the new SDL_RWops structure, or NIL on failure."
  (file (:string :encoding :utf-8))
  (mode (:string :encoding :ascii)))

M src/sdl2-surface.lisp => src/sdl2-surface.lisp +31 -0
@@ 27,6 27,22 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ext:trap-fpe t nil))

(defcstruct sdl-surface
  "Collection of pixels used in software blitting. Defined in file
SDL2/SDL_surface.h."
  (flags        :uint32)
  (format       :pointer)
  (w            :int)
  (h            :int)
  (pitch        :int)
  (pixels       :pointer)
  (userdata     :pointer)
  (locked       :int)
  (list-blitmap :pointer)
  (clip-rect    (:struct sdl-rect))
  (map          :pointer)
  (refcount     :int))

(defcfun ("SDL_FreeSurface" freesurface) :void
  "Free RGB surface. Declared in SDL2/SDL_surface.h"
  (surface :pointer))


@@ 37,3 53,18 @@
  (srcrect :pointer)
  (dst     :pointer)
  (dstrect :pointer))

(defcfun ("SDL_SaveBMP_RW" savebmp-rw) :int
  "Save SURFACE to SDL data stream in BMP format. Declared in SDL2/SDL_surface.h."
  (surface :pointer)
  (dts     :pointer)
  (freedst :int))

(defcfun ("SDL_CreateRGBSurfaceWithFormat" creatergbsurfacewithformat) :pointer
  "Allocate new RGB surface with the given pixel format.
Declared in SDL2/SDL_surface.h."
  (flags  :uint32)
  (width  :int)
  (height :int)
  (depth  :int)
  (format :uint32))

M src/sdl2.lisp => src/sdl2.lisp +0 -8
@@ 240,11 240,3 @@ methods on GAME."
      (game-update-low game)
      (game-render     game)
      (game-sleep-low  game))))

; Declared in SDL/SDL_rwops.h

(defcfun ("SDL_RWFromConstMem" rwfromconstmem) :pointer
  "Prepare a read-only memory buffer, for use with RWops. Use contents of memory
pointed by MEM and of SIZE bytes. Declared in file SDL/SDL_rwops.h."
  (mem  :pointer)
  (size :int))

M src/utils.lisp => src/utils.lisp +9 -0
@@ 53,3 53,12 @@
    (if mus?
        (mix-playmusic chunk 1)
        (mix-playchanneltimed -1 chunk 0 -1))))

(defun render-save-screenshot (renderer path)
  (let ((format +PIXELFORMAT-ARGB8888+))
    (with-foreign-objects ((surface :pointer))
      (setf surface (creatergbsurfacewithformat 0 640 480 32 format))
      (with-foreign-slots ((pixels pitch) surface (:struct sdl-surface))
        (renderreadpixels renderer (null-pointer) format pixels pitch))
      (savebmp-rw surface (rwfromfile path "wb") 1)
      (freesurface surface))))

M test/sdl2-image-test.lisp => test/sdl2-image-test.lisp +4 -0
@@ 23,6 23,10 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
  (sb-int:set-floating-point-modes :traps nil))

#+ecl
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ext:trap-fpe t nil))

(fiveam:in-suite cl-octaspire-sdl2-suite)

(fiveam:test test-with-image

M test/sdl2-mixer-test.lisp => test/sdl2-mixer-test.lisp +4 -0
@@ 23,6 23,10 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
  (sb-int:set-floating-point-modes :traps nil))

#+ecl
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ext:trap-fpe t nil))

(fiveam:in-suite cl-octaspire-sdl2-suite)

(fiveam:test test-with-mixer

M test/sdl2-render-test.lisp => test/sdl2-render-test.lisp +16 -0
@@ 23,6 23,10 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
  (sb-int:set-floating-point-modes :traps nil))

#+ecl
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ext:trap-fpe t nil))

(fiveam:in-suite cl-octaspire-sdl2-suite)

(fiveam:test test-renderclear-renderpresent


@@ 36,3 40,15 @@
          (setf var 123)))
      (is (= 123 var)))))

(fiveam:test test-setrenderdrawcolor-renderclear-renderpresent
  (with-init (#x20)
    (let ((var 1))
      (with-window ("name" 0 0 128 256 0)
        (with-renderer (window 0 0)
          (setrenderdrawcolor renderer #xFF #xFF #xFF #xFF)
          (renderclear renderer)
          (renderpresent renderer)
          (sleep 1)
          (setf var 123)))
      (is (= 123 var)))))


M test/sdl2-test.lisp => test/sdl2-test.lisp +4 -0
@@ 23,6 23,10 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
  (sb-int:set-floating-point-modes :traps nil))

#+ecl
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ext:trap-fpe t nil))

(fiveam:def-suite cl-octaspire-sdl2-suite
  :description "Top level suite for testing CL-OCTASPIRE-SDL2.")


A test/utils-test.lisp => test/utils-test.lisp +48 -0
@@ 0,0 1,48 @@
;; Copyright (c) 2020, 2021, 2022 octaspire.com
;;
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:

;; The above copyright notice and this permission notice shall be included in all
;; copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.
(in-package :cl-octaspire-sdl2/test)

#+sbcl
(eval-when (:compile-toplevel :load-toplevel :execute)
  (sb-int:set-floating-point-modes :traps nil))

#+ecl
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ext:trap-fpe t nil))

(fiveam:in-suite cl-octaspire-sdl2-suite)

(fiveam:test test-render-save-screenshot
  (let ((var 1)
        (path "test-render-save-screenshot.bmp"))
    (with-everything (0 0 "title" 0 0 100 100 0 #x20)
      (with-image (#x2)
        (cffi:with-foreign-objects ((texture :pointer)
                                    (nrect :pointer))
          (setf nrect (null-pointer))
          (with-texture-load-rw (renderer *red.png* texture)
            (rendercopy renderer texture nrect nrect)
            (render-save-screenshot renderer path)
            ;; TODO this just makes sure that the file exists. Add pixel level
            ;; comparison of the data, to make sure that image contains
            ;; correct screenshot image.
            (is (probe-file path))
            (setf var 123)))))
    (is (= 123 var))))