package ThreadSafe;
use strict;
use warnings;
use 5.007_002; # Perl 5.7.2 or higher needed for CLONE_SKIP
use Win32::GUI 1.03, 'WM_DESTROY';

use Storable qw(freeze thaw);

use threads;
use threads::shared;
use Thread::Queue;


our $VERSION = "0.00_02";

# Make Win32::GUI thread-safe
sub Win32::GUI::CLONE_SKIP {1};
sub Win32::GUI::ListBox::Item::CLONE_SKIP {1};
sub Win32::GUI::ListView::Item::CLONE_SKIP {1};
sub Win32::GUI::ListView::SubItem::CLONE_SKIP {1};
sub Win32::GUI::Timer::CLONE_SKIP {1};
sub Win32::GUI::NotifyIcon::CLONE_SKIP {1};
sub Win32::GUI::DC::CLONE_SKIP {1};
sub Win32::GUI::Pen::CLONE_SKIP {1};
sub Win32::GUI::Brush::CLONE_SKIP {1};
sub Win32::GUI::AcceleratorTable::CLONE_SKIP {1};
sub Win32::GUI::WindowProps::CLONE_SKIP {1};

sub THREAD_SAFE_ANCHOR() 	{32768 + 200};
sub WM_CLOSE()				{ 0x0010};

my %Marshall : shared;
my $MasterQ = new Thread::Queue;
my $PortCallback;

###############################################
#This is the main event processor. only runs in the original thread
my $EVENTS = sub {
    return 1 if threads->self->tid() != 0;
    my ( $obj, $wparam, $lparam, $type, $msgcode ) = @_;
    print "Events $msgcode\n";
    if( exists $Marshall{MSGS}{$msgcode} )
    {   lock %Marshall;
        foreach my $thr (keys %{ $Marshall{MSGS}{$msgcode} }){
            #push to the Anchor'd thread's event Q
            print "Event: passing $msgcode to $thr\n";
            if( $thr == 0 ){
            	my $DdQ;
            	$DdQ = $Marshall{Threads}{0}{data}->dequeue() if $Marshall{Threads}{0}{data}->pending();
            	&$PortCallback( $obj, $wparam, $lparam, $type, $msgcode, (defined $DdQ?@{thaw $DdQ}:undef) );
            }else{
				my @event = ($obj->{-handle}, $wparam, $lparam, $type, $msgcode);
				my $event2Q = freeze( \@event );
				$Marshall{Threads}{$thr}{evt}->enqueue($event2Q);
            }
        }
    }
    
    return 1;
};

#This is the handler for adding/removing hooks.
my $ANCHORS = sub {
    my ( $obj, $thread, $delete, $type, $msgcode ) = @_;
    
    my $dQ = $MasterQ->dequeue();
    my @params = @{ thaw( $dQ) };
    # 0 = thread, 1 = MSGCODE, 2 = delete
    print join(' ','ANCHORS',@params),"\n";
    if( !$delete ){
        # add a hook
        my %mcode : shared = ($params[0] => 1);
        if( !exists $Marshall{MSGS}{$params[1]} ){
            {lock %Marshall;
            $Marshall{MSGS}{$params[1]} = \%mcode;
            }
            #Hook( handle, msg, coderef)
            print "Hooking $thread to $params[1]\n";
            Win32::GUI::Hook($Marshall{Win}, $params[1], sub { &$EVENTS(@_) } );
        }else{
            {lock %Marshall;
            $Marshall{MSGS}{$params[1]}{$params[0]}=1;
            }
        }
    }else{
        # remove a hook
        if( exists $Marshall{MSGS}{$params[1]} ){
            # hooks DO exists for this message
            print "UnHook of $params[1] from $params[0]\n";
            { lock %Marshall;
            delete $Marshall{MSGS}{$params[1]}{$params[0]};
            }
            #UnHook( handle, msg, coderef)
            if( scalar(keys %{$Marshall{MSGS}{$params[1]}}) == 0 ){
                # There are NO more Anchors to the Port for this msg, unhook all
                print "UnHook $params[1]\n";
                Win32::GUI::UnHook($Marshall{Win},$msgcode);
            }
        }
    }
    
    return 1;
};


###############################################
#This is the main constructor formed by the Win32::GUI::Window
sub Port{
    return undef if threads->self->tid() != 0;
    
    my ( $win, $callback ) = @_;
    
    return undef if ref( $win ) ne 'Win32::GUI::Window';
    
    my $handle : shared = $win->{-handle};
    my %msgs : shared;
    my %thrs : shared;
    
    $PortCallback = $callback;
    
    print "Preparing Port $handle\n";
    { lock %Marshall;
        #
        $Marshall{Win}      = $handle;
        $Marshall{MSGS}     = \%msgs;
        $Marshall{Threads}  = \%thrs;
        Win32::GUI::Hook($handle, THREAD_SAFE_ANCHOR, $ANCHORS);
    }
    
    return 1;
}

sub Close{
	return undef if threads->self->tid() != 0;
	{	lock %Marshall;
		$Marshall{die} = 1;
	}
	print "Close\n";
	return -1;
}

############################################################
# Utilities used by threads in the ThreadSafe environment
sub SendMessage{
	my $MESSAGE = shift;
	my $WPARAM 	= shift;
	my $LPARAM	= shift;
	
	my @data = @_;
	
	if( exists $Marshall{MSGS}{$MESSAGE} ){
		my $thr;
		foreach $thr (keys %{$Marshall{MSGS}{$MESSAGE}}){
			$Marshall{Threads}{$thr}{data}->enqueue(freeze \@data) if scalar @data;
		}		
	}
	if( exists $Marshall{die} ){
		Win32::GUI::SendMessageTimeout($Marshall{Win}, $MESSAGE, $WPARAM, $LPARAM, 0, 300);
	}else{
		Win32::GUI::SendMessage($Marshall{Win}, $MESSAGE, $WPARAM, $LPARAM);
	}
	
	return 1;
}


############################################################
# This is the method threads use to hook a message in the Window that is 'Port'
sub Anchor{
    # is this per object or module?
    my ( $msg, $delete ) = @_;
    $delete = 0 if !defined $delete;
    
    my $thr = threads->self->tid();
    my @params = ( $thr, $msg, $delete);
    
    if( !exists $Marshall{Threads}{$thr}  && !$delete){
    	my %thread : shared;
    	$thread{evt}  = new Thread::Queue if $thr != 0;
    	$thread{data} = new Thread::Queue;
        {lock %Marshall;
        $Marshall{Threads}{$thr} = \%thread;
        }
        print "Anchor : Queue created for $thr\n";
    }
    print "Anchor : Delete $msg for $thr\n" if $delete;
    print "Anchor : Add $msg for $thr\n" if !$delete;
    $MasterQ->enqueue( freeze( \@params) );
    print "Sending Anchor Msg\n";
   	SendMessage(THREAD_SAFE_ANCHOR, $thr, $delete);
    print "Sent Anchor Msg\n";
}

############################################################
# This is called by NON-Port threads to fire events or them.
sub DoEvents{
    my $code = shift;
    return undef if ref $code ne 'CODE';
    my $thr = threads->self->tid();
    my $result;
    if( exists $Marshall{Threads}{$thr} ){
        my $dQ = $Marshall{Threads}{$thr}->dequeue_nb();
        if( defined $dQ ){
        	my @params = @{thaw($dQ)};
			my $DdQ = $Marshall{Threads}{$thr}{data}->dequeue();
			print "DoEvents $thr ",join(',',@params), "\n";
            $result = &$code( @params, @{thaw $DdQ} );
        }
    }
    return $result;
}

# This is called by NON-Port threads to fire events or them.
sub Dialog{
    my $code = shift;
    return undef if ref $code ne 'CODE';
    my $thr = threads->self->tid();
    
    my $result = 1;
    if( exists $Marshall{Threads}{$thr} ){
        my $dQ;
        while( $result != -1 ){
            $dQ = $Marshall{Threads}{$thr}{evt}->dequeue();
            my @params = @{thaw($dQ)};
            print "Dialog $thr ",join(',',@params), "\n";
            my $DdQ;
            $DdQ = $Marshall{Threads}{$thr}{data}->dequeue() if $Marshall{Threads}{$thr}{data}->pending();
            $result = &$code( @params,  (defined $DdQ?@{thaw $DdQ}:undef) );
        }
    }
    
    return 1;
}

1;