Perl OpenHMD Module (Alpha)

package OpenHMD;

use strict;
use warnings;

use Const::Fast;
use Exporter 'import';
use Inline  C       => Config
        =>  LIBS    => '-lopenhmd',
;
use Inline 'C';

const our $OHMD_VENDOR  => 0;
const our $OHMD_PRODUCT => 1;
const our $OHMD_PATH    => 2 ;

const our $OHMD_ROTATION_QUAT                   =>  1;
const our $OHMD_LEFT_EYE_GL_MODELVIEW_MATRIX    =>  2;
const our $OHMD_RIGHT_EYE_GL_MODELVIEW_MATRIX   =>  3;
const our $OHMD_LEFT_EYE_GL_PROJECTION_MATRIX   =>  4;
const our $OHMD_RIGHT_EYE_GL_PROJECTION_MATRIX  =>  5;
const our $OHMD_POSITION_VECTOR                 =>  6;
const our $OHMD_SCREEN_HORIZONTAL_SIZE          =>  7;
const our $OHMD_SCREEN_VERTICAL_SIZE            =>  8;
const our $OHMD_LENS_HORIZONTAL_SEPARATION      =>  9;
const our $OHMD_LENS_VERTICAL_POSITION          => 10;
const our $OHMD_LEFT_EYE_FOV                    => 11;
const our $OHMD_LEFT_EYE_ASPECT_RATIO           => 12;
const our $OHMD_RIGHT_EYE_FOV                   => 13;
const our $OHMD_RIGHT_EYE_ASPECT_RATIO          => 14;
const our $OHMD_EYE_IPD                         => 15;
const our $OHMD_PROJECTION_ZFAR                 => 16;
const our $OHMD_PROJECTION_ZNEAR                => 17;
const our $OHMD_DISTORTION_K                    => 18;

const our $OHMD_SCREEN_HORIZONTAL_RESOLUTION    => 0;
const our $OHMD_SCREEN_VERTICAL_RESOLUTION      => 1;

our @EXPORT_OK = (
    '$OHMD_VENDOR',
    '$OHMD_PRODUCT',
    '$OHMD_PATH',

    '$OHMD_ROTATION_QUAT',
    '$OHMD_LEFT_EYE_GL_MODELVIEW_MATRIX',
    '$OHMD_RIGHT_EYE_GL_MODELVIEW_MATRIX',
    '$OHMD_LEFT_EYE_GL_PROJECTION_MATRIX',
    '$OHMD_RIGHT_EYE_GL_PROJECTION_MATRIX',
    '$OHMD_POSITION_VECTOR',
    '$OHMD_SCREEN_HORIZONTAL_SIZE',
    '$OHMD_SCREEN_VERTICAL_SIZE',
    '$OHMD_LENS_HORIZONTAL_SEPARATION',
    '$OHMD_LENS_VERTICAL_POSITION',
    '$OHMD_LEFT_EYE_FOV',
    '$OHMD_LEFT_EYE_ASPECT_RATIO',
    '$OHMD_RIGHT_EYE_FOV',
    '$OHMD_RIGHT_EYE_ASPECT_RATIO',
    '$OHMD_EYE_IPD',
    '$OHMD_PROJECTION_ZFAR',
    '$OHMD_PROJECTION_ZNEAR',
    '$OHMD_DISTORTION_K',

    '$OHMD_SCREEN_HORIZONTAL_RESOLUTION',
    '$OHMD_SCREEN_VERTICAL_RESOLUTION',
);

our %EXPORT_TAGS = (
    CONSTANTS => [
        '$OHMD_VENDOR',
        '$OHMD_PRODUCT',
        '$OHMD_PATH',

        '$OHMD_ROTATION_QUAT',
        '$OHMD_LEFT_EYE_GL_MODELVIEW_MATRIX',
        '$OHMD_RIGHT_EYE_GL_MODELVIEW_MATRIX',
        '$OHMD_LEFT_EYE_GL_PROJECTION_MATRIX',
        '$OHMD_RIGHT_EYE_GL_PROJECTION_MATRIX',
        '$OHMD_POSITION_VECTOR',
        '$OHMD_SCREEN_HORIZONTAL_SIZE',
        '$OHMD_SCREEN_VERTICAL_SIZE',
        '$OHMD_LENS_HORIZONTAL_SEPARATION',
        '$OHMD_LENS_VERTICAL_POSITION',
        '$OHMD_LEFT_EYE_FOV',
        '$OHMD_LEFT_EYE_ASPECT_RATIO',
        '$OHMD_RIGHT_EYE_FOV',
        '$OHMD_RIGHT_EYE_ASPECT_RATIO',
        '$OHMD_EYE_IPD',
        '$OHMD_PROJECTION_ZFAR',
        '$OHMD_PROJECTION_ZNEAR',
        '$OHMD_DISTORTION_K',

        '$OHMD_SCREEN_HORIZONTAL_RESOLUTION',
        '$OHMD_SCREEN_VERTICAL_RESOLUTION',
    ],
);

sub new {
    my $class = shift;

    my $self = bless {
    }, $class;

    return $self;
}

#################
# THIN WRAPPERS #
#################

sub ohmd_ctx_create {
    my $self = shift;

    my $context = inline_ohmd_ctx_create();

    return $context;
}

sub ohmd_ctx_destroy {
    my ($self, $context) = @_;

    inline_ohmd_ctx_destroy ($context);

    return $self;
}

sub ohmd_ctx_probe {
    my ($self, $context) = @_;

    my $devices = inline_ohmd_ctx_probe ($context);

    return $devices;
}

sub ohmd_ctx_update {
    my ($self, $context) = @_;

    inline_ohmd_ctx_update ($context);

    return $self;
}

sub ohmd_list_open_device {
    my ($self, $context, $index) = @_;

    my $device = inline_ohmd_list_open_device ($context, $index);

    return $device;
}

sub ohmd_device_geti {
    my ($self, $device, $type) = @_;

    my $value = inline_ohmd_device_geti ($device, $type);

    return $value;
}

sub ohmd_device_getf {
    my ($self, $device, $type) = @_;

    my @values = inline_ohmd_device_getf ($device, $type);

    return @values;
}

sub ohmd_list_gets {
    my ($self, $context, $index, $type) = @_;

    my @values = inline_ohmd_list_gets ($context, $index, $type);

    return @values;
}

1;

__DATA__
__C__

#include "openhmd/openhmd.h"

int inline_ohmd_ctx_create() {
    return ohmd_ctx_create();
}

void inline_ohmd_ctx_destroy(int ctx) {
    ohmd_ctx_destroy(ctx);
}

int inline_ohmd_ctx_probe(int ctx) {
    return ohmd_ctx_probe(ctx);
}

void inline_ohmd_ctx_update(int ctx) {
    ohmd_ctx_update(ctx);
}

int inline_ohmd_list_open_device(int ctx, int index) {
    return ohmd_list_open_device(ctx, index);
}

char* inline_ohmd_list_gets(int ctx, int index, int type) {
    return ohmd_list_gets(ctx, index, type);
}

int inline_ohmd_device_geti(int device, int type) {
    int buffer[1];

    ohmd_device_geti(device, type, buffer);

    return buffer[0];
}

void inline_ohmd_device_getf (int device, int type) {
    float buffer[16];

    ohmd_device_getf(device, type, buffer);

    Inline_Stack_Vars;
    Inline_Stack_Reset;

    int i;
    for(i = 0; i < 16; i++) {
        Inline_Stack_Push(sv_2mortal(newSVnv(buffer[i])));
    }

    Inline_Stack_Done;
}