| … | |
… | |
| 212 | $ev->wait; |
212 | $ev->wait; |
| 213 | |
213 | |
| 214 | =head2 Use the OpenGL module to share a texture between OpenCL and OpenGL and draw some julia |
214 | =head2 Use the OpenGL module to share a texture between OpenCL and OpenGL and draw some julia |
| 215 | set tunnel effect. |
215 | set tunnel effect. |
| 216 | |
216 | |
| 217 | This is quite a long example to get you going. |
217 | This is quite a long example to get you going - you can download it from |
|
|
218 | L<http://cvs.schmorp.de/OpenCL/examples/juliaflight>. |
| 218 | |
219 | |
| 219 | use OpenGL ":all"; |
220 | use OpenGL ":all"; |
| 220 | use OpenCL; |
221 | use OpenCL; |
| 221 | |
222 | |
|
|
223 | my $S = $ARGV[0] || 256; # window/texture size, smaller is faster |
|
|
224 | |
| 222 | # open a window and create a gl texture |
225 | # open a window and create a gl texture |
| 223 | OpenGL::glpOpenWindow width => 256, height => 256; |
226 | OpenGL::glpOpenWindow width => $S, height => $S; |
| 224 | my $texid = glGenTextures_p 1; |
227 | my $texid = glGenTextures_p 1; |
| 225 | glBindTexture GL_TEXTURE_2D, $texid; |
228 | glBindTexture GL_TEXTURE_2D, $texid; |
| 226 | glTexImage2D_c GL_TEXTURE_2D, 0, GL_RGBA8, 256, 256, 0, GL_RGBA, GL_UNSIGNED_BYTE, 0; |
229 | glTexImage2D_c GL_TEXTURE_2D, 0, GL_RGBA8, $S, $S, 0, GL_RGBA, GL_UNSIGNED_BYTE, 0; |
| 227 | |
230 | |
| 228 | # find and use the first opencl device that let's us get a shared opengl context |
231 | # find and use the first opencl device that let's us get a shared opengl context |
| 229 | my $platform; |
232 | my $platform; |
| 230 | my $dev; |
233 | my $dev; |
| 231 | my $ctx; |
234 | my $ctx; |
| … | |
… | |
| 250 | # now the boring opencl code |
253 | # now the boring opencl code |
| 251 | my $src = <<EOF; |
254 | my $src = <<EOF; |
| 252 | kernel void |
255 | kernel void |
| 253 | juliatunnel (write_only image2d_t img, float time) |
256 | juliatunnel (write_only image2d_t img, float time) |
| 254 | { |
257 | { |
| 255 | float2 p = (float2)(get_global_id (0), get_global_id (1)) / 256.f * 2.f - 1.f; |
258 | int2 xy = (int2)(get_global_id (0), get_global_id (1)); |
|
|
259 | float2 p = convert_float2 (xy) / $S.f * 2.f - 1.f; |
| 256 | |
260 | |
| 257 | float2 m = (float2)(1.f, p.y) / fabs (p.x); |
261 | float2 m = (float2)(1.f, p.y) / fabs (p.x); // tunnel |
| 258 | m.x = fabs (fmod (m.x + time * 0.05f, 4.f)) - 2.f; |
262 | m.x = fabs (fmod (m.x + time * 0.05f, 4.f) - 2.f); |
| 259 | |
263 | |
| 260 | float2 z = m; |
264 | float2 z = m; |
| 261 | float2 c = (float2)(sin (time * 0.05005), cos (time * 0.06001)); |
265 | float2 c = (float2)(sin (time * 0.01133f), cos (time * 0.02521f)); |
| 262 | |
266 | |
| 263 | for (int i = 0; i < 25 && dot (z, z) < 4.f; ++i) |
267 | for (int i = 0; i < 25 && dot (z, z) < 4.f; ++i) // standard julia |
| 264 | z = (float2)(z.x * z.x - z.y * z.y, 2.f * z.x * z.y) + c; |
268 | z = (float2)(z.x * z.x - z.y * z.y, 2.f * z.x * z.y) + c; |
| 265 | |
269 | |
| 266 | float3 colour = (float3)(z.x, z.y, z.x * z.y); |
270 | float3 colour = (float3)(z.x, z.y, atan2 (z.y, z.x)); |
| 267 | write_imagef (img, (int2)(get_global_id (0), get_global_id (1)), (float4)(colour * p.x * p.x, 1.)); |
271 | write_imagef (img, xy, (float4)(colour * p.x * p.x, 1.)); |
| 268 | } |
272 | } |
| 269 | EOF |
273 | EOF |
| 270 | |
274 | |
| 271 | my $prog = $ctx->build_program ($src); |
275 | my $prog = $ctx->build_program ($src); |
| 272 | my $kernel = $prog->kernel ("juliatunnel"); |
276 | my $kernel = $prog->kernel ("juliatunnel"); |
| … | |
… | |
| 276 | for (my $time; ; ++$time) { |
280 | for (my $time; ; ++$time) { |
| 277 | # acquire objects from opengl |
281 | # acquire objects from opengl |
| 278 | $queue->acquire_gl_objects ([$tex]); |
282 | $queue->acquire_gl_objects ([$tex]); |
| 279 | |
283 | |
| 280 | # configure and run our kernel |
284 | # configure and run our kernel |
| 281 | $kernel->set_image2d (0, $tex); |
285 | $kernel->setf ("mf", $tex, $time*2); # mf = memory object, float |
| 282 | $kernel->set_float (1, $time); |
|
|
| 283 | $queue->nd_range_kernel ($kernel, undef, [256, 256], undef); |
286 | $queue->nd_range_kernel ($kernel, undef, [$S, $S], undef); |
| 284 | |
287 | |
| 285 | # release objects to opengl again |
288 | # release objects to opengl again |
| 286 | $queue->release_gl_objects ([$tex]); |
289 | $queue->release_gl_objects ([$tex]); |
| 287 | |
290 | |
| 288 | # wait |
291 | # wait |
