| … | |
… | |
| 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 |
| … | |
… | |
| 301 | |
304 | |
| 302 | glXSwapBuffers; |
305 | glXSwapBuffers; |
| 303 | |
306 | |
| 304 | select undef, undef, undef, 1/60; |
307 | select undef, undef, undef, 1/60; |
| 305 | } |
308 | } |
|
|
309 | |
|
|
310 | =item How to modify the previous example to not rely on GL sharing. |
|
|
311 | |
|
|
312 | For those poor souls with only a sucky CPU OpenCL implementation, you |
|
|
313 | currently have to read the image into some perl scalar, and then modify a |
|
|
314 | texture or use glDrawPixels or so). |
|
|
315 | |
|
|
316 | First, when you don't need gl sharing, you can create the context much simpler: |
|
|
317 | |
|
|
318 | $ctx = $platform->context (undef, [$dev]) |
|
|
319 | |
|
|
320 | To use a texture, you would modify the above example by creating an |
|
|
321 | OpenCL::Image manually instead of deriving it from a texture: |
|
|
322 | |
|
|
323 | my $tex = $ctx->image2d (OpenCL::MEM_WRITE_ONLY, OpenCL::RGBA, OpenCL::UNORM_INT8, $S, $S); |
|
|
324 | |
|
|
325 | And in the darw loop, intead of acquire_gl_objects/release_gl_objects, you |
|
|
326 | would read the image2d after the kernel has written it: |
|
|
327 | |
|
|
328 | $queue->read_image ($tex, 0, 0, 0, 0, $S, $S, 1, 0, 0, my $data); |
|
|
329 | |
|
|
330 | And then you would upload the pixel data to the texture (or use glDrawPixels): |
|
|
331 | |
|
|
332 | glTexSubImage2D_s GL_TEXTURE_2D, 0, 0, 0, $S, $S, GL_RGBA, GL_UNSIGNED_BYTE, $data; |
|
|
333 | |
|
|
334 | The fully modified example can be found at |
|
|
335 | L<http://cvs.schmorp.de/OpenCL/examples/juliaflight-nosharing>. |
| 306 | |
336 | |
| 307 | =head1 DOCUMENTATION |
337 | =head1 DOCUMENTATION |
| 308 | |
338 | |
| 309 | =head2 BASIC CONVENTIONS |
339 | =head2 BASIC CONVENTIONS |
| 310 | |
340 | |
| … | |
… | |
| 1204 | |
1234 | |
| 1205 | =item $ev = $queue->write_buffer_rect (OpenCL::Memory buf, cl_bool blocking, $buf_x, $buf_y, $buf_z, $host_x, $host_y, $host_z, $width, $height, $depth, $buf_row_pitch, $buf_slice_pitch, $host_row_pitch, $host_slice_pitch, $data, $wait_events...) |
1235 | =item $ev = $queue->write_buffer_rect (OpenCL::Memory buf, cl_bool blocking, $buf_x, $buf_y, $buf_z, $host_x, $host_y, $host_z, $width, $height, $depth, $buf_row_pitch, $buf_slice_pitch, $host_row_pitch, $host_slice_pitch, $data, $wait_events...) |
| 1206 | |
1236 | |
| 1207 | http://www.khronos.org/registry/cl/sdk/1.1/docs/man/xhtml/clEnqueueWriteBufferRect.html |
1237 | http://www.khronos.org/registry/cl/sdk/1.1/docs/man/xhtml/clEnqueueWriteBufferRect.html |
| 1208 | |
1238 | |
|
|
1239 | =item $ev = $queue->copy_buffer_to_image ($src_buffer, $dst_image, $src_offset, $dst_x, $dst_y, $dst_z, $width, $height, $depth, $wait_events...) |
|
|
1240 | |
|
|
1241 | L<http://www.khronos.org/registry/cl/sdk/1.1/docs/man/xhtml/clEnqueueCopyBufferToImage.html> |
|
|
1242 | |
| 1209 | =item $ev = $queue->read_image ($src, $blocking, $x, $y, $z, $width, $height, $depth, $row_pitch, $slice_pitch, $data, $wait_events...) |
1243 | =item $ev = $queue->read_image ($src, $blocking, $x, $y, $z, $width, $height, $depth, $row_pitch, $slice_pitch, $data, $wait_events...) |
| 1210 | |
1244 | |
| 1211 | L<http://www.khronos.org/registry/cl/sdk/1.1/docs/man/xhtml/clEnqueueCopyBufferRect.html> |
1245 | C<$row_pitch> (and C<$slice_pitch>) can be C<0>, in which case the OpenCL |
| 1212 | |
1246 | module uses the image width (and height) to supply default values. |
| 1213 | =item $ev = $queue->copy_buffer_to_image ($src_buffer, $dst_image, $src_offset, $dst_x, $dst_y, $dst_z, $width, $height, $depth, $wait_events...) |
|
|
| 1214 | |
1247 | |
| 1215 | L<http://www.khronos.org/registry/cl/sdk/1.1/docs/man/xhtml/clEnqueueReadImage.html> |
1248 | L<http://www.khronos.org/registry/cl/sdk/1.1/docs/man/xhtml/clEnqueueReadImage.html> |
| 1216 | |
1249 | |
| 1217 | =item $ev = $queue->write_image ($src, $blocking, $x, $y, $z, $width, $height, $depth, $row_pitch, $slice_pitch, $data, $wait_events...) |
1250 | =item $ev = $queue->write_image ($src, $blocking, $x, $y, $z, $width, $height, $depth, $row_pitch, $slice_pitch, $data, $wait_events...) |
| 1218 | |
1251 | |
|
|
1252 | C<$row_pitch> (and C<$slice_pitch>) can be C<0>, in which case the OpenCL |
|
|
1253 | module uses the image width (and height) to supply default values. |
| 1219 | L<http://www.khronos.org/registry/cl/sdk/1.1/docs/man/xhtml/clEnqueueWriteImage.html> |
1254 | L<http://www.khronos.org/registry/cl/sdk/1.1/docs/man/xhtml/clEnqueueWriteImage.html> |
| 1220 | |
1255 | |
| 1221 | =item $ev = $queue->copy_image ($src_image, $dst_image, $src_x, $src_y, $src_z, $dst_x, $dst_y, $dst_z, $width, $height, $depth, $wait_events...) |
1256 | =item $ev = $queue->copy_image ($src_image, $dst_image, $src_x, $src_y, $src_z, $dst_x, $dst_y, $dst_z, $width, $height, $depth, $wait_events...) |
| 1222 | |
1257 | |
| 1223 | L<http://www.khronos.org/registry/cl/sdk/1.1/docs/man/xhtml/clEnqueueCopyImage.html> |
1258 | L<http://www.khronos.org/registry/cl/sdk/1.1/docs/man/xhtml/clEnqueueCopyImage.html> |
