#!/usr/bin/perl

use OpenGL ":all";
use OpenCL;

my $S = $ARGV[0] || 256; # window/texture size, smaller is faster

# open a window and create a gl texture
OpenGL::glpOpenWindow width => $S, height => $S;
my $texid = glGenTextures_p 1;
glBindTexture GL_TEXTURE_2D, $texid;
glTexImage2D_c GL_TEXTURE_2D, 0, GL_RGBA8, $S, $S, 0, GL_RGBA, GL_UNSIGNED_BYTE, 0;

# find and use the first opencl device that let's us get a shared opengl context
my $platform;
my $dev;
my $ctx;

sub get_context {
   for (OpenCL::platforms) {
      $platform = $_;
      for ($platform->devices) {
         $dev = $_;
         $ctx = eval { $platform->context ([OpenCL::GLX_DISPLAY_KHR, undef, OpenCL::GL_CONTEXT_KHR, undef], [$dev]) }
            and return;
      }
   }

   die "cannot find suitable OpenCL device\n";
}

get_context;

print "using ", $dev->name, "\n";

my $queue = $ctx->queue ($dev);

# now attach an opencl image2d object to the opengl texture
my $tex = $ctx->gl_texture2d (OpenCL::MEM_WRITE_ONLY, GL_TEXTURE_2D, 0, $texid);

# now the boring opencl code
my $src = <<EOF;
kernel void
juliatunnel (write_only image2d_t img, float time)
{
  int2 xy = (int2)(get_global_id (0), get_global_id (1));
  float2 p = convert_float2 (xy) / $S.f * 2.f - 1.f;

  float2 m = (float2)(1.f, p.y) / fabs (p.x); // tunnel
  m.x = fabs (fmod (m.x + time * 0.05f, 4.f) - 2.f);

  float2 z = m;
  float2 c = (float2)(sin (time * 0.01133f), cos (time * 0.02521f));

  for (int i = 0; i < 25 && dot (z, z) < 4.f; ++i) // standard julia
    z = (float2)(z.x * z.x - z.y * z.y, 2.f * z.x * z.y) + c;

  float3 colour = (float3)(z.x, z.y, atan2 (z.y, z.x));
  write_imagef (img, xy, (float4)(colour * p.x * p.x, 1.));
}
EOF

my $prog = $ctx->build_program ($src);
my $kernel = $prog->kernel ("juliatunnel");

# program compiled, kernel ready, now draw and loop

for (my $time; ; ++$time) {
   # acquire objects from opengl
   $queue->acquire_gl_objects ([$tex]);

   # configure and run our kernel
   $kernel->setf ("mf", $tex, $time*2); # mf = memory object, float
   $queue->nd_range_kernel ($kernel, undef, [$S, $S], undef);

   # release objects to opengl again
   $queue->release_gl_objects ([$tex]);

   # wait
   $queue->finish;

   # now draw the texture, the defaults should be all right
   glTexParameterf GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST;

   glEnable GL_TEXTURE_2D;
   glBegin GL_QUADS;
      glTexCoord2f 0, 1; glVertex3i -1, -1, -1;
      glTexCoord2f 0, 0; glVertex3i  1, -1, -1;
      glTexCoord2f 1, 0; glVertex3i  1,  1, -1;
      glTexCoord2f 1, 1; glVertex3i -1,  1, -1;
   glEnd;

   glXSwapBuffers;

   select undef, undef, undef, 1/60;
}