1#!perl
2
3use strict;
4use Test::More;
5use Data::Dumper;
6use File::Spec;
7
8BEGIN {
9 unless (exists $ENV{'DISPLAY'}) {
10   plan skip_all => '$DISPLAY is not set.';
11   exit;
12 }
13
14 eval "use Tk";
15 if ($@) {
16   plan skip_all => "Tk module not installed";
17   exit;
18 }
19
20 eval "use Tk::Zinc";
21 if ($@) {
22   plan skip_all => "Tk::Zinc module not installed";
23   exit;
24 }
25
26 eval "use Tk::Button";
27 if ( $@ ) {
28   plan skip_all => "Tk modules not installed";
29   exit;
30 }
31
32 eval "use Tk::JPEG;";
33 if ( $@ ) {
34   plan skip_all => "Tk::JPEG modules not installed";
35   exit;
36 }
37
38 eval "use Astro::FITS::Header;";
39 if ( $@ ) {
40   plan skip_all => "Astro::FITS::Header not installed.";
41   exit;
42 }
43
44 plan tests => 5;
45
46};
47
48require_ok("Starlink::AST");
49require_ok("Starlink::AST::Tk");
50
51my $zoom = 1;
52my @factor;
53$factor[0] = 1.7;
54$factor[1] = 1.7;
55print "# zoom = $zoom, xfactor = $factor[0], yfactor = $factor[1]\n";
56
57Starlink::AST::Begin();
58
59# Get FITS Header
60# ---------------
61my @cards;
62while(<DATA>) {
63  push @cards, $_;
64}
65my $header = new Astro::FITS::Header( Cards => \@cards );
66my @axes;
67$axes[0] = $header->value( "NAXIS1" );
68$axes[1] = $header->value( "NAXIS2" );
69
70# Make FitsChan
71# -------------
72my $wcsinfo;
73if ($header->can("get_wcs")) {
74  $wcsinfo = $header->get_wcs();
75} else {
76  # Use fallback position
77  $wcsinfo = get_wcs( $header );
78}
79isa_ok( $wcsinfo, "Starlink::AST::FrameSet" );
80
81# Create Tk test harness
82# ----------------------
83my $c = create_window( \@axes, $zoom, \@factor );
84
85# Handle data
86# -----------
87my $width = $c->cget( '-width' );
88my $height = $c->cget( '-height' );
89print "# width = $width, height = $height\n";
90
91my $xmin = $width/2 - $axes[0]*$zoom/2;
92my $ymin = $height/2 + $axes[1]*$zoom/2;
93print "# xmin = $xmin, ymin = $ymin\n";
94
95# Plot image
96# ---------
97my $jpeg = File::Spec->catfile( "data", "m31.jpg" );
98my $jpg = $c->Photo( -format => 'jpeg', -file => $jpeg );
99
100my $image = $c->Photo();
101$image->copy($jpg, -zoom => ($zoom, $zoom));
102$c->add( 'icon', 1, -position => [$xmin, $ymin], -image => $image, -anchor => 'sw',
103	 -tags => [ 'image' ] );
104
105# Handle data
106# -----------
107my ( $x1, $y2, $x2, $y1 ) = $c->bbox( "image" );
108print "# x1 = $x1, x2 = $x2,y1 = $y1, y2 = $y2\n";
109
110my $xleft   = $x1/$width;
111my $xright  = ($x1 + $axes[0]*$zoom)/$width;
112my $ybottom = $y2/$height;
113my $ytop    = ($y2 + $axes[1]*$zoom)/$height;
114print "# xleft = $xleft, xright = $xright\n";
115print "# ytop = $ytop, ybottom = $ybottom\n";
116
117# Change Frame
118# ------------
119#$wcsinfo->Set( System => "GALACTIC" );
120
121# AST axes
122# --------
123my $plot = Starlink::AST::Plot->new( $wcsinfo,
124   [$xleft, $ybottom, $xright, $ytop],
125   [0,0, $axes[0], $axes[1]], 'Grid=1, Title="M31 Test Image"');
126isa_ok( $plot, "Starlink::AST::Plot" );
127
128my $status = $plot->tk( $c );
129is( $status, 1, "Result from registering Tk with AST" );
130
131$plot->Set( Colour => 2, Width => 5 );
132$plot->Grid();
133
134# Switch to GRAPHICS frame for easy plotting
135
136my $ra1 = $wcsinfo->Unformat( 1, "0:40:00" );
137my $dec1 = $wcsinfo->Unformat( 2, "41:30:00" );
138my $ra2 = $wcsinfo->Unformat( 1, "0:44:00" );
139my $dec2 = $wcsinfo->Unformat( 2, "42:00:00" );
140
141print "\n# Current Frame " . $plot->Get( "Domain" ) . "\n";
142print "# Plotting at $ra1, $dec1\n";
143print "# Plotting at $ra2, $dec2\n";
144$plot->Mark( 24, [$ra1, $ra2], [$dec1, $dec2] );
145
146$plot->Set( Current => 1 );
147print "\n# Current Frame " . $plot->Get( "Domain" ) . "\n";
148$plot->Text("Test Text 1", [0.4,0.4],[-0.5,0.866],"CC");
149$plot->Set( Colour => 3  );
150$plot->Text("Test Text 2", [0.5,0.5],[0.0,-1.0],"CC");
151$plot->Set( Colour => 4 );
152$plot->Text("Test Text 3", [0.6,0.6],[0.5,0.866],"CC");
153
154#$plot->Set( Colour => 6, Width => 5 );
155$plot->Mark( 24, [0.6,0.5,0.4], [0.4, 0.3,0.3]  );
156
157#$plot->Set( Colour => 2, Width => 5 );
158#$plot->PolyCurve( [0.2,0.3,0.25], [0.8,0.5,0.5]);
159
160# Tk MainLoop
161# -----------
162print "# Entering MainLoop()\n";
163MainLoop();
164
165# Done!
166exit;
167
168# A S S O C I A T E D   S U B - R O U T I N E S #############################
169
170# test harness window
171sub create_window {
172   my $axes = shift;
173   my $zoom = shift;
174   my $factor = shift;
175
176   my $MW = MainWindow->new();
177   $MW->positionfrom("user");
178   $MW->geometry("+40+100");
179   $MW->title("Starlink::AST::Tk");
180   $MW->iconname("Starlink::AST::Tk");
181   $MW->configure( -cursor => "tcross" );
182   $MW->after( 3000, sub { exit; } );
183
184   # create the canvas widget
185   my $canvas = $MW->Zinc( -width       => $axes[0]*$zoom*$$factor[0],
186			   -height      => $axes[1]*$zoom*$$factor[1],
187			   -backcolor  => 'darkgrey',
188			   -borderwidth => 3 );
189   $canvas->pack();
190
191   my $frame = $MW->Frame( -relief => 'flat', -borderwidth => 1 );
192   $frame->pack( -side => 'bottom', -fill => 'both', -expand => 'yes');
193
194   my $button = $frame->Button( -text             => 'Quit',
195                                -font             => 'Helvetica 12',
196	   		        -activeforeground => 'white',
197                                -activebackground => 'red',
198                                -foreground       => 'white',
199                                -background       => 'darkgrey',
200                                -borderwidth      => 3,
201                                -command => sub { exit; } );
202   $button->pack( -side => 'right' );
203
204   return $canvas;
205}
206
207# Implementation of the get_wcs method for old versions of Astro::FITS::Header
208
209sub get_wcs {
210  my $self = shift;
211  my $fchan = Starlink::AST::FitsChan->new();
212  for my $i ( $self->cards() ) {
213    $fchan->PutFits( $i, 0);
214  }
215  $fchan->Clear( "Card" );
216  return $fchan->Read();
217}
218
219# read FITS file
220#sub read_file_native {
221#   my $file = shift;
222#   my $axes = shift;
223#
224#   my $status = 0;
225#   my $fptr = Astro::FITS::CFITSIO::open_file(
226#             $file, Astro::FITS::CFITSIO::READONLY(), $status);
227#
228#   my ($array, $nullarray, $anynull);
229#   $fptr->read_pixnull(
230#       Astro::FITS::CFITSIO::TLONG(), [1,1], $$axes[0]*$$axes[1],
231#       $array, $nullarray, $anynull ,$status );
232#   $fptr->close_file($status);
233#
234#   return $array;
235#}
236
237#sub read_file_pdl {
238#   my $file = shift;
239#
240#   my $image = PDL->rfits( $file );
241#   return $image;
242#}
243
244__DATA__
245SIMPLE  =                    T / file does conform to FITS standard
246BITPIX  =                  -32 / number of bits per data pixel
247NAXIS   =                    2 / number of data axes
248NAXIS1  =                  300 / length of data axis 1
249NAXIS2  =                  300 / length of data axis 2
250EXTEND  =                    T / FITS dataset may contain extensions
251COMMENT   FITS (Flexible Image Transport System) format is defined in 'Astronomy
252COMMENT   and Astrophysics', volume 376, page 359; bibcode: 2001A&A...376..359H
253OBJECT  = 'M31 (Digitised Sky Survey)'/ Title of the dataset
254DATE    = '2004-02-25T09:33:25'/ file creation date (YYYY-MM-DDThh:mm:ss UT)
255ORIGIN  = 'CASB -- STScI'      / Origin of FITS image
256BSCALE  =                  1.0 / True_value = BSCALE * FITS_value + BZERO
257BZERO   =                  0.0 / True_value = BSCALE * FITS_value + BZERO
258HDUCLAS1= 'NDF     '           / Starlink NDF (hierarchical n-dim format)
259HDUCLAS2= 'DATA    '           / Array component subclass
260CTYPE1  = 'RA---TAN'           / X-axis type
261CTYPE2  = 'DEC--TAN'           / Y-axis type
262CRVAL1  =              10.6847 / Reference pixel value
263CRVAL2  =               41.269 / Reference pixel value
264CRPIX1  =                150.5 / Reference pixel
265CRPIX2  =                150.5 / Reference pixel
266CDELT1  =                -0.01 / Degrees/pixel
267CDELT2  =                 0.01 / Degrees/pixel
268CROTA2  =                  0.0 / Axis rotation
269EPOCH   =               2000.0 / Epoch of reference equinox
270COMMENT
271COMMENT This file was produced by the SkyView survey analysis system from
272COMMENT available astronomical surveys.  The data are formatted
273COMMENT as a simple two-dimensional FITS image with the same units as
274COMMENT the orginal survey.  A single ASCII table extension may be present
275COMMENT which describes catalog objects found within the field of view.         COMMENT Copies of relevant copyright notices are included in this file.
276COMMENT
277COMMENT Questions should be directed to:
278COMMENT
279COMMENT     scollick@skyview.gsfc.nasa.gov
280COMMENT          or
281COMMENT     mcglynn@grossc.gsfc.nasa.gov
282COMMENT
283COMMENT     SkyView
284COMMENT     Code 668.1
285COMMENT     Goddard Space Flight Center, Greenbelt, MD 20771
286COMMENT     301-286-7780
287COMMENT
288COMMENT SkyView is supported by NASA ADP grant NAS 5-32068.
289COMMENT
290SURVEY  = 'Digitized Sky Survey'
291BANDPASS=                    8 / GSSS Bandpass code
292TELESCOP= 'Palomar 48-inch Schmidt'/ Telescope where plate taken
293SITELONG= '-116:51:48.00'      / Longitude of Observatory
294SITELAT = '+33:24:24.00'       / Latitute of Observatory
295SCANIMG = 'CASB -- STScI     ' / Name of original scan
296COMMENT  Based on photographic data obtained using Oschin Schmidt Telescope
297COMMENT  on Palomar Mountain.  The Palomar Observatory Sky Survey was funded
298COMMENT  by the National Geographic Society.  The Oschin Shmidt Telescope is
299COMMENT  operated by the California Institue of Technology and Palomar
300COMMENT  Observatory.  The plates were processed into the present compressed
301COMMENT  digital format with their permission.  The Digitized Sky Survey was
302COMMENT  produced at the Space Telescope Science Institute (ST ScI) under
303COMMENT  U. S. Goverment grant NAG W-2166.
304COMMENT
305COMMENT  Investigators using these scans are requested to include the above
306COMMENT  acknowledgements in any publications.
307COMMENT
308COMMENT  Copyright (c) 1994, Association of Universities for Research in
309COMMENT  Astronomy, Inc.  All rights reserved.
310COMMENT
311COMMENT  Properties of original survey:
312COMMENT  Provenance - Data taken by Oshcin Schmidt Telescope on Palomar Mountain
313COMMENT    Compressed and distribution by Space Telescope Science Institute.
314COMMENT  Copyright - AURA Inc. based upon photographic data obtained using
315COMMENT    Oschin Schmidt Telescope, restrictions on data transmissions
316COMMENT    prior to April, 1996.
317COMMENT  Frequency- 600 THz (J band image)
318COMMENT  Pixel Scale - 1.7".
319COMMENT  Pixel Units - Pixel values are given as scaled densities.
320COMMENT  Resolution - Depends on plate. Typically 2" or better.
321COMMENT  Coordinate system - Equatorial
322COMMENT  Projection - Schmidt
323COMMENT  Equinox - 2000
324COMMENT  Epoch - ca. 1957
325COMMENT
326COMMENT  Note that images generated by SkyView may contain distortions
327COMMENT  due to resampling of the data.
328END
329