#!/usr/bin/perl -w

# A simple ToME cmovie player.  <SPACE> enters single-step mode (type a
# char for each step), 't' switches back to normal mode, 'q' exits.

use Curses;

die "usage: $0 filename\n" if scalar @ARGV != 1;
my $in = "<$ARGV[0]";
$in = "zcat $ARGV[0] |" if $ARGV[0] =~ /\.gz$/;
$in = "unzip -p $ARGV[0] |" if $ARGV[0] =~ /\.zip$/;
open IN, $in or die "Cannot open $ARGV[0]:  $!\n";

my %color = (
  d => COLOR_PAIR(7),
  w => COLOR_PAIR(0),
  s => COLOR_PAIR(6),
  o => COLOR_PAIR(1) | A_BOLD,
  r => COLOR_PAIR(1),
  g => COLOR_PAIR(2),
  b => COLOR_PAIR(4),
  u => COLOR_PAIR(3),
  D => COLOR_PAIR(7) | A_BOLD,
  W => COLOR_PAIR(6) | A_BOLD,
  v => COLOR_PAIR(5),
  y => COLOR_PAIR(3) | A_BOLD,
  R => COLOR_PAIR(5) | A_BOLD,
  G => COLOR_PAIR(2) | A_BOLD,
  B => COLOR_PAIR(4) | A_BOLD,
  U => COLOR_PAIR(3),
);
my @colors = ();

my $single_step = 0;

sub curs_die (;$) {
  clear;
  refresh;
  endwin;
  die @_;
}

sub handle_char ($) {
  my $c = $_[0];

  return 0 if $c eq 'q';
  $single_step = 1 if $c eq ' ';
  $single_step = 0 if $c eq 't';
  return 1;
}

initscr;
cbreak;
noecho;
keypad 1;
clear;
if (has_colors) {
  start_color;
  init_pair 1, COLOR_RED, COLOR_BLACK;
  init_pair 2, COLOR_GREEN, COLOR_BLACK;
  init_pair 3, COLOR_YELLOW, COLOR_BLACK;
  init_pair 4, COLOR_BLUE, COLOR_BLACK;
  init_pair 5, COLOR_MAGENTA, COLOR_BLACK;
  init_pair 6, COLOR_CYAN, COLOR_BLACK;
  init_pair 7, COLOR_BLACK, COLOR_BLACK;
}

my $first_line = 1;

while (<IN>) {
  if ($first_line) {
    $/ = "\r\n" if /\r\n/;
    $first_line = 0;
  }

  my $rin = '';
  vec($rin, fileno(STDIN), 1) = 1;
  if (!$single_step && select($rin, undef, undef, 0)) {
    my $c = getch;
    last if handle_char $c == 0;
  }

  chomp;
  next if !$_ || /^#/;
  if (/^C:/) { clear; next }
  if (/^W:/) { getch; next }
  if (/^B:(.*)$/) {
    my $line = $1;
    my $len = length $line;
    clrtoeol 0, 0;
    attrset($color{v}) if has_colors;
    addstr 0, 0, '###';
    attrset($color{o}) if has_colors;
    addstr 0, 3, $line;
    attrset($color{v}) if has_colors;
    addstr 0, 3+$len, '###';
    attrset($color{w}) if has_colors;
    addstr 0, 6+$len, '(more)';
    next;
  }
  if (/^S:(\d+):$/) {
    addch $LINES-1, $COLS-1, ($single_step ? '=' : '>');
    refresh;
    if ($single_step) {
      my $c = getch;
      last if handle_char $c == 0;
    } else {
      select(undef, undef, undef, $1/1000);
    }
    next;
  }
  if (/^E:(\d+):(.*)$/) {
    my ($row, $line) = ($1, $2);
    chomp $line;
    my @a = split '', $line;
    my $ilast = 0;
    my @col = ();
    $colors[$row] = \@col;
    for my $i (0..$#a) {
      next if $i < $#a && $a[$i+1] eq $a[$i];
      curs_die "Line '$_'\n" if !exists($color{$a[$i]});
      push @col, [ $ilast, $i - $ilast + 1, $color{$a[$i]} ];
      $ilast = $i + 1;
    }
    next;
  }
  if (/^L:(\d+):(.*)$/) {
    my ($row, $line) = ($1, $2);
    for my $col (@{$colors[$row]}) {
      attrset($$col[2]) if has_colors;
      addstr $row, $$col[0], substr($line, $$col[0], $$col[1]);
    }
    next;
  }
  if (/^P:(\d+):(\d+):(.):(.)$/) {
    my ($c, $r, $ch, $attr) = ($1, $2, $3, $4);
    attrset($color{$attr}) if has_colors;
    addch $r, $c, $ch;
  }
}
addch $LINES-1, $COLS-1, 'Z';
refresh;
getch;

clear;
refresh;
endwin;