From 2ecdf1e97f415a5818c4dcd7a2ddff6dc7ecdd0f Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 30 Apr 2021 09:25:23 -0400
Subject: Add fallback method for loading shared libraries.

---
 sdl2/bindings.scm       |  2 +-
 sdl2/bindings/image.scm |  2 +-
 sdl2/bindings/mixer.scm |  2 +-
 sdl2/bindings/ttf.scm   |  2 +-
 sdl2/config.scm.in      | 38 +++++++++++++++++++++++++++++++++-----
 5 files changed, 37 insertions(+), 9 deletions(-)

(limited to 'sdl2')

diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm
index c46af8b..05d31fb 100644
--- a/sdl2/bindings.scm
+++ b/sdl2/bindings.scm
@@ -30,7 +30,7 @@
   #:use-module (sdl2 config))
 
 (define sdl-func
-  (let ((lib (dynamic-link %libsdl2)))
+  (let ((lib (dynamic-link* %libsdl2)))
     (lambda (return-type function-name arg-types)
       "Return a procedure for the foreign function FUNCTION-NAME in
 the SDL2 shared library.  That function must return a value of
diff --git a/sdl2/bindings/image.scm b/sdl2/bindings/image.scm
index 598c024..0902d6c 100644
--- a/sdl2/bindings/image.scm
+++ b/sdl2/bindings/image.scm
@@ -28,7 +28,7 @@
   #:use-module (sdl2 config))
 
 (define sdl-image-func
-  (let ((lib (dynamic-link %libsdl2-image)))
+  (let ((lib (dynamic-link* %libsdl2-image)))
     (lambda (return-type function-name arg-types)
       "Return a procedure for the foreign function FUNCTION-NAME in
 the SDL2_image shared library.  That function must return a value of
diff --git a/sdl2/bindings/mixer.scm b/sdl2/bindings/mixer.scm
index 638b409..73b5fdb 100644
--- a/sdl2/bindings/mixer.scm
+++ b/sdl2/bindings/mixer.scm
@@ -30,7 +30,7 @@
   #:use-module (sdl2 bindings))
 
 (define sdl-mixer-func
-  (let ((lib (dynamic-link %libsdl2-mixer)))
+  (let ((lib (dynamic-link* %libsdl2-mixer)))
     (lambda (return-type function-name arg-types)
       "Return a procedure for the foreign function FUNCTION-NAME in
 the SDL2_mixer shared library.  That function must return a value of
diff --git a/sdl2/bindings/ttf.scm b/sdl2/bindings/ttf.scm
index 1accf6c..f559da4 100644
--- a/sdl2/bindings/ttf.scm
+++ b/sdl2/bindings/ttf.scm
@@ -29,7 +29,7 @@
   #:use-module (sdl2 bindings))
 
 (define sdl-ttf-func
-  (let ((lib (dynamic-link %libsdl2-ttf)))
+  (let ((lib (dynamic-link* %libsdl2-ttf)))
     (lambda (return-type function-name arg-types)
       "Return a procedure for the foreign function FUNCTION-NAME in
 the SDL2_ttf shared library.  That function must return a value of
diff --git a/sdl2/config.scm.in b/sdl2/config.scm.in
index b9121ab..b1343dd 100644
--- a/sdl2/config.scm.in
+++ b/sdl2/config.scm.in
@@ -1,14 +1,42 @@
 (define-module (sdl2 config)
-  #:export (%libsdl2
+  #:use-module (ice-9 match)
+  #:use-module (system foreign)
+  #:export (dynamic-link*
+            %libsdl2
             %libsdl2-image
             %libsdl2-ttf
             %libsdl2-mixer))
 
+;; Try to link against multiple library possibilities, such as the
+;; absolute file name discovered by ./configure or by searching the
+;; library load path as a fallback method.  Useful when restributing
+;; relocatable builds.
+(define (dynamic-link* names)
+  (let loop ((names names))
+    (match names
+      (()
+       (error "could not find library" names))
+      ((name . rest)
+       (or (false-if-exception (dynamic-link name))
+           (loop rest))))))
+
 ;; Special case Windows since the DLL names are different.  Performing
 ;; this check at runtime allows a Linux machine to cross-compile
 ;; guile-sdl2 for a Windows target.
 (define %windows? (string-prefix? "Windows" (utsname:sysname (uname))))
-(define %libsdl2 (if %windows? "SDL2" "@SDL2_LIBDIR@/libSDL2"))
-(define %libsdl2-image (if %windows? "SDL2_image" "@SDL2_IMAGE_LIBDIR@/libSDL2_image"))
-(define %libsdl2-ttf (if %windows? "SDL2_ttf" "@SDL2_TTF_LIBDIR@/libSDL2_ttf"))
-(define %libsdl2-mixer (if %windows? "SDL2_mixer" "@SDL2_MIXER_LIBDIR@/libSDL2_mixer"))
+(define %libsdl2
+  (if %windows?
+      '("SDL2")
+      '("@SDL2_LIBDIR@/libSDL2" "libSDL2")))
+(define %libsdl2-image
+  (if %windows?
+      '("SDL2_image")
+      '("@SDL2_IMAGE_LIBDIR@/libSDL2_image" "libSDL2_image")))
+(define %libsdl2-ttf
+  (if %windows?
+      '("SDL2_ttf")
+      '("@SDL2_TTF_LIBDIR@/libSDL2_ttf" "libSDL2_ttf")))
+(define %libsdl2-mixer
+  (if %windows?
+      '("SDL2_mixer")
+      '("@SDL2_MIXER_LIBDIR@/libSDL2_mixer" "libSDL2_mixer")))
-- 
cgit v1.2.3