#!perl
use 5.010;
use strict;
use warnings;
use Getopt::Long;
use IO::Uncompress::Gunzip ();

# Compiles the Yale Bright Star Catalogue, 5th revised edition (Hoffleit
# and Warren 1991, CDS V/50, catalog.gz), with the IAU's star names (WGSN,
# IAU-CSN.txt, by HR number), into include/tks/tks_bsc5.h: every star with a
# J2000 position, brightest first. Shipped so a reader can regenerate the
# table; never installed.
#
#     perl tools/bsccompile --dir ../plan_time_keeper_sky/sources/bsc5

my ($dir, $out) = ('', 'include/tks/tks_bsc5.h');
GetOptions('dir=s' => \$dir, 'out=s' => \$out) or die "usage: bsccompile --dir <directory of catalog.gz and IAU-CSN.txt> [--out <header>]\n";
die "bsccompile: --dir <directory> is needed\n" unless $dir;

# The IAU names, by HR number: the ASCII name and the one with diacritics.
my %name;
open my $nf, '<:encoding(UTF-8)', "$dir/IAU-CSN.txt" or die "bsccompile: $dir/IAU-CSN.txt: $!\n";
while (my $line = <$nf>) {
    next if $line =~ /^[#\$]/ || $line !~ /\S/;
    # fixed columns: the ASCII name in 1-18, the one with diacritics in 19-36,
    # the designation from 37 (a name of 17 letters leaves one space)
    my ($ascii, $utf8) = map { (my $v = $_) =~ s/^\s+|\s+$//g; $v } substr($line, 0, 18), substr($line, 18, 18);
    my ($hr) = substr($line, 36, 13) =~ /^HR (\d+)\b/ or next;
    die "bsccompile: HR $hr named twice ($name{$hr}[0], $ascii)\n" if $name{$hr};
    $name{$hr} = [$ascii, $utf8];
}
close $nf;

my $z = IO::Uncompress::Gunzip->new("$dir/catalog.gz") or die "bsccompile: $dir/catalog.gz: $IO::Uncompress::Gunzip::GunzipError\n";
my (@stars, $skipped);
while (my $line = <$z>) {
    chomp $line;
    $line .= ' ' x (197 - length $line) if length $line < 197;
    my $f = sub { my ($from, $to) = @_; my $v = substr($line, $from - 1, $to - $from + 1); $v =~ s/^\s+|\s+$//g; $v };
    my $hr = $f->(1, 4) + 0;
    if ($f->(76, 77) eq '') { $skipped++; next }
    my $ra  = 15 * ($f->(76, 77) + $f->(78, 79) / 60 + $f->(80, 83) / 3600);
    my $dec = ($f->(85, 86) + $f->(87, 88) / 60 + $f->(89, 90) / 3600) * ($f->(84, 84) eq '-' ? -1 : 1);
    my $v   = $f->(103, 107);
    die "bsccompile: HR $hr has a position and no magnitude\n" if $v eq '';
    push @stars, {
        hr => $hr, ra => $ra, dec => $dec, v => $v + 0,
        bv => ($f->(110, 114) eq '' ? 'NAN' : $f->(110, 114) + 0),
        pmra => ($f->(149, 154) eq '' ? 0 : $f->(149, 154) + 0),
        pmde => ($f->(155, 160) eq '' ? 0 : $f->(155, 160) + 0),
        plx  => ($f->(162, 166) eq '' || $f->(161, 161) eq 'D' ? 0 : $f->(162, 166) + 0),
        rv   => ($f->(167, 170) eq '' ? 0 : $f->(167, 170) + 0),
        flam => ($f->(5, 7) eq '' ? 0 : $f->(5, 7) + 0),
        bayer => $f->(8, 10), sup => $f->(11, 11), con => $f->(12, 14),
        name => $name{$hr},
    };
}
die "bsccompile: " . scalar(@stars) . " stars and $skipped without a position, not 9096 and 14\n" unless @stars == 9096 && $skipped == 14;
@stars = sort { $a->{v} <=> $b->{v} || $a->{hr} <=> $b->{hr} } @stars;

my $c = sub { my $s = shift; $s =~ s/(["\\])/\\$1/g; qq{"$s"} };
my (@names, %ni);
for my $s (@stars) {
    next unless $s->{name};
    $ni{ $s->{hr} } = scalar @names;
    push @names, $s->{name};
}
open my $oh, '>:encoding(UTF-8)', $out or die "bsccompile: $out: $!\n";
my $n = @stars;
my $named = @names;
print $oh <<"EOT";
#ifndef TKS_BSC5_H
#define TKS_BSC5_H

/* Generated by tools/bsccompile from the Yale Bright Star Catalogue, 5th
 * revised edition (Hoffleit and Warren 1991, CDS V/50; public domain), and the
 * IAU Catalog of Star Names (IAU WGSN, IAU-CSN.txt; CC BY): the $n stars with
 * a J2000 position (the 14 entries without one are left out), brightest
 * first. Right ascension and declination in degrees, J2000 (FK5); proper
 * motions in arcseconds a year, that in right ascension times cos(dec);
 * parallax in arcseconds (0 where unknown or dynamical); radial velocity in
 * km/s; V and B-V in magnitudes (B-V NAN where unknown). Do not edit:
 * regenerate. */

#define TKS_STARS $n
#define TKS_STAR_NAMES $named

typedef struct tks_star_row {
    double  ra, dec, pmra, pmdec, plx, rv;
    double  vmag, bv;
    int16_t hr, flamsteed, name;    /* name: an index into tks_star_names, or -1 */
    char    bayer[4], sup, con[4];
} tks_star_row;

static const char *const tks_star_names[TKS_STAR_NAMES][2] = {
EOT
printf $oh "    { %s, %s },\n", $c->($_->[0]), $c->($_->[1]) for @names;
print $oh "};\n\nstatic const tks_star_row tks_bsc5[TKS_STARS] = {\n";
for my $s (@stars) {
    printf $oh "    { %.6f, %.6f, %s, %s, %s, %s, %s%s, %s%s, %d, %d, %d, %s, '%s', %s },\n",
        $s->{ra}, $s->{dec}, $s->{pmra}, $s->{pmde}, $s->{plx}, $s->{rv}, sprintf('%.2f', $s->{v}), '',
        ($s->{bv} eq 'NAN' ? ('NAN', '') : (sprintf('%.2f', $s->{bv}), '')), $s->{hr}, $s->{flam},
        (exists $ni{ $s->{hr} } ? $ni{ $s->{hr} } : -1), $c->($s->{bayer}),
        ($s->{sup} eq '' ? '\\0' : $s->{sup}), $c->($s->{con});
}
print $oh "};\n\n#endif\n";
close $oh;
printf "%s: %d stars, %d named, %d without a position\n", $out, $n, $named, $skipped;
