16 files changed, 337 insertions(+), 10 deletions(-)

M .gitignore
M Makefile
M cl-octaspire-sdl2.asd
M src/package.lisp
A src/sdl2-pixels.lisp
A src/sdl2-rect.lisp
M src/sdl2-render.lisp
A src/sdl2-rwops.lisp
M src/sdl2-surface.lisp
M src/sdl2.lisp
M src/utils.lisp
M test/sdl2-image-test.lisp
M test/sdl2-mixer-test.lisp
M test/sdl2-render-test.lisp
M test/sdl2-test.lisp
A test/utils-test.lisp

@@ 1,2 1,3 @@
 *.fasl
 test/assets.lisp
+test-render-save-screenshot.bmp

@@ 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 ""

@@ 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"))

@@ 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

@@ 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.")

@@ 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))

@@ 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))

@@ 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)))

@@ 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))

@@ 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))

@@ 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))))

@@ 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

@@ 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

@@ 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)))))
+

@@ 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.")
 

@@ 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))))