From 2ecdf1e97f415a5818c4dcd7a2ddff6dc7ecdd0f Mon Sep 17 00:00:00 2001 From: David Thompson 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(-) 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