;;; Chickadee Game Toolkit ;;; Copyright © 2019 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: ;; ;; libmpg123 bindings. ;; ;;; Code: (define-module (chickadee audio mpg123) #:use-module (chickadee config) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) #:use-module (system foreign) #:export (mpg123-init mpg123-exit mpg123-open mpg123-close mpg123-format mpg123-read mpg123-time-seek mpg123-length)) ;;; ;;; Enums ;;; (define MPG123_VERBOSE 0) (define MPG123_FLAGS 1) (define MPG123_ADD_FLAGS 2) (define MPG123_FORCE_RATE 3) (define MPG123_DOWN_SAMPLE 4) (define MPG123_RVA 5) (define MPG123_DOWNSPEED 6) (define MPG123_UPSPEED 7) (define MPG123_START_FRAME 8) (define MPG123_DECODE_FRAMES 9) (define MPG123_ICY_INTERVAL 10) (define MPG123_OUTSCALE 11) (define MPG123_TIMEOUT 12) (define MPG123_REMOVE_FLAGS 13) (define MPG123_RESYNC_LIMIT 14) (define MPG123_INDEX_SIZE 15) (define MPG123_PREFRAMES 16) (define MPG123_FEEDPOOL 17) (define MPG123_FEEDBUFFER 18) (define MPG123_ENC_8 #x00f) (define MPG123_ENC_16 #x040) (define MPG123_ENC_24 #x4000) (define MPG123_ENC_32 #x100) (define MPG123_ENC_SIGNED #x080) (define MPG123_ENC_FLOAT #xe00) (define MPG123_ENC_SIGNED_16 (logior MPG123_ENC_16 MPG123_ENC_SIGNED #x10)) (define MPG123_ENC_UNSIGNED_16 (logior MPG123_ENC_16 #x20)) (define MPG123_ENC_UNSIGNED_8 #x01) (define MPG123_ENC_SIGNED_8 (logior MPG123_ENC_SIGNED #x02)) (define MPG123_ENC_ULAW_8 #x04) (define MPG123_ENC_ALAW_8 #x08) (define MPG123_ENC_SIGNED_32 (logior MPG123_ENC_32 MPG123_ENC_SIGNED #x1000)) (define MPG123_ENC_UNSIGNED_32 (logior MPG123_ENC_32 #x2000)) (define MPG123_ENC_SIGNED_24 (logior MPG123_ENC_24 MPG123_ENC_SIGNED #x1000)) (define MPG123_ENC_UNSIGNED_24 (logior MPG123_ENC_24 #x2000)) (define MPG123_ENC_FLOAT_32 #x200) (define MPG123_ENC_FLOAT_64 #x400) ;;; ;;; Low-level bindings ;;; (define mpg123-func (let ((lib (dynamic-link* %libmpg123))) (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 (mpg123-func return-type func-name arg-types))) (define off_t int) (define-foreign %mpg123-init int "mpg123_init" '()) (define-foreign mpg123-exit void "mpg123_exit" '()) (define-foreign mpg123-new '* "mpg123_new" '(* *)) (define-foreign mpg123-delete void "mpg123_delete" '(*)) (define-foreign mpg123-param int "mpg123_param" (list '* int long double)) (define-foreign mpg123-getparam int "mpg123_getparam" (list '* int '* '*)) (define-foreign mpg123-getformat int "mpg123_getformat" '(* * * *)) (define-foreign mpg123-plain-strerror '* "mpg123_plain_strerror" (list int)) (define-foreign mpg123-strerror '* "mpg123_strerror" '(*)) (define-foreign %mpg123-open int "mpg123_open" '(* *)) (define-foreign %mpg123-close int "mpg123_close" '(*)) (define-foreign %mpg123-read int "mpg123_read" (list '* '* size_t '*)) (define-foreign mpg123-timeframe off_t "mpg123_timeframe" (list '* double)) (define-foreign mpg123-seek-frame off_t "mpg123_seek_frame" (list '* off_t int)) (define-foreign %mpg123-length off_t "mpg123_length" (list '*)) ;;; ;;; Error Handling ;;; (define (mpg123-check-error func error-id message . args) (let* ((error-string (pointer->string (mpg123-plain-strerror error-id)))) (unless (zero? error-id) (apply throw 'mpg123-error func (string-append message ": ~A") (append args (list error-string)))))) ;;; ;;; High-level bindings ;;; (define (display-mpg123-handle handle port) (display "#" port)) (define-wrapped-pointer-type mpg123-handle? wrap-mpg123-handle unwrap-mpg123-handle display-mpg123-handle) (define (mpg123-init) (mpg123-check-error "mpg123-init" (%mpg123-init) "failed to initialize")) (define (mpg123-open file-name) (let ((handle (or (mpg123-new %null-pointer %null-pointer) (error "failed to create mpg123 handle")))) (%mpg123-open handle (string->pointer file-name)) (wrap-mpg123-handle handle))) (define (mpg123-close handle) (let ((ptr (unwrap-mpg123-handle handle))) (%mpg123-close ptr) (mpg123-delete ptr))) (define (mpg123-format handle) (let ((rate (make-bytevector (sizeof long))) (channels (make-bytevector (sizeof int))) (encoding (make-bytevector (sizeof int)))) (mpg123-check-error "mpg123-format" (mpg123-getformat (unwrap-mpg123-handle handle) (bytevector->pointer rate) (bytevector->pointer channels) (bytevector->pointer encoding)) "failed to get audio format info") (let* ((encoding (bytevector-sint-ref encoding 0 (native-endianness) (sizeof int))) (bits-per-sample (cond ((= encoding MPG123_ENC_SIGNED_8) 8) ((= encoding MPG123_ENC_SIGNED_16) 16) ((= encoding MPG123_ENC_SIGNED_24) 24) ((= encoding MPG123_ENC_SIGNED_32) 32) (else (error "unsupported mp3 encoding" encoding))))) (values (bytevector-sint-ref rate 0 (native-endianness) (sizeof long)) (bytevector-sint-ref channels 0 (native-endianness) (sizeof int)) bits-per-sample)))) (define (mpg123-read handle buffer) (let* ((bv (make-bytevector (sizeof size_t))) (error-code (%mpg123-read (unwrap-mpg123-handle handle) (bytevector->pointer buffer) (bytevector-length buffer) (bytevector->pointer bv)))) (when (> error-code 0) (mpg123-check-error "mpg123-read" error-code "failed to read audio")) (bytevector-sint-ref bv 0 (native-endianness) (sizeof size_t)))) (define (mpg123-time-seek handle t) (let ((offset (mpg123-timeframe (unwrap-mpg123-handle handle) t))) (mpg123-check-error "mpg123-time-seek" (mpg123-seek-frame (unwrap-mpg123-handle handle) offset SEEK_SET) "failed to seek"))) (define (mpg123-length handle) (%mpg123-length (unwrap-mpg123-handle handle)))