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