view release on metacpan or  search on metacpan

Graphics/IIS/iis.pd  view on Meta::CPAN

    }
    if (-e "$HOME/iraf/dev/imt1i" && -e "$HOME/iraf/dev/imt1o") {
       $fifi = "$HOME/iraf/dev/imt1i"; $fifo = "$HOME/iraf/dev/imt1o";
    }
    if (defined $ENV{'IMTDEV'} && $ENV{'IMTDEV'} =~ /^fifo:(.*):(.*)$/) {
       $fifi = $1; $fifo = $2;
   }
   if ($fifi eq "" && $fifo eq "") { # Still not found use this default
       warn "WARNING: cannot locate FIFO pipes in /dev/, $HOME/dev, ".
           "$HOME/iraf/dev or environment variable \$IMTDEV\n";
       $fifi = "$HOME/dev/imt1i"; $fifo = "$HOME/dev/imt1o";
   }
   print "Using FIFO devices in:  $fifi\n".
         "                   out: $fifo\n" if $PDLA::verbose;
   for $pipe ($fifi, $fifo) {
      if (!-p $pipe) {
         print "FIFO $pipe does not exist - try and create now? "; my $ans = <STDIN>;
         system "/usr/etc/mknod $pipe p" if $ans =~ /^y/i;

         if ($ans =~ /^y/i) {
            unlink $pipe if -e $pipe;
            my $path = $ENV{PATH};
            $ENV{PATH} .= ":/etc:/usr/etc";

            # Note system return value is backwards - hence 'and'

            if ( system('mknod', $pipe, 'p') and system('mkfifo',$pipe) ) {
                die "Failed to create named pipe $pipe\n";
            }
            $ENV{PATH} = $path;
         }
      }
   }
1;}


ENDOFPM

################################ XS CODE ######################################

pp_addhdr(<<"EOD");
#include "libiis.h"
EOD

# Non-blocking I/O

pp_addhdr(<<"EOD") if defined $Config{'o_nonblock'} && $Config{'o_nonblock'} ne 'O_NONBLOCK';
#define O_NONBLOCK $Config{'o_nonblock'}
EOD

pp_addhdr(<<"EOD");
#include "pdliisdisp.c"
EOD

pp_addxs('',<<'EOD');

MODULE = PDLA::Graphics::IIS PACKAGE = PDLA::Graphics::IIS

void
_iiscur_int()
   PPCODE:
    STRLEN n_a;
    STRLEN n_b;
    float x,y;
    char ch;
    int   frame       = (int)SvIV( perl_get_sv("iisframe", FALSE) );

    iis_open(SvPV(perl_get_sv("fifi",FALSE),n_a),SvPV(perl_get_sv("fifo",FALSE),n_b),
       (int)SvIV( perl_get_sv("fbconfig", FALSE) ),
       (int)SvIV( perl_get_sv("fb_x", FALSE) ),
       (int)SvIV( perl_get_sv("fb_y", FALSE) ) );
    iis_cur(&x,&y,&ch);
    iis_close();

    EXTEND(sp,3);
    PUSHs(sv_2mortal(newSVnv((float)x)));
    PUSHs(sv_2mortal(newSVnv((float)y)));
    PUSHs(sv_2mortal(newSVpv(&ch,1)));


EOD

# Internal routine for iis()

pp_bless('PDLA::Graphics::IIS');

pp_def('_iis',
        Pars => 'image(m,n); min(); max();',
        OtherPars => 'char *perl_title',
	Doc  => undef,
        Code => '

   int   frame = (int)SvIV( perl_get_sv("iisframe", FALSE) );

   unsigned short hdr[8];
   unsigned char *data;
   int j,nlines, x,y, offx, offy, nx, ny, nx2, ny2, baseX, baseY, m1, n1;
   int ntrans;
   float xx, yx, xy, yy, xo, yo; int w_type; /* WCS */
   float fmin, fmax;
   char wcsbuf[SZ_WCSTEXT];
   char title[33];  /* 32 chars + null terminator */
   int chan;
   STRLEN n_a;
   STRLEN n_b;

   /* Open pipes etc */

   if (frame<1 || frame>4)
       barf("$iisframe must be in range 1--4");

    iis_open(SvPV(perl_get_sv("fifi",FALSE),n_a),SvPV(perl_get_sv("fifo",FALSE),n_b),
       (int)SvIV( perl_get_sv("fbconfig", FALSE) ),
       (int)SvIV( perl_get_sv("fb_x", FALSE) ),
       (int)SvIV( perl_get_sv("fb_y", FALSE) ) );

   /* Convenience variables */

   nx = $PRIV(__m_size);
   ny = $PRIV(__n_size);
   fmin = (float) $min();