From a9aa99ac55440b36fe0c2c647bcfa151f08bcce2 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Fri, 17 Dec 2021 08:56:20 -0500 Subject: Add libturbojpeg bindings. --- Makefile.am | 1 + chickadee/config.scm.in | 4 ++ chickadee/image/jpeg.scm | 150 +++++++++++++++++++++++++++++++++++++++++++++++ configure.ac | 10 ++++ guix.scm | 2 + 5 files changed, 167 insertions(+) create mode 100644 chickadee/image/jpeg.scm diff --git a/Makefile.am b/Makefile.am index bbb2887..1ce452d 100644 --- a/Makefile.am +++ b/Makefile.am @@ -65,6 +65,7 @@ SOURCES = \ chickadee/audio/vorbis.scm \ chickadee/audio/wav.scm \ chickadee/audio.scm \ + chickadee/image/jpeg.scm \ chickadee/graphics/gl.scm \ chickadee/graphics/engine.scm \ chickadee/graphics/color.scm \ diff --git a/chickadee/config.scm.in b/chickadee/config.scm.in index e4a8e1f..721a6d5 100644 --- a/chickadee/config.scm.in +++ b/chickadee/config.scm.in @@ -27,6 +27,7 @@ #:export (dynamic-link* %datadir %chickadee-version + %libturbojpeg %libopenal %libvorbisfile %libmpg123 @@ -65,6 +66,9 @@ (else '(absolute ...))))) +(define-library-name %libturbojpeg + ("@TURBOJPEG_LIBDIR@/libturbojpeg") + ("libturbojpeg")) (define-library-name %libopenal ("@OPENAL_LIBDIR@/libopenal") ("libopenal")) diff --git a/chickadee/image/jpeg.scm b/chickadee/image/jpeg.scm new file mode 100644 index 0000000..4ba60fe --- /dev/null +++ b/chickadee/image/jpeg.scm @@ -0,0 +1,150 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2021 David Thompson +;;; +;;; Chickadee is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published +;;; by the Free Software Foundation, either version 3 of the License, +;;; or (at your option) any later version. +;;; +;;; Chickadee is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; . + +;;; Commentary: +;; +;; JPEG image loading. +;; +;;; Code: + +(define-module (chickadee image jpeg) + #:use-module (chickadee config) + #:use-module (ice-9 binary-ports) + #:use-module (ice-9 exceptions) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-11) + #:use-module (system foreign) + #:export (load-jpeg)) + + +;;; +;;; Enums +;;; + +(define TJERR_WARNING 0) +(define TJERR_FATAL 1) + +(define TJPF_RGBA 7) + +(define TJFLAG_BOTTOMUP 2) + + +;;; +;;; Low-level bindings +;;; + +(define libturbojpeg-func + (let ((lib (dynamic-link* %libturbojpeg))) + (lambda (return-type function-name arg-types) + (pointer->procedure return-type + (dynamic-func function-name lib) + arg-types)))) + +(define-syntax-rule (define-foreign name return-type func-name arg-types) + (define name + (libturbojpeg-func return-type func-name arg-types))) + +(define-foreign tj-get-error-code + int "tjGetErrorCode" '(*)) + +(define-foreign tj-get-error-str2 + '* "tjGetErrorStr2" '(*)) + +(define-foreign tj-init-decompress + '* "tjInitDecompress" '()) + +(define-foreign tj-destroy + int "tjDestroy" '(*)) + +(define-foreign tj-decompress-header3 + int "tjDecompressHeader3" (list '* '* unsigned-long '* '* '* '*)) + +(define-foreign tj-decompress2 + int "tjDecompress2" (list '* '* unsigned-long '* int int int int int)) + + +;;; +;;; High-level bindings +;;; + +(define (display-tjhandle handle port) + (display "#" port)) + +(define-wrapped-pointer-type tjhandle? + wrap-tjhandle unwrap-tjhandle display-tjhandle) + +(define (check-error handle) + (let* ((ptr (if handle (unwrap-tjhandle handle) %null-pointer)) + (error-code (tj-get-error-code ptr)) + (error-string (pointer->string (tj-get-error-str2 ptr)))) + (if (= error-code TJERR_FATAL) + (raise-exception (make-exception-with-message error-string)) + (format (current-error-port) "warning: ~a~%" error-string)))) + +(define (init-decompress) + (wrap-tjhandle (tj-init-decompress))) + +(define (destroy-handle handle) + (tj-destroy (unwrap-tjhandle handle))) + +(define (decompress-headers handle buffer) + (let ((result (make-s32vector 4))) + (unless (zero? (tj-decompress-header3 (unwrap-tjhandle handle) + (bytevector->pointer buffer) + (bytevector-length buffer) + (bytevector->pointer result) + (bytevector->pointer result 4) + (bytevector->pointer result 8) + (bytevector->pointer result 12))) + (check-error handle)) + (values (s32vector-ref result 0) + (s32vector-ref result 1) + (s32vector-ref result 2) + (s32vector-ref result 3)))) + +(define (decompress handle buffer width pitch height pixel-format flags) + (let ((bv (make-bytevector (* pitch height)))) + (unless (zero? (tj-decompress2 (unwrap-tjhandle handle) + (bytevector->pointer buffer) + (bytevector-length buffer) + (bytevector->pointer bv) + width pitch height pixel-format flags)) + (check-error handle)) + bv)) + +(define (load-jpeg file-name) + (if (file-exists? file-name) + (let ((buffer (call-with-input-file file-name get-bytevector-all)) + (handle (init-decompress))) + (dynamic-wind + (lambda () #t) + (lambda () + (let-values (((width height subsamples color-space) + (decompress-headers handle buffer))) + (let ((pitch (* width 4))) + (values (decompress handle buffer width pitch height + TJPF_RGBA 0) ; TJFLAG_BOTTOMUP + width height)))) + (lambda () + (destroy-handle handle)))) + (raise-exception + (make-exception (make-external-error) + (make-exception-with-message + (string-append "file not found: " file-name)))))) diff --git a/configure.ac b/configure.ac index bdef4ce..61fd8d3 100644 --- a/configure.ac +++ b/configure.ac @@ -25,6 +25,16 @@ GUILE_PROGS GUILE_MODULE_REQUIRED([gl]) GUILE_MODULE_REQUIRED([sdl2]) +PKG_CHECK_MODULES([TURBOJPEG], [libturbojpeg]) +PKG_CHECK_VAR([TURBOJPEG_LIBDIR], [libturbojpeg], [libdir]) +AC_MSG_CHECKING([libturbojpeg library path]) +AS_IF([test "TURBOJPEG_LIBDIR" = "x"], [ + AC_MSG_FAILURE([Unable to identify libturbojpeg lib path.]) +], [ + AC_MSG_RESULT([$TURBOJPEG_LIBDIR]) +]) +AC_SUBST([TURBOJPEG_LIBDIR]) + PKG_CHECK_MODULES([OpenAL], [openal]) PKG_CHECK_VAR([OPENAL_LIBDIR], [openal], [libdir]) AC_MSG_CHECKING([OpenAL library path]) diff --git a/guix.scm b/guix.scm index 490dcd0..dc82246 100644 --- a/guix.scm +++ b/guix.scm @@ -47,6 +47,7 @@ (gnu packages audio) (gnu packages autotools) (gnu packages fontutils) + (gnu packages image) (gnu packages pkg-config) (gnu packages readline) (gnu packages texinfo) @@ -140,6 +141,7 @@ SDL2 C shared library via the foreign function interface.") (inputs (list freetype target-guile + libjpeg-turbo libvorbis mpg123 openal -- cgit v1.2.3