QOA implementation
Posted: Sun Jun 18, 2023 6:31 pm
Hi,
someone thought it would be nice to have:
QOA.pbi
qoaconv.pb (not working with C backend. See bug report) Fix added in QOA.pbi
qoaplay.pb
someone thought it would be nice to have:
QOA.pbi
Code: Select all
;
; https://qoaformat.org/
;
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
CompilerEndIf
#QOA_MIN_FILESIZE = 16
#QOA_MAX_CHANNELS = 8
#QOA_SLICE_LEN = 20
#QOA_SLICES_PER_FRAME = 256
#QOA_FRAME_LEN = (#QOA_SLICES_PER_FRAME * #QOA_SLICE_LEN)
#QOA_LMS_LEN = 4
#QOA_MAGIC = $716f6166 ; 'qoaf'
Macro QOA_FRAME_SIZE(channels, slices)
(8 + #QOA_LMS_LEN * 4 * channels + 8 * slices * channels)
EndMacro
Structure qoa_lms_t
history.l[#QOA_LMS_LEN]
weights.l[#QOA_LMS_LEN]
EndStructure
Structure qoa_desc
channels.l
samplerate.l
samples.l
lms.qoa_lms_t[#QOA_MAX_CHANNELS]
CompilerIf Defined(QOA_RECORD_TOTAL_ERROR, #PB_Constant)
error.d
CompilerEndIf
EndStructure
Declare.l qoa_encode_header(*qoa.qoa_desc, *bytes.Ascii)
Declare.l qoa_encode_frame(*sample_data.Word, *qoa.qoa_desc, frame_len.l, *bytes.Ascii)
Declare.i qoa_encode(*sample_data.Word, *qoa.qoa_desc, *out_len.Long)
Declare.l qoa_max_frame_size(*qoa.qoa_desc)
Declare.l qoa_decode_header(*bytes.Ascii, size.l, *qoa.qoa_desc)
Declare.l qoa_decode_frame(*bytes.Ascii, size.l, *qoa.qoa_desc, *sample_data.Word, *frame_len.Long)
Declare.i qoa_decode(*bytes.Ascii, size.l, *file.qoa_desc)
;-Implementation
Structure AsciiArray
a.a[0]
EndStructure
Structure WordArray
w.w[0]
EndStructure
Structure LongArray
l.l[0]
EndStructure
Macro QOA_MALLOC(sz)
AllocateMemory(sz, #PB_Memory_NoClear)
EndMacro
Macro QOA_FREE(p)
FreeMemory(p)
EndMacro
Macro qoa_uint64_t
q
EndMacro
DataSection
qoa_quant_tab: ; [17]
Data.l 7, 7, 7, 5, 5, 3, 3, 1 ; -8..-1
Data.l 0 ; 0
Data.l 0, 2, 2, 4, 4, 6, 6, 6 ; 1.. 8
qoa_scalefactor_tab: ; [16]
Data.l 1, 7, 21, 45, 84, 138, 211, 304, 421, 562, 731, 928, 1157, 1419, 1715, 2048
qoa_reciprocal_tab: ; [16]
Data.l 65536, 9363, 3121, 1457, 781, 475, 311, 216, 156, 117, 90, 71, 57, 47, 39, 32
qoa_dequant_tab: ; [16][8]
Data.l 1, -1, 3, -3, 5, -5, 7, -7
Data.l 5, -5, 18, -18, 32, -32, 49, -49
Data.l 16, -16, 53, -53, 95, -95, 147, -147
Data.l 34, -34, 113, -113, 203, -203, 315, -315
Data.l 63, -63, 210, -210, 378, -378, 588, -588
Data.l 104, -104, 345, -345, 621, -621, 966, -966
Data.l 158, -158, 528, -528, 950, -950, 1477, -1477
Data.l 228, -228, 760, -760, 1368, -1368, 2128, -2128
Data.l 316, -316, 1053, -1053, 1895, -1895, 2947, -2947
Data.l 422, -422, 1405, -1405, 2529, -2529, 3934, -3934
Data.l 548, -548, 1828, -1828, 3290, -3290, 5117, -5117
Data.l 696, -696, 2320, -2320, 4176, -4176, 6496, -6496
Data.l 868, -868, 2893, -2893, 5207, -5207, 8099, -8099
Data.l 1064, -1064, 3548, -3548, 6386, -6386, 9933, -9933
Data.l 1286, -1286, 4288, -4288, 7718, -7718, 12005, -12005
Data.l 1536, -1536, 5120, -5120, 9216, -9216, 14336, -14336
EndDataSection
Global.LongArray *qoa_quant_tab
*qoa_quant_tab = ?qoa_quant_tab
Global.LongArray *qoa_scalefactor_tab
*qoa_scalefactor_tab = ?qoa_scalefactor_tab
Global.LongArray *qoa_reciprocal_tab
*qoa_reciprocal_tab = ?qoa_reciprocal_tab
Global.LongArray *qoa_dequant_tab
*qoa_dequant_tab = ?qoa_dequant_tab
Procedure.l qoa_lms_predict(*lms.qoa_lms_t)
Protected.l prediction, i
For i = 0 To #QOA_LMS_LEN - 1
prediction + (*lms\weights[i] * *lms\history[i])
Next i
ProcedureReturn prediction >> 13
EndProcedure
Procedure qoa_lms_update(*lms.qoa_lms_t, sample.l, residual.l)
Protected.l delta, i
delta = residual >> 4
For i = 0 To #QOA_LMS_LEN - 1
If *lms\history[i] < 0
*lms\weights[i] - delta
Else
*lms\weights[i] + delta
EndIf
Next i
For i = 0 To #QOA_LMS_LEN - 2
*lms\history[i] = *lms\history[i + 1]
Next i
*lms\history[#QOA_LMS_LEN - 1] = sample
EndProcedure
Procedure.l qoa_div(v.l, scalefactor.l)
Protected.l reciprocal, n
reciprocal = *qoa_reciprocal_tab\l[scalefactor]
n = (v * reciprocal + (1 << 15)) >> 16
n = n + (Bool(v > 0) - Bool(v < 0)) - (Bool(n > 0) - Bool(n < 0)) ; round away from 0
ProcedureReturn n
EndProcedure
Procedure.l qoa_clamp(v.l, min.l, max.l)
If v < min
ProcedureReturn min
EndIf
If v > max
ProcedureReturn max
EndIf
ProcedureReturn v
EndProcedure
Procedure.l qoa_clamp_s16(v.l)
;If v + 32768 > 65535
If v < -32768
ProcedureReturn -32768
EndIf
If v > 32767
ProcedureReturn 32767
EndIf
;EndIf
ProcedureReturn v
EndProcedure
Procedure.qoa_uint64_t qoa_read_u64(*bytes.AsciiArray, *p.Long)
*bytes + *p\l
*p\l + 8
ProcedureReturn (*bytes\a[0] << 56) | (*bytes\a[1] << 48) | (*bytes\a[2] << 40) | (*bytes\a[3] << 32) | (*bytes\a[4] << 24) | (*bytes\a[5] << 16) | (*bytes\a[6] << 8) | (*bytes\a[7] << 0)
EndProcedure
Procedure qoa_write_u64(v.qoa_uint64_t, *bytes.AsciiArray, *p.Long)
*bytes + *p\l
*p\l + 8
*bytes\a[0] = (v >> 56) & $ff
*bytes\a[1] = (v >> 48) & $ff
*bytes\a[2] = (v >> 40) & $ff
*bytes\a[3] = (v >> 32) & $ff
*bytes\a[4] = (v >> 24) & $ff
*bytes\a[5] = (v >> 16) & $ff
*bytes\a[6] = (v >> 8) & $ff
*bytes\a[7] = (v >> 0) & $ff
EndProcedure
;-Encoder
Procedure.l qoa_encode_header(*qoa.qoa_desc, *bytes.AsciiArray)
Protected p.l
qoa_write_u64((#QOA_MAGIC << 32) | *qoa\samples, *bytes, @p)
ProcedureReturn p
EndProcedure
Procedure.l qoa_encode_frame(*sample_data.WordArray, *qoa.qoa_desc, frame_len.l, *bytes.AsciiArray)
Protected.l channels, p, slices, frame_size, c, weights_sum, i, sample_index, best_scalefactor, sfi, scalefactor
Protected.l slice_len, slice_start, slice_end, si
Protected Dim prev_scalefactor.l(#QOA_MAX_CHANNELS)
Protected.qoa_uint64_t weights, history, best_error, best_slice, slice, current_error
Protected.qoa_lms_t best_lms, lms
Protected.l sample, predicted, residual, scaled, clamped, quantized, dequantized, reconstructed
Protected.q error
channels = *qoa\channels
p = 0
slices = (frame_len + #QOA_SLICE_LEN - 1) / #QOA_SLICE_LEN
frame_size = QOA_FRAME_SIZE(channels, slices)
; Write the frame header
qoa_write_u64(*qoa\channels << 56 | *qoa\samplerate << 32 | frame_len << 16 | frame_size, *bytes, @p)
For c = 0 To channels - 1
; If the weights have grown too large, reset them To 0. This may happen
; with certain high-frequency sounds. This is a last resort And will
; introduce quite a bit of noise, but should at least prevent pops/clicks
weights_sum = *qoa\lms[c]\weights[0] * *qoa\lms[c]\weights[0]
weights_sum + *qoa\lms[c]\weights[1] * *qoa\lms[c]\weights[1]
weights_sum + *qoa\lms[c]\weights[2] * *qoa\lms[c]\weights[2]
weights_sum + *qoa\lms[c]\weights[3] * *qoa\lms[c]\weights[3]
If weights_sum > $2fffffff
*qoa\lms[c]\weights[0] = 0
*qoa\lms[c]\weights[1] = 0
*qoa\lms[c]\weights[2] = 0
*qoa\lms[c]\weights[3] = 0
EndIf
; Write the current LMS state
weights = 0
history = 0
For i = 0 To #QOA_LMS_LEN - 1
history = (history << 16) | (*qoa\lms[c]\history[i] & $ffff)
weights = (weights << 16) | (*qoa\lms[c]\weights[i] & $ffff)
Next i
qoa_write_u64(history, *bytes, @p)
qoa_write_u64(weights, *bytes, @p)
Next c
; We encode all samples With the channels interleaved on a slice level.
; E.g. For stereo: (ch-0, slice 0), (ch 1, slice 0), (ch 0, slice 1), ...
;For (int sample_index = 0; ; sample_index += QOA_SLICE_LEN) {
sample_index = 0
While sample_index < frame_len
For c = 0 To channels - 1
slice_len = qoa_clamp(#QOA_SLICE_LEN, 0, frame_len - sample_index)
slice_start = sample_index * channels + c
slice_end = (sample_index + slice_len) * channels + c
; Brute for search for the best scalefactor. Just go through all
; 16 scalefactors, encode all samples for the current slice And
; meassure the total squared error.
;best_error = -1
best_error = $7FFFFFFFFFFFFFFF
For sfi = 0 To 15
; There is a strong correlation between the scalefactors of
; neighboring slices. As an optimization, start testing
; the best scalefactor of the previous slice first.
scalefactor = (sfi + prev_scalefactor(c)) % 16
; We have To reset the LMS state To the last known good one
; before trying each scalefactor, As each pass updates the LMS
; state when encoding.
CopyMemory(@*qoa\lms[c], @lms, SizeOf(qoa_lms_t))
slice = scalefactor
current_error = 0
;For (int si = slice_start; si < slice_end; si += channels) {
si = slice_start
While si < slice_end
sample = *sample_data\w[si]
predicted = qoa_lms_predict(@lms)
residual = sample - predicted
scaled = qoa_div(residual, scalefactor)
clamped = qoa_clamp(scaled, -8, 8)
quantized = *qoa_quant_tab\l[clamped + 8]
;dequantized = PeekL(?qoa_dequant_tab + ((SizeOf(long) * scalefactor * 8) + (SizeOf(long) * quantized)))
dequantized = *qoa_dequant_tab\l[scalefactor * 8 + quantized]
reconstructed = qoa_clamp_s16(predicted + dequantized)
error = (sample - reconstructed)
current_error + (error * error)
If current_error > best_error
;Debug Str(current_error) + " " + Str(best_error)
Break
EndIf
qoa_lms_update(@lms, reconstructed, dequantized)
slice = (slice << 3) | quantized
si + channels
Wend
;Next
If current_error < best_error
best_error = current_error
best_slice = slice
CopyMemory(@lms, @best_lms, SizeOf(qoa_lms_t))
best_scalefactor = scalefactor
EndIf
Next sfi
prev_scalefactor(c) = best_scalefactor
CopyMemory(@best_lms, @*qoa\lms[c], SizeOf(qoa_lms_t))
CompilerIf Defined(QOA_RECORD_TOTAL_ERROR, #PB_Constant)
*qoa\error + best_error
CompilerEndIf
; If this slice was shorter than QOA_SLICE_LEN, we have To left-
; shift all encoded Data, To ensure the rightmost bits are the empty
; ones. This should only happen in the last frame of a file As all
; slices are completely filled otherwise.
best_slice << ((#QOA_SLICE_LEN - slice_len) * 3)
qoa_write_u64(best_slice, *bytes, @p)
Next c
sample_index + #QOA_SLICE_LEN
Wend
;Next
ProcedureReturn p
EndProcedure
Procedure.i qoa_encode(*sample_data.WordArray, *qoa.qoa_desc, *out_len.Long)
Protected.l num_frames, num_slices, encoded_size, c, i, p, frame_len, sample_index, frame_size
Protected.AsciiArray *bytes
Protected.WordArray *frame_samples
If *qoa\samples = 0 Or *qoa\samplerate = 0 Or *qoa\samplerate > $ffffff Or *qoa\channels = 0 Or *qoa\channels > #QOA_MAX_CHANNELS
ProcedureReturn #Null
EndIf
; Calculate the encoded size And allocate
num_frames = (*qoa\samples + #QOA_FRAME_LEN-1) / #QOA_FRAME_LEN
num_slices = (*qoa\samples + #QOA_SLICE_LEN-1) / #QOA_SLICE_LEN
encoded_size = 8 ; 8 byte file header
encoded_size + num_frames * 8 ; 8 byte frame headers
encoded_size + num_frames * #QOA_LMS_LEN * 4 * *qoa\channels ; 4 * 4 bytes lms state per channel
encoded_size + num_slices * 8 * *qoa\channels ; 8 byte slices
*bytes = QOA_MALLOC(encoded_size)
For c = 0 To *qoa\channels - 1
; Set the initial LMS weights To {0, 0, -1, 2}. This helps With the
; prediction of the first few ms of a file.
*qoa\lms[c]\weights[0] = 0
*qoa\lms[c]\weights[1] = 0
*qoa\lms[c]\weights[2] = -(1<<13)
*qoa\lms[c]\weights[3] = (1<<14)
; Explicitly set the history samples To 0, As we might have some garbage in there.
For i = 0 To #QOA_LMS_LEN - 1
*qoa\lms[c]\history[i] = 0
Next i
Next c
; Encode the header And go through all frames
p = qoa_encode_header(*qoa, *bytes)
CompilerIf Defined(QOA_RECORD_TOTAL_ERROR, #PB_Constant)
*qoa\error = 0
CompilerEndIf
frame_len = #QOA_FRAME_LEN
sample_index = 0
While sample_index < *qoa\samples
frame_len = qoa_clamp(#QOA_FRAME_LEN, 0, *qoa\samples - sample_index)
*frame_samples = *sample_data + sample_index * *qoa\channels * 2 ; * 2 because of short (word)
frame_size = qoa_encode_frame(*frame_samples, *qoa, frame_len, *bytes + p)
p + frame_size
sample_index + frame_len
Wend
*out_len\l = p
ProcedureReturn *bytes
EndProcedure
;-Decoder
Procedure.l qoa_max_frame_size(*qoa.qoa_desc)
ProcedureReturn QOA_FRAME_SIZE(*qoa\channels, #QOA_SLICES_PER_FRAME)
EndProcedure
Procedure.l qoa_decode_header(*bytes.AsciiArray, size.l, *qoa.qoa_desc)
Protected.l p
Protected.qoa_uint64_t file_header, frame_header
If size < #QOA_MIN_FILESIZE
ProcedureReturn 0
EndIf
; Read the file header, verify the magic number ('qoaf') and read the total number of samples.
file_header = qoa_read_u64(*bytes, @p)
If file_header >> 32 <> #QOA_MAGIC
ProcedureReturn 0
EndIf
*qoa\samples = file_header & $ffffffff
If Not *qoa\samples
ProcedureReturn 0
EndIf
; Peek into the first frame header To get the number of channels and the samplerate.
frame_header = qoa_read_u64(*bytes, @p)
*qoa\channels = (frame_header >> 56) & $0000ff
*qoa\samplerate = (frame_header >> 32) & $ffffff
If *qoa\channels = 0 Or *qoa\samples = 0 Or *qoa\samplerate = 0
ProcedureReturn 0
EndIf
ProcedureReturn 8
EndProcedure
Procedure.l qoa_decode_frame(*bytes.AsciiArray, size.l, *qoa.qoa_desc, *sample_data.WordArray, *frame_len.Long)
Protected.l p, channels, samplerate, samples, frame_size, data_size, num_slices, max_total_samples
Protected.l c, i, sample_index, scalefactor, slice_start, slice_end, si
Protected.l predicted, quantized, dequantized, reconstructed
Protected.qoa_uint64_t frame_header, history, weights, slice
p = 0
*frame_len\l = 0
If size < 8 + #QOA_LMS_LEN * 4 * *qoa\channels
ProcedureReturn 0
EndIf
; Read And verify the frame header
frame_header = qoa_read_u64(*bytes, @p)
channels = (frame_header >> 56) & $0000ff
samplerate = (frame_header >> 32) & $ffffff
samples = (frame_header >> 16) & $00ffff
frame_size = (frame_header ) & $00ffff
data_size = frame_size - 8 - #QOA_LMS_LEN * 4 * channels
num_slices = data_size / 8
max_total_samples = num_slices * #QOA_SLICE_LEN
If channels <> *qoa\channels Or samplerate <> *qoa\samplerate Or frame_size > size Or samples * channels > max_total_samples
ProcedureReturn 0
EndIf
; Read the LMS state: 4 x 2 bytes history, 4 x 2 bytes weights per channel
For c = 0 To channels - 1
history = qoa_read_u64(*bytes, @p)
weights = qoa_read_u64(*bytes, @p)
For i = 0 To #QOA_LMS_LEN - 1
*qoa\lms[c]\history[i] = history >> 48
history << 16
*qoa\lms[c]\weights[i] = weights >> 48
weights << 16
Next i
Next c
; Decode all slices For all channels in this frame
For sample_index = 0 To samples - 1 Step #QOA_SLICE_LEN
For c = 0 To channels - 1
slice = qoa_read_u64(*bytes, @p)
scalefactor = (slice >> 60) & $f
slice_start = sample_index * channels + c
slice_end = qoa_clamp(sample_index + #QOA_SLICE_LEN, 0, samples) * channels + c
;For si = slice_start To slice_end - 1 Step channels
si = slice_start
While si < slice_end
predicted = qoa_lms_predict(@*qoa\lms[c])
quantized = (slice >> 57) & $7
;dequantized = PeekL(?qoa_dequant_tab + (SizeOf(Long) * 8 * scalefactor) + (SizeOf(Long) * quantized))
dequantized = *qoa_dequant_tab\l[scalefactor * 8 + quantized]
reconstructed = qoa_clamp_s16(predicted + dequantized)
*sample_data\w[si] = reconstructed
slice << 3
qoa_lms_update(@*qoa\lms[c], reconstructed, dequantized)
si + channels
Wend
;Next si
Next c
Next sample_index
*frame_len\l = samples
ProcedureReturn p
EndProcedure
Procedure.i qoa_decode(*bytes.AsciiArray, size.l, *qoa.qoa_desc)
Protected.l p, total_samples, sample_index, frame_len, frame_size
Protected.WordArray *sample_data, *sample_ptr
p = qoa_decode_header(*bytes, size, *qoa)
If Not p
ProcedureReturn #Null
EndIf
; Calculate the required size of the sample buffer And allocate
total_samples = *qoa\samples * *qoa\channels
*sample_data = QOA_MALLOC(total_samples * SizeOf(Word))
sample_index = 0
; Decode all frames
Repeat
*sample_ptr = *sample_data + sample_index * *qoa\channels * 2 ; * 2 because of short (word)
frame_size = qoa_decode_frame(*bytes + p, size - p, *qoa, *sample_ptr, @frame_len)
p + frame_size
sample_index + frame_len
Until frame_size = 0 Or sample_index >= *qoa\samples
;} While (frame_size && sample_index < qoa->samples);
*qoa\samples = sample_index
ProcedureReturn *sample_data
EndProcedure
;-File read/write convenience functions
Procedure.l qoa_write(filename.s, *sample_data.WordArray, *qoa.qoa_desc)
Protected.i f
Protected.l size
Protected *encoded
f = CreateFile(#PB_Any, filename)
If Not f
ProcedureReturn 0
EndIf
*encoded = qoa_encode(*sample_data, *qoa, @size)
If Not *encoded
CloseFile(f)
ProcedureReturn 0
EndIf
CompilerIf #PB_Compiler_Backend = #PB_Backend_C
PokeS(*encoded, "qoaf", #PB_Ascii|#PB_String_NoZero)
CompilerEndIf
WriteData(f, *encoded, size)
CloseFile(f)
QOA_FREE(*encoded)
ProcedureReturn size
EndProcedure
Procedure.i qoa_read(filename.s, *qoa.qoa_desc)
Protected.i f
Protected.l size, bytes_read
Protected *Data.AsciiArray
Protected.WordArray *sample_data
f = ReadFile(#PB_Any, filename)
If Not f
ProcedureReturn #Null
EndIf
size = Lof(f)
If size <= 0
CloseFile(f)
ProcedureReturn #Null
EndIf
*Data = QOA_MALLOC(size)
If Not *Data
CloseFile(f)
ProcedureReturn #Null
EndIf
bytes_read = ReadData(f, *Data, size)
CloseFile(f)
*sample_data = qoa_decode(*Data, bytes_read, *qoa)
QOA_FREE(*Data)
ProcedureReturn *sample_data
EndProcedure
Code: Select all
EnableExplicit
#QOA_RECORD_TOTAL_ERROR = #True
IncludeFile "qoa.pbi"
Macro QOACONV_STR_ENDS_WITH(S, E)
Bool(Right(S, Len(E)) = E)
EndMacro
;-WAV reader / writer
Procedure.l QOACONV_CHUNK_ID(S.s)
Protected *S.AsciiArray, Result.l
*S = Ascii(S)
Result = (((*S\a[3])) << 24 | ((*S\a[2])) << 16 | ((*S\a[1])) << 8 | ((*S\a[0])))
FreeMemory(*S)
ProcedureReturn Result
EndProcedure
Procedure qoaconv_fwrite_u32_le(v.l, file.i)
Protected.l wrote
Protected Dim buf.a(3)
buf(0) = $ff & (v )
buf(1) = $ff & (v >> 8)
buf(2) = $ff & (v >> 16)
buf(3) = $ff & (v >> 24)
wrote = WriteData(file, @buf(0), SizeOf(Long))
If wrote <> SizeOf(Long)
PrintN("Write error")
End
EndIf
EndProcedure
Procedure qoaconv_fwrite_u16_le(v.u, file.i)
Protected.l wrote
Protected Dim buf.a(1)
buf(0) = $ff & (v )
buf(1) = $ff & (v >> 8)
wrote = WriteData(file, @buf(0), SizeOf(Unicode))
If wrote <> SizeOf(Unicode)
PrintN("Write error")
End
EndIf
EndProcedure
Procedure.l qoaconv_fread_u32_le(file.i)
Protected.l read_
Protected Dim buf.a(3)
read_ = ReadData(file, @buf(0), SizeOf(Long))
If read_ <> SizeOf(Long)
PrintN("Read error or unexpected end of file")
End
EndIf
ProcedureReturn (buf(3) << 24) | (buf(2) << 16) | (buf(1) << 8) | buf(0)
EndProcedure
Procedure.u qoaconv_fread_u16_le(file.i)
Protected.u read_
Protected Dim buf.a(1)
read_ = ReadData(file, @buf(0), SizeOf(Unicode))
If read_ <> SizeOf(Unicode)
PrintN("Read error or unexpected end of file")
End
EndIf
ProcedureReturn (buf(1) << 8) | buf(0)
EndProcedure
Procedure.l qoaconv_wav_write(filename.s, *sample_data.WordArray, *qoa.qoa_desc)
Protected.i fh
Protected.l data_size, samplerate
Protected.w bits_per_sample, channels
data_size = *qoa\samples * *qoa\channels * SizeOf(Unicode)
samplerate = *qoa\samplerate
bits_per_sample = 16
channels = *qoa\channels
; Lifted from https://www.jonolick.com/code.html - public domain
; Made endian agnostic using qoaconv_fwrite()
fh = CreateFile(#PB_Any, filename)
If Not fh
PrintN("Can't open " + filename + " for writing")
End
EndIf
WriteString(fh, "RIFF", #PB_Ascii)
qoaconv_fwrite_u32_le(data_size + 44 - 8, fh)
;WriteString(fh, "WAVEfmt " + Chr($10) + Chr($0) + Chr($0) + Chr($0) + Chr($1) + Chr($0), #PB_Ascii)
WriteString(fh, "WAVEfmt " + Chr($10), #PB_Ascii)
WriteByte(fh, $0)
WriteByte(fh, $0)
WriteByte(fh, $0)
WriteByte(fh, $1)
WriteByte(fh, $0)
qoaconv_fwrite_u16_le(channels, fh)
qoaconv_fwrite_u32_le(samplerate, fh)
qoaconv_fwrite_u32_le(channels * samplerate * bits_per_sample/8, fh)
qoaconv_fwrite_u16_le(channels * bits_per_sample/8, fh)
qoaconv_fwrite_u16_le(bits_per_sample, fh)
WriteString(fh, "data", #PB_Ascii)
qoaconv_fwrite_u32_le(data_size, fh)
WriteData(fh, *sample_data, data_size)
CloseFile(fh)
ProcedureReturn data_size + 44 - 8
EndProcedure
Procedure.i qoaconv_wav_read(filename.s, *qoa.qoa_desc)
Protected.i fh
Protected.l container_type, wav_size, wavid
Protected.l data_size, format_length, format_type, channels, samplerate, byte_rate, block_align, bits_per_sample
Protected.l chunk_type, chunk_size, seek_result, read_
Protected *wav_bytes
fh = ReadFile(#PB_Any, filename)
If Not fh
PrintN("Can't open " + filename + " for reading")
End
EndIf
container_type = qoaconv_fread_u32_le(fh)
If container_type <> QOACONV_CHUNK_ID("RIFF")
PrintN("Not a RIFF container")
End
EndIf
wav_size = qoaconv_fread_u32_le(fh)
wavid = qoaconv_fread_u32_le(fh)
If wavid <> QOACONV_CHUNK_ID("WAVE")
PrintN("No WAVE id found")
End
EndIf
; Find the fmt And Data chunk, skip all others
While #True
chunk_type = qoaconv_fread_u32_le(fh)
chunk_size = qoaconv_fread_u32_le(fh)
If chunk_type = QOACONV_CHUNK_ID("fmt ")
If chunk_size <> 16
PrintN("WAV fmt chunk size missmatch")
End
EndIf
format_type = qoaconv_fread_u16_le(fh)
channels = qoaconv_fread_u16_le(fh)
samplerate = qoaconv_fread_u32_le(fh)
byte_rate = qoaconv_fread_u32_le(fh)
block_align = qoaconv_fread_u16_le(fh)
bits_per_sample = qoaconv_fread_u16_le(fh)
ElseIf chunk_type = QOACONV_CHUNK_ID("data")
data_size = chunk_size
Break
Else
FileSeek(fh, chunk_size, #PB_Relative)
EndIf
Wend
If format_type <> 1
PrintN("Type in fmt chunk is not PCM")
End
EndIf
If bits_per_sample <> 16
PrintN("Bits per samples != 16")
End
EndIf
If data_size = 0
PrintN("No data chunk")
End
EndIf
*wav_bytes = AllocateMemory(data_size, #PB_Memory_NoClear)
If Not *wav_bytes
PrintN("Malloc for " + Str(data_size) + " bytes failed")
End
EndIf
read_ = ReadData(fh, *wav_bytes, data_size)
If read_ <> data_size
PrintN("Read error or unexpected end of file for " + Str(data_size) + " bytes")
End
EndIf
CloseFile(fh)
*qoa\samplerate = samplerate
*qoa\samples = data_size / (channels * (bits_per_sample/8))
*qoa\channels = channels
ProcedureReturn *wav_bytes
EndProcedure
OpenConsole()
If CountProgramParameters() >= 3
PrintN(#CRLF$ + "Usage: qoaconv in.{wav,qoa} out.{wav,qoa}")
EndIf
;-Decode input
Define desc.qoa_desc
Define *sample_data.WordArray
If QOACONV_STR_ENDS_WITH(ProgramParameter(0), ".wav")
*sample_data = qoaconv_wav_read(ProgramParameter(0), @desc)
ElseIf QOACONV_STR_ENDS_WITH(ProgramParameter(0), ".qoa")
*sample_data = qoa_read(ProgramParameter(0), @desc)
Else
PrintN("Unknown file type for " + ProgramParameter(0))
End
EndIf
If Not *sample_data
PrintN("Can't load/decode " + ProgramParameter(0))
End
EndIf
PrintN(ProgramParameter(0) + ": channels: " + Str(desc\channels) + ", samplerate: " + Str(desc\samplerate) + " hz, samples per channel: " + Str(desc\samples) + ", duration: " + Str(desc\samples / desc\samplerate) + " sec")
;-Encode output
Define.l bytes_written
Define.d psnr
If QOACONV_STR_ENDS_WITH(ProgramParameter(1), ".wav")
bytes_written = qoaconv_wav_write(ProgramParameter(1), *sample_data, @desc)
ElseIf QOACONV_STR_ENDS_WITH(ProgramParameter(1), ".qoa")
bytes_written = qoa_write(ProgramParameter(1), *sample_data, @desc)
CompilerIf Defined(QOA_RECORD_TOTAL_ERROR, #PB_Constant)
psnr = -20.0 * Log10(Sqr(desc\error/(desc\samples * desc\channels)) / 32768.0)
CompilerEndIf
Else
PrintN("Unknown file type for " + ProgramParameter(1))
End
EndIf
If bytes_written = 0
PrintN("Can't write/encode " + ProgramParameter(1))
End
EndIf
FreeMemory(*sample_data)
PrintN(ProgramParameter(1) + ": size: " + Str(bytes_written / 1024) + " kb (" + Str(bytes_written) + " bytes) = " + StrF(((bytes_written*8)/(desc\samples/desc\samplerate))/1024, 2) + " kbit/s, psnr: " + StrF(psnr, 2) + " db")
Code: Select all
EnableExplicit
IncludeFile "qoa.pbi"
Procedure qoaplay_poke_u32_le(v.l, *buffer.AsciiArray)
*buffer\a[0] = $ff & (v )
*buffer\a[1] = $ff & (v >> 8)
*buffer\a[2] = $ff & (v >> 16)
*buffer\a[3] = $ff & (v >> 24)
EndProcedure
Procedure qoaplay_poke_u16_le(v.u, *buffer.AsciiArray)
*buffer\a[0] = $ff & (v )
*buffer\a[1] = $ff & (v >> 8)
EndProcedure
Procedure.i qoaplay_build_wav(*sample_data.WordArray, *qoa.qoa_desc)
Protected.l data_size, samplerate
Protected.w bits_per_sample, channels
Protected *wav
data_size = *qoa\samples * *qoa\channels * SizeOf(Unicode)
samplerate = *qoa\samplerate
bits_per_sample = 16
channels = *qoa\channels
*Wav = AllocateMemory(44 + data_size, #PB_Memory_NoClear)
If *Wav
PokeS(*Wav + 0, "RIFF", -1, #PB_Ascii|#PB_String_NoZero)
qoaplay_poke_u32_le(data_size + 44 - 8, *Wav + 4)
PokeS(*Wav + 8 , "WAVEfmt ", -1, #PB_Ascii|#PB_String_NoZero)
PokeA(*Wav + 16, $10)
PokeA(*Wav + 17, $0)
PokeA(*Wav + 18, $0)
PokeA(*Wav + 19, $0)
PokeA(*Wav + 20, $1)
PokeA(*Wav + 21, $0)
qoaplay_poke_u16_le(channels, *Wav + 22)
qoaplay_poke_u32_le(samplerate, *Wav + 24)
qoaplay_poke_u32_le(channels * samplerate * bits_per_sample/8, *Wav + 28)
qoaplay_poke_u16_le(channels * bits_per_sample/8, *Wav + 32)
qoaplay_poke_u16_le(bits_per_sample, *Wav + 34)
PokeS(*Wav + 36, "data", -1, #PB_Ascii|#PB_String_NoZero)
qoaplay_poke_u32_le(data_size, *Wav + 40)
CopyMemory(*sample_data, *Wav + 44, data_size)
EndIf
ProcedureReturn *Wav
EndProcedure
Define desc.qoa_desc, *sample_data.WordArray, *wav, Sound.i, Startms.q, Endms.q, KeyPressed$
OpenConsole()
If CountProgramParameters() <> 1 Or Right(ProgramParameter(0), 4) <> ".qoa"
PrintN(#CRLF$ + "Usage: qoaplay in.qoa")
End
EndIf
InitSound()
Startms = ElapsedMilliseconds()
*sample_data = qoa_read(ProgramParameter(0), @desc)
Endms = ElapsedMilliseconds()
PrintN("Time to read/convert: " + Str(Endms - Startms) + "ms")
If *sample_data
*wav = qoaplay_build_wav(*sample_data, @desc)
FreeMemory(*sample_data)
If *wav
sound = CatchSound(#PB_Any, *wav, MemorySize(*wav))
If sound
PrintN(ProgramParameter(0) + ": channels: " + Str(desc\channels) + ", samplerate: " + Str(desc\samplerate) + " hz, samples per channel: " + Str(desc\samples) + ", duration: " + Str(desc\samples / desc\samplerate) + " sec")
Startms = ElapsedMilliseconds()
PlaySound(sound)
Print("00:00:00")
Repeat
Delay(1000)
Print(#BS$ + #BS$ + #BS$ + #BS$ + #BS$ + #BS$ + #BS$ + #BS$ + FormatDate("%hh:%ii:%ss", (ElapsedMilliseconds() - Startms) / 1000))
KeyPressed$ = Inkey()
Until SoundStatus(sound) <> #PB_Sound_Playing Or KeyPressed$ = #ESC$
PrintN("")
FreeSound(sound)
EndIf
EndIf
EndIf
