Skip to content

Instantly share code, notes, and snippets.

@ab5tract
Last active Aug 16, 2019
Embed
What would you like to do?
#!/usr/bin/env perl6
use v6.d;
use REX::File;
use Audio::Sndfile;
sub MAIN(:i(:$in-dir), :o(:$out-dir)) {
mkdir $out-dir unless $out-dir.IO.d;
my (@fails, $total, %words);
for $in-dir.IO.dir(test => / '.rx2' $/) -> $rf {
$total++;
#say "Processing $rf";
my $rex = REX::File.new: :path($rf);
say "Encountered stereo rex file: $rf" if $rex.info.fChannels == 2;
if $rex.&check-name-parity {
my @words = $rex.&words;
for @words.kv -> $idx, $w {
%words{$w}++;
my $name = $out-dir ~ "/$w - %words{$w}.wav";
$rex.&render-slice-file($name, $idx);
}
} else {
@fails.push: $rf;
}
}
say "There were {+@fails}/$total REX files where name mismatched slice count";
say "Here are the processed words:";
dd %words;
}
sub words($rex) {
$rex.name.split(' - ')[0].split(' ')
}
sub check-name-parity($rex) {
so $rex.&words.elems == +$rex.slices
}
sub render-slice-file($rex, $filename, $idx) {
my $format = Audio::Sndfile::Info::WAV +| Audio::Sndfile::Info::FLOAT;
my $as = Audio::Sndfile.new(:$filename, :$format, channels => 1, :samplerate($rex.sample-rate), :w);
$as.write-float($rex.samples[$idx][0]);
$as.close;
}
use REX::Native;
use NativeCall;
class REX::File {
has $.path is required where *.IO.e;
has $.name = $!path.IO.basename.subst('.rx2', '');
has Pointer[void] $.handle = get-rex-handle($!path);
has REXInfo $.info = rex-get-info($!handle);
has $.sample-rate = $!info.fSampleRate;
has @!slices;
has $!sample-length;
has $!seconds-length;
my atomicint $REFCOUNT = 0;
method new(:$path) {
# REX::Native needs to load the dylib into memory
initialize if $REFCOUNT == 0;
$REFCOUNT⚛++;
self.bless: :$path;
}
my class Slice {
has REXInfo $.info handles <fSampleRate fChannels>;
has REXSliceInfo $.slice-info handles <fSampleLength>;
has Int $.idx;
has Pointer[void] $.handle;
has CArray[CArray[num32]] $.samples = rex-render-slice($!handle, $!idx, $!slice-info.fSampleLength, $!info.fChannels);
method seconds {
self.fSampleLength / self.fSampleRate
}
method ms {
self.seconds * 1000
}
method interleaved {
if self.fChannels == 2 {
my $ret = CArray[num32].allocate(self.fSampleLength * 2);
for ^self.fSampleLength -> $s {
$ret.push: $!samples[0][$s], $!samples[1][$s]
}
} else {
$!samples[0]
}
}
}
method slices {
if ! @!slices {
for ^$!info.fSliceCount -> $idx {
@!slices.push: Slice.new(:$!info, :slice-info(rex-get-slice-info($!handle, $idx)), :$idx, :$!handle);
}
}
@!slices
}
method samples {
[ self.slices>>.samples ]
}
method sample-length {
$!sample-length ||= [+] self.slices>>.fSampleLength
}
method seconds-length {
$!seconds-length ||= [+] self.slices>>.seconds;
}
submethod DESTROY {
free-rex-handle($!handle);
uninitialize if --⚛$REFCOUNT == 0;
}
}
use v6.d;
use NativeCall;
constant LIBRARY = './dist/REX Shared Library.framework/Versions/Current/REX Shared Library';
constant DEBUG = False;
enum REXError
(
#/* Not really errors */
kREXError_NoError => 1,
kREXError_OperationAbortedByUser => 2,
kREXError_NoCreatorInfoAvailable => 3,
#/* Run-time errors */
kREXError_OutOfMemory => 105,
kREXError_FileCorrupt => 106,
kREXError_REX2FileTooNew => 107,
kREXError_FileHasZeroLoopLength => 108,
#/* Implementation errors */
kREXImplError_DLLNotInitialized => 200,
kREXImplError_DLLAlreadyInitialized => 201,
kREXImplError_InvalidHandle => 202,
kREXImplError_InvalidSize => 203,
kREXImplError_InvalidArgument => 204,
kREXImplError_InvalidSlice => 205,
kREXImplError_InvalidSampleRate => 206,
kREXImplError_BufferTooSmall => 207,
kREXImplError_IsBeingPreviewed => 208,
kREXImplError_NotBeingPreviewed => 209,
kREXImplError_InvalidTempo => 210,
#/* DLL error - call the cops! */
kREXError_Undefined => 666
);
my %REXErrorLookup = REXError.enums.antipairs;
subset Error of Int where { %REXErrorLookup{$^err}:exists && $^err != kREXError_NoError }
enum REXCallbackResult <kREXCallback_Abort kREXCallback_Continue>;
# C Structs
class REXInfo is repr('CStruct') is export {
has int32 $.fChannels;
has int32 $.fSampleRate;
has int32 $.fSliceCount;
has int32 $.fTempo;
has int32 $.fOriginalTempo;
has int32 $.fPPQLength;
has int32 $.fTimeSignNom;
has int32 $.fTimeSignDenom;
has int32 $.fBitDepth;
}
class REXSliceInfo is repr('CStruct') is export {
has int32 $.fPPQPos;
has int32 $.fSampleLength;
}
class REXCreatorInfo is repr('CStruct') {
has Str $.fName;
has Str $.fCopyright;
has Str $.fURL;
has Str $.fEmail;
has Str $.fFreeText;
}
# C functions
my sub lib-path { LIBRARY }
sub REXInitializeDLL() returns int32 is native(&lib-path) {*}
sub REXUninitializeDLL() is native(&lib-path) {*}
sub REXCreateCallback returns Pointer is native(&lib-path) is export {*}
sub REXCreate(Pointer[void] $handle is rw, Blob $buffer, int32 $size, Pointer, Pointer[void]) returns int32
is native(&lib-path) {*}
sub REXDelete(Pointer[void] $handle is rw) is native(&lib-path) {*}
sub REXGetInfo(Pointer[void] $handle, int32 $size, REXInfo $info is rw)
returns int32 is native(&lib-path) {*}
sub REXGetSliceInfo(Pointer[void] $handle, int32 $index, int32 $size,
REXSliceInfo $info is rw) returns int32 is native(&lib-path) {*}
sub REXRenderSlice(Pointer[void] $handle, int32 $idx, int32 $length, CArray[CArray[num32]] $buffers) returns int32 is native(&lib-path) {*}
# Custom subs
sub error-name (Error $e) { %REXErrorLookup{$e} }
my $INITIALIZED;
sub initialize is export {
if !$INITIALIZED {
my $e = REXInitializeDLL;
if $e != kREXError_NoError {
die "Error initializing the REX dynamic library: {error-name $e}";
} else {
$*ERR.put("Initializing REX library into memory") if DEBUG;
$INITIALIZED = True
}
}
}
# This must be called!
sub uninitialize is export {
if $INITIALIZED {
REXUninitializeDLL;
$*ERR.put("Uninitializing REX library from memory") if DEBUG;
$INITIALIZED = False;
} else {
die "uninitialize() called prior to initialize()";
}
}
sub get-rex-handle($path where *.IO.e) is export {
my $f = $path.IO.open(:bin);
my Blob $rex-blob = $f.slurp;
$f.close; # Ensure we don't hit fopen limits!
my Pointer[void] $handle .= new;
my $err = REXCreate($handle, $rex-blob, $rex-blob.elems, Pointer, Pointer[void]);
if $err ~~ Error {
die "Error: {error-name $err}";
}
$handle
}
sub free-rex-handle(Pointer[void] $handle) is export {
REXDelete($handle);
}
sub rex-get-info($handle) is export {
my REXInfo $info .= new;
my $err = REXGetInfo($handle, nativesizeof(REXInfo.new), $info);
if $err ~~ Error {
die "Error: {error-name $err}";
}
$info
}
sub rex-get-slice-info($handle, $idx) is export {
my REXSliceInfo $slice .= new;
my $err = REXGetSliceInfo($handle, $idx, nativesizeof(REXSliceInfo.new), $slice);
if $err ~~ Error {
die "Error getting slice info: {error-name $err}";
}
$slice
}
sub rex-render-slice($handle, $idx, $length, $channels where * <= 2) is export {
my $buffers = CArray[CArray[num32]].new(CArray[num32].allocate($length) xx $channels);
if $channels == 1 {
$buffers[1] = CArray[num32]; # Give it the type object aka NULL
}
say "Created CArray buffers of length {$buffers[0].elems} for $channels channels" if DEBUG;
my $err = REXRenderSlice($handle, $idx, $length, $buffers);
if $err ~~ Error {
die "Error rendering slice $idx: {error-name e}";
}
$buffers
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment