#! perl -w

=for docs

MineSwooper

 Features to be added:-
 	automated play
 	load and save game
 	cheat keys
 	classic mode
 	record & playback
 	undo & redo
 	lives (or legs!)
 	rc file with settings
 	saved statistics sets & hi scores
 	pause
 	custom geometry
 	dynamic chance and probabilites display onmouseover or keypress

Techniques: Perl/Tk

    * there is a determined effort to separate the GUI from the game state
    but this is difficult because Tk gives us lots of

    * The minefield is a canvas and the squares are rectangle items
    * The squares are created in order and therefore given the ids one
    to the number of squares which is handy for lookups
    * The mine, flag, question mark, and mine proximity count items are
    placed on top of the rectangle and given a disabled state so that they
    are transparent to clicks - the rectangle recieves all the clicks
    * The squares use the disabled state when left-clicked (opened) to look
    like the background and stop receiving clicks
    * When a flag or question mark item is placed on a square it is given a tag
    'Flag_' + id where the id is of the associated square
    * When the game ends all the squares are disabled so they can't be clicked
    but they are given the enabled colours so things look right


TODO:

* More sizes for flag icons.
* BUG: upon clear, incorrectly flagged squares were cleared which
shouldn't happen - better way?
* Better Bang - with restart icon - Also show any bad flags with a cross
* timer - escape key to pause to 'boss mode' - iconises
* Cheat key - shows all numbers and mines

mod here!

BUGS:

* can click flag - this differs from the MS version.
* flags not working at all! - I think I've fixed it!

CHANGES: added useage of Log::TraceMessages


=cut

use strict;
use Tk;
use Tk::Dialog;
use Tk::DialogBox;
use Tk::Menu;
use Tk::Canvas;
use Data::Dumper;
use Log::TraceMessages qw(t d);
$Log::TraceMessages::On = 1;
# Hot file handle magic...
select((select(STDERR), $| = 1)[0]);
select((select(STDOUT), $| = 1)[0]);
# Main window...
my $VERSION = '1.0.1';
my $title   = 'MineSwooper';
my $mw      = new MainWindow( -title => $title );
# Field geometries - width, height & number of mines...
# We should load more saved geometries from the rc file...
# The "standard" field geometries are...
my @ggeoms = (
    [ Beginner     => 10, 10, 8 ],
    [ Intermediate => 16, 16, 40 ],
    [ Expert       => 30, 16, 99 ],
);
# Globals to hold current geometry - total number of squares and square pixel size
my ( $gpixels, $gminesleft, $gsquares, $ggeom, $ggeomname, $gw, $gh, $gm ) =
  ( 20, '000' );
# We have a hash of the mine locations...
my %gmines;
# We have a hash of flag locations...
my %gflags;
# We have a hash of question mark locations...
my %gqmarks;
# Lets create a little map of the mine proximity counts.
my @gmap;
# We also need a way of limiting recursion when we click an empty square
# i.e. one with zero adjacent mines - we can do this nicely with a lookup hash...
my %safety;
# Let's do some GUI stuff...
# the main window contains a raised frame split into 3 sunken frames...
my $fr = $mw->Frame(
    -relief      => 'raised',
    -borderwidth => 3,
  )->pack(
    -fill   => 'both',
    -expand => 1,
  );
my $fr1 = $fr->Frame(
    -relief      => 'sunken',
    -borderwidth => 3,
  )->pack(
    -anchor => 'n',
    -fill   => 'x',
    -expand => 1,
    -padx   => 5,
    -pady   => 5,
  );
my $fr2 = $fr->Frame(
    -relief      => 'sunken',
    -borderwidth => 3,
  )->pack(
    -fill   => 'both',
    -expand => 1,
    -padx   => 5,
    -pady   => 5,
  );
my $fr3 = $fr->Frame(
    -relief      => 'sunken',
    -borderwidth => 3,
  )->pack(
    -anchor => 's',
    -fill   => 'x',
    -expand => 1,
    -padx   => 5,
    -pady   => 5,
  );
# Choose a nice font for the mine proximity counts on the
# squares - ask for a font sized in pixels just a little
# smaller than the size of a square...
$mw->fontCreate(
    'sq',
    -family => 'Helvetica',
    -size   => 0 - ( $gpixels - 4 ),
    -weight => 'bold',
);
$mw->fontCreate(
    'readout',
    -family => 'Courier',
    -size   => 0 - ( $gpixels + 4 ),
    -weight => 'bold',
);
#~ my %fm = $mw->fontActual("sq");
#~ print "Font: ", Dumper(\%fm);
# Load some pimaps...
my %pix;
load_pixmaps();
foreach ( keys %pix ) {
    $mw->Pixmap( $_, -data => $pix{$_} );
}
# Set the windowmanager icon (Win32 specific) -- use an icon without transparency here...
if ( $^O eq 'MSWin32' ) {
    $mw->Icon( -image => 'icon32' );
}
# choose the best sized image for the mine...
{
    my @minepix = sort ( grep /^mine\d+$/, keys %pix );
    t "Mine pix: ", d( \@minepix );
    # choose the largest that fits! - todo
}
# Show the number of mines left...
$fr1->Label(
    -textvariable => \$gminesleft,
    -bg           => 'black',
    -fg           => 'green',
    -relief       => 'sunken',
    -borderwidth  => 2,
    -font         => 'readout',
  )->pack(
    -side => 'left',
    -padx => 3,
    -pady => 3,
  );
# create a status bar in the bottom frame
my $statustext = "$title - version $VERSION";
$fr3->Label( -textvariable => \$statustext, )->pack( -side => 'left' );
# Save the standard font by creating a dummy label and deleting it again...
my $stdfont;
{
    my $b = $mw->Label( -text => 'irrelevant' );
    $stdfont = $b->cget('-font');
    my %fm = $mw->fontActual($stdfont);
    t "Standard font: ", d( \%fm );
    $b->destroy();
}

sub menu_do {
    t "menu_do: '@_'";
}
# Stick on a menu...
# some definitive menu usage...
# we have to specify a font for each menu item
# to give each menu item an image we can cheat by using a checkbutton
{
    my $mb = $mw->Menu( -type => 'menubar' );
    my $f = $mb->cascade( -label => '~File', -tearoff => 0, -font => $stdfont );
    # Add the standard field geometries
    foreach my $i ( 0 .. 2 ) {
        my ( $name, $w, $h, $m ) = @{ $ggeoms[$i] };
        t "geom: '$name' width = $w height = $h, mines = $m";
        #~ # take a temp copy of $i to make the closure happy...
        #~ my $t = $i;
        $f->command(
            -label => '~' . ( $i + 1 ) . '. ' . $name,
            -font    => $stdfont,
            -command => [ \&start_game, $i ],
        );
    }
    my $cust =
      $f->cascade( -label => '~Custom', -tearoff => 0, -font => $stdfont );
    $f->separator();
    $cust->command( -label => '~New', -font => $stdfont );
    # todo - add custom entries...
    $f->command( -label => 'New',      -font => $stdfont );
    $f->command( -label => '~Open',    -font => $stdfont );
    $f->command( -label => 'Save ~As', -font => $stdfont );
    $f->separator();
    $f->command( -label => 'E~xit', -font => $stdfont );
    my $h = $mb->cascade( -label => '~Help', -tearoff => 0, -font => $stdfont );
    $h->command( -label => '~Help', -font => $stdfont );
    $h->separator();
    $h->command( -label => '~About', -image => 'mine16', -font => $stdfont );
    #
    $mw->configure( -menu => $mb );
}
# The field canvas...
my $c;
# Establish some default geometry - load from saved would be best - todo...
start_game(0);
# button for testing - to reset enabled state of all squares ...
#~ $mw->Button(
#~ -text    => 'reenable state',
#~ -command => sub { $c->itemconfigure( 'sq', -state => 'normal' ); }
#~ )->pack();
# Go...
MainLoop();
#------------------------------------------------------------------
sub start_game {
    my $i = shift;
    t "start_game('$i')";
    my ( $name, $w, $h, $m ) = @{ $ggeoms[$i] };
    # some checking requied here
    # is it an impossible task?
    # will it fit on the screen?
    ( $ggeom, $ggeomname, $gw, $gh, $gm ) = ( $i, $name, $w, $h, $m );
    $gsquares = $gw * $gh;
    build_field();
    # Put mines in random locations.
    plant_mines();
    # Then calculate the counts for each square.
    pre_calculate_map();
    $gminesleft = sprintf( "%03d", $gm );
}

sub build_field {
    my ( $w, $h, $m ) = ( $gw, $gh, $gm );
    # delete an existing canvas...
    if ( defined $c ) {
        $c->destroy();
        $c = undef;
    }
    # The canvas geometry has been designed by trial and error
    # It looks good with a thin border around the squares
    $c = $fr2->Canvas(
        -width       => $w * $gpixels + 2,
        -height      => $h * $gpixels + 2,
        -bg          => 'black',
        -closeenough => 0.0,
      )->pack(
        -padx => 5,
        -pady => 5,
      );
    # The squares...
    for ( my $y = 0; $y < $h; $y++ ) {
        for ( my $x = 0; $x < $w; $x++ ) {
            $c->createRectangle(
                $x * $gpixels + 3,
                $y * $gpixels + 3,
                ( $x + 1 ) * $gpixels + 2,
                ( $y + 1 ) * $gpixels + 2,
                -fill            => 'green',
                -outline         => 'black',
                -activefill      => 'mediumseagreen',
                -activeoutline   => 'green',
                -disabledfill    => 'grey',
                -disabledoutline => 'yellow',
            );
        }
    }
    $c->addtag( 'sq', 'all' );
    # Bind the various callbacks to the squares...
    $c->bind( 'sq', '<1>' => \&click_sq_1 );
    $c->bind( 'sq', '<2>' => \&click_sq_2 );
    $c->bind( 'sq', '<3>' => \&click_sq_3 );
}
# populate the hash %gmines with $gm mines out of $gsquares squares
# "Aha! that looks like time to use a hash to check whether we
# already have a mine in this square" - nope! we would have to do far too
# much work!
# The quickest way I have found that scales well is to create
# an array of all the available square ids
# and pluck them as we choose a random element. Then each time, we have less
# squares to choose from.
sub plant_mines {
    %gmines = ();
    my @sqs = ( 1 .. $gsquares );
    foreach ( 1 .. $gm ) {
        # choose a random array element...
        my $i = int( rand @sqs );
        $gmines{ $sqs[$i] } = 1;
        # remove this item from the list of choices...
        my $t = splice @sqs, $i, 1;
        #~ print "Removed element $i which was $t from ", Dumper( \@sqs );
    }
    print_mines();
}
# print mines to STDOUT
sub print_mines {
    print "\n";
    for ( my $y = 0; $y < $gh; $y++ ) {
        for ( my $x = 0; $x < $gw; $x++ ) {
            if ( $gmines{ ( $y * $gw ) + $x + 1 } ) {
                print '*';
            } else {
                print '-';
            }
        }
        print "\n";
    }
    print "\n";
}
# Now, we could calculate them by taking each square in turn and
# looking for mines at its adjacent squares, but I think it would
# be fun to take each mine in turn and incrementing the count
# of its neighbours!
# Would this be faster? We will have to run some tests!
# We have to take care to realise that the map has a
# zero-based index but the ids of the squares start at 1!
sub pre_calculate_map {
    # fill map with zeroes...
    @gmap = (0) x $gsquares;
    foreach ( keys %gmines ) {
        my @adj = get_adj( id_to_co($_) );
        my @ids = map co_to_id( $$_[0], $$_[1] ), @adj;
        map { $gmap[ $_ - 1 ]++ } @ids;
    }
    #~ print "Map: ", Dumper( \@gmap );
}
# Return a list of adjacent squares by id as id...
sub get_adj_id {
    my @adj = get_adj( id_to_co( $_[0] ) );
    return map co_to_id( $$_[0], $$_[1] ), @adj;
}
# Return a list of adjacent squares by coords as coords...
sub get_adj {
    my ( $x, $y ) = @_;
    # for the eight possible surrounding coord pairs,
    # pick out the pairs that are within the grid...
    my @adj = grep {
        my ( $x, $y ) = @$_;
        $x >= 0 && $x < $gw && $y >= 0 && $y < $gh;
      } (
        [ $x - 1, $y - 1 ],
        [ $x,     $y - 1 ],
        [ $x + 1, $y - 1 ],
        [ $x - 1, $y ],
        [ $x + 1, $y ],
        [ $x - 1, $y + 1 ],
        [ $x,     $y + 1 ],
        [ $x + 1, $y + 1 ]
      );
    return @adj;
}
# conversion between coords and square id...
sub co_to_id {
    my ( $x, $y ) = @_;
    return ( $y * $gw ) + $x + 1;
}
# conversion between square id and coords...
sub id_to_co {
    my $i = $_[0] - 1;
    return ( $i % $gw, int( $i / $gw ) );
}
# left button click...
sub click_sq_1 {
    my ($id) = $c->find( 'withtag', 'current' );
    # reset the safety catch!
    %safety = ();
    open_sq( $id, 0 );
}
# middle button click...
sub click_sq_2 {
    t "click_sq_2\n";
    # this should do something useful or at least entertaining!
}
# right button click...
sub click_sq_3 {
    #~ print "click_sq_3\n";
    my ($id) = $c->find( 'withtag', 'current' );
    toggle_flag_sq($id);
}
# $clearing tells us that this was not the item clicked but part of a recursive clear
sub open_sq {
    my ( $id, $clearing ) = @_;
    #~ print "open_sq id: $id\n";
    # Since this sub can be called for disabled squares we must check its state...
    return if $c->itemcget( $id, '-state' ) eq 'disabled';
    # if there is a flag here (erroneously) and we are recursively
    # clearing then don't clear this one...
    return if ( $clearing and $gflags{$id} );
    # If there's a flag on it, clear it and disable the square...
    clear_flag($id);
    $c->itemconfigure( $id, -state => 'disabled' );
    # what's here?
    if ( $gmines{$id} ) {
        return bang($id);
    }
    # Get adjacent squares...
    my @adj = get_adj_id($id);
    # how many mines near me?
    my $count = grep $gmines{$_}, @adj;
    # don't have to count these since they can be pre-calculated but -- whatever!
    #~ print "\t count = $count\n";
    if ( not $count ) {
        # do a recursive clear for all adjacent squares...
        foreach (@adj) {
            next if $safety{$_};
            $safety{$_} = 1;
            open_sq( $_, 1 );
        }
    } else {
        # put a number on the canvas...
        # Create the text disabled so it is transparent to clicks - this is not
        # strictly necessary during normal gameplay but useful when
        # we re-activate all squares...
        $c->createText(
            sq_centre($id),
            -font  => 'sq',
            -text  => "$count",
            -state => 'disabled'
        );
    }
    return check_finished();
}
# Return the center of this canvas item - for centering numbers and images...
sub sq_centre {
    my $id = shift;
    my ( $x1, $y1, $x2, $y2 ) = $c->bbox($id);
    #~ print "\tbbox: ", Dumper [$x1, $y1, $x2, $y2];
    return ( $x1 + int( ( $x2 - $x1 ) / 2 ), $y1 + int( ( $y2 - $y1 ) / 2 ) );
}

sub bang {
    my $id = shift;
    print "\n****** BANG! ******\n";
    # show all mines...
    foreach ( keys %gmines ) {
        $c->createImage(
            sq_centre($_),
            -disabledimage => 'mine16',
            -state         => 'disabled'
        );
    }
    disable_all();
}
# Toggle a flag or question mark on this square...
sub toggle_flag_sq {
    my $id = shift;
    # If there's a flag here, make it a questionmark...
    if ( $gflags{$id} ) {
        return flag_to_quest($id);
    }
    # If there's a questionmark here, clear it...
    if ( $gqmarks{$id} ) {
        return quest_to_nowt($id);
    }
    # else nothing here so add a flag...
    return nowt_to_flag($id);
}
# Convert flag to questionmark...
sub flag_to_quest {
    my $id = shift;
    # Remove flag...
    # todo: remove this section when working ok - can just clear_flag
    my $tag = "Flag_$id";
    my $f = $c->find( 'withtag', $tag );
    if ( not $f ) {
        t "No flag graphic for '$id'!";
        return;
    }
    # todo: end
    clear_flag($id);
    # Add questionmark...
    $gqmarks{$id} = 1;
    my $qm = $c->createText(
        sq_centre($id),
        -font  => 'sq',
        -text  => '?',
        -state => 'disabled',
        -tags  => [ "Quest_$id", 'QUEST' ]
    );
    t d($qm);
    1;
}

sub quest_to_nowt {
    my $id = shift;
    # Remove quest...
    my $tag = "Quest_$id";
    my $q = $c->find( 'withtag', $tag );
    if ( not $q ) {
        t "No questionmark graphic for '$id'!";
    }
    $c->delete($tag);
    delete $gqmarks{$id};
    # We must check if finished...
    return check_finished();
}

sub nowt_to_flag {
    my $id = shift;
    $c->createImage(
        sq_centre($id),
        -disabledimage => 'flag10',
        -state         => 'disabled',
        -tags          => [ "Flag_$id", 'FLAG' ],
    );
    $gflags{$id} = 1;
    # We must check if finished...
    return check_finished();
}
# Clear any flag from this square and update the number of mines left...
sub clear_flag {
    my $id = shift;
    delete $gflags{$id};
    $c->delete("Flag_$id");
    $gminesleft = sprintf( "%03d", $gm - scalar( keys %gflags ) );
}

sub check_finished {
    # update the mines left to find...
    $gminesleft = sprintf( "%03d", $gm - scalar( keys %gflags ) );
    # We can't be finished if the number of mines left isn't zero...
    return if ( $gminesleft != 0 );
    # Its possible we're finished - check for any flags in the wrong places...
    print "Checking finished...\n";
    return if grep { not defined $gmines{$_} } keys %gflags;
    # check if there are any squares left uncovered...
    # i.e. squares minus mines
    my @sqs = $c->find( 'withtag', 'sq' );
    #~ print "Squares: '@sqs'.\n";
    my @left = grep { $c->itemcget( $_, '-state' ) ne 'disabled' } @sqs;
    print "Left '@left'.\n";
    if ( scalar @left ne scalar keys %gmines ) {
        print "Not finished yet!\n";
        return;
    }
    # Wow! we're finished...
    disable_all();
    # congratulate user...
    my $d = $mw->DialogBox( -title => "$title", -buttons => ["OK"] );
    my $fr = $d->Frame->pack( -fill => 'x' );
    $fr->Label( -image => 'icon32' )
      ->pack( -side => 'left', -padx => 20, -pady => 20 );
    $fr->Label( -text => 'Well Done!' )->pack( -side => 'left' );
    $d->Show();
    # Actually finished - disable all squares but make them look the same
}
# When game is finished, disable remaining enabled squares but
# make them look like enabled squares...
sub disable_all {
    # all flags - all mines - all untouched
    my @sqs = $c->find( 'withtag', 'sq' );
    #~ print "Squares: '@sqs'.\n";
    my @left = grep { $c->itemcget( $_, '-state' ) ne 'disabled' } @sqs;
    print "Left '@left'.\n";
    foreach (@left) {
        $c->itemconfigure(
            $_,
            -state           => 'disabled',
            -disabledfill    => 'green',
            -disabledoutline => 'black',
        );
    }
    $mw->update();
}

sub load_pixmaps {
    $pix{'mine32'} = <<'EOXPM';
/* XPM */
static char *mine32[] = {
/* width height num_colors chars_per_pixel */
"    32    32       16            1",
/* colors */
"` c none",
". c #c0c0c0",
"# c #808080",
"a c #ffffff",
"b c #000000",
"c c #000000",
"d c #000000",
"e c #000000",
"f c #000000",
"g c #000000",
"h c #000000",
"i c #000000",
"j c #000000",
"k c #000000",
"l c #000000",
"m c #000000",
/* pixels */
"``````````````.##```````````````",
"`````````````.a.#b``````````````",
"`````````````.a.#b``````````````",
"`````````````.a.#b``````````````",
"`````..`````..a.#.b`````bb``````",
"````.aa.``..a.a..#.bb``ba#b`````",
"```...aa...a.a.a..#.#bba##bb````",
"```##..aaaa.a.a....#.##b#bbb````",
"````##..aa.a.a....#.###bbbb`````",
"`````#.aa.a......#.#.#b#bb``````",
"`````#aa.a......#.#.###b#b``````",
"````#.a.a......#.#.#.#b#bbb`````",
"````#a.a....###.#.#.###b#bb`````",
"````#.a....##aa#b#.###b#bbbb````",
"`###aa#.#.##a..#bb###b#b#bbbbbb`",
"#aaa.#.#.#.#a..#bbb#b#b#bbbbbbbb",
"#...#.#.#.#b####bbbb#b#bbbbb###b",
"b###.#.#.#.#bbbbbbbbb#bbbbbbbbbb",
"`bbb#########bbbbbbb#bbbbbbbbbb`",
"```bb#######b#bbbbb#bbbbbbbb````",
"```bbb#b#b#b#b#b#b#bbbbbbbb`````",
"````bbb#b#b#b#b#b#bbbbbbbbb`````",
"````bbbb#b#b#b#b#bbbbbbbbb``````",
"`````bbbb#bbbbbbbbbbbbbbbb``````",
"````b#bbbbbbbbbbbbbbbbbbbbb`````",
"```b#.#bbbbbbbbbbbbbbbbbbbbb````",
"```b.#bbbbbbbbbbbbbbbbbb#bbb````",
"````bbbb`bbbbbbbbbbbb``bb#b`````",
"`````bb````bbbbbbbb`````bb``````",
"``````````````bb#bb`````````````",
"``````````````b##bb`````````````",
"```````````````bbb``````````````"
};
EOXPM
    $pix{'mine16'} = <<'EOXPM';

/* XPM */
static char *mine16[] = {
/* width height num_colors chars_per_pixel */
"    15    16        8            1",
/* colors */
"` c none",
". c #808080",
"# c #ffffff",
"a c #c0c0c0",
"b c #000000",
"c c #000000",
"d c #000000",
"e c #000000",
/* pixels */
"```````.```````",
"``````.#.``````",
"``````.#.```.``",
"``..``.#.``.ab`",
"`.a#..#aa..abb`",
"``.a##aa.a.bb``",
"```.#aa.a..b```",
"...#aa#ab.bbbbb",
".##aa.a.bbbbb..",
".....abbbbbbbbb",
"```.a..bbbbb```",
"```a..bbbbbbb``",
"``a.bbbbbbb.bb`",
"`a.bb`b.b``b.b`",
"``bb``b.b```b``",
"``````bbb``````"
};
EOXPM
    $pix{'icon32'} = <<'EOXPM';
/* XPM */
static char *icon32[] = {
/* width height num_colors chars_per_pixel */
"    32    32        8            1",
/* colors */
"` c #040204",
". c #04fe04",
"# c #848284",
"a c #fcfe04",
"b c #c4c2c4",
"c c #0402fc",
"d c #fcfefc",
"e c #04fe44",
/* pixels */
"ccccccccccccccb##ccccccccccccccc",
"cccccccccccccbdb#`cccccccccccccc",
"cceeeeeeeeeeebdb#`eeeeeeeeeeeecc",
"cce..........bdb#`...........ecc",
"cce.abbaaaaabbdb#b`aaaaa``aa.ecc",
"cce.bddbaabbdbdbb#b``aa`d#`a.ecc",
"ccebbbddbbbdbdbdbb#b#``d##``.ecc",
"cce##bbddddbdbdbbbb#b##`#```.ecc",
"cce.##bbddbdbdbbbb#b###````a.ecc",
"cce.a#bddbdbbbbbb#b#b#`#``aa.ecc",
"cce.a#ddbdbbbbbb#b#b###`#`aa.ecc",
"cce.#bdbdbbbbbb#b#b#b#`#```a.ecc",
"cce.#dbdbbbb###b#b#b###`#``a.ecc",
"cce.#bdbbbb##dd#`#b###`#````.ecc",
"c###dd#b#b##dbb#``###`#`#``````c",
"#dddb#b#b#b#dbb#```#`#`#````````",
"#bbb#b#b#b#`####````#`#`````###`",
"`###b#b#b#b#`````````#``````````",
"c```#########```````#``````````c",
"cce``#######`#`````#````````.ecc",
"cce```#`#`#`#`#`#`#````````a.ecc",
"cce.```#`#`#`#`#`#`````````a.ecc",
"cce.````#`#`#`#`#`````````aa.ecc",
"cce.a````#````````````````aa.ecc",
"cce.`#`````````````````````a.ecc",
"cce`#b#`````````````````````.ecc",
"cce`b#``````````````````#```.ecc",
"cce.````a````````````aa``#`a.ecc",
"cce..``....````````.....``...ecc",
"cceeeeeeeeeeee``#``eeeeeeeeeeecc",
"cccccccccccccc`##``ccccccccccccc",
"ccccccccccccccc```cccccccccccccc"
};
EOXPM
    $pix{'flag10'} = <<'EOXPM';

/* XPM */
static char *flag10[] = {
/* width height num_colors chars_per_pixel */
"    10    10        5            1",
/* colors */
"` c #000000",
". c #7d0000",
"# c #7d7d7d",
"a c none",
"b c #ff0000",
/* pixels */
"abbbb.aaaa",
"abbb..aaaa",
"abb...aaaa",
"ab....aaaa",
"aaaaa`aaaa",
"aaaaa`aaaa",
"aaaaa`aaaa",
"aaaaa`aaaa",
"aaaa#`#aaa",
"aa#`````#a"
};
EOXPM
}
__END__