"Fossies" - the Fresh Open Source Software Archive

Member "PDL-2.080/GENERATED/PDL/Graphics/IIS.pm" (28 May 2022, 12217 Bytes) of package /linux/misc/PDL-2.080.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "IIS.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 2.079_vs_2.080.

    1 #
    2 # GENERATED WITH PDL::PP! Don't modify!
    3 #
    4 package PDL::Graphics::IIS;
    5 
    6 our @EXPORT_OK = qw(iis iiscur iiscirc $stdimage $iisframe saoimage ximtool _iis _iiscirc );
    7 our %EXPORT_TAGS = (Func=>\@EXPORT_OK);
    8 
    9 use PDL::Core;
   10 use PDL::Exporter;
   11 use DynaLoader;
   12 
   13 
   14    
   15    our @ISA = ( 'PDL::Exporter','DynaLoader' );
   16    push @PDL::Core::PP, __PACKAGE__;
   17    bootstrap PDL::Graphics::IIS ;
   18 
   19 
   20 
   21 
   22 
   23 
   24 #line 4 "iis.pd"
   25 
   26 =head1 NAME
   27 
   28 PDL::Graphics::IIS - Display PDL images on IIS devices (saoimage/ximtool)
   29 
   30 =head1 SYNOPSIS
   31 
   32  use PDL::Graphics::IIS;
   33  saoimage ( -geometry => '800x800' );
   34  iis rvals(100,100);
   35 
   36 =head1 DESCRIPTION
   37 
   38 This module provides an interface to any image display 'device' which support the
   39 'IIS protocol' - viz the SAOimage and Ximtool X-windows programs, the
   40 old SunView imtool program and presumably even the original IIS CRT itself
   41 if they aren't all in museums!
   42 
   43 These programs should be familiar to astronomers - they are used by
   44 the common IRAF system. The programs and their HTML documentation
   45 can be obtained from the following URLs:
   46 
   47  SAOimage: http://tdc-www.harvard.edu/software/saoimage.html
   48  Ximtool:  http://iraf.noao.edu/iraf/web/projects/x11iraf/x11iraf.html
   49 
   50 Non-astronomers may find they quite nifty for displaying 2D data.
   51 
   52 The Perl variable C<$stdimage> is exported from the module and controls
   53 the frame buffer configuration currently in use. The default value
   54 is C<imt1024> which specifies a C<1024x1024> frame buffer. Other
   55 values supported by the module are:
   56  
   57  imt512, imt800, imt1024, imt1600, imt2048, and imt4096.
   58 
   59 If you have a F<$HOME/.imtoolrc> you can use it to specify other frame
   60 buffer names and configurations in exactly the same way you can in
   61 IRAF. Here is a sample file:
   62 
   63  -------------------snip-------------------------
   64  # Format:  configno nframes width height
   65   1  2  512  512         # imt1|imt512
   66   2  2  800  800         # imt2|imt800
   67   3  2 1024 1024         # imt3|imt1024
   68   4  1 1600 1600         # imt4|imt1600
   69   5  1 2048 2048         # imt5|imt2048
   70   6  1 4096 4096         # imt6|imt4096
   71   7  1 8192 8192         # imt7|imt8192
   72   8  1 1024 4096         # imt8|imt1x4
   73   9  2 1144  880         # imt9|imtfs    full screen (1152x900 minus frame)
   74  10  2 1144  764         # imt10|imtfs35 full screen at 35mm film aspect ratio
   75  -------------------snip-------------------------
   76 
   77 (Note: some versions of SAOimage may not even work if this file is not
   78 present. If you get funny error messages about 'imtoolrc' try copying
   79 the above to F<$HOME/.imtoolrc> or F</usr/local/lib/imtoolrc>)
   80 
   81 The Perl variable C<$iisframe> is also exported from the module and controls
   82 which display frame number to use in programs such as Ximtool which supports
   83 multiple frames. This allows you to do useful things such as blink between
   84 images.
   85 
   86 The module communicates with the IIS device down FIFO pipes (special UNIX
   87 files) - unlike IRAF this module does a pretty decent job of intelligently
   88 guessing which file names to use for the pipes and will prompt for their
   89 creating if absent. Also if SAOimage or Ximtool are started from within Perl
   90 using the module this will guarantee correct file names!
   91 
   92 =head1 FUNCTIONS
   93 
   94 =cut
   95 
   96 use strict;
   97 use warnings;
   98 #line 99 "IIS.pm"
   99 
  100 
  101 
  102 
  103 
  104 
  105 
  106 #line 84 "iis.pd"
  107 
  108 
  109 use PDL::Core '';
  110 use PDL::Basic '';
  111 use Carp;
  112 
  113 $iisframe      = 1;                # Starting defaults
  114 $stdimage      = "imt1024";
  115 $last_stdimage = "";
  116 $HOME          = $ENV{'HOME'};     # Used a lot so shorten
  117 
  118 
  119 ################ Public routines #################
  120 
  121 # Display
  122 
  123 =head2 iis
  124 
  125 =for ref
  126 
  127 Displays an image on a IIS device (e.g. SAOimage/Ximtool)
  128 
  129 =for usage
  130 
  131  iis $image, [ { MIN => $min, MAX => $max,
  132                  TITLE => 'pretty picture',
  133                  FRAME => 2 } ]
  134  iis $image, [$min,$max]
  135 
  136 =for sig
  137 
  138  (image(m,n),[\%options]) or (image(m,n),[min(),max()])
  139 
  140 Displays image on a IIS device. If C<min()> or C<max()> are omitted they
  141 are autoscaled. A good demonstration of PDL broadcasting can be had
  142 by giving C<iis()> a data *cube* - C<iis()> will be repeatedly called
  143 for each plane of the cube resulting in a poor man's movie!
  144 
  145 If supplied, C<TITLE> is used to label the frame, if no title is
  146 supplied, either the C<OBJECT> value stored in the image header or a
  147 default string is used (the title is restricted to a maximum
  148 length of 32 characters). 
  149 
  150 To specify which frame to draw to, either use
  151 the package variable C<$iisframe>, or the C<FRAME> option.
  152 
  153 =cut
  154 
  155 sub iis {
  156     my $usage = 'Usage: iis ( $image, [\%hash | $min, $max] )';
  157     barf $usage if $#_<0 || $#_>2;
  158 
  159     my $image  = shift;
  160     my ( $min, $max );
  161 
  162     my $title = 'perlDL rules !';
  163     my $header = $image->gethdr();
  164     if ( defined $header and defined $$header{OBJECT} ) {
  165       $title = $$header{OBJECT};
  166       $title =~ s/^'(.*)'$/$1/;
  167     }
  168 
  169     my $frame = $iisframe;
  170     if ( $#_ == 1 ) { $min = $_[0]; $max = $_[1]; }
  171     elsif ( $#_ == 0 ) {
  172       barf $usage unless ref($_[0]) eq "HASH";
  173 
  174       my $opt = new PDL::Options( { MIN => undef, MAX => undef, TITLE => $title, FRAME => $frame } );
  175       $opt->options( shift );
  176       my $options = $opt->current;
  177 
  178       $min   = $$options{MIN};
  179       $max   = $$options{MAX};
  180       $title = $$options{TITLE};
  181       $iisframe = $$options{FRAME};
  182     }
  183 
  184     my($nx,$ny) = dims($image);
  185     fbconfig($stdimage) if $stdimage ne $last_stdimage;
  186     $min = $image->min unless defined $min;
  187     $max = $image->max unless defined $max;
  188     print "Displaying $nx x $ny image in frame $iisframe from $min to $max ...\n" if $PDL::verbose;
  189     PDL::_iis($image,$min,$max,$title);
  190     $iisframe = $frame; # restore value
  191     1;
  192 }
  193 
  194 =head2 iiscur
  195 
  196 =for ref
  197 
  198 Return cursor position from an IIS device (e.g. SAOimage/Ximtool)
  199 
  200 =for usage
  201 
  202  ($x,$y) = iiscur($ch)
  203 
  204 This function puts up an interactive cursor on the IIS device and returns
  205 the C<($x,$y)> position and the character typed (C<$ch>)
  206 by the user.
  207 
  208 =cut
  209 
  210 sub iiscur {
  211     barf 'Usage: ($x,$y) = iiscur($ch)' if $#_>=1;
  212     my ($x,$y,$ch) = _iiscur_int();
  213     $_[0] = $ch; # Pass this back in args
  214     return ($x,$y);
  215 }
  216 
  217 =head2 iiscirc
  218 
  219 =for ref
  220 
  221 Draws a circle on a IIS device (e.g. SAOimage/Ximtool)
  222 
  223 =for sig
  224 
  225  (x(),y(),radius(),colour())
  226 
  227 =for usage
  228 
  229  iiscirc $x, $y, [$radius, $colour]
  230 
  231 Draws circles on the IIS device with specified points and colours. Because
  232 this module uses 
  233 L<PDL::PP> broadcasting you can supply lists of points via
  234 1D arrays, etc.
  235 
  236 An amusing PDL idiom is:
  237 
  238  pdl> iiscirc iiscur
  239 
  240 Note the colours are the same as IRAF, viz:
  241 
  242  201 = cursor color (white)
  243  202 = black
  244  203 = white
  245  204 = red
  246  205 = green
  247  206 = blue
  248  207 = yellow
  249  208 = cyan
  250  209 = magenta
  251  210 = coral
  252  211 = maroon
  253  212 = orange
  254  213 = khaki
  255  214 = orchid
  256  215 = turquoise
  257  216 = violet
  258  217 = wheat
  259 
  260 =cut
  261 
  262 sub iiscirc {
  263    barf 'Usage: iiscirc( $x, $y, [$radius, $colour] )' if $#_<1 || $#_>3;
  264    my($x, $y, $radius, $colour)=@_;
  265    fbconfig($stdimage) if $stdimage ne $last_stdimage;
  266    $radius = 10 unless defined $radius;
  267    $colour = 204 unless defined $colour;
  268    PDL::_iiscirc($x, $y, $radius, $colour);
  269    1;
  270 }
  271 
  272 =head2 saoimage
  273 
  274 =for ref
  275 
  276 Starts the SAOimage external program
  277 
  278 =for usage
  279 
  280  saoimage[(command line options)]
  281 
  282 Starts up the SAOimage external program. Default FIFO devices are chosen
  283 so as to be compatible with other IIS module functions. If no suitable
  284 FIFOs are found it will offer to create them.
  285 
  286 e.g.:
  287 
  288 =for example
  289 
  290  pdl> saoimage
  291  pdl> saoimage( -geometry => '800x800' )
  292 
  293 =cut
  294 
  295 sub saoimage {  # Start SAOimage
  296    fbconfig($stdimage) if $stdimage ne $last_stdimage;
  297    if( !($pid = fork)) {    # error or child
  298       exec("saoimage", -idev => $fifo, -odev => $fifi, @_) if defined $pid;
  299       die "Can't start saoimage: $!\n";
  300    }
  301    return $pid;
  302 }
  303 
  304 =head2 ximtool
  305 
  306 =for ref
  307 
  308 Starts the Ximtool external program
  309 
  310 =for usage
  311 
  312  ximtool[(command line options)]
  313 
  314 Starts up the Ximtool external program. Default FIFO devices are chosen
  315 so as to be compatible with other IIS module functions. If no suitable
  316 FIFOs are found it will offer to create them.
  317 
  318 e.g.
  319 
  320 =for example
  321 
  322  pdl> ximtool
  323  pdl> ximtool (-maxColors => 64)
  324 
  325 =cut
  326 
  327 sub ximtool {  # Start Ximtool
  328    fbconfig($stdimage) if $stdimage ne $last_stdimage;
  329    if( !($pid = fork)) {    # error or child
  330       exec("ximtool", -xrm => "ximtool*input_fifo: $fifi", -xrm => "ximtool*output_fifo: $fifo", @_) if defined $pid;
  331       die "Can't start ximtool: $!\n";
  332    }
  333    return $pid;
  334 }
  335 
  336 
  337 ################ Private routines #################
  338 
  339 # Change the frame buffer configuration
  340 
  341 sub fbconfig {
  342     my $name = shift;
  343     parseimtoolrc() unless $parsed++;
  344     findfifo() unless $foundfifo++;
  345     barf 'No frame buffer configuration "'.$name.'" found'."\n"
  346        unless defined $imtoolrc{$name};
  347     ($fbconfig, $fb_x, $fb_y ) = @{ $imtoolrc{$name} };
  348     print "Using $stdimage - fbconfig=$fbconfig (${fb_x}x$fb_y)\n" if $PDL::verbose;;
  349     $last_stdimage = $stdimage;
  350 1;}
  351 
  352 # Try and find user/system imtoolrc definitions
  353 
  354 sub parseimtoolrc {
  355    # assoc array holds imtool configuations - init with some standard
  356    # ones in case imtoolrc goes missing
  357 
  358    %imtoolrc = (
  359      'imt512'  => [1,512,512],   'imt800'  => [2,800,800],
  360      'imt1024' => [3,1024,1024], 'imt1600' => [4,1600,1600],
  361      'imt2048' => [5,2048,2048], 'imt4096' => [6,4096,4096],
  362    );
  363 
  364    # Look for imtoolrc file
  365 
  366    $imtoolrc = "/usr/local/lib/imtoolrc";
  367    $imtoolrc = "$HOME/.imtoolrc" if -e "$HOME/.imtoolrc";
  368    if (!-e $imtoolrc) {
  369       warn "WARNING: unable to find an imtoolrc file in $HOME/.imtoolrc\n".
  370            "or /usr/local/lib/imtoolrc. Will try \$stdimage = imt1024.\n";
  371       return 1;
  372    }
  373 
  374    # Load frame buffer configuartions from imtoolrc file and
  375    # store in assoc array
  376 
  377    open(IMTOOLRC, $imtoolrc) || die "File $imtoolrc not found";
  378     while(<IMTOOLRC>) {
  379        if  ( /^\s*(\d+)\s+\d+\s+(\d+)\s+(\d+)\s+\#\s*(\S+)\s/ ) {
  380           foreach $name (split(/\|/,$4)) {
  381              $imtoolrc{$name} = [$1,$2,$3];
  382           }
  383       }
  384    }close(IMTOOLRC);
  385 1;}
  386 
  387 # Try a few obvious places for the FIFO pipe and create if necessary
  388 
  389 sub findfifo {
  390     $fifi = ""; $fifo = "";
  391     if (-e "/dev/imt1i" && -e "/dev/imt1o") {
  392        $fifi = "/dev/imt1i"; $fifo = "/dev/imt1o";
  393     }
  394     if (-e "$HOME/dev/imt1i" && -e "$HOME/dev/imt1o") {
  395        $fifi = "$HOME/dev/imt1i"; $fifo = "$HOME/dev/imt1o";
  396     }
  397     if (-e "$HOME/iraf/dev/imt1i" && -e "$HOME/iraf/dev/imt1o") {
  398        $fifi = "$HOME/iraf/dev/imt1i"; $fifo = "$HOME/iraf/dev/imt1o";
  399     }
  400     if (defined $ENV{'IMTDEV'} && $ENV{'IMTDEV'} =~ /^fifo:(.*):(.*)$/) {
  401        $fifi = $1; $fifo = $2;
  402    }
  403    if ($fifi eq "" && $fifo eq "") { # Still not found use this default
  404        warn "WARNING: cannot locate FIFO pipes in /dev/, $HOME/dev, ".
  405            "$HOME/iraf/dev or environment variable \$IMTDEV\n";
  406        $fifi = "$HOME/dev/imt1i"; $fifo = "$HOME/dev/imt1o";
  407    }
  408    print "Using FIFO devices in:  $fifi\n".
  409          "                   out: $fifo\n" if $PDL::verbose;
  410    for $pipe ($fifi, $fifo) {
  411       if (!-p $pipe) {
  412          print "FIFO $pipe does not exist - try and create now? "; my $ans = <STDIN>;
  413          system "/usr/etc/mknod $pipe p" if $ans =~ /^y/i;
  414 
  415          if ($ans =~ /^y/i) {
  416             unlink $pipe if -e $pipe;
  417             my $path = $ENV{PATH};
  418             $ENV{PATH} .= ":/etc:/usr/etc";
  419 
  420             # Note system return value is backwards - hence 'and'
  421 
  422             if ( system('mknod', $pipe, 'p') and system('mkfifo',$pipe) ) {
  423                 die "Failed to create named pipe $pipe\n";
  424             }
  425             $ENV{PATH} = $path;
  426          }
  427       }
  428    }
  429 1;}
  430 #line 431 "IIS.pm"
  431 
  432 
  433 
  434 #line 950 "../../blib/lib/PDL/PP.pm"
  435 
  436 *_iis = \&PDL::Graphics::IIS::_iis;
  437 #line 438 "IIS.pm"
  438 
  439 
  440 
  441 #line 950 "../../blib/lib/PDL/PP.pm"
  442 
  443 *_iiscirc = \&PDL::Graphics::IIS::_iiscirc;
  444 #line 445 "IIS.pm"
  445 
  446 
  447 
  448 
  449 
  450 #line 619 "iis.pd"
  451 
  452 
  453 =head1 BUGS
  454 
  455 None known
  456 
  457 =head1 AUTHOR
  458 
  459 Copyright (C) Karl Glazebrook 1997.
  460 All rights reserved. There is no warranty. You are allowed
  461 to redistribute this software / documentation under certain
  462 conditions. For details, see the file COPYING in the PDL
  463 distribution. If this file is separated from the PDL distribution,
  464 the copyright notice should be included in the file.
  465 
  466 =cut
  467 #line 468 "IIS.pm"
  468 
  469 
  470 
  471 
  472 # Exit with OK status
  473 
  474 1;