#!/usr/bin/perl
use strict;
use warnings;

use Getopt::Long::Descriptive;
use Graphics::ColorUtils qw(name2rgb);
use RTF::Writer;
use Text::VimColor;

my ($opt, $usage) = describe_options(
  '%c %o <filename>',
  # no options yet, obviously
  [ 'help|h',          'display this message' ],
  [ 'filetype|ft|f=s', 'filetype; Vim guesses by default' ],
  [ 'font-face|F=s',   'font face to use; defaults to Courier New',
                       { default => 'Courier New' } ],
  [ 'font-size|Z=i',   'font size to use, in points; defaults to 14',
                       { default => 14 } ],
);

$usage->die if $opt->{help} or @ARGV != 1;

my $syn = Text::VimColor->new(
  file => $ARGV[0],
  ($opt->{filetype} ? (filetype => $opt->{filetype}) : ()),
);

my $rtf = RTF::Writer->new_to_string(\my $str);

# RTF::Writer "helpfully" converts - to "non-breaking hyphen," which Apple's
# RTF does not seem to support.  This overrides that. -- rjbs, 2007-09-05
local $RTF::Writer::Escape[ ord('-') ] = '-';

# It's easier to human-read the RTF if the linebreaks are only in the same
# place. -- rjbs, 2007-09-05
local $RTF::Writer::AUTO_NL = 0;

$rtf->prolog(
  fonts  => [ $opt->{font_face} ],
  colors => [ all_colors() ],
);

my $hp_size = $opt->{font_size} * 2; # RTF uses half-points for font size

# Set size, font, and background color.
$rtf->print(
  \"\\fs$hp_size\\f0",
  color_controls_for('Normal')
);

my $tokens = $syn->marked;

while (my $pair = shift @$tokens) {
  my ($type, $text) = @$pair;

  $rtf->print(
    color_controls_for($type),
    " $text",
  );
}

$rtf->close;

print $str;

# SUBROUTINES

sub color_to_rgb {
  my ($str) = @_;

  if ($str =~ /#([0-9a-f]{6})/i) {
    return [ map { hex } unpack "(a2)*", $1 ]
  } else {
    my @rgb = name2rgb($str);
    return unless @rgb;
    return \@rgb;
  }
}

sub groups_from_file {
  my ($filename) = @_;

  open my $fh, '<', $filename or die "couldn't open $filename to read: $!";

  my %color;

  LINE: while (my $line = <$fh>) {
    chomp $line;
    $line =~ s/\A\s+//;
    next LINE unless $line =~ /\Ahi(?:ghlight)?/;

    my ($group) = $line =~ /\Ahi(?:ghlight)?\s+(\w+)/;

    my %attr;

    if (my ($fg) = $line =~ /guifg=(\S+)/) {
      $attr{fg} = color_to_rgb($1);
    }

    if (my ($bg) = $line =~ /guibg=(\S+)/) {
      $attr{bg} = color_to_rgb($bg);
    }

    $color{ $group } = \%attr;
  }

  return %color;
}

my %color_pos;
my @colors;
BEGIN {
  my %color = (
    groups_from_file("$ENV{HOME}/.vim/colors/manxome.vim"),
  );

  $color{Normal} ||= {};
  $color{Normal}{bg} ||= [   0,   0,   0 ];
  $color{Normal}{fg} ||= [ 127, 127, 127 ];

  for my $group (keys %color) {
    for my $which (qw(fg bg)) {
      next unless my $rgb = $color{ $group }{ $which };

      my $pos = $color_pos{ join('-', @$rgb) };

      unless (defined $pos) {
        push @colors, $rgb;
        $pos = $color_pos{ join('-', @$rgb) } = $#colors;
      }

      $color_pos{ "$group:$which" } = $pos;
    }
  }
}

sub color_controls_for {
  my ($group) = @_;

  my $ctrl = '';
  for (qw(f b)) {
    $ctrl .= "\\c$_"
          .  (defined $color_pos{"$group:${_}g"}
             ? $color_pos{"$group:${_}g"}
             : $color_pos{"Normal:${_}g"});
  }

  return \$ctrl;
}

sub all_colors { @colors }