#!/usr/bin/perl -w

use Wx qw[:everything];
use strict;

package HexCanvas;
use base qw(Wx::Panel Class::Accessor::Fast);
use Wx qw[:everything];
use Math::Trig;

__PACKAGE__->mk_accessors(qw(dragging last_device_x last_device_y
    old_scale scale origin_x origin_y hex_side hex_half_width hex_quarter_height
    ));

# bitmap flags to describe the nature of a mouse event
our (
    $ME_LEFT_BUTTON,
    $ME_BUTTON_DOWN, 
    $ME_BUTTON_UP,
) = map { 2 ** $_ } (0 .. 15);

################################################################################
# Constructor.
sub new { #{{{1

    my( $class, $parent, $id, $pos, $size) = @_;
    $parent = undef              unless defined $parent;
    $id     = -1                 unless defined $id;
    $pos    = wxDefaultPosition  unless defined $pos;
    $size   = [ 200, 200 ]      unless defined $size;

    my $self = $class->SUPER::new( $parent, $id, $pos, $size);

    $self->scale(0.125);
    $self->old_scale(0.125);
    $self->origin_x(100);
    $self->origin_y(100);

    $self->SetCursor(wxCROSS_CURSOR);

    Wx::Event::EVT_PAINT($self, \&repaint_canvas);

    Wx::Event::EVT_MOUSE_EVENTS( $self,
        sub { 
            my ($self, $event) = @_;

            my $event_flags = 0;
            $event_flags |= $ME_LEFT_BUTTON if $event->Button(wxMOUSE_BTN_LEFT);
            $event_flags |= $ME_BUTTON_DOWN if $event->ButtonDown;
            $event_flags |= $ME_BUTTON_UP if $event->ButtonUp;

            my $refresh = $self->mouse_event_handler($event_flags, $event->GetX, $event->GetY);
            $self->repaint_canvas() if $refresh;

            $self->last_device_x($event->GetX);
            $self->last_device_y($event->GetY);

            # have to skip to get EVT_LEAVE_WINDOW as well
            $event->Skip;
        }
    );

    # hex sizing
    $self->calculate_hex_dims(40);

    $self->SetBackgroundStyle(wxBG_STYLE_CUSTOM);

    return $self;
}

#*******************************************************************************
sub mouse_event_handler { #{{{2
    my ($self, $event_flags, $device_x, $device_y) = @_;

    my  $refresh;

    # left button down/up toggles dragging flag
    if ($event_flags & $ME_LEFT_BUTTON) {
        $self->dragging($event_flags & $ME_BUTTON_DOWN);
    }

    # motion while dragging moves origin
    if (defined $device_x && $self->dragging && $event_flags == 0) {
        $self->move_origin($device_x, $device_y);
        $refresh = 1;
    }

    return $refresh;
}

#*******************************************************************************
sub calculate_hex_dims { #{{{1
    my ($self, $side) = @_;

    $self->hex_side($side);
    $self->hex_half_width( int( cos (deg2rad(30)) * $self->hex_side));
    $self->hex_quarter_height ( $self->hex_side / 2);

    return;
}

#*******************************************************************************
sub repaint_canvas { #{{{1
    my ($self) = @_;

    my $dc = Wx::AutoBufferedPaintDC->new( $self );

    $dc->Clear;
    $dc->SetUserScale($self->scale, $self->scale);
    $dc->SetDeviceOrigin($self->origin_x, $self->origin_y);

    # we draw the grid in logical coords; we need to know what the logical extents of the canvas are.
    my ($width, $height) = $self->GetSizeWH;
    my ($min_x, $max_x) = ( $dc->DeviceToLogicalX(0), $dc->DeviceToLogicalX($width));
    my ($min_y, $max_y) = ( $dc->DeviceToLogicalY(0), $dc->DeviceToLogicalY($height));

    # move mins & maxes to grid lines to get smooth scrolling of hexes.
    # These limits are within the canvas boundaries so we see the edge of the hex region.
    my $x_grid_size = $self->hex_half_width * 2;
    my $y_grid_size = $self->hex_side * 2 + $self->hex_quarter_height * 2;
    $min_x += ($x_grid_size - ($min_x % $x_grid_size));
    $min_y += ($y_grid_size - ($min_y % $y_grid_size));
    $max_x -= $max_x % $x_grid_size;
    $max_y -= $max_y % $y_grid_size;

    my ($x,$y) = ($min_x,$min_y);

    # create a list of points that define a hexagon
    my @points = ();
    push @points, Wx::Point->new( $x + $self->hex_half_width * 2, $y + $self->hex_quarter_height );
    push @points, Wx::Point->new( $x + $self->hex_half_width, $y );
    push @points, Wx::Point->new( $x, $y + $self->hex_quarter_height );
    push @points, Wx::Point->new( $x, $y + $self->hex_quarter_height + $self->hex_side );
    push @points, Wx::Point->new( $x + $self->hex_half_width, $y + $self->hex_quarter_height * 2 + $self->hex_side );
    push @points, Wx::Point->new( $x + $self->hex_half_width * 2, $y + $self->hex_quarter_height + $self->hex_side );

    $dc->SetBrush(wxBLUE_BRUSH);
    $dc->SetPen(wxGREEN_PEN);

    my $row = 0;
    while ($y < $max_y) {

        $x = $row % 2 ? $min_x : $min_x + $self->hex_half_width;

        while (($x + $self->hex_half_width * 2) < $max_x) {

            $dc->SetBrush(wxRED_BRUSH) if ($x == 0 || $y == 0);

            # draw the line
            $dc->DrawPolygon( \@points, $x - $min_x, $y - $min_y);

            $dc->SetBrush(wxBLUE_BRUSH) if ($x == 0 || $y == 0);

            $x += $self->hex_half_width * 2;

        }

        $y += $self->hex_quarter_height + $self->hex_side;
        $row++;

    }

    return;
}

#*******************************************************************************
sub move_origin { #{{{1
    my ($self, $device_x, $device_y) = @_;

    $self->origin_x ( $self->origin_x - ($self->last_device_x - $device_x));
    $self->origin_y ( $self->origin_y - ($self->last_device_y - $device_y));

    return;
}

################################################################################

package HexFrame; 

use base qw(Wx::Frame);
use Wx qw[:everything];

#*******************************************************************************
# Constructor.
sub new { #{{{2
    my ($class, $parent) = @_;

    my $self = $class->SUPER::new( $parent, -1, 'HexSample - Hold Left Button And Drag');

    $self->{canvas} = (HexCanvas->new($self, -1));
    $self->SetSizer(my $sizer = Wx::BoxSizer->new(wxHORIZONTAL));
    $sizer->Add($self->{canvas}, 1, wxEXPAND, 0 );
    $self->SetBackgroundStyle(wxBG_STYLE_CUSTOM);

    return $self;
}

################################################################################

package HexApp; # {{{1

use base qw(Wx::App );

sub new { # {{{2
    my( $class, @args ) = @_;
    my $self = $class->SUPER::new( @args );

    $self->{frame} = HexFrame->new();
    $self->{frame}->Show(1);

    return $self;
}

#*******************************************************************************

sub OnInit { # {{{2
    my( $self ) = shift;

    my $rc = $self->SUPER::OnInit();

    return 1;
}

################################################################################

package main;

unless(caller){

    my $app = HexApp->new();

    $app->MainLoop();
}