blob: e54e943d7eb404284dceb52be8e647d7a68eb0b8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
|
;;; Chickadee Game Toolkit
;;; Copyright © 2019 David Thompson <davet@gnu.org>
;;;
;;; 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
;;; <http://www.gnu.org/licenses/>.
;;; 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 <vorbis-file>
(wrap-vorbis-file bv ptr)
vorbis-file?
(bv vorbis-file-bv)
(ptr unwrap-vorbis-file))
(define (display-vorbis-file vf port)
(format port "#<vorbis-file ~x>" (pointer-address (unwrap-vorbis-file vf))))
(set-record-type-printer! <vorbis-file> 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 <vorbis-info>
(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))))
|