1
pp_addpm({At=>Top},<<'EOD');
5
PDL::Graphics::Karma - interface to Karma visualisation applications
9
Can send PDL 2D/3D data to kview, xray, kslice_3d, etc...
11
Data is transferred using shared memory when available on
12
the OS (and segments big enough - e.g. Linux but not
13
Solaris unless tuned) so ought to be very fast.
17
perldl> kim $a, {App=>'xray'}
19
to send to a specific viewer and/or
21
perldl> kim $a, {BB=>[0,50,-100,100]}
23
to specify the bounding box in world coordinates (here for a 2D image)
28
to reuse the last viewer.
30
You can start the viewers from PDL.
32
For further info about Karma see http://www.atnf.csiro.au/karma.
33
The binary distribution can be downloaded from
34
http://www.atnf.csiro.au/karma/ftp.html.
49
pp_addhdr(<<'ENDOFHDR');
50
#include <karma_iarray.h>
51
#include <karma_dsxfr.h>
52
#include <karma_conn.h>
58
#include <karma_overlay.h>
59
#include <karma_event.h>
60
#include <k_event_codes.h>
62
#define K_PDL_Byte K_UBYTE
63
#define K_PDL_Short K_SHORT
64
#define K_PDL_Ushort K_USHORT
65
#define K_PDL_Long K_INT
66
#define K_PDL_Float K_FLOAT
67
#define K_PDL_Double K_DOUBLE
69
static KOverlayList mylist;
70
static int first_overlay=1;
72
double* packdouble ( SV* sv, int *ndims ) {
79
if (!(SvROK(sv) && SvTYPE(SvRV(sv))==SVt_PVAV)) /* Test */
82
array = (AV *) SvRV(sv); /* dereference */
84
*ndims = (int) av_len(array) + 1; /* Number of dimensions */
86
darr = (double *) PDL->smalloc( (*ndims) * sizeof(double) );
88
barf("Out of memory");
90
for(i=0; i<(*ndims); i++) {
91
bar = *(av_fetch( array, i, 0 )); /* Fetch */
92
darr[i] = (double) SvNV(bar);
99
void ensure_initialised() {
101
static int first = 1;
105
/* Initialise communications package */
107
conn_initialise ( ( void (*) () ) NULL );
108
/* Register multi_array client protocol support */
109
dsxfr_register_connection_limits (-1, 1);
113
int ensure_connection(char *karma_app)
116
ensure_initialised();
117
/* Attempt connection to module */
119
if ( !conn_attempt_connection ("localhost",
120
r_get_def_port (karma_app, r_getenv("DISPLAY")),
128
static void add_cmap (multi_array **multi_desc, packet_desc* pack_desc,
130
/* This routine will add a colourmap to a multi_aray data structure.
131
The multi_array header pointer must be pointed to by multi_desc .This
132
pointer will be updated with a new pointer.
133
The pointer to the top level packet descriptor of the general data
134
structure which contains the colourmap must be pointed to by pack_desc .
135
The pointer to the top level packet of the general data structure which
136
contains the colourmap must be pointed to by packet .
137
The routine returns nothing.
140
multi_array *new_multi_desc;
141
static char function_name[] = "add_cmap";
143
if ( ( new_multi_desc = ds_alloc_multi (2) ) == NULL )
145
m_abort (function_name, "multi_array");
147
if ( ( (*new_multi_desc).array_names[0] = st_dup ("Frame") ) == NULL )
149
m_abort (function_name, "frame name");
151
if ( ( (*new_multi_desc).array_names[1] = st_dup ("RGBcolourmap") )
154
m_abort (function_name, "colourmap name");
156
(*new_multi_desc).headers[0] = (**multi_desc).headers[0];
157
(*new_multi_desc).data[0] = (**multi_desc).data[0];
158
(*new_multi_desc).headers[1] = pack_desc;
159
(*new_multi_desc).data[1] = packet;
160
(**multi_desc).headers[0] = NULL;
161
(**multi_desc).data[0] = NULL;
162
ds_dealloc_multi (*multi_desc);
163
*multi_desc = new_multi_desc;
164
} /* End Function add_cmap */
168
pp_addpm(<<'ENDOFPM');
169
use vars qw($LASTAPP);
170
$LASTAPP = 'kview'; # Default application
173
pp_add_exported('','kim krgb kstarted kcur');
175
pp_addpm(<<'ENDOFPM');
179
# kim - send image data to karma app
185
Sends piddle data array to an external Karma application for viewing
189
kim($pdl, [$karma-app, $lut])
191
Sends $pdl data to Karma application viewer. Remembers the
192
last one used [default: kview].
198
barf('Usage: kim $pdl [,{App => $karma-app, LUT => $lut, BB => $bb}]')
203
$app = $LASTAPP unless ($app = delete($hash->{App}));
204
my ($lut,$haslut) = (PDL->zeroes(PDL::byte,1,1),0);
205
if (defined($hash->{LUT})) {
210
if ($pdl->getndims == 3) {
211
$inds = [0,$pdl->getdim(0)-1,0,$pdl->getdim(1)-1,0,
212
$pdl->getdim(2)-1] unless $inds=delete($hash->{BB});
213
ksend3D ($pdl, $lut,$haslut,$app,$inds);
216
$inds = [0,$pdl->getdim(0)-1,0,$pdl->getdim(1)-1]
217
unless $inds=delete($hash->{BB});
218
ksend2D ($pdl, $lut, $haslut,$app,$inds);
227
kstarted([$karma-app])
231
Tests if a Karma application is running.
233
It tries to connect to the karma application, returns 1 on
236
Can be used to check if a karma application has already been
239
xray unless kstarted 'xray';
244
barf('Usage: kstarted [$karma-app]')
246
my $app = $#_ > -1 ? shift : $LASTAPP;
248
return kconnect($app);
256
krgb($lut, [$karma-app])
260
Sends RGB image to an external Karma application for viewing
263
Does not change current default viewer.
268
barf('Usage: krgb($lut, [$karma-app])') if $#_==-1;
270
push @args, $LASTAPP if $#_==0;
271
barf "must be [3,..] rgb piddle" unless $args[0]->getdim(0) == 3;
272
if ($args[0]->getndims <= 3) { krgb_private(@args) } else {
273
krgb3d_private(@args)}
278
# Add all the karma app startup commands
280
for $app (qw(kview koords kpvslice krenzo kshell xray kslice_3d)) {
282
pp_add_exported('',$app);
284
pp_addpm(<<"ENDOFPM");
290
Starts external Karma application $app
298
perldl> kview (-num_col => 42)
303
sub $app { # Start $app
304
if( !(\$pid = fork)) { # error or child
305
exec("$app", \@_) if defined \$pid;
306
die "Can't start kview: \$!\n";
322
RETVAL = ensure_connection(app);
324
conn_close(conn_get_client_connection("multi_array",0));
330
# currently lut is assumed to be 8bits
332
Pars => 'im(m,n); byte lut(o,p)', Doc=>undef,
333
OtherPars => 'int haslut; char* karma_app; SV *bb',
334
Code => 'array_desc *arrayd;
335
array_pointer arrayp;
340
packet_desc *tpack_desc;
341
unsigned short *cmap;
345
static char *elem_names[1] = { "intensity" };
347
double *dbb = packdouble($COMP(bb),&bblen);
350
barf("need 4 coodinates for 2D boundary box");
351
fc[0] = dbb[2]; lc[0] = dbb[3];
352
fc[1] = dbb[0]; lc[1] = dbb[1];
353
lengths[0] = $SIZE(n);
354
lengths[1] = $SIZE(m);
355
ms = $SIZE(m); ns = $SIZE(n); os = $SIZE(o); ps = $SIZE(p);
356
printf("Sending to %s...\n",$COMP(karma_app));
357
if (!ensure_connection($COMP(karma_app)))
358
barf("Error connecting to %s via karma communications",
361
dtype = $TBSULFD(K_PDL_Byte,K_PDL_Short,K_PDL_Ushort,
362
K_PDL_Long,K_PDL_Float,K_PDL_Double);
364
/* First create array descriptor */
366
if ( ( arrayd = ds_easy_alloc_array_desc
368
(CONST double *) fc, (CONST double *) lc,
369
(CONST double **) NULL, (CONST char **) NULL, 1, &dtype,
370
(CONST char **) elem_names) ) == NULL )
372
barf("couldn\'t allocate mem for multi array descriptor");
375
/* Now try and create the karma array in various kinds of memory */
377
if ( !ds_alloc_shm_array (&arrayp, arrayd, FALSE, FALSE) &&
378
!ds_alloc_mmap_array (-1, 0, 0, TRUE, &arrayp, arrayd, FALSE, FALSE) &&
379
!ds_alloc_vm_array (&arrayp, arrayd, FALSE, FALSE) )
380
barf("Unable to create space for karma array (tried shm/mmap/vm)\n");
382
if ((arraym=ds_easy_alloc_array_from_array_desc(arrayd,&arrayp,FALSE)) == NULL)
383
barf("couldn\'t allocate mem for multi array");
385
ptr = ($GENERIC()*) (*(char **) arraym->data[0]);
389
barf("first dim must be 3 for rgb");
390
if ( ( cmap = ds_cmap_alloc_colourmap (ps,
391
(multi_array **) NULL,
392
&tpack_desc, &tpack) ) == NULL )
393
barf("couldn\'t allocate mem for cmap");
394
add_cmap(&arraym, tpack_desc, tpack);
397
/* Copy piddle into karma array */
400
unsigned short *cm = cmap;
409
*cm++ = $lut() * 256;
413
/* Send a to module */
414
dsxfr_put_multi("connections",arraym);
417
conn_close(conn_get_client_connection("multi_array",0));
418
ds_dealloc_multi(arraym);
421
# Note reason for seperate 3D function is kview gives error:
422
# right_x: 0.000000e+00 must not equal left_x: 0.000000e+00
423
# if given a MxNx1 image
425
# currently lut is assumed to be 8bits
427
Pars => 'im(m,n,z); byte lut(o,p)', Doc=>undef,
428
OtherPars => 'int haslut; char* karma_app; SV* bb',
429
Code => 'array_desc *arrayd;
430
array_pointer arrayp;
433
int ms, ns, os, ps, zs;
435
packet_desc *tpack_desc;
436
unsigned short *cmap;
440
static char *elem_names[1] = { "intensity" };
442
double *dbb = packdouble($COMP(bb),&bblen);
445
barf("need 6 coodinates for 3D boundary box");
446
fc[0] = dbb[4]; lc[0] = dbb[5];
447
fc[1] = dbb[2]; lc[1] = dbb[3];
448
fc[2] = dbb[0]; lc[2] = dbb[1];
449
lengths[0] = $SIZE(z);
450
lengths[1] = $SIZE(n);
451
lengths[2] = $SIZE(m);
452
zs = $SIZE(z); ms = $SIZE(m); ns = $SIZE(n);
453
os = $SIZE(o); ps = $SIZE(p);
454
printf("Sending to %s...\n",$COMP(karma_app));
455
if (!ensure_connection($COMP(karma_app)))
456
barf("Error connecting to %s via karma communications",
459
dtype = $TBSULFD(K_PDL_Byte,K_PDL_Short,K_PDL_Ushort,
460
K_PDL_Long,K_PDL_Float,K_PDL_Double);
462
/* First create array descriptor */
464
if ( ( arrayd = ds_easy_alloc_array_desc
466
(CONST double *) fc, (CONST double *) lc,
467
(CONST double **) NULL, (CONST char **) NULL, 1, &dtype,
468
(CONST char **) elem_names) ) == NULL )
470
barf("couldn\'t allocate mem for multi array descriptor");
474
/* Now try and create the karma array in various kinds of memory */
476
if ( !ds_alloc_shm_array (&arrayp, arrayd, FALSE, FALSE) &&
477
!ds_alloc_mmap_array (-1, 0, 0, TRUE, &arrayp, arrayd, FALSE, FALSE) &&
478
!ds_alloc_vm_array (&arrayp, arrayd, FALSE, FALSE) )
479
barf("Unable to create space for karma array (tried shm/mmap/vm)\n");
481
if ((arraym=ds_easy_alloc_array_from_array_desc(arrayd,&arrayp,FALSE)) == NULL)
482
barf("couldn\'t allocate mem for multi array");
484
ptr = ($GENERIC()*) (*(char **) arraym->data[0]);
488
barf("first dim must be 3 for rgb");
489
if ( ( cmap = ds_cmap_alloc_colourmap (ps,
490
(multi_array **) NULL,
491
&tpack_desc, &tpack) ) == NULL )
492
barf("couldn\'t allocate mem for cmap");
493
add_cmap(&arraym, tpack_desc, tpack);
496
unsigned short *cm = cmap;
507
*cm++ = $lut() * 256;
511
/* Send a to module */
512
dsxfr_put_multi("connections",arraym);
515
conn_close(conn_get_client_connection("multi_array",0));
516
ds_dealloc_multi(arraym);'
521
pp_def( 'krgb_private',
522
Pars => 'im(m,n,o)', Doc=>undef,
523
OtherPars => 'char* karma_app;',
524
Code => q@int ms=$SIZE(m);
525
multi_array *multi_desc;
528
static unsigned int elem_types[3] =
529
{K_UBYTE, K_UBYTE, K_UBYTE};
530
static char *elem_names[3] =
531
{"Red Intensity", "Green Intensity", "Blue Intensity"};
534
barf("first dim must be 3 for rgb");
535
lengths[0] = $SIZE(o);
536
lengths[1] = $SIZE(n);
538
/* check if we can use the 'preallocated' equivalent */
539
if ( ( array = ds_easy_alloc_n_element_array
540
(&multi_desc, 2, lengths,
541
(CONST double *) NULL, (CONST double *) NULL,
542
(CONST char **) NULL, 3, elem_types,
543
(CONST char **) elem_names) ) == NULL )
545
barf("couldn\'t allocate mem for multi array");
548
if (!ensure_connection($COMP(karma_app)))
549
barf("Error connecting to %s via karma communications",
560
dsxfr_put_multi("connections",multi_desc);
563
ds_dealloc_multi(multi_desc);
564
conn_close(conn_get_client_connection("multi_array",0));@
567
pp_def( 'krgb3d_private',
568
Pars => 'im(m,n,o,p)', Doc=>undef,
569
OtherPars => 'char* karma_app;',
570
Code => q@int ms=$SIZE(m);
571
multi_array *multi_desc;
574
static unsigned int elem_types[3] =
575
{K_UBYTE, K_UBYTE, K_UBYTE};
576
static char *elem_names[3] =
577
{"Red Intensity", "Green Intensity", "Blue Intensity"};
580
barf("first dim must be 3 for rgb");
581
lengths[0] = $SIZE(p);
582
lengths[1] = $SIZE(o);
583
lengths[2] = $SIZE(n);
585
/* check if we can use the 'preallocated' equivalent */
586
if ( ( array = ds_easy_alloc_n_element_array
587
(&multi_desc, 3, lengths,
588
(CONST double *) NULL, (CONST double *) NULL,
589
(CONST char **) NULL, 3, elem_types,
590
(CONST char **) elem_names) ) == NULL )
592
barf("couldn\'t allocate mem for multi array");
595
if (!ensure_connection($COMP(karma_app)))
596
barf("Error connecting to %s via karma communications",
609
dsxfr_put_multi("connections",multi_desc);
612
ds_dealloc_multi(multi_desc);
613
conn_close(conn_get_client_connection("multi_array",0));@
617
Pars => 'x(); y(); r(); ell(); PA(); fill(); int id();',
618
OtherPars => 'char* karma_app; char* colour; int coordtype; int dotext;',Doc=><<'EOD',
624
Overlay graphics markers on a Karma application (e.g. kview)
628
koverlay $x, $y, {Options...}
630
Currently the only markers supported are ellipses. The default
631
is a circle of radius 10 units,
636
koverlay $x, sqrt($x), {Radius=>$x/3, Colour=>'green', App=>'kpolar'}
640
Radius - [piddle] specify radius of ellipses (major axis if ellipse). Default = 10 units.
641
Ellip - [piddle] specify ellipticity of ellipses. Default = 0 i.e. circle.
642
PA - [piddle] specify principle axis (degrees rotation anticlockwise
643
from the Y axis). Default.
644
ID - [piddle] Numeric integer id labels to apply.
645
Colour - [string] Colour name for overlay (e.g. 'red'). Default = 'blue'
646
App - [string] name of Karma app to send too
647
Fill - [piddle] whether outlines are filled (0 or 1). (Note filled,
648
ellipses are not yet available in Karma).
649
Coords - [string] "World" or "Pixel" - type of coordinates for x/y/r.
650
Note pixel implementation rounds to nearest pixel due
651
to Karma overlays not supporting proper IMAGE_PIXEL
656
Signature => 'x(); y(); {r(); ell(); PA(); fill(); int id();}',
660
int coordtype = $COMP(coordtype) == 1 ? OVERLAY_COORD_WORLD : OVERLAY_COORD_LINEAR;
661
int dotext = $COMP(dotext);
664
printf("Sending to %s...\n",$COMP(karma_app));
667
ensure_initialised ();
668
if ((mylist=overlay_va_create_list(NULL, NULL,
669
OVERLAY_ATT_END))==NULL)
670
printf("Error initialising overlay list");
673
if (!conn_attempt_connection ("localhost",
674
r_get_def_port ($COMP(karma_app), r_getenv("DISPLAY")),"2D_overlay"))
675
barf("Error connecting to %s via karma communications",$COMP(karma_app));
680
ell = 0.9999999999999999;
683
overlay_arc(mylist, coordtype, (double)$x(), (double)$y(),
684
coordtype, (double)$r(), (double)($r()*1.0/(1.0-ell)),
685
(double)$PA(), $COMP(colour),
686
(int)($fill() ? 1:0) );
688
sprintf(string,"%-80d\0", $id());
689
overlay_text(mylist, string, coordtype, (double)($x()+0.8*$r()), (double)($y()+0.8*$r()*1.0/(1.0-ell)),
690
$COMP(colour), "fixed", 0);
693
while ( !overlay_have_token (mylist) ) dm_native_poll (-1);
694
overlay_release_token (mylist);
695
conn_close(conn_get_client_connection("2D_overlay",0));
696
overlay_remove_objects(mylist,0);
698
barf("Infinite ellipticity was specified!\n");
702
my $hash = ref($_[-1]) eq "HASH" ? pop @_ : {};
703
barf("Usage: koverlay: \$x, \$y, {Options...} \n") if @_ != 2;
705
$hash = {iparse({App => $LASTAPP,
712
Coords => "WORLD"},$hash)};
713
my ($app,$col,$rad,$ell,$PA,$fill,$id,$dotext);
715
$col = $hash->{Colour};
716
$rad = $hash->{Radius};
717
$ell = $hash->{Ellipse};
719
$fill = $hash->{Fill};
721
unless (defined ($id = $hash->{ID})) {
722
$id = pdl(0); $dotext = 0;
725
my $supported = {"WORLD"=>1, "PIXEL"=>2};
727
$type = $supported->{uc($hash->{Coords})} if defined $hash->{Coords};
728
barf "koverlay: Unsupported coordinate type" unless $type;
730
&PDL::_koverlay_int($x,$y,$rad,$ell,$PA,$fill,$id,$app,$col,$type,$dotext);
741
Return cursor position from a Karma application (e.g. kview/xray)
745
($x,$y) = kcur($ch, {App=>'karma-app',Coords=>"World|Pixel"})
747
This function connects to a Karma application and returns
748
the ($x,$y) position and the character typed ($ch)
749
by the user. By default world coordinates are returned.
753
print kcur {App=>"kview", Coords=>"World"}
758
my $hash = pop if ref($_[$#_]) eq "HASH";
759
my $supported = {"WORLD"=>1, "PIXEL"=>2};
761
$type = $supported->{uc($hash->{Coords})} if defined $hash->{Coords};
762
barf "kcur: Unsupported coordinate type" unless $type;
764
$app = $LASTAPP unless ($app = delete($hash->{App}));
765
my ($x,$y,$ch) = &_kcur_int($app,$type);
766
$_[0] = $ch; # Pass this back in args
773
pp_addxs('',<<'EOD');
775
MODULE = PDL::Graphics::Karma PACKAGE = PDL::Graphics::Karma
780
char* app = SvPV(ST(0),PL_na);
781
int type = SvIV(ST(1));
786
ensure_initialised();
788
if (!conn_attempt_connection ("localhost",
789
r_get_def_port (app, r_getenv("DISPLAY")),"generic_event"))
790
barf("Error connecting to %s via karma communications",app);
792
myconn = conn_get_client_connection("generic_event",0);
794
event_wait( K_EVENT_MASK_KEYPRESS , myconn, &coord );
797
x = coord.data.keypress.position.world.x;
798
y = coord.data.keypress.position.world.y;
801
x = coord.data.keypress.position.image_pixel.x;
802
y = coord.data.keypress.position.image_pixel.y;
804
conn_close(conn_get_client_connection("generic_event",0));
806
PUSHs(sv_2mortal(newSVnv( x )));
807
PUSHs(sv_2mortal(newSVnv( y )));
808
PUSHs(sv_2mortal(newSVpv( coord.data.keypress.string ,1)));
813
pp_addpm({At=>Bot},<<'EOD');
818
Copyright (C) 1997-2001 Christian Soeller, Karl Glazebrook. Reproducing
819
documentation from the pdl distribution in any way that does not include a
820
statement telling who the original authors are is forbidden. Reproducing
821
and/or distributing the documentation in any form that alters the text is
822
forbidden. This module is free software and can be distributed under the
823
same terms as PDL itself.
added
removed
Graphics/Karma/karma.pd
