@@ -2,13 +2,15 @@ REBOL [
2
2
title: "REBOL 3 codec for WAV file format"
3
3
name: 'codec-WAV
4
4
author: "Oldes"
5
- version: 0.1 .0
6
- date: 11-Oct-2018
5
+ version: 0.2 .0
6
+ date: 2-Mar-2020
7
7
history: [
8
8
0.1.0 11-Oct-2018 "Oldes" {
9
9
Initial version with DECODE and IDENTIFY functions.
10
- Not all chunks are parsed.
11
- }
10
+ Not all chunks are parsed.}
11
+ 0.2.0 2-Mar-2020 "Oldes" {
12
+ Sound data are now as a vector! instead of raw binary!
13
+ Support for encoding wav data.}
12
14
]
13
15
]
14
16
@@ -148,44 +150,85 @@ register-codec [
148
150
channels: (format/2 )
149
151
bits: (format/6 )
150
152
chunks: (chunks)
151
- data: (either empty? data [none][rejoin data])
153
+ data: (either empty? data [none][make vector! reduce [ 'integer! format /6 rejoin data] ])
152
154
]
153
155
]
154
156
]
155
157
156
158
encode : function [
157
- spec [object! ]
159
+ spec [object! vector! ]
158
160
] [
159
- if 'wave <> select spec 'type [ return none ]
160
- out: binary (128 + length? spec/data )
161
- binary/write out [
162
- #{ 52494646 00000000 57415645 }
161
+ case [
162
+ vector? spec [
163
+ bitsPerSample: spec/size
164
+ data: to binary! spec
165
+ spec: []
166
+ ]
167
+ vector? spec/data [
168
+ bitsPerSample: spec/data/size
169
+ data: to binary! spec/data
170
+ ]
171
+ binary? spec/data [
172
+ bitsPerSample: select spec 'bits
173
+ data: spec/data
174
+ ]
175
+ 'else [
176
+ print "*** Unsupported data!"
177
+ return none
178
+ ]
163
179
]
164
-
165
- index: index? spec/data ; stores original data position
166
180
167
- foreach [tag value] spec/chunks [
181
+ out: binary (128 + length? data)
182
+ binary/write out [ #{ 52494646 00000000 57415645 } ]
183
+
184
+ if bitsPerSample [blockAlign: bitsPerSample / 8 ]
185
+ chunks: select spec 'chunks
186
+
187
+ unless chunks [
188
+ ;- creates main WAV chunks (format & data length) if not provided by user
189
+ channels: any [select spec 'channels 1 ]
190
+ sampleRate: any [select spec 'rate 44100 ]
191
+ bitsPerSample: any [bitsPerSample 16 ]
192
+ blockAlign: bitsPerSample / 8
193
+
194
+ chunks: reduce [
195
+ <fmt > reduce [
196
+ 1
197
+ channels
198
+ sampleRate
199
+ (channels * sampleRate * blockAlign) ; bytesPerSec
200
+ blockAlign
201
+ bitsPerSample
202
+ ]
203
+ <data > length? data
204
+ ]
205
+ ]
206
+
207
+ foreach [tag value] chunks [
168
208
switch tag [
169
209
<fmt > [
170
210
binary/write out reduce [
171
211
'BYTES "fmt "
172
- 'UI32LE 16 + length? value/7
173
- 'UI16LE value/1 ; compression
174
- 'UI16LE value/2 ; channels
175
- 'UI32LE value/3 ; sampleRate
176
- 'UI32LE value/4 ; bytesPerSec
177
- 'UI16LE value/5 ; blockAlign
178
- 'UI16LE value/6 ; bitsPerSample
179
- 'BYTES value/7
212
+ 'UI32LE 16 + any [ length? value/7 0 ]
213
+ 'UI16LE value/1 ; compression
214
+ 'UI16LE value/2 ; channels
215
+ 'UI32LE value/3 ; sampleRate
216
+ 'UI32LE value/4 ; bytesPerSec
217
+ 'UI16LE value/2 * any [blockAlign value /5 ] ; uses real values where possible
218
+ 'UI16LE any [bitsPerSample value/6 ]
219
+ 'BYTES any [ value/7 #{} ]
180
220
]
181
221
]
182
222
<data > [
223
+ ; not using `value` directly as a reported length, because it can be wrong.
224
+ value: copy/part data value
225
+ bytes: length? value
183
226
binary/write out reduce [
184
227
'BYTES "data"
185
- 'UI32LE value
186
- 'BYTES copy /part spec /data value
228
+ 'UI32LE bytes
229
+ 'BYTES value
187
230
]
188
- spec/ data: skip spec / data value
231
+ data: skip data bytes
189
232
]
190
233
<fact > [
191
234
value: to binary! value
@@ -198,8 +241,6 @@ register-codec [
198
241
]
199
242
]
200
243
201
- spec/data: at head spec/data index ;resets the data series to original position
202
-
203
244
bytes: (length? out/buffer ) - 8
204
245
binary/write out reduce ['at 5 'UI32LE bytes]
205
246
out/buffer
0 commit comments