Passing an array of structures to a Perl 6 NativeCall function
As far as I'm aware, there's no built-in way to do this. However, there's enough rope to hang yourself build a workaround:
role StructArray[Mu:U \T where .REPR eq 'CStruct'] does Positional[T] {
has $.bytes;
has $.elems;
method new(UInt \n) {
self.bless(bytes => buf8.allocate(n * nativesizeof T), elems => n);
}
method AT-POS(UInt \i where ^$!elems) {
nativecast(T, Pointer.new(nativecast(Pointer, $!bytes) + i * nativesizeof T));
}
method pointer {
nativecast(Pointer[T], $!bytes);
}
}
This should allow the following to work:
my @foo-array := StructArray[foo].new(10); # 'array' with 10 elements
@foo-array[0].x = 42;
Interaction with C functions is possible by passing @foo-array.pointer
to a parameter of type Pointer[foo]
. As structures are passed by pointer as well, you could also pass @foo-array[0]
to a parameter of type foo
for the same effect.
The following code shows how to pass a pointer to byte and pointer to wchar to a windows api function.
I didn't have a case yet where I need to pass in an array of structures, but I don't see why the same technique would not apply. Most important: You must make sure you allocate memory for your data!
use NativeCall;
constant UINT := uint32;
constant BOOL := uint32;
constant BYTE := uint8;
constant WCHAR := uint16;
constant int := int32;
constant LPWTSTR := CArray[WCHAR];
constant PBYTE := CArray[BYTE];
my $virtual-keycode = 0xBC; # comma
sub SetConsoleCP(UINT) is native('Kernel32') returns BOOL { * };
sub SetConsoleOutputCP(UINT) is native('Kernel32') returns BOOL { * };
# winapi: int ToUnicode( UINT wVirtKey, UINT wScanCode, const PBYTE lpKeyState, LPWSTR pwszBuff, int cchBuff, UINT wFlags );
sub ToUnicode(UINT, UINT, PBYTE is rw, LPWTSTR is rw, int32, UINT) is native("User32") returns int32 { * };
my @kbs := CArray[BYTE].new(0 xx 256);
my @buf := CArray[WCHAR].new(0 xx 2);
say "Can't set Codepage" unless SetConsoleCP(65001) && SetConsoleOutputCP(65001);
say "Got Unicode" ~ @buf[0] ~ " -> " ~ @buf[0].chr
if ToUnicode( $virtual-keycode, 0, @kbs, @buf, 2 ,0);