;;; 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: ;; ;; libvorbis bindings. ;; ;;; Code: (define-module (chickadee audio vorbis) #: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 (vorbis-open vorbis-clear vorbis-info vorbis-time-total vorbis-time-seek vorbis-read vorbis-fill-buffer vorbis-info? vorbis-info-version vorbis-info-channels vorbis-info-sample-rate)) ;;; ;;; Low-level Bindings ;;; (define vorbis-func (let ((lib (dynamic-link* %libvorbisfile))) (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 (vorbis-func return-type func-name arg-types))) (define ogg-sync-state (list '* ; data int ; storage int ; fill int ; returned int ; unsynced int ; headerbytes int ; bodybytes )) (define ogg-stream-state (list '* ; body_data long ; body_storage long ; body_fill long ; body_returned '* ; lacing_vals '* ; granule_vals long ; lacing_storage long ; lacing_fill long ; lacing_packet long ; lacing_returned (make-list 282 uint8) ; header int ; header_fill int ; e_o_s int ; b_o_s long ; serialno long ; pageno int64 ; packetno int64 ; granulepos )) (define oggpack-buffer (list long ; endbyte int ; endbit '* ; buffer '* ; ptr long ; storage )) (define vorbis-dsp-state (list int ; analysisp '* ; vi '* ; pcm '* ; pcmret int ; pcm_storage int ; pcm_current int ; pcm_returned int ; preextrapolate int ; eofflag long ; lW long ; W long ; nW long ; centerW int64 ; granulepos int64 ; sequence int64 ; glue_bits int64 ; time_bits int64 ; floor_bits int64 ; res_bits '* ; backend_state )) (define vorbis-block (list '* ; pcm oggpack-buffer ; opb long ; lW long ; W long ; nW int ; pcmend int ; mode int ; eofflag int64 ; granulepos int64 ; sequence '* ; vd '* ; localstore long ; localtop long ; localalloc long ; totaluse '* ; reap long ; glue_bits long ; time_bits long ; floor_bits long ; res_bits '* ; internal )) (define %vorbis-info (list int ; version int ; channels long ; rate long ; bitrate_upper long ; bitrate_nominal long ; bitrate_lower long ; bitrate_window '* ; codec_setup )) (define ov-callbacks (list '* ; read_func '* ; seek_func '* ; close_func '* ; tell_func )) (define ogg-vorbis-file (list '* ; datasource int ; seekable int64 ; offset int64 ; end ogg-sync-state ; oy int ; links '* ; offsets '* ; dataoffsets '* ; serialnos '* ; pcmlengths '* ; vi '* ; vc int64 ; pcm_offset int ; ready_state long ; current_serialno int ; current_link double ; bittrack double ; samptrack ogg-stream-state ; os vorbis-dsp-state ; vd vorbis-block ; vb ov-callbacks ; callbacks )) (define OV_FALSE -1) (define OV_EOF -2) (define OV_HOLE -3) (define OV_EREAD -128) (define OV_EFAULT -129) (define OV_EIMPL -130) (define OV_EINVAL -131) (define OV_ENOTVORBIS -132) (define OV_EBADHEADER -133) (define OV_EVERSION -134) (define OV_ENOTAUDIO -135) (define OV_EBADPACKET -136) (define OV_EBADLINK -137) (define OV_ENOSEEK -138) (define-foreign ov-fopen int "ov_fopen" '(* *)) (define-foreign ov-open-callbacks int "ov_open_callbacks" (list '* '* '* long '*)) (define-foreign ov-clear int "ov_clear" '(*)) (define-foreign ov-info '* "ov_info" (list '* int)) (define-foreign ov-read long "ov_read" (list '* '* int int int int '*)) (define-foreign ov-comment '* "ov_comment" (list '* int)) (define-foreign ov-raw-seek int "ov_raw_seek" (list '* long)) (define-foreign ov-time-seek int "ov_time_seek" (list '* double)) (define-foreign ov-seekable long "ov_seekable" '(*)) (define-foreign ov-time-total double "ov_time_total" (list '* int)) ;;; ;;; High-level public API ;;; (define-record-type (wrap-vorbis-file bv ptr) vorbis-file? (bv vorbis-file-bv) (ptr unwrap-vorbis-file)) (define (display-vorbis-file vf port) (format port "#" (pointer-address (unwrap-vorbis-file vf)))) (set-record-type-printer! display-vorbis-file) (define (vorbis-open file-name) "Open the OGG Vorbis audio file located at FILE-NAME." (let* ((bv (make-bytevector (sizeof ogg-vorbis-file))) (ptr (bytevector->pointer bv))) (ov-fopen (string->pointer file-name) ptr) (wrap-vorbis-file bv ptr))) (define (vorbis-clear vf) "Clear the buffers of the Vorbis file VF." (ov-clear (unwrap-vorbis-file vf))) (define-record-type (make-vorbis-info version channels sample-rate) vorbis-info? (version vorbis-info-version) (channels vorbis-info-channels) (sample-rate vorbis-info-sample-rate)) (define (vorbis-info vf) (match (parse-c-struct (ov-info (unwrap-vorbis-file vf) -1) %vorbis-info) ((version channels sample-rate _ _ _ _ _) (make-vorbis-info version channels sample-rate)))) (define (vorbis-time-total vf) (ov-time-total (unwrap-vorbis-file vf) -1)) (define (vorbis-time-seek vf t) (ov-time-seek (unwrap-vorbis-file vf) t)) (define* (vorbis-read vf buffer #:optional (start 0)) (ov-read (unwrap-vorbis-file vf) (bytevector->pointer buffer start) (- (bytevector-length buffer) start) 0 ; little endian 2 ; 16 bits per sample 1 ; signed data %null-pointer)) (define (vorbis-fill-buffer vf buffer) (let ((capacity (bytevector-length buffer))) (let loop ((size 0)) (if (< size capacity) (let ((result (vorbis-read vf buffer size))) (cond ((zero? result) size) ((= result OV_HOLE) (loop size)) ((or (= result OV_EBADLINK) (= result OV_EINVAL)) -1) (else (loop (+ size result))))) size))))