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

use Getopt::Long::Descriptive;
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 } ],
);

die $usage->text 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;

my %color = (
  _default   => [ 255, 255, 255 ],
  _bg        => [   0,   0,   0 ],

  Comment    => [   0, 255,   0 ],
  Constant   => [   0, 255, 255 ], 
  Identifier => [   0,   0, 238 ], 
  Statement  => [   0, 170, 170 ], 
  PreProc    => [ 255, 255, 255 ], 
  Type       => [   0, 170, 170 ], 
  Special    => [ 255, 255, 255 ], 
  Underlined => [   0, 170,   0 ], 
  Error      => [ 255,   0,   0 ], 
  Todo       => [ 170, 170,   0 ], 
);

my %color_pos;
my @colors;

for (keys %color) {
  my @rgb = @{ $color{ $_ } };

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

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

  $color_pos{ $_ } = $pos;
}

$rtf->prolog(
  fonts  => [ $opt->{font_face} ],
  colors => [ @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\\cb$color_pos{_bg}");

my $tokens = $syn->marked;

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

  my $pos = defined $color_pos{ $type }
          ? $color_pos{ $type }
          : $color_pos{ '_default' };

  $rtf->print(
    \"\\cf$pos ",
    $text,
  );
}

$rtf->close;

print $str;