File indexing completed on 2024-09-29 06:22:15

0001 #!/usr/bin/perl
0002 #
0003 # read-hippo.pl  For reading kstars hipNNN.dat data files
0004 
0005 use strict;
0006 my $ERROR;
0007 my @STARS;
0008 my @DEC_REGIONS = (
0009 #    [90, 50], [50, 20], [20, -20], 
0010     [-20, -50], [-50, -90]);
0011 
0012 my $cnt;
0013 
0014 while(<>) {
0015     m/^\s*#/ and do {  next};
0016     m/\S/ or     do {  next;};
0017     chomp;
0018     my $star = kstars_unpack($_) or do {
0019         warn sprintf("%4d: FORMAT ERROR ($ERROR):\n$_\n", $.);
0020         next;
0021     };
0022     $star->{line} = $.;
0023     $star->{name} or next;
0024     push @STARS, $star;
0025     #print_star_line($star);
0026 
0027 }
0028 
0029 @STARS = sort { $b->{mag} <=> $a->{mag} } @STARS;
0030 for my $star ( @STARS ) {
0031     printf "%4.1f %s\n", $star->{mag}, $star->{name};
0032     #print_star_line($star);
0033 }
0034 
0035 exit;
0036 #my @missing = grep {! $_->{gname} || $_->{gname} =~ /^xx/} @STARS;
0037  
0038 
0039 
0040 sub print_star_line {
0041     my $star = shift;
0042     #printf "%8.2f ", $star->{pm};
0043     printf "%s %s %s%s%s %s%s%s %s%s",
0044     @$star{qw/ra_str dec_str dra ddec parallax mag bv_index spec_type mult/};
0045     my $s2;
0046     $star->{var_range} || $star->{var_period} and do {
0047         $s2 = sprintf " %4.2f %6.2f", @$star{qw/var_range var_period/};
0048     };
0049     $star->{name} || $star->{gname} and $s2 ||= " " x 12;
0050     $s2 and print $s2;
0051     $star->{name} and print $star->{name};
0052     $star->{name} and $star->{gname} and print " ";
0053     $star->{gname} and print ": $star->{gname}";
0054     print "\n";
0055 }
0056 #print_stars(@missing);
0057 exit;
0058 
0059 #==========================================================================
0060 #
0061 #
0062 
0063 
0064 sub print_stars {
0065     my @stars = sort {$a->{mag} <=> $b->{mag}} @_;
0066     for my $dec_region (@DEC_REGIONS) {
0067         my ($top, $bot) = @$dec_region;
0068         print "\nFrom $top to $bot:\n";
0069         for my $star ( @stars) {
0070             my $dec = $star->{dec};
0071             next unless $dec < $top and $dec >= $bot;
0072             printf "%4d: %s %s %6.2f %2s %8s %s\n\n",
0073                @$star{(qw/line ra_hm dec_hm mag spec_type gname name/)};
0074 
0075         }
0076     }
0077 }
0078 
0079 sub kstars_unpack {
0080     my $line = shift;
0081     chomp $line;
0082     my $s1 = substr($line, 0, 60, "");
0083     $s1 =~ m{^(\d{6}\.\d\d)\s    # RA  HHMMSS.SS
0084             ([+-]\d{6}\.\d)\s    # DEC DDMMSS.SS
0085             ([+-]\d{6}\.\d)      # dRA/dt 
0086             ([+-]\d{6}\.\d)      # dDec/dt
0087                 (\d{5}\.\d)\s    # Parallax
0088               ([\d-]\d\.\d\d)    # Magnitude
0089               ([\d-]\d\.\d\d)    # B-V index
0090               ([A-Z ].|sd)\s     # Spectral Type
0091               (\d)               # Multiplicity
0092           }x or do 
0093     {
0094         $ERROR = "Positional Error (0-59)";
0095         return;
0096     };
0097     my $star = {
0098         ra_str    => $1,
0099         dec_str   => $2,
0100         dra       => $3,
0101         ddec      => $4,
0102         parallax  => $5,
0103         mag       => $6,
0104         bv_index  => $7,
0105         spec_type => $8,
0106         mult      => $9,
0107         line      => $.,
0108         pm        => sqrt($3 * $3 + $4 * $4),
0109     };
0110     $star->{ra}       = hms_to_hour($star->{ra_str});
0111     $star->{dec}      = hms_to_hour($star->{dec_str}); 
0112     $star->{ra_hm}    = hms_to_hm($star->{ra_str});
0113     $star->{dec_hm}   = hms_to_hm($star->{dec_str});
0114 
0115     $line or return $star;
0116 
0117     my $s2 = substr($line, 0, 12, "");
0118     #print "$s2\n";
0119     $s2 =~ m/^\s+(\d\.\d\d)?   # var range
0120               \s+(\d+\.\d\d)?  # var period
0121               /x or do 
0122     {
0123         $ERROR = "Variable params (61 - 71)";
0124         return;
0125     };
0126     $star->{var_range}  = $1;
0127     $star->{var_period} = $2;
0128     $line or return $star;
0129     
0130     $star->{gname} = $line =~ s/\s*:\s*(\S.*)$// ? $1 : "";
0131     $star->{name}  = $line ? $line : "";
0132     return $star;
0133 }
0134 
0135 sub hms_to_hour {
0136     my $string = shift;
0137     $string =~ /^([+-]?\d\d)(\d\d)(\d\d(?:\.\d*)?)/ or return;
0138     my ($h, $m, $s) = ($1, $2, $3);
0139     my $sign = $h < 0 ? -1 : 1;
0140     $h = abs($h);
0141     $m += $s / 60;
0142     return $sign * ($h + $m / 60);
0143 }
0144 
0145 sub hms_to_hm {
0146     my $string = shift;
0147     $string =~ s/([+-]?\d\d)(\d\d).*/$1:$2/;
0148     return $string;
0149 }