opengl_modern.pl

#!/usr/bin/env perl

##############################################################################
# AUTHOR'S NOTE                                                              #
# =============                                                              #
#                                                                            #
# This is just a test script for OpenGL::Modern. It is not intended as an    #
# example of good coding practices! :)                                       #
##############################################################################

use Mojo::Base 'Mojo::EventEmitter';

use Devel::Dwarn;
use Mojo::Log;
use OpenGL::Shader;

use Mojo::Loader 'data_section';
use OpenGL::Modern ':all';
use OpenHMD::Backend::Inline ':all';

use OpenGL qw(:glutfunctions :glutconstants :glufunctions);

has is_ticking      =>    1;
has window_width    => 1280;
has window_height   =>  768;
has use_shader      =>    1;

has log => sub { Mojo::Log->new };
has openhmd_context => sub { ohmd_ctx_create() };

has openhmd_device => sub {
    my $context = $_[0]->openhmd_context;
    ohmd_ctx_probe($context);
    return ohmd_list_open_device($context, 0);
};

has fbo_left => sub {
    my $self = shift;
    $self->glut_fbo(
        map { $_ * 1.6 }
            $self->window_width / 2,
            $self->window_height,
    );
};

has fbo_right => sub {
    my $self = shift;
    $self->glut_fbo(
        map { $_ * 1.6 }
            $self->window_width / 2,
            $self->window_height,
    );
};

has shader => sub {
    my $shader = OpenGL::Shader->new('GLSL');
    $shader->Load(
        data_section(ref $_[0], 'dk1.frag.glsl'),
        data_section(ref $_[0], 'dk1.vert.glsl'),
    );
    return $shader;
};

if (!caller) {
    my $self = __PACKAGE__->new->init;
    $self->main;
}

sub init {
    my $self = shift;

    $self->on(key_state => sub {
        my ($self, $args) = @_;
        if ($args->{name} eq 'GLUT_KEY_27' && $args->{state}) {
            $self->log->info('[MAIN] Ticking stopping..');
            $self->is_ticking(0);
        }
    });

    $self->on(key_state => sub {
        my ($self, $args) = @_;
        if ($args->{name} eq 'GLUT_SKEY_F1' && $args->{state}) {
            $self->use_shader(!$self->use_shader);
            $self->log->info(sprintf '[MAIN] Toggled shader: %i',
                $self->use_shader,
            );
        }
    });

    $self->glut_init;

    return $self;
}

sub main {
    my $self = shift;

    $self->tick while $self->is_ticking;

    return $self;
}

sub tick {
    my $self = shift;

    $self->openhmd_tick;
    $self->glut_tick;

    return $self;
}

##############################################################################
# OpenHMD                                                                    #
##############################################################################

sub openhmd_tick {
    my $self = shift;

    ohmd_ctx_update($self->openhmd_context);

    return $self;
}

sub openhmd_matrices {
    my $self = shift;

    my @matrices = map { pack 'f16' } 0 .. 3;
    ohmd_device_getf($self->openhmd_device,
        $OHMD_LEFT_EYE_GL_PROJECTION_MATRIX, $matrices[0],
    );
    ohmd_device_getf($self->openhmd_device,
        $OHMD_LEFT_EYE_GL_MODELVIEW_MATRIX, $matrices[1],
    );
    ohmd_device_getf($self->openhmd_device,
        $OHMD_RIGHT_EYE_GL_PROJECTION_MATRIX, $matrices[2],
    );
    ohmd_device_getf($self->openhmd_device,
        $OHMD_RIGHT_EYE_GL_MODELVIEW_MATRIX, $matrices[3],
    );

    return map { [unpack 'f*', $_] } @matrices;
}

##############################################################################
# GLUT                                                                       #
##############################################################################

sub glut_init {
    my $self = shift;

    glutInit();
    glutInitDisplayMode(GLUT_RGBA | GLUT_DOUBLE);
    glutInitWindowSize($self->window_width, $self->window_height);
    glutCreateWindow('OpenGL Modern');
    glewInit();

    glutDisplayFunc(sub { $self->glut_display_hmd });
    glutReshapeFunc(sub { $self->glut_reshape(@_) });
    glutKeyboardFunc(sub { $self->glut_keyboard(1, @_) });
    glutSpecialFunc(sub { $self->glut_special(1, @_) });

    return $self;
}

sub glut_special {
    my ($self, $state, $key, $x, $y) = @_;

    state $names = [qw(
        GLUT_SKEY_F1
    )];

    my $name = $names->[$key - 1];
    $self->log->info(sprintf '[GLUT] Key state (%i) for %s', $state, $name);

    $self->emit('key_state', {
        name    => $name,
        state   => $state,
    });

    return $self;
}

sub glut_display_render {
    my ($self, $fbo, $projection, $modelview) = @_;

    $self->log->debug('[GLUT] Display (Render)');

    glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, $fbo->{frame});

    glClearColor(0, 0, 0, 1);
    glClear(GL_COLOR_BUFFER_BIT);

    glMatrixMode(GL_PROJECTION);
    glLoadMatrixf_p(@{$projection});

    glViewport(0, 0, $fbo->{width}, $fbo->{height});

    glMatrixMode(GL_MODELVIEW);
    glLoadMatrixf_p(@{$modelview});

    glTranslatef(0, 0, -4);

    glBegin(GL_LINES);
    foreach my $axis (0 .. 2) {
        my @values = (0, 0, 0);
        $values[$axis] = 1;

        glColor3fv_p(@values);
        glVertex3f(0, 0, 0);
        glVertex3fv_p(@values);
    }
    glEnd();

    return $self;
}

sub glut_display_hmd {
    my $self = shift;

    $self->log->debug('[GLUT] Display (HMD)');

    my @matrices = $self->openhmd_matrices;

    my $left = $self->fbo_left;
    $self->glut_display_render($left, @matrices[0, 1]);

    my $right = $self->fbo_right;
    $self->glut_display_render($right, @matrices[2, 3]);

    glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, 0);
    $self->shader->Enable if $self->use_shader;

    glClearColor(0, 0, 0, 1);
    glClear(GL_COLOR_BUFFER_BIT);

    glMatrixMode(GL_PROJECTION);
    glLoadIdentity();

    glViewport(0, 0, $self->window_width, $self->window_height);
    gluOrtho2D(0, 2, 0, 1);

    glMatrixMode(GL_MODELVIEW);
    glLoadIdentity();

    glEnable(GL_TEXTURE_2D);

    glBindTexture(GL_TEXTURE_2D, $left->{texture});
    glColor3f(1, 1, 1);
    glBegin(GL_QUADS);
    glTexCoord2i(0, 1); glVertex2f(0, 1);
    glTexCoord2i(0, 0); glVertex2f(0, 0);
    glTexCoord2i(1, 0); glVertex2f(1, 0);
    glTexCoord2i(1, 1); glVertex2f(1, 1);
    glEnd();

    glBindTexture(GL_TEXTURE_2D, $right->{texture});
    glColor3f(1, 1, 1);
    glBegin(GL_QUADS);
    glTexCoord2i(0, 1); glVertex2f(1, 1);
    glTexCoord2i(0, 0); glVertex2f(1, 0);
    glTexCoord2i(1, 0); glVertex2f(2, 0);
    glTexCoord2i(1, 1); glVertex2f(2, 1);
    glEnd();

    glDisable(GL_TEXTURE_2D);
    $self->shader->Disable;

    glutSwapBuffers();

    return $self;
}

sub glut_keyboard {
    my ($self, $state, $key, $x, $y) = @_;

    my $name = sprintf 'GLUT_KEY_%i', $key;
    $self->log->info(sprintf '[GLUT] Key state (%i) for %s', $state, $name);

    $self->emit('key_state', {
        name    => $name,
        state   => $state,
    });

    return $self;
}

sub glut_reshape {
    my ($self, $width, $height) = @_;

    $self->log->info(sprintf '[GLUT] Window reshape: %i x %i',
        $width, $height,
    );

    $self->window_width($width);
    $self->window_height($height);

    return $self;
}

sub glut_tick {
    my $self = shift;

    glutMainLoopEvent();
    glutPostRedisplay();

    return $self;
}

sub glut_fbo {
    my ($self, $width, $height) = @_;

    my $texture = glGenTextures_p(1);
    glBindTexture(GL_TEXTURE_2D, $texture);

    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

    glTexImage2D_c(GL_TEXTURE_2D, 0, GL_RGBA8, $width, $height, 0, GL_BGRA, GL_UNSIGNED_BYTE, 0);

    my $frame = glGenFramebuffersEXT_p(1);
    glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, $frame);
    glFramebufferTexture2DEXT(GL_FRAMEBUFFER_EXT, GL_COLOR_ATTACHMENT0_EXT, GL_TEXTURE_2D, $texture, 0);

    my $render = glGenRenderbuffersEXT_p(1);
    glBindRenderbufferEXT(GL_RENDERBUFFER_EXT, $render);
    glRenderbufferStorageEXT(GL_RENDERBUFFER_EXT, GL_DEPTH_COMPONENT24, $width, $height);
    glFramebufferRenderbufferEXT(GL_FRAMEBUFFER_EXT, GL_DEPTH_ATTACHMENT_EXT, GL_RENDERBUFFER_EXT, $render);

    return {
        texture => $texture,
        frame   => $frame,
        render  => $render,
        width   => $width,
        height  => $height,
    };
}

##############################################################################
# gl                                                                         #
##############################################################################

sub glColor3fv_p {
    my $values = pack 'f*', @_;
    my $values_ptr = unpack 'Q', pack 'P', $values;
    glColor3fv_c($values_ptr);
}

sub glVertex3fv_p {
    my $values = pack 'f*', @_;
    my $values_ptr = unpack 'Q', pack 'P', $values;
    glVertex3fv_c($values_ptr);
}

sub glGenTextures_p {
    my $size = shift;
    my $values = pack sprintf 'I%i', $size;
    my $values_ptr = unpack 'Q', pack 'P', $values;
    glGenTextures_c($size, $values_ptr);
    return unpack 'I*', $values;
}

sub glGenFramebuffersEXT_p {
    my $size = shift;
    my $values = pack sprintf 'I%i', $size;
    my $values_ptr = unpack 'Q', pack 'P', $values;
    glGenFramebuffersEXT_c($size, $values_ptr);
    return unpack 'I*', $values;
}

sub glGenRenderbuffersEXT_p {
    my $size = shift;
    my $values = pack sprintf 'I%i', $size;
    my $values_ptr = unpack 'Q', pack 'P', $values;
    glGenRenderbuffers_c($size, $values_ptr);
    return unpack 'I*', $values;
}

sub glLoadMatrixf_p {
    my $values = pack 'f*', @_;
    my $values_ptr = unpack 'Q', pack 'P', $values;
    glLoadMatrixf_c($values_ptr);
}

__DATA__

@@ dk1.vert.glsl
#version 120

void main(void)
{
    gl_TexCoord[0] = gl_MultiTexCoord0;
    gl_Position = ftransform();
}

@@ dk1.frag.glsl
#version 120

// Taken from mts3d forums, from user fredrik.

uniform sampler2D warpTexture;

const vec2 LeftLensCenter = vec2(0.2863248, 0.5);
const vec2 RightLensCenter = vec2(0.7136753, 0.5);
const vec2 LeftScreenCenter = vec2(0.25, 0.5);
const vec2 RightScreenCenter = vec2(0.75, 0.5);
const vec2 Scale = vec2(0.1469278, 0.2350845);
const vec2 ScaleIn = vec2(4, 2.5);
const vec4 HmdWarpParam   = vec4(1, 0.22, 0.24, 0);

// Scales input texture coordinates for distortion.
vec2 HmdWarp(vec2 in01, vec2 LensCenter)
{
    vec2 theta = (in01 - LensCenter) * ScaleIn; // Scales to [-1, 1]
    float rSq = theta.x * theta.x + theta.y * theta.y;
    vec2 rvector = theta * (HmdWarpParam.x + HmdWarpParam.y * rSq +
        HmdWarpParam.z * rSq * rSq +
        HmdWarpParam.w * rSq * rSq * rSq);
    return LensCenter + Scale * rvector;
}

void main()
{
    // The following two variables need to be set per eye
    vec2 LensCenter = gl_FragCoord.x < 640 ? LeftLensCenter : RightLensCenter;
    vec2 ScreenCenter = gl_FragCoord.x < 640 ? LeftScreenCenter : RightScreenCenter;

    vec2 oTexCoord = gl_FragCoord.xy / vec2(1280, 800);

    vec2 tc = HmdWarp(oTexCoord, LensCenter);
    if (any(bvec2(clamp(tc,ScreenCenter-vec2(0.25,0.5), ScreenCenter+vec2(0.25,0.5)) - tc)))
    {
        gl_FragColor = vec4(0.0, 0.0, 0.0, 1.0);
        return;
    }

    tc.x = gl_FragCoord.x < 640 ? (2.0 * tc.x) : (2.0 * (tc.x - 0.5));
    gl_FragColor = texture2D(warpTexture, tc);
}