path: root/chickadee/audio/mpg123.scm

;;; Chickadee Game Toolkit
;;; Copyright © 2019 David Thompson <dthompson2@worcester.edu>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

;;; 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 "#<mpg123-handle>" port))

(define-wrapped-pointer-type <mpg123-handle> 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)))