#!/usr/bin/perl -w
# Copyright 2003 Matthew Helsley
#
# This program assists you in making anagrams. It takes in the text
# from which you wish to make the anagram, and then limits you
# to using those letters (it ignores case differences, punctuation,
# and non-alphabetic characters). 
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#

use strict;
use Gtk2;
use Glib ':constants';


Gtk2->init();

sub minimum {
	my $numA = shift ;
	my $numB = shift ;

	if ($numA > $numB){
		return $numB;
	}else{
		return $numA;
	}
}

sub maximum {
	my $numA = shift ;
	my $numB = shift ;

	if ($numA > $numB){
		return $numA;
	}else{
		return $numB;
	}
}

# Convert a string to a pool
sub str2pool 
{
	my $word = $_[0];
    my %charset = ();
	
	if (!defined($word)){
		return %charset;
	}
		
	while(length($word) > 0) {
		my $char = substr($word, 0, 1);
		$word = substr($word, 1, length($word) - 1);
		$char = lc $char;
		$_ = $char;
		if (/[abcdefghijklmnopqrstuvwxyz]{1}/){
			if (defined $charset{$char}){
				$charset{$char} = $charset{$char} + 1;
			} else {
				$charset{$char} = 1;
			}
		}
	}
	return %charset;
}

# "Clip" a string to use only those characters found in the pool
sub str_clip {
	my $str = shift;
	my $pool_ref = shift;
	my $result = "";

	if ((!defined($str)) || (!defined($pool_ref))){
		return $result;
	}

	my %tmppool = %{$pool_ref};
	
	while(length($str) > 0) {
		my $char = substr($str, 0, 1);
		$str = substr($str, 1, length($str) - 1);
		my $lchar = lc $char;
		$_ = $lchar;
		if (/[abcdefghijklmnopqrstuvwxyz]{1}/){
			if (defined $tmppool{$lchar}){
				if ($tmppool{$lchar} > 0){
					$tmppool{$lchar}--;
					$result = $result . $char;
				}# else "Clipped " . $char . " (ran out of $char)\n";
			}# else "Clipped " . $char . " (not in set)\n";
		} else {
			$result = $result . $char;
		}
	}

	return $result;
}

# Convert a pool to a string
sub pool2str {
	my $pool_ref = shift;
	my $result = "";

	if (!defined($pool_ref)){
		return $result;
	}

	for my $char (sort keys %{$pool_ref}) {
		my $i = 0;
		for ($i = 0; $i < $$pool_ref{$char}; $i++){
			$result = $result . $char;
		}
	}

	return $result;
}

# Add A to B returning C
sub pool_add_result {
	my $pool_a_ref = shift;
	my $pool_b_ref = shift;
	my %pool_c = ();

	if (!defined($pool_a_ref)) {
		return %pool_c;
	}

	if (!defined($pool_b_ref)) {
		return %{$pool_a_ref};
	}

	for my $char (keys %{$pool_a_ref}) {
		if (defined ${$pool_b_ref}{$char}){
			$pool_c{$char} = ${$pool_a_ref}{$char} + ${$pool_b_ref}{$char};
		} else {
			$pool_c{$char} = ${$pool_a_ref}{$char};
		}
	}

	for my $char (keys %{$pool_b_ref}) {
		if (!defined ${$pool_a_ref}{$char}){
			$pool_c{$char} = ${$pool_b_ref}{$char};
		}
	}
	
	return %pool_c;
}

sub pool_add {
	my $pool_a_ref = shift;
	my $pool_b_ref = shift;

	if (!defined($pool_a_ref) || !defined($pool_b_ref)) {
		return;
	}

	for my $char (keys %{$pool_a_ref}) {
		if (defined ${$pool_b_ref}{$char}){
			$$pool_a_ref{$char} = ${$pool_a_ref}{$char} + ${$pool_b_ref}{$char};
		}
	}

	for my $char (keys %{$pool_b_ref}) {
		if (!defined ${$pool_a_ref}{$char}){
			$$pool_a_ref{$char} = ${$pool_b_ref}{$char};
		}
	}	
}

sub pool_intersect {
	my $pool_a_ref = shift;
	my $pool_b_ref = shift;
	my %pool_c = ();

	for my $char (keys %{$pool_a_ref}) {
		if (defined ${$pool_b_ref}{$char}){
			$pool_c{$char} = minimum(${$pool_a_ref}{$char},${$pool_b_ref}{$char});
		}
	}
	
	return %pool_c;
}

# Subtract B from A returning C
sub pool_subtract {
	my $pool_a_ref = shift;
	my $pool_b_ref = shift;
	my %pool_c = ();
	
	if (!is_pool_subset($pool_b_ref, $pool_a_ref)){
#		print "Tried to remove non-subset from pool!";
		%{$pool_a_ref} = ();
		return ; 
	}

	for my $char (keys %{$pool_b_ref}) {
		$$pool_a_ref{$char} -= $$pool_b_ref{$char};
		if ($$pool_a_ref{$char} < 0){
			$$pool_a_ref{$char} = 0;
		}
	}
}

# Is A a subset of B
sub is_pool_subset {
	my $pool_a_ref = shift;
	my $pool_b_ref = shift;

	for my $char (sort keys %{$pool_a_ref}) {
		if (!defined($$pool_b_ref{$char})){
			return 0;
		}

		if ($$pool_b_ref{$char} < $$pool_a_ref{$char}){
			return 0;
		}
	}

	return 1;
}

sub pool_print {
	my $pool = shift ;

	for my $char (sort keys %{$pool}) {
		print "(" . $char . "," . $$pool{$char} . ")";
	}
}
# my $argstr = "";
#for (my $i = 0; $i <= $#ARGV; $i++){
#	$argstr = $argstr . " " . $ARGV[$i];
#}

# my %words = ();

#while(<STDIN>){
#	chomp ;
#	my $word = $_;
#	my %pool = str2pool($word);
##	print $word . " ";
#
#	if (#%pool > 0){
##		pool_print(\%pool);
##	}
#		$words{$word} = \%pool;
#	}
##	print "\n";
#}

my $initial_string = "A quick brown fox jumps over the lazy dog";
my $window = new Gtk2::Window("toplevel");
my $pool_widget = new Gtk2::Entry();
my $anagram_widget = new Gtk2::Entry();
my %pool = str2pool($initial_string);
my $hbox = new Gtk2::HBox(0);
my $remainder_table = new Gtk2::Table(1,26,0);
my %remainder_table_map = ();

if (1) {
	my $alphabet = "abcdefghijklmnopqrstuvwxyz";
	
	for(my $i = 0; $i < 26; $i++){
		my $char = substr($alphabet, 0, 1);
		$alphabet = substr($alphabet, 1, length($alphabet) - 1);
		$remainder_table_map{$char} = $i;
	}
}

if (defined $remainder_table){
	$remainder_table->{"resize-mode"} = 'queue';
	set_remainder_table(\%pool);
	$remainder_table->show();
}

sub set_remainder_table {
	my $pool_ref = shift;

	if (!defined($pool_ref)){
		return;
	}

	$remainder_table->hide();

	# Clean out the table except for the column headers
	$remainder_table->resize(1, 26);
	for my $child ($remainder_table->get_children()) {
		$remainder_table->remove($child);
	}

	# Calculate the max count of any given letter
	my $max_count = 0;
	for my $char (sort keys %{$pool_ref}) {
		$max_count = maximum($remainder_table_map{$char}, $max_count);
	}

	if ($max_count < 1){
		$max_count = 1;
	}

	# Resize the table to have max_count + 1 rows
	$remainder_table->resize($max_count, 26);

	# Fill out the rows/columns
	for my $char (sort keys %{$pool_ref}) {
		my $i = $remainder_table_map{$char};

		for (my $j = 0; $j < $$pool_ref{$char}; $j++){
			my $label = new Gtk2::Label($char);
			$label->show();
			$remainder_table->attach($label, $i, $i + 1, $j, $j + 1,
									 ['fill','shrink'], ['fill'], 0, 0);
		}
	}
	
	# Show the remainder table again
	$remainder_table->show();
}

if (defined $pool_widget){
	$pool_widget->set_text($initial_string);
	$pool_widget->signal_connect("insert-text" => \&pool_insert);
	$pool_widget->signal_connect("delete-text" => \&pool_remove);
	$pool_widget->set_sensitive(1);
	$pool_widget->show();
}

if (defined $anagram_widget){
	$anagram_widget->set_text("");
	$anagram_widget->signal_connect("insert-text" => \&anagram_insert);
	$anagram_widget->signal_connect("delete-text" => \&anagram_remove);
	$anagram_widget->set_sensitive(1);
	$anagram_widget->show();
}


$window->signal_connect("delete_event" => sub { Gtk2->main_quit(); } );
$window->set_border_width(15);
$window->set_position('center');
$window->set_default_size(608,0);
$window->set_title("Anagram Maker");
$window->add($hbox);


my $vbox = new Gtk2::VBox(0);

my $label = new Gtk2::Frame('Original:');
$label->add($pool_widget);
$label->show();
$vbox->pack_start($label, 0, 1, 2);

$label = new Gtk2::Frame('Anagram:');
$label->add($anagram_widget);
$label->show();
$vbox->pack_start($label, 0, 1, 2);

$vbox->show();

$hbox->pack_start($vbox, 1, 1, 2); # Text "column"

$label = new Gtk2::Frame('Remainder:');
$label->add($remainder_table);
$label->show();

$hbox->pack_end($label, 0, 0, 2); # Remainder "column"

$hbox->show();
$window->show();

Gtk2->main();
exit(0);

#
# Pool Callbacks
#
sub pool_insert
{
	my ($pool_w, $new_text, $new_text_len, $position) = @_;
	my %text_pool = str2pool($new_text);

    # Unlike removal, insertion always succeeds
	pool_add(\%pool, \%text_pool);
	set_remainder_table(\%pool);
#	return $position;
}

sub pool_remove
{
	my ($pool_w, $start_pos, $end_pos) = @_;
	my $anagram_text = $anagram_widget->get_chars(0, -1);
	my $pool_str = "";

	if ($start_pos > 0){
		$pool_str = $pool_w->get_chars(0, $start_pos);
	}

	if ($end_pos > 0) {
		$pool_str = $pool_str . $pool_w->get_chars($end_pos, -1);
	}

	%pool = str2pool($pool_str);

	$anagram_text = str_clip($anagram_text, \%pool);
	$anagram_widget->set_text($anagram_text); # This triggers anagram_insert!!
	set_remainder_table(\%pool);
#	return $start_pos;
}

#
# Anagram Callbacks
#
sub anagram_insert
{
	my ($anagram_w, $new_text, $new_text_len, $position) = @_;
	my %text_pool = str2pool($new_text);

	# Can only insert from pool
	if (is_pool_subset(\%text_pool, \%pool)){
#		print "Removing " . pool2str(\%text_pool) . " from pool.\n";
		pool_subtract(\%pool, \%text_pool);
	} else {
		# cause insertion to fail completely -- this is probably more intuitive
		# than clipping the new_text and inserting that (and less complicated to
		# code).
		$anagram_w->signal_stop_emission_by_name("insert-text");
		return;
	}

	set_remainder_table(\%pool);
#	return $position;
}

sub anagram_remove
{
	my ($anagram_w, $start_pos, $end_pos) = @_;
	my %text_pool = str2pool($anagram_w->get_chars($start_pos, $end_pos));
	
#	print "Returning " . pool2str(\%text_pool) . " to pool.\n";
	pool_add(\%pool, \%text_pool);
	set_remainder_table(\%pool);
#	return $start_pos;
}