anags.pl This is a xchat2 plugin. Get dict.txt from http://xomnom.com/dict.txt

anags.pl

#!/usr/bin/perl
#
# Anagrams game script by Xomnom
#   last modified: 2010 Mar. 4
use strict;
use Math::Random::MT::Perl qw(srand rand);
my $version = '1.8';
Xchat::register 'ANAGS', $version, '', '';
srand();
my $status = 0;
my $dict_file = Xchat::get_info('xchatdir').'/dict.txt';  # get from http://xomnom.com/dict.txt
my $points_file = Xchat::get_info('xchatdir').'/anapts.txt';
my $instrurl = 'http://xomnom.com/anagrules.txt';
my %words = ();
my %lifetime = ();
my %scorers = ();
my @tiles = ();
my @table = ();
my %melds = ();
my $timer_channel = "ERROR";
my $timer_hook = "ERROR";

# load dictionary
if (open RDICT, '<', $dict_file) {
    my @entry = ();
    foreach my $line (<RDICT>) {
        if ($line) {
            @entry = split /\||\n/, $line;
            $words{$entry[1]} = $entry[0];
        }
    }
    close RDICT;
} else {
    $status--;
    Xchat::print '-- Failed reading \'dict.txt\'!';
}

# load lifetime points
if (open RPTS, '<', $points_file) {
    my @entry = ();
    foreach my $line (<RPTS>) {
        if ($line) {
            @entry = split /\||\n/, $line;
            $lifetime{$entry[1]} = $entry[0];
        }
    }
    close RPTS;
} elsif (open WPTS, '>', $points_file) {
    close WPTS;
    Xchat::print '-- \'anapts.txt\' not found!  Created blank \'anapts.txt\'.';
} else {
    $status--;
    Xchat::print '-- Failed reading or writing \'anapts.txt\'!';
}

# start listener
if ($status == 0) {
    Xchat::hook_print 'Channel Message', 'chanmsg';
    restore();
    Xchat::print "-- ANAGS v$version loaded successfully.";
} else {
    Xchat::print "-- ANAGS v$version failed to load!  status: $status";
}

# main handler
sub chanmsg {
    my @msg_words = split / /, lc $_[0][1];
    my $player = Xchat::strip_code $_[0][0];
    my $channel = Xchat::get_info 'channel';
    if ($msg_words[0] eq '!anag') {
        if ($status == 1) {
            $timer_channel = $channel;
            $status = 2;
            Xchat::command "msg $channel -- ANAGS v$version; instructions: $instrurl";
            $timer_hook = Xchat::hook_timer 2400, 'draw';
        } else {
            Xchat::command "msg $channel -- Not ready!";
        }
    } elsif ($status > 1) {
        if ($msg_words[0] eq '!quit') {
            Xchat::unhook $timer_hook;
            record();
            restore();
            Xchat::command "msg $channel -- Stopped.";
        } elsif ('=' eq substr $msg_words[0], 0, 1) {
            my $guess = substr $msg_words[0], 1;
            if (length($guess) < 4) {
                Xchat::command "msg $channel -- $player: sorry, '$guess' is too short.";
            } elsif (length($guess) > 15) {
                Xchat::command "msg $channel -- $player: sorry, '$guess' is too long.";
            } elsif ((defined $msg_words[1]) and ($guess eq $msg_words[1].'d') and (substr($msg_words[1], -1) eq 'e')) {
                Xchat::command "msg $channel -- $player: sorry, can't just append 'd' after 'e'.";
            } elsif ((defined $msg_words[1]) and ($guess eq $msg_words[1].'s')) {
                Xchat::command "msg $channel -- $player: sorry, can't just append 's'.";
            } elsif (not ((defined $msg_words[1]) and (length($guess) == length($msg_words[1])))) {
                if (exists $words{$guess}) {
                    my $pile = $guess;
                    my $k = -1;
                    for (my $i = 1; $i < @msg_words; $i++) {
                        if (exists $melds{$msg_words[$i]}) {
                            foreach my $c (split //, $msg_words[$i]) {
                                $k = index $pile, $c;
                                if ($k == -1) {
                                    $pile = '!';
                                    last;
                                } else {
                                    $pile = substr($pile, 0, $k).substr($pile, $k + 1);
                                }
                            }
                        } else {
                            $pile = '!';
                            last;
                        }
                        last if ($pile eq '!');
                    }
                    if ($pile ne '!') {
                        my $longcat = "@table";
                        foreach my $c (split //, $pile) {
                            $k = index $longcat, $c;
                            if ($k == -1) {
                                $longcat = '!';
                                last;
                            } else {
                                $longcat = substr($longcat, 0, $k).substr($longcat, $k + 1);
                            }
                        }
                        if ($longcat ne '!') {
                            if (exists $melds{$guess}) {
                                Xchat::command "msg $channel -- $melds{$guess} already has '$guess'; no duplicates allowed."
                            } else {
                                @table = ();
                                foreach my $c (split //, $longcat) {
                                    push @table, $c if $c =~ /[a-z]/;
                                }
                                # that was original in a terrifying way
                                for (my $i = 1; $i < @msg_words; $i++) {
                                    $scorers{$melds{$msg_words[$i]}} -= $words{$msg_words[$i]};
                                    delete $melds{$msg_words[$i]};
                                }
                                $melds{$guess} = $player;
                                $k = $words{$guess};
                                if (exists $scorers{$player}) {
                                    $scorers{$player} += $k;
                                    $longcat = $scorers{$player};
                                    Xchat::command "msg $channel -- $player got $guess($k), and now has $longcat points: free tiles: @table";
                                    my @builder = ();
                                    while (my ($entry, $melder) = each %melds) {
                                        push @builder, $entry.'('.$words{$entry}.')' if $melder eq $player;
                                    }
                                    Xchat::command "msg $channel -- $player\'s words: @builder";
                                } else {
                                    $scorers{$player} = $k;
                                    Xchat::command "msg $channel -- $player got $guess($k), and now has $k points: free tiles: @table";
                                }
                            }
                        }
                    }
                } elsif (exists $scorers{$player}) {
                    $scorers{$player} -= 4;
                    Xchat::command "msg $channel -- '$guess' is not a word (four-point penalty to $player)!"
                }
            }
        }
    }
}

# expose next letter
sub draw {
    Xchat::unhook $timer_hook;
    push @table, pop @tiles;
    if (@tiles > 0) {
        Xchat::command "msg $timer_channel -- Free tiles: @table";
        my $n = 3200 * sqrt(@table) + 8000 - 90 * @tiles;
        $timer_hook = Xchat::hook_timer $n, 'draw';
    } else {
        Xchat::command "msg $timer_channel -- Tile stock depleted; free tiles: @table";
        my $n = 3200 * sqrt(@table) + 16000;
        $timer_hook = Xchat::hook_timer $n, 'stop';
    }
}

sub stop {
    Xchat::unhook $timer_hook;
    record();
    my @max = (-1000);
    my @builder = ();
    while (my ($player, $score) = each %scorers) {
        if ($score > $max[0]) {
            @max = ($score, $player);
        } elsif ($score == $max[0]) {
            push @max, $player;
        }
        push @builder, "$player($score)";
    }
    if (@max > 1) {
        Xchat::command "msg $timer_channel -- Game over; scores: @builder";
        my $score = $max[0];
        for (my $i = 1; $i < @max; $i++) {
            my $player = $max[$i];
            @builder = ();
            while (my ($entry, $melder) = each %melds) {
                push @builder, $entry.'('.$words{$entry}.')' if $melder eq $player;
            }
            my $life = $lifetime{$player};
            Xchat::command "msg $timer_channel -- $player won with $score points and now has $life lifetime points: @builder";
        }
    }
    restore();
}

# store lifetime points
sub record {
    while (my ($player, $score) = each %scorers) {
        if (exists $lifetime{$player}) {
            $lifetime{$player} += $score;
        } else {
            $lifetime{$player} = $score;
        }
    }
    if (open WPTS, '>', $points_file) {
        while (my ($player, $score) = each %lifetime) {
            print WPTS sprintf "%u|%s\n", $score, $player;
        }
        close WPTS;
    } else {
        Xchat::command 'msg Xom -- Failed opening \'anapts.txt\' for write!';
    }
}

# restore initial state
sub restore {
    %scorers = ();
    %melds = ();
    @table = ();
    @tiles = (
        'e', 'e', 'e', 'e', 'e', 'e', 'e', 'e', 'e', 'e', 'e', 'e',
        'a', 'a', 'a', 'a', 'a', 'a', 'a', 'a', 'a',
        'i', 'i', 'i', 'i', 'i', 'i', 'i', 'i', 'i',
        'o', 'o', 'o', 'o', 'o', 'o', 'o', 'o',
        'n', 'n', 'n', 'n', 'n', 'n',
        'r', 'r', 'r', 'r', 'r', 'r',
        't', 't', 't', 't', 't', 't',
        'l', 'l', 'l', 'l', 's', 's', 's', 's',
        'u', 'u', 'u', 'u', 'd', 'd', 'd', 'd',
        'g', 'g', 'g', 'b', 'b', 'c', 'c', 'm', 'm',
        'p', 'p', 'f', 'f', 'h', 'h',
        'v', 'v', 'w', 'w', 'y', 'y',
        'k', 'j', 'x', 'q', 'z'
    );
    my $j = 0;
    for (my $i = $#tiles; $i >= 0; $i--)
    {
        $j = int rand($i + 1);
        @tiles[$i, $j] = @tiles[$j, $i];
    }
    splice @tiles, -10;
    $status = 1;
}