#!/usr/bin/perl
use strict;
use warnings;
use Regexp::Common qw(comment delimited);

my $COMMENT_k = $RE{comment}{C}{-keep};
my $COMMENT   = $RE{comment}{C};
my $STRING    = $RE{delimited}{-delim=>'"'}{-keep};

my ($name, $dim, $x, $y, $num_cols, $px_width, @pal, @px);

$_ = do { local $/; <> };

/\G \s* $COMMENT_k/xgc and (my $cmt = $3) =~ /\A\s* XPM \s*\z/x
	or die "Not XPM data.\n";

/\G \s* static \s+ char \s* \* \s* ([\w-]+) \[\] \s* = \s* \{/xgc
	or die "Invalid XPM data.\n";

$name = $1;

/\G \s* (?:$COMMENT \s*)? $STRING \s* ,/xgc
	or die "Missing XPM dimension specification.\n";

($dim = $3) =~ /\A\s* (\d+) \s+ (\d+) \s+ (\d+) \s+ (\d+) \s*\z/gcx
	or die "Invalid XPM dimension specification.\n";

($x, $y, $num_cols, $px_width) = ($1, $2, $3, $4);

for my $i (1 .. $num_cols) {
	/\G \s* $STRING \s* ,/xgc
		or die "Invalid XPM palette data.\n";
	push @pal, $3;
}

# eat comment if any
/\G \s* $COMMENT?/xgc;

for my $i (1 .. $y - 1) {
	/\G \s* $STRING \s* ,/xgc
		or die "Invalid XPM pixel data.\n";

	use bytes;
	die "Invalid XPM pixel data.\n"
		if length($3) != $x * $px_width;

	push @px, $3;
}

/\G \s* $STRING/xgc
	or die "Invalid XPM pixel data.\n";
push @px, $3;

/\G \s* \} \s* \; \s* \z/gx
	or die "Missing closing bracket after XPM pixel data.\n";

$name =~ s/\W+/_/g;

print map({ "$_\n" }
	qq{our \ $name = split /\\n/, <<'END_XPM_DATA';},
	$dim,
	@pal,
	@px,
	'END_XPM_DATA'
);