Upgrade to SDL2!

This commit is massive and crazy and I'm not going to do the usual GNU
ChangeLog thing because it's just too much.  Let's just be happy that
the port is completed!

2 files changed, 50 insertions, 57 deletions

diff --git a/sly/render/font.scm b/sly/render/font.scm
index 433e4bc..f9d1a91 100644
--- a/sly/render/font.scm
+++ b/sly/render/font.scm
@@ -27,8 +27,9 @@
   #:use-module (srfi srfi-4)
   #:use-module (srfi srfi-9)
   #:use-module (system foreign)
-  #:use-module ((sdl sdl) #:prefix SDL:)
-  #:use-module ((sdl ttf) #:prefix SDL:)
+  #:use-module ((sdl2) #:prefix sdl2:)
+  #:use-module ((sdl2 surface) #:prefix sdl2:)
+  #:use-module ((sdl2 ttf) #:prefix sdl2:)
   #:use-module (gl)
   #:use-module (sly wrappers gl)
   #:use-module (sly render color)
@@ -47,7 +48,7 @@
 ;;;
 
 (define (enable-fonts)
-  (SDL:ttf-init))
+  (sdl2:ttf-init))
 
 (define-record-type <font>
   (make-font ttf point-size)
@@ -58,7 +59,7 @@
 (define (load-font filename point-size)
   "Load the TTF font in FILENAME with the given POINT-SIZE."
   (if (file-exists? filename)
-      (make-font (SDL:load-font filename point-size) point-size)
+      (make-font (sdl2:load-font filename point-size) point-size)
       (error "File not found!" filename)))
 
 (define* (load-default-font #:optional (point-size 12))
@@ -66,33 +67,14 @@
 argument with a default value of 12."
   (load-font (string-append %datadir "/fonts/DejaVuSans.ttf") point-size))
 
-(define (flip-pixels-vertically pixels width height)
-  "Create a new bytevector that reverses the rows in PIXELS, a WIDTH x
-HEIGHT, 32 bit color bytevector."
-  (let ((buffer (make-u8vector (bytevector-length pixels)))
-        (row-width (* width 4))) ; assuming 32 bit color
-    (let loop ((y 0))
-      (when (< y height)
-        (let* ((y* (- height y 1))
-               (source-start (* y row-width))
-               (target-start (* y* row-width)))
-          (bytevector-copy! pixels source-start buffer target-start row-width)
-          (loop (1+ y)))))
-    buffer))
+(define %sdl-white (sdl2:make-color 255 255 255 255))
 
 (define (render-text font text)
   "Return a new texture with TEXT rendered using FONT."
   ;; An empty string will result in a surface value of #f, in which
   ;; case we want to abort the texture creation process.
-  (and-let* ((surface (SDL:render-utf8 (font-ttf font) text
-                                       (SDL:make-color 255 255 255) #t))
-             (width (SDL:surface:w surface))
-             (height (SDL:surface:h surface))
-             ;; Need to flip pixels so that origin is on the bottom-left.
-             (pixels (flip-pixels-vertically (SDL:surface-pixels surface)
-                                             width height)))
-    ;; Need to flip pixels so that origin is on the bottom-left.
-    (bytevector->texture pixels width height 'linear 'linear)))
+  (let ((surface (sdl2:render-font-blended (font-ttf font) text %sdl-white)))
+    ((@@ (sly render texture) surface->texture) surface 'linear 'linear)))
 
 (define* (make-label font text #:key (anchor 'top-left))
   "Create a sprite that displays TEXT rendered using FONT.  ANCHOR
diff --git a/sly/render/texture.scm b/sly/render/texture.scm
index ef8c3ea..bb7f88c 100644
--- a/sly/render/texture.scm
+++ b/sly/render/texture.scm
@@ -24,18 +24,19 @@
 
 (define-module (sly render texture)
   #:use-module (ice-9 match)
+  #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-9)
   #:use-module (gl)
   #:use-module (gl low-level)
   #:use-module (gl contrib packed-struct)
+  #:use-module (sdl2 image)
+  #:use-module (sdl2 surface)
   #:use-module (sly render color)
   #:use-module (sly utils)
   #:use-module (sly math vector)
   #:use-module (sly wrappers gl)
-  #:use-module (sly wrappers freeimage)
   #:export (make-texture
             make-texture-region
-            bytevector->texture
             load-texture
             texture?
             texture-region?
@@ -140,36 +141,46 @@ downscaling and MAG-FILTER for upscaling."
                            pixels))
     (make-texture texture-id #f width height 0 0 1 1)))
 
-(define (bitmap->texture bitmap min-filter mag-filter)
-  "Translates a freeimage bitmap into an OpenGL texture."
-  (bytevector->texture (freeimage-get-bits bitmap)
-                       (freeimage-get-width bitmap)
-                       (freeimage-get-height bitmap)
-                       min-filter mag-filter
-                       (version-1-2 bgra)))
-
-(define (load-bitmap filename)
-  ;; Throw an error if image file does not exist or else we will
-  ;; segfault later.
-  (unless (file-exists? filename)
-    (throw 'image-not-found filename))
-  ;; Load image and convert it to 32 bit color.
-  (let* ((image-type (freeimage-get-file-type filename))
-         (bitmap (freeimage-load image-type filename))
-         (32bit-bitmap (freeimage-convert-to-32-bits bitmap)))
-    (freeimage-unload bitmap)
-    32bit-bitmap))
-
-(define* (load-texture file-name #:optional #:key
+(define (flip-pixels-vertically pixels width height)
+  "Create a new bytevector that reverses the rows in PIXELS, a WIDTH x
+HEIGHT, 32 bit color bytevector."
+  (let ((buffer (make-u8vector (bytevector-length pixels)))
+        (row-width (* width 4))) ; assuming 32 bit color
+    (let loop ((y 0))
+      (when (< y height)
+        (let* ((y* (- height y 1))
+               (source-start (* y row-width))
+               (target-start (* y* row-width)))
+          (bytevector-copy! pixels source-start buffer target-start row-width)
+          (loop (1+ y)))))
+    buffer))
+
+(define (surface->texture surface min-filter mag-filter)
+  "Convert SURFACE, an SDL2 surface object, into a texture that uses
+the given MIN-FILTER and MAG-FILTER."
+  ;; Convert to 32 bit RGBA color.
+  (call-with-surface (convert-surface-format surface 'abgr8888)
+    (lambda (surface)
+      (let* ((width (surface-width surface))
+             (height (surface-height surface))
+             ;; OpenGL textures use the bottom-left corner as the
+             ;; origin, whereas SDL uses the top-left, so the rows
+             ;; of pixels must be reversed before creating a
+             ;; texture from them.
+             (pixels (flip-pixels-vertically (surface-pixels surface)
+                                             width height)))
+        (bytevector->texture pixels width height
+                             min-filter mag-filter)))))
+
+(define* (load-texture file #:optional #:key
                        (min-filter 'nearest) (mag-filter 'nearest))
-  "Load a texture from an image file at FILENAME.  MIN-FILTER and
-MAG-FILTER describe the method that should be used for minification
-and magnification.  Valid values are 'nearest and 'linear.  By
-default, 'nearest is used."
-  (let* ((bitmap (load-bitmap file-name))
-         (texture (bitmap->texture bitmap min-filter mag-filter)))
-    (freeimage-unload bitmap)
-    texture))
+  "Load a texture from an image in FILE.  MIN-FILTER and MAG-FILTER
+describe the method that should be used for minification and
+magnification.  Valid values are 'nearest and 'linear.  By default,
+'nearest is used."
+  (call-with-surface (load-image file)
+    (lambda (surface)
+      (surface->texture surface min-filter mag-filter))))
 
 (define (anchor-texture texture anchor)
   "Translate ANCHOR into a vector that represents the desired centtral