Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

AgentChat

by t0mas (Priest)
on Sep 01, 2000 at 12:44 UTC ( [id://30694]=sourcecode: print w/replies, xml ) Need Help??
Category: Chatterbox Clients
Author/Contact Info t0mas@netlords.net
Description: AgentChat is a chatterbox client. It uses small animated characters to communicate the contents of the chatterbox to the astonished user. These characters, called Agents, are ActiveX components that can be controled by the OLE interface.

See pod for further details.
#!/usr/local/bin/perl -w
#
# AgentChat program
# by t0mas@netlords.net
#
# Version 
# 0.01    Initial release
# 0.02    Changed character loading and added XP checks
# 0.03    Added Babelfish support


# Modules
use strict;
use Win32::OLE;
use Win32::OLE::Variant;
use PerlMonksChat;

# User set vars
use vars qw($user $passwd $sound $checkXP @Characters %Monks);
use vars qw($debug $translate);

####################################################################
# Config section start

# Username and password for PerlMonks (comment out for AM)

$user="your_monk_id";
$passwd="your_monk_passwd";

# Comment out if you don't want xp checks... 

$checkXP="Yup";

# Comment out if you prefer to have a quiet office... 

$sound="Yup";

# Use babelfish to traslate the chat from English to other language
# Babelfish supports French, German, Italian, Portuguese, and 
# Spanish. You must have a text-to-speech engine installed that 
# supports the language of your choise, or the Agents will remain 
# silent (the ballon text will show anyway)
#
# Comment out if you prefer English... 

#$translate='German';

# Debug mode (Offline mode for testing...)
# Comment out if you want real live chat... 

#$debug="Yup";

# Add entries to array to load all the characters you want
# (A fine source of new characters is the MS Agent Ring:
# http://www.msagentring.org/agentchars.html)

@Characters = (
    # Name and animation file (full path or file name if, file is
    # in the default directory, usually %winDir%\msagent\chars)
    {name => 'Merlin', file => 'merlin.acs',},
    {name => 'Peedy',  file => 'peedy.acs',},
    {name => 'Genie',  file => 'genie.acs',},
    {name => 'Robby',  file => 'robby.acs',},
);

# Add entries to hash to make a given monk always pop up as the 
# same character

%Monks = (
    #Monk            # Character to use
    root        =>    'Genie',  # Because he's everywhere
    merlyn        =>    'Merlin', # Because he's a wizard (P+++++)
    chromatic    =>    'Robby',  # Because he shines like chrome
    Corion        =>    'Peedy',  # Because he likes Peedy better... 
);

# Config section end
####################################################################

# Non user vars
use vars qw(@newchat $i $Char $RandomChar $Action $monk %CharNums);
use vars qw($Agent $SpeechLine $PMChat $personalMsg $chatLine);
use vars qw($xpCnt $oldXP $xpChange %Languages $VERSION);

# Version
$VERSION='0.03';

# Languages hash (map language to speech engine)
%Languages = (
    English => 0x0409,
    French => 0x040C, 
    German => 0x0407, 
    Italian => 0x0410, 
    Portuguese => 0x0816, 
    Spanish => 0x0C0A,
);

# Require WWW::Babelfish if we shall translate
if ($translate) {
    if (! eval "require WWW::Babelfish") {
        die "It seems like the Babelfish " .
            "has slipped out of your ear!";
    }
}

# Initialize OLE
Win32::OLE->Initialize(Win32::OLE::COINIT_MULTITHREADED);

# Create a new agent OLE object
$Agent = Win32::OLE->new('Agent.Control.2')
    or die Win32::OLE->LastError();
$Agent->{Connected} = Variant(VT_BOOL, 1);

# Loop all defined Characters
for $i (0..$#Characters) {
    # Load characters
    $Agent->Characters->Load($Characters[$i]{name},
        $Characters[$i]{file})
    or die Win32::OLE->LastError();

    # Insert refs in hash
    $Characters[$i]{agent} = $Agent->Characters(
        $Characters[$i]{name});

    # Turn off sound effects if we don't want sound
    $Characters[$i]{agent}->{SoundEffectsOn} = Variant(VT_BOOL, 0)
        unless ($sound);

    # Set language
    if ($translate && $Languages{$translate}) {
        $Characters[$i]{agent}->{LanguageID}=$Languages{$translate} 
            if defined $sound;
    } else {
        $Characters[$i]{agent}->{LanguageID}=$Languages{English} 
            if defined $sound;
    }

    # Add to Num hash 
    $CharNums{$Characters[$i]{name}} = $i;
}

# Do some startup animation, using first character [0]
$SpeechLine=&addSpeechTags("Welcome to Agent Chat $VERSION");
$Characters[0]{agent}->Show;
$Characters[0]{agent}->Play("Greet");
$Characters[0]{agent}->Speak($SpeechLine);
sleep(5);
$Characters[0]{agent}->Hide;
sleep(5);

# Create a PM chat object
$PMChat=PerlMonksChat->new();
$PMChat->add_cookies;

# Login
if ($user && $passwd) {
    $PMChat->login($user, $passwd);
}

# Set xpCnt to 4 to get XP on first run
$xpCnt=4;

# Eternal loop (use ctrl+c to exit program)
while (1) {

    # Get new chat lines     
    @newchat=($debug)?&debugMessages():$PMChat->getnewlines();

    # Check for xp changes every 60 seconds
    if ($checkXP && ($user && $passwd) && (++$xpCnt == 5)) {

        # Call sub
        $xpChange=&getXP();

        # Put first in @newchat if any changes
        unshift(@newchat,$xpChange) if ($xpChange);

        # Reset getXp counter
        $xpCnt=0;
    }

    # Somebody said something
    if (@newchat) {

        # Random character
        $RandomChar=int(rand(@Characters));

        # Speak each line
        foreach $chatLine (@newchat){

            # Reset personal message flag
            $personalMsg=0;    

            # Find out who said what
            if ($chatLine=~/^<([^>]+)>/) {
                # /msg message
                $monk=$1;    
            } elsif ($chatLine=~/^([^*][^\s]+)/){
                # /me message (doesn't handle spaces in names...)
                $monk=$1;    
            } elsif ($chatLine=~/^\*\s*(.+)\ssays/){
                # Personal message (* nnn says )
                $monk=$1;
                $personalMsg=1;
            } elsif ($chatLine=~/^\*/){
                # The Xp info (* You gained...) is considered personal
                $monk="root";
                $personalMsg=1;
            } else {
                $monk="_FIXME_PLEASE_";    
            }

            # Find out if monk has a predefined character
            if ($Monks{$monk}) {
                # Character for monk
                $Char=$CharNums{$Monks{$monk}};
            } else {
                # Character for other monks
                $Char=$RandomChar;
            }

            # Hide any visible character and wait for the to hide
            # (Agents run multi-threaded...)
            for $i (0..$#Characters) {
                if ($Characters[$i]{agent}->Visible &&
                    $Characters[$i]{name} ne 
                    $Characters[$Char]{name}) {

                    # Hide character and make new character wait
                    $Action=$Characters[$i]{agent}->Hide;
                    $Characters[$Char]{agent}->Wait($Action);
                }
            }

            # Format for speech and maybe translate (kind of...)
            $SpeechLine=&addSpeechTags($chatLine);

            # Show character if not visible
            if (! $Characters[$Char]{agent}->Visible) {
                $Characters[$Char]{agent}->Show;
            } else {
                $Characters[$Char]{agent}->Play("RestPose");
            }

            #
            # Play some animations:
            #  

            # 1. Based on $personalMsg flag
            $Characters[$Char]{agent}->Play("Announce")       
                if ($personalMsg==1);

            # 2. Based on emoticon (smiley) at end of lines
            $Characters[$Char]{agent}->Play("Sad")       
                if ($chatLine=~/['8:;][-~^]*[(cC{]$/);   # :-( 
            $Characters[$Char]{agent}->Play("Pleased")   
                if ($chatLine=~/['8:;][-~^]*[)D>Pb}]$/); # :-) 
            $Characters[$Char]{agent}->Play("Confused")  
                if ($chatLine=~/['8:;][-~^]*[\/]$/);     # :-/ 
            $Characters[$Char]{agent}->Play("Uncertain") 
                if ($chatLine=~/['8:;][-~^]*[I]$/);      # :-I 
            $Characters[$Char]{agent}->Play("Alert")     
                if ($chatLine=~/['8:;][-~^]*[O]$/);      # :-O 
            $Characters[$Char]{agent}->Play("Surprised") 
                if ($chatLine=~/['8:;][-~^]*[o]$/);      # :-o

            # 3. Based on acronym
            $Characters[$Char]{agent}->Play("Pleased") 
                if ($chatLine=~/^lol$/i);     # Laughing Out Loud
            $Characters[$Char]{agent}->Play("Pleased") 
                if ($chatLine=~/^rotfl$/i);   # Rolling On The Floor 
                                   # Laughing 

            # Say message
            $Characters[$Char]{agent}->Speak($SpeechLine);

            # Log to STDOUT
            print "$Characters[$Char]{name} ($monk): $chatLine\n";

            # Pause to wait for user to read message
            sleep(5);
        }

        # Keep character onscreen awhile after speaking
        sleep(5);

        # Hide last character 
        $Characters[$Char]{agent}->Hide;
    }

    # Sleep a while (10 seconds to make vroom happy :)
    sleep(10);
}

####################################################################
sub getXP {

    #
    # Get users XP
    #

    my $xpMsg;
    my $xpDiff;

    # Not in debug mode
    return undef if ($debug);

    # Get xp from PM
    my %XP=$PMChat->xp;

    # Check if we've got something
    if (%XP) {

        # Check for first time use
        if ($oldXP) {

            # Find out diffrence (if any)
            $xpDiff=$XP{xp}-$oldXP;
            if ($xpDiff>0) {
                # Somtimes you win...
                $xpMsg = 
"* You gained $xpDiff experience point(s). :)";
            } elsif ($xpDiff<0) {
                # somtimes you lose...
                $xpMsg =
"* Ack! You lost $xpDiff experience point(s). :(";
            } else {
                # No changes
                $xpMsg = undef;
            }
        } else {
            # Print xp info first time
                $xpMsg =
"* You have $XP{xp} XP points and $XP{xp2nextlevel} points to go until
+" .
" the next level. You have $XP{votesleft} votes left today."; 
        }

        # save oldXP
        $oldXP=$XP{xp};

    } else {
        $xpMsg = 
"* Could not get your XP nodelet. :I";
    }

    # Return xp message
    return $xpMsg;
}

####################################################################
sub addSpeechTags {

    #
    # A try to make message speakable.
    #

    # Receive text as parameter
    my $textToTag = shift || "";

    # Var to hold the babelfish object and the translated text
    my $fish;
    my $tempText;

    # Remove first * from personal messages
    $textToTag =~ s/^\*\s*//; 

    # Change <monk> msg ---> monk says msg
    $textToTag =~ s/^<([^>]+)>/$1 says/;

    # Remove emoticon (smiley) at end of lines
    $textToTag =~ s/['8:;][-~^]*[)(cC{D>\/Pb}IOo]$//; 

    # Try to translate
    if ($translate) {
        if ($ENV{HTTP_proxy}) {
            $fish = new WWW::Babelfish(
                'agent' => 'Mozilla/8.0',
                'proxy' => $ENV{HTTP_proxy});
        } else {
            $fish = new WWW::Babelfish(
                'agent' => 'Mozilla/8.0');
        }

        if (defined($fish)) {
            $tempText = $fish->translate(
                'source' => 'English',
                'destination' => $translate,
                'text' => $textToTag,
                'delimiter' => "\n\t");

            $textToTag=$tempText if defined($tempText);
        }
    }

    # Emphasizes _word_ types of words
    $textToTag =~ s/\s_([^_\s]+)_\s/ \\Emp\\$1 /;

    # Change chr to pronounsables 
    # TODO - Think this over a bit first...
#    $textToTag =~ s/-/\\MAP="minus"="-"\\/;
#    $textToTag =~ s/\+/\\MAP="plus"="\+"\\/;
#    $textToTag =~ s/\*/\\MAP="times"="\*"\\/;
#    $textToTag =~ s/\//\\MAP="divided by"="\/"\\/;
#    $textToTag =~ s/\$/\\MAP="dollar"="\$"\\/;
#    $textToTag =~ s/_/\\MAP="underline"="_"\\/;
#    $textToTag =~ s/{/\\MAP="left curly bracket"="{"\\/;
#    $textToTag =~ s/}/\\MAP="right curly bracket"="}"\\/;
#    $textToTag =~ s/[/\\MAP="left square bracket"="["\\/;
#    $textToTag =~ s/]/\\MAP="right square bracket"="]"\\/;

    # Return tagged text
    return $textToTag;

}

####################################################################
sub debugMessages {

    #
    # A list of common? phrases from the chatterbox
    #

    # Return list
    return ("merlyn wanders off to do some teaching",
            "<KM> guten morgen folks",
            "kudra is just a sugar mouse in the rain...",
            "<merlyn> {grin}",
            "<le> hi KM"
            ); 

}

####################################################################
__END__


=head1 NAME

AgentChat - Chatterbox client using Microsoft Agents

=head1 DESCRIPTION

AgentChat is a chatterbox client. It uses small animated characters 
to communicate the contents of the chatterbox to the astonished 
user.These characters, called Agents, are ActiveX components that 
can be controled by the OLE interface.

WARNING. This software works only on an operating system called 
Microsoft Windows (namly the 95,98,NT, and 2000 flavours). Besides 
this obscure OS you will need to download and install Agents from 
the Microsoft Agent Home at 
http://msdn.microsoft.com/workshop/imedia/agent/default.asp. 
And of cause Perl.

I shamelessly admit that I use a Microsoft OS (MOS). As a MOS user 
I am used to limitations and I know how to reboot my computer. Any 
given RealOS(tm) let the user expand his desktop to a number of 
virtual screens and thus being able to run many space-consuming 
applications. You can have your IDE in one screen, a word processor
in another and your chatterbox client in a third.

As A MOS user I am forced to minimize my IDE to document in my word 
processor and the mimimize my word processor to follow the chat at 
PerlMonks. Thus a MOS user spends half of his/her days minimizing 
and maximizing windows. The other half they chat at PerlMonks.

As any Boss can imagine, having your workers minimizing and 
maximizing all day long, have severe impact on productivity. This 
situation must be delt with with the highest priority. An easy 
solution would be to change the OS to one of those 
virtual-multi-screened-super-stable-free-of-cost OS'es, but that 
would be such a waste of invested funds, as people actually have to 
BUY and pay MONEY for a MOS. So the problem needed to be solved in 
a different way...

AgentChat solves one of the minimize/maximize problems, the 
catterbox one.

Given that you have sucessfully installed a MOS, Microsoft Agent 
and Perl, the fun can begin. Head over to the Config section at 
the top of the program and follow the instructions there to 
configure AgentChat. After you are done, start it up and follow 
the action...

The first thing that's supposed to happen is that a wizard pops up 
on your screen, bows and welcomes you to AgentChat. He will then 
dissapear. A few seconds later another character (or the same one , 
depending on your configuration) pops up and reads the catterbox 
messages. When it's done it will too dissapear, just to pop up again
when a new message has been posted to the chatterbox. You can 
configure AgentChat to output the messages using syntetic speech 
and/or text boxes like in the comics. All this automagically.

As the characters pop up, say a message and dissapears they sort of 
maximize/minimize themeselves, thus releaving the MOS user of one 
heavy task during his/her work hours. 

The MOS users will now only have to do their maximize/minimize 
routines when they want activly participate in chats, using a 
chatterbox of their choise to enter chat messages. This situation 
is addressed in section FUTURE DEVELOPEMT.

Have Fun :) 

=head1 SEE ALSO

L<Win32::OLE>, L<Win32::OLE::Variant>, L<PerlMonksChat>

=head1 BUGS

Probably a few...  

=head1 FUTURE DEVELOPMENT

=over 4

=item *

Input possibilities, either by speech or keyboard

=back

=head1 DISCLAIMER

I do not guarantee B<ANYTHING> with this package. If you use it you
are doing so B<AT YOUR OWN RISK>! I may or may not support this
depending on my time schedule...

=head1 AUTHOR

t0mas@netlords.net

=head1 COPYRIGHT

Copyright 2000, t0mas@netlords.net

This package is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://30694]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others taking refuge in the Monastery: (6)
As of 2024-03-19 03:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found