#!/usr/bin/perl -w
use Tk 8;
use Tk::Text;
use Tk::Image;

use Image::Xbm;
use strict;

use vars qw/ %GOB $crazy0naCAMEL $MirrorCamel/;
&init();
&set_us_up_the_gui();
&MainLoop();

exit;
## S U B L A N D
sub set_us_up_the_menu_bar
{
    $GOB{filemenu} = $GOB{F}->Menubutton(
                                  -text         => 'File',
                                  -relief       => 'raised',
                                  -background   => "#AFFAAF",
                                  -borderwidth  => 2,
                                   )->pack(side => 'left',
                                           padx => 2
                                           );

    $GOB{filemenu}->configure(-menu =>
                              $GOB{filemenu}->Menu(-tearoff => 0)
                             ,);
# "Open" menubutton
    $GOB{filemenu}->command(
                   -label       => 'Load',
                   -accelerator => 'Ctrl+O',
                   -underline   => 0,
                   -command     => \&f_open,
                    );

# "Open" menubutton
    $GOB{filemenu}->command(
                   -label       => 'Save As',
                   -accelerator => 'Ctrl+A',
                   -underline   => 5,
                   -command     => \&f_saveas,
                    );


    return undef;
}

sub f_open
{
    my $file=$GOB{W}->getOpenFile(-defaultextension => ".xbm",
                                  -initialdir       => ".",
                                  -title         => "Open File:"
                                 ,);
    if($file)
    {
        print "loading $file ...\n";
        &draw_us_up_a_picture(Image::Xbm->new(-file => $file)->as_string());
    }
    else
    {
        print "no file to load\n";
    }

    return undef;
}


sub f_saveas
{
    my $file=$GOB{W}->getSaveFile(-defaultextension => ".xbm",
                                -initialdir       => "./*.xbm",
                                -title         => "Save File:"
                               ,);

    if($file and length $file > 0)
    {
        my $picXBM = &make_us_up_the_picture();
        print "no picture, nothing to save\n", last unless $picXBM;
        print "saved $file, looks great\n" if $picXBM->save($file);
    }
    else
    {
        print "no filename, can't save shit\n";
    }
    return undef;
}



sub set_us_up_an_entry
{
    my $key = shift;
    $GOB{$key} = $GOB{W}->Entry(
                            -background => "white",
                            -borderwidth => 1,
                            -relief => "groove",
                            -font => "Courier",
                            -width => 2,
                           ,);

    $GOB{$key}->pack(-expand => 'no',
                   -side => 'left',
                   -in => $GOB{F}, # pack the thing into Frame
                  ,);
    return undef;
}


sub set_us_up_a_button
{
    my ( $wig , $key , $text , $relief , $sub )=@_;
    $GOB{$key} = $wig->Button(-text => $text,
                              -relief => $relief,
                              ,)->pack(-expand => 'no',
                                       -side => 'left',
                                      ,);

    $GOB{$key}->configure(-command => [ $sub, $GOB{$key} ] );
#    $GOB{TX}->in($GOB{F});

    return undef;
}

sub set_us_up_the_gui
{

    $GOB{W} = new MainWindow(-background => 'darkblue',
                             -borderwidth => 1,
                             -relief => 'groove',
                             -width => 500,
                             -height => 500,
                         ,);

    $GOB{W}->title("crazy tk xbm thingy");

#    $GOB{W}->resizable(0,0); # no, no

    $GOB{F} = $GOB{W}->Frame(
#                             -borderwidth => 0,
#                             -highlightbackground => "",
#                             -highlightthickness => "",
#                             -takefocus  => "",

#                             -class => "",
#                             -highlightcolor => "",
                             -relief  => "groove",

#                             -cursor => "",

                              -height => 25,
                              -width => 500,
                           ,);

    $GOB{F}->pack(-anchor => 'n',
                  -side => 'top',
                  -expand => 'no',
                 ,);

 ## called in this order, because of the packing order

    &set_us_up_the_menu_bar();

    &set_us_up_a_label( $GOB{F} , '  ', 'flat' );

    &set_us_up_a_button($GOB{F},
                        'flip',
                        'Flip All Squares',
                        'groove',
                        \&flip_em_all
                        ,);

    &set_us_up_a_label( $GOB{F} , '  ', 'flat' );

    &set_us_up_a_label( $GOB{F} , 'X:', 'groove' );
    &set_us_up_an_entry('TX');

    &set_us_up_a_label( $GOB{F} , '  ', 'flat' );

    &set_us_up_a_label( $GOB{F} , 'Y:',  'groove' );
    &set_us_up_an_entry('TY');

    &set_us_up_a_label( $GOB{F} , '  ', 'flat' );

    &set_us_up_a_button($GOB{F},
                        'makegrid',
                        'Make the grid',
                        'groove',
                        \&set_us_up_the_grid,
                        ,);

    &set_us_up_a_label( $GOB{F} , '  ', 'flat' );

    &set_us_up_a_button($GOB{F},
                        'cleargrid',
                        'Clear the grid',
                        'groove',
                        \&clear_us_up_the_grid,
                        ,);

## we don't need a mouse press listener till we got a grid, buttt, so what
    $GOB{W}->bind('<ButtonPress>' => [\&flip_square, Ev('x'), Ev('y')]
           ,);
    return undef;
}

sub set_us_up_a_label
{
    my ($widg, $text,$relief) = @_;
    $widg->Label(-text => $text,
                 -relief => $relief,
                 -font => "Arial",
#                 -anchor => 'center',
            ,)->pack(-side => 'left',
                     -expand => 1,);
}

sub clear_us_up_the_grid
{
    unless (exists $GOB{grid} )
    {
        &draw_us_up_a_picture($MirrorCamel);
        return undef;
    }

    $GOB{gridc}->delete('all');
    $GOB{gridc}->packForget;

    delete $GOB{grid};
    delete $GOB{gridc};
    return undef;
}


sub make_us_up_the_picture
{
    my $picture = "";

    if(exists $GOB{grid})
    {   for my $row (@{$GOB{grid}})
        {
            for my $id (@{$row})
            {
                $picture .= ( $GOB{gridc}->itemcget($id,-fill) eq 'white' )?
                            '-' : '#';
            }
            $picture .="\n";
        }
        return Image::Xbm->new_from_string($picture);
    }
    return undef;
}

sub set_us_up_the_grid
{
    my ($x, $y, $scale) = @_;

    $scale = 8 unless $scale;

    unless($x and $y)
    {
        $x = $GOB{TX}->get();
        $y = $GOB{TY}->get();
    }

    $GOB{TX}->delete(0,'end');
    $GOB{TY}->delete(0,'end');

    &draw_us_up_a_picture($crazy0naCAMEL) unless $x and $y;

    $x =~ s/\D//;
    $y =~ s/\D//;
    
    $x =~ s/(.{2}).*$/$1/;
    $y =~ s/(.{2}).*$/$1/;

    return unless $x and $y;

    $GOB{TX}->insert(0,$x) if $x;
    $GOB{TY}->insert(0,$y) if $y;


    &clear_us_up_the_grid() if (exists $GOB{grid} );

    $GOB{gridc} = $GOB{W}->Canvas(-width      => ( $x + 2 ) * $scale,
                                 -height     => ( $y + 2 ) * $scale,
                                 -background => "#AFFAAF",
                                ,)->pack;
    
    $GOB{grid} = &layout_canvas_grid($GOB{gridc}, $x, $y, $scale);

    return undef;
}


sub layout_canvas_grid
{
    my ( $widget , $colsX , $rowsY , $scale) = @_;

    $scale = 10 unless $scale;
    
    my @danums;

    for my $iy(1..$rowsY)
    {
        my @dabums;
        for my $ix(1..$colsX)
        {
            my $id = $widget->create('rectangle',
                                      $ix * $scale,
                                      $iy * $scale,
                                      $ix * $scale + $scale,
                                      $iy * $scale + $scale,
                                      -fill=>'white',
                                    ,);

            $widget->itemconfigure($id);
            push @dabums, $id;
        }
        push @danums, \@dabums;
    }

    return \@danums;
}


sub flip_em_all
{

    for my $row( @{ $GOB{grid} } )
    {
        for my $id( @{ $row } )
        {
            my $color = $GOB{gridc}->itemcget($id,-fill);
            $color = ( $color eq 'white' ) ? 'black' : 'white';
            $GOB{gridc}->itemconfigure($id,
                                   -fill => $color
                                  ,);
        }
    }
}

sub flip_square
{
    my ($widget,$x,$y,$wihi) = @_;

    return unless $widget =~ /Tk::Canvas/;

    my $id = $GOB{gridc}->find('overlapping', $x, $y, $x + 1 , $y + 1 );

    if($id)
    {
        my $color = $GOB{gridc}->itemcget($id,-fill);
        $color = ( $color eq 'white' ) ? 'black' : 'white';
        $GOB{gridc}->itemconfigure($id,
                                   -fill => $color
                                  ,);
    }
}


sub draw_us_up_a_picture
{
    my $XBM = Image::Xbm->new_from_string(shift);
    my @picrow = map {[split '',$_ ]} split "\n", $XBM->as_string();

    return undef unless @picrow;

    &set_us_up_the_grid( $$XBM{-width} , $$XBM{-height} );

    for( my $iy =0; $iy < $$XBM{-height}; $iy++)
    {
        for( my $ix=0; $ix < $$XBM{-width}; $ix++ )
        {
           $GOB{gridc}->itemconfigure($GOB{grid}->[$iy][$ix],
                                     -fill => 'black',
                                    ,)
           unless $picrow[$iy][$ix] ne '#';
        }
    }

    return undef;
}


sub init {
$crazy0naCAMEL =
"---------#-----------#--------
---------##------####---------
-----######-----#---#---------
---##---###-----##--#---------
--##########----#--#----------
---##--#####-----##-----------
---#---####------#-##---------
---#---####---####-#----------
---#--####---#-----#----------
---#--####----##-##-----------
---#-#########--######--------
---#-####---##--#######-------
---#-#######-#-#########------
---#--####################----
----#-#####################---
-----#######################--
-------#####################--
--------###################---
--------######------#######---
---------####-------######----
---------###---------#####----
---------###---------###-#----
---------###---------###-#----
---------###----------##-#----
---------###----------####----
--------##-----------###------
";

$MirrorCamel ="----------.##.-------------------------------------------.##.-----------
--------.########.--------.##.-----------.##.--------.########.---------
-------.###########------.########---########.------###########.--------
-------#############.---.##########-##########.---.#############--------
-----.################.--#########'-`#########--.################.------
----.###################-#######-------#######-###################.-----
---#############################-------#############################----
--##############################'-----`##############################---
-###############################-------###############################--
-##############################'-------`##############################--
-##--#########################'---------`#########################--##--
-##.-###-###################'-------------`###################-###-.##--
--#-####--###-#####-#####---------------------#####-#####-###--####-#---
----###---###-#####.-###-----------------------###-.#####-###---###-----
----##'---##--`####--###-----------------------###--####'--##---`##-----
----##----###.--###'--##'---------------------`##--`###--.###----##-----
----##-----#######'---##-----------------------##---`#######-----##-----
----##-----.####'-----##-----------------------##-----`####.-----##-----
---.##-----#######-----##---------------------##-----#######-----##.----
----###.---`#'`###'----###-------------------###----`###'`#'---.###-----
----###----------------#####---------------#####----------------###-----
------------------------------------------------------------------------
------------------------------------------------------------------------
----------------------.##.--------------------.##.----------------------
------.##.--------.########.----------------.########.--------.##.------
--########.------###########.--------------.###########------.########--
-##########.---.#############--------------#############.---.##########-
-`#########--.################.----------.################.--#########'-
----#######-###################.--------.###################-#######----
----#############################------#############################----
---`##############################----##############################'---
----###############################--###############################----
----`##############################--##############################'----
-----`#########################--##--##--#########################'-----
-------`###################-###-.##--##.-###-###################'-------
-----------#####-#####-###--####-#----#-####--###-#####-#####-----------
------------###-.#####-###---###--------###---###-#####.-###------------
------------###--####'--##---`##--------##'---##--`####--###------------
-----------`##--`###--.###----##--------##----###.--###'--##'-----------
------------##---`#######-----##--------##-----#######'---##------------
------------##-----`####.-----##--------##-----.####'-----##------------
-----------##-----#######-----##.------.##-----#######-----##-----------
----------###----`###'`#'---.###--------###.---`#'`###'----###----------
--------#####----------------###--------###----------------#####--------";

}