| 1 |
root |
1.1 |
#!/usr/bin/perl |
| 2 |
|
|
|
| 3 |
|
|
use OpenGL ":all"; |
| 4 |
|
|
use OpenCL; |
| 5 |
|
|
|
| 6 |
|
|
my $S = $ARGV[0] || 256; # window/texture size, smaller is faster |
| 7 |
|
|
|
| 8 |
|
|
# open a window and create a gl texture |
| 9 |
|
|
OpenGL::glpOpenWindow width => $S, height => $S; |
| 10 |
|
|
my $texid = glGenTextures_p 1; |
| 11 |
|
|
glBindTexture GL_TEXTURE_2D, $texid; |
| 12 |
|
|
glTexImage2D_c GL_TEXTURE_2D, 0, GL_RGBA8, $S, $S, 0, GL_RGBA, GL_UNSIGNED_BYTE, 0; |
| 13 |
|
|
|
| 14 |
|
|
# find and use the first opencl device that let's us get a shared opengl context |
| 15 |
|
|
my $platform; |
| 16 |
|
|
my $dev; |
| 17 |
|
|
my $ctx; |
| 18 |
|
|
|
| 19 |
|
|
for (OpenCL::platforms) { |
| 20 |
|
|
$platform = $_; |
| 21 |
|
|
for ($platform->devices) { |
| 22 |
|
|
$dev = $_; |
| 23 |
root |
1.2 |
$ctx = $platform->context (undef, [$dev]) |
| 24 |
root |
1.1 |
and last; |
| 25 |
|
|
} |
| 26 |
|
|
} |
| 27 |
|
|
|
| 28 |
|
|
$ctx |
| 29 |
|
|
or die "cannot find suitable OpenCL device\n"; |
| 30 |
|
|
|
| 31 |
root |
1.3 |
print "using ", $dev->name, "\n"; |
| 32 |
|
|
|
| 33 |
root |
1.1 |
my $queue = $ctx->queue ($dev); |
| 34 |
|
|
|
| 35 |
|
|
# now the boring opencl code |
| 36 |
|
|
my $src = <<EOF; |
| 37 |
|
|
kernel void |
| 38 |
|
|
juliatunnel (write_only image2d_t img, float time) |
| 39 |
|
|
{ |
| 40 |
|
|
int2 xy = (int2)(get_global_id (0), get_global_id (1)); |
| 41 |
|
|
float2 p = convert_float2 (xy) / $S.f * 2.f - 1.f; |
| 42 |
|
|
|
| 43 |
|
|
float2 m = (float2)(1.f, p.y) / fabs (p.x); // tunnel |
| 44 |
|
|
m.x = fabs (fmod (m.x + time * 0.05f, 4.f) - 2.f); |
| 45 |
|
|
|
| 46 |
|
|
float2 z = m; |
| 47 |
|
|
float2 c = (float2)(sin (time * 0.01133f), cos (time * 0.02521f)); |
| 48 |
|
|
|
| 49 |
|
|
for (int i = 0; i < 25 && dot (z, z) < 4.f; ++i) // standard julia |
| 50 |
|
|
z = (float2)(z.x * z.x - z.y * z.y, 2.f * z.x * z.y) + c; |
| 51 |
|
|
|
| 52 |
|
|
float3 colour = (float3)(z.x, z.y, atan2 (z.y, z.x)); |
| 53 |
|
|
write_imagef (img, xy, (float4)(colour * p.x * p.x, 1.)); |
| 54 |
|
|
} |
| 55 |
|
|
EOF |
| 56 |
|
|
|
| 57 |
|
|
my $prog = $ctx->build_program ($src); |
| 58 |
|
|
my $kernel = $prog->kernel ("juliatunnel"); |
| 59 |
|
|
|
| 60 |
|
|
my $tex = $ctx->image2d (OpenCL::MEM_WRITE_ONLY, OpenCL::RGBA, OpenCL::UNORM_INT8, $S, $S); |
| 61 |
|
|
|
| 62 |
|
|
# program compiled, kernel ready, now draw and loop |
| 63 |
|
|
|
| 64 |
|
|
for (my $time; ; ++$time) { |
| 65 |
|
|
# configure and run our kernel |
| 66 |
|
|
$kernel->setf ("mf", $tex, $time*2); # mf = memory object, float |
| 67 |
|
|
$queue->nd_range_kernel ($kernel, undef, [$S, $S], undef); |
| 68 |
|
|
|
| 69 |
|
|
# read image |
| 70 |
|
|
$queue->read_image ($tex, 0, 0, 0, 0, $S, $S, 1, 0, 0, my $data); |
| 71 |
|
|
|
| 72 |
|
|
# wait |
| 73 |
|
|
$queue->finish; |
| 74 |
|
|
|
| 75 |
|
|
# upload texture |
| 76 |
|
|
glTexSubImage2D_s GL_TEXTURE_2D, 0, 0, 0, $S, $S, GL_RGBA, GL_UNSIGNED_BYTE, $data; |
| 77 |
|
|
|
| 78 |
|
|
# now draw the texture, the defaults should be all right |
| 79 |
|
|
glTexParameterf GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST; |
| 80 |
|
|
|
| 81 |
|
|
glEnable GL_TEXTURE_2D; |
| 82 |
|
|
glBegin GL_QUADS; |
| 83 |
|
|
glTexCoord2f 0, 1; glVertex3i -1, -1, -1; |
| 84 |
|
|
glTexCoord2f 0, 0; glVertex3i 1, -1, -1; |
| 85 |
|
|
glTexCoord2f 1, 0; glVertex3i 1, 1, -1; |
| 86 |
|
|
glTexCoord2f 1, 1; glVertex3i -1, 1, -1; |
| 87 |
|
|
glEnd; |
| 88 |
|
|
|
| 89 |
|
|
# with glDrawPixels, you would simply do: |
| 90 |
|
|
# glDrawPixels_s $S, $S, GL_RGBA, GL_UNSIGNED_BYTE, $data; |
| 91 |
|
|
# and then start to worry a lot about the coordinate system |
| 92 |
|
|
# used in the opencl kernel |
| 93 |
|
|
|
| 94 |
|
|
glXSwapBuffers; |
| 95 |
|
|
|
| 96 |
|
|
select undef, undef, undef, 1/60; |
| 97 |
|
|
} |
