rex-extract.p6

#!/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;
}

rex-file.p6

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;
	}
}

rex-native.p6

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
}