#!perl

use strict;
use warnings;
use OpenGL::Modern qw(
  glewCreateContext glewInit glpSetAutoCheckErrors glewDestroyContext
  glpCheckErrors glGetString
  glGenTextures_p glBindTexture glDeleteTextures_p
  glTexImage2D_c glTexParameteri
  glGetTexLevelParameteriv_p glGetIntegerv_p
  glPixelStorei glGetTexImage_c
  glActiveTexture
  glCreateShader glDeleteShader glShaderSource_p glCompileShader
  glAttachShader glDetachShader
  glGetShaderiv_p glGetShaderInfoLog_p
  glCreateProgram glDeleteProgram glLinkProgram glUseProgram
  glGetProgramiv_p glGetProgramInfoLog_p
  glGetUniformLocation glUniform1i glGetActiveUniform_p
  glGenFramebuffers_p glBindFramebuffer glDeleteFramebuffers_p
  glFramebufferTexture glCheckFramebufferStatus
  glGenBuffers_p glDeleteBuffers_p glBindBuffer glBufferData_c
  glGenVertexArrays_p glDeleteVertexArrays_p glBindVertexArray
  glViewport glVertexAttribPointer_c
  glEnableVertexAttribArray glDisableVertexAttribArray
  glDrawArrays glFinish
  GL_FRAMEBUFFER GL_COLOR_ATTACHMENT0 GL_FRAMEBUFFER_COMPLETE
  GL_UNPACK_ALIGNMENT GL_PACK_ALIGNMENT
  GL_TEXTURE_2D GL_R32F GL_RED GL_FLOAT GL_COLOR_BUFFER_BIT
  GL_TEXTURE_MIN_FILTER GL_TEXTURE_MAG_FILTER
  GL_TEXTURE0 GL_TEXTURE1
  GL_TEXTURE_WIDTH GL_TEXTURE_HEIGHT GL_MAX_TEXTURE_SIZE GL_MAX_VIEWPORT_DIMS
  GL_TEXTURE_WRAP_S GL_TEXTURE_WRAP_T GL_NEAREST GL_CLAMP_TO_EDGE
  GL_VERSION GLEW_OK
  GL_COMPILE_STATUS GL_LINK_STATUS GL_FALSE
  GL_VERTEX_SHADER GL_FRAGMENT_SHADER
  GL_ARRAY_BUFFER GL_STATIC_DRAW GL_TRIANGLE_STRIP
);
use PDL;

sub with_time (&$) {
  require Time::HiRes;
  my @t = Time::HiRes::gettimeofday();
  my $ret = &{$_[0]}();
  printf "$_[1]: %g ms\n", Time::HiRes::tv_interval(\@t) * 1000;
  $ret;
}

print "Perl $^V OpenGL::Modern $OpenGL::Modern::VERSION PDL $PDL::VERSION\n";

# 3.3 core so MacOS allows >2.1
glewCreateContext(3, 3, 1, 2) == GLEW_OK or die "glewCreateContext failed";
glewInit() == GLEW_OK or die "glewInit failed";
glpSetAutoCheckErrors(1);
print "OpenGL ", glGetString(GL_VERSION), "\n";
my $max_tex_dim = glGetIntegerv_p(GL_MAX_TEXTURE_SIZE);
print "Max texture dim = $max_tex_dim\n";
my $max_vp_dim = glGetIntegerv_p(GL_MAX_VIEWPORT_DIMS);
print "Max viewport dim = $max_vp_dim\n";

my $vertex_shader = <<'EOF';
#version 330
precision highp float;
layout(location = 0) in vec2 pos;
smooth out vec2 texLoc;
void main() {
  gl_Position = vec4(pos, 0.0, 1.0);
  texLoc = (pos + 1.0) / 2.0;
}
EOF

my $fragment_shader = <<'EOF';
#version 330
precision highp float;
uniform sampler2D tex;
smooth in vec2 texLoc;
out vec4 outputColor;

void main() {
  float x = texture(tex, texLoc).r;
  float y = pow(x, 2);
  outputColor = vec4(y, 0, 0, 1);
}
EOF

my $pos_data = float('1.0 -1.0; 1.0 1.0; -1.0 -1.0; -1.0 1.0');
my $program = compile_program($vertex_shader, $fragment_shader);
my ($size, $utype, $name) = glGetActiveUniform_p($program, 0);
print "glGetActiveUniform_p: (size=$size, type=@{[
  OpenGL::Modern::enum2name('UniformType', $utype)
]}, name=$name)\n";
my $tex_uniform = glGetUniformLocation($program, "tex");
my $attrib_buffer = glGenBuffers_p(1);
glBindBuffer(GL_ARRAY_BUFFER, $attrib_buffer);
glBufferData_c(GL_ARRAY_BUFFER, $pos_data->nbytes, $pos_data->make_physical->address_data, GL_STATIC_DRAW);
glBindBuffer(GL_ARRAY_BUFFER, 0);
my $vao = glGenVertexArrays_p(1);
glBindVertexArray($vao);

my ($xdim, $ydim) = (16384, 16384);
my $p = sequence(float, $xdim, $ydim);
my $skip0 = int($xdim / 2) - 1;
my $skip1 = int(($ydim-1) / 2);
my $slicearg = '::'.$skip0.',::'.$skip1;
print "Source data: ", $p->slice($slicearg);
my $p_cpu_squared = with_time { $p ** 2 } 'square CPU';
print "Squared on CPU: ", $p_cpu_squared->slice($slicearg);

my ($type, $internalformat, $format) = (GL_FLOAT, GL_R32F, GL_RED);
my ($srcTextureID) = glGenTextures_p(1);
with_time {
glActiveTexture(GL_TEXTURE0);
glBindTexture(GL_TEXTURE_2D, $srcTextureID);
glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
my $input = $p;
die "Input as texture must have 2 dims, but has [@{[$input->{Points}->dims]}]" if $input->ndims != 2;
my ($dim0, $dim1) = $input->dims;
glTexImage2D_c(GL_TEXTURE_2D, 0, $internalformat, $dim0, $dim1,
  0, $format, $type, $input->address_data);
tex_parameters();
glBindTexture(GL_TEXTURE_2D, 0);
} 'setup src texture';

my ($destTextureID) = glGenTextures_p(1);
glActiveTexture(GL_TEXTURE1);
glBindTexture(GL_TEXTURE_2D, $destTextureID);
my ($dim0, $dim1) = ($xdim, $ydim);
glTexImage2D_c(GL_TEXTURE_2D, 0, $internalformat, $dim0, $dim1,
  0, $format, $type, 0);
tex_parameters();
glBindTexture(GL_TEXTURE_2D, 0);

my ($fbo_id) = glGenFramebuffers_p(1);
glBindFramebuffer(GL_FRAMEBUFFER, $fbo_id);
glFramebufferTexture(GL_FRAMEBUFFER, GL_COLOR_ATTACHMENT0, $destTextureID, 0);
my $fbstat = glCheckFramebufferStatus(GL_FRAMEBUFFER);
die "FBO Status error: " . glpErrorString(glGetError()) if !$fbstat;
die "FBO Status: ".OpenGL::Modern::enum2name('FramebufferStatus', $fbstat)
  if $fbstat != GL_FRAMEBUFFER_COMPLETE;

with_time {
glViewport(0,0,$xdim,$ydim);
glBindBuffer(GL_ARRAY_BUFFER, $attrib_buffer);
glVertexAttribPointer_c(0, 2, GL_FLOAT, GL_FALSE, 0, 0);
glEnableVertexAttribArray(0);
glActiveTexture(GL_TEXTURE0); # do before bind
glBindTexture(GL_TEXTURE_2D, $srcTextureID);
glUseProgram($program);
glUniform1i($tex_uniform, 0);
glDrawArrays(GL_TRIANGLE_STRIP, 0, 4);
glUseProgram(0);
glDisableVertexAttribArray(0);
glBindBuffer(GL_ARRAY_BUFFER, 0);
glFinish();
} 'render' for 1..10;

my $p2 = zeroes(float, $xdim, $ydim);
with_time {
glBindTexture(GL_TEXTURE_2D, $destTextureID);
my ($w, $h) = map glGetTexLevelParameteriv_p(GL_TEXTURE_2D, 0, $_), GL_TEXTURE_WIDTH, GL_TEXTURE_HEIGHT;
print "Texture $w x $h\n";
glPixelStorei(GL_PACK_ALIGNMENT, 1);
glGetTexImage_c(GL_TEXTURE_2D, 0, $format, $type, $p2->address_data);
glBindTexture(GL_TEXTURE_2D, 0);
} 'copy dest to CPU';
print "From GPU: ", $p2->slice($slicearg);

glpCheckErrors();
END {
glBindTexture(GL_TEXTURE_2D, 0);
glDeleteTextures_p($_) for grep $_, $srcTextureID, $destTextureID;
glBindFramebuffer(GL_FRAMEBUFFER, 0);
glDeleteFramebuffers_p($_) for grep $_, $fbo_id;
glBindVertexArray(0);
glDeleteVertexArrays_p($_) for grep $_, $vao;
glUseProgram(0);
glDeleteProgram($_) for grep $_, $program;
glBindBuffer(GL_ARRAY_BUFFER, 0);
glDeleteBuffers_p($_) for grep $_, $attrib_buffer;
glewDestroyContext();
}

sub tex_parameters {
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
}

sub compile_shader {
  my ($type, $src) = @_;
  my $shader = glCreateShader($type);
  glShaderSource_p($shader, $src);
  glCompileShader($shader);
  my $status = glGetShaderiv_p($shader, GL_COMPILE_STATUS);
  if ($status == GL_FALSE) {
    my $str = sprintf("%s shader compilation failed!\n",
        $type == GL_VERTEX_SHADER ? "Vertex" : "Fragment");
    $str .= glGetShaderInfoLog_p($shader);
    glDeleteShader($shader);
    die $str;
  }
  $shader;
}

sub compile_program {
  my ($vsrc, $fsrc) = @_;
  my $vShader = compile_shader(GL_VERTEX_SHADER, $vsrc);
  my $fShader = eval { compile_shader(GL_FRAGMENT_SHADER, $fsrc) };
  if (my $err = $@) {
    glDeleteShader($vShader);
    die $err;
  }
  my $program = glCreateProgram();
  glAttachShader($program, $vShader);
  glAttachShader($program, $fShader);
  glLinkProgram($program);
  my $status = glGetProgramiv_p($program, GL_LINK_STATUS);
  glDetachShader($program, $vShader);
  glDetachShader($program, $fShader);
  glDeleteShader($vShader);
  glDeleteShader($fShader);
  if ($status == GL_FALSE) {
    my $str = "Program linker failed.\n";
    $str .= glGetProgramInfoLog_p($program);
    glDeleteProgram($program);
    die $str;
  }
  $program;
}
