commit 6f9873733191ef7b27c263b86c824d677833281c Author: Noah Petherbridge Date: Mon Dec 2 12:16:44 2013 -0800 Initial commit for PCCC 3.0 diff --git a/CHANGES.txt b/CHANGES.txt new file mode 100644 index 0000000..8938f9e --- /dev/null +++ b/CHANGES.txt @@ -0,0 +1,171 @@ ++--------------------------+ +| Perl CyanChat Client 2.x | ++--------------------------+ + +3.0 Jun 21 2007 + - Made some changes to the Debug Window: + - The output filehandles (STDOUT; STDERR) are no longer bound to this window; they're + sent to the terminal (if present) like default. + - Only CC packets are displayed in the Debug Window. Server packets are in blue text, + and client packets are in red. + - Changed the default Special Guest color back to orange, and the action color back + to yellow. + - Built in support for "profiles." Your configuration, ignore lists, and chat logs + are now saved in your home directory instead of in PCCC's directory. So on Linux + this means /home/username/.pccc, and WinXP is C:/Documents and Settings/user/PCCC + - Made a minor edit to the Net::CyanChat library, so that it can detect when the + server has banned you from the room. + - Added support for sound effects. It uses the Win32::MediaPlayer module on Windows, + or the system command `play` on Linux. + - Added a "Force Quit" command under the File Menu. It's disabled by default. When + you attempt at least once to exit the program properly, and it for whatever reason + fails to exit, the Force Quit option becomes enabled. Alternatively, the keyboard + shortcut Ctrl+Alt+Q will kill the program. + - Moved the configuration options for MutualIgnore, LoudIgnore, and SendIgnore to + the bottom of the "Ignored Users" tab. + - Created a "Sounds" tab, with configurable options for: + - Enable sounds -- disable this, and all sounds are disabled. + - Play sounds on certain events... + - When a user joins the room + - When a user exits the room + - When a public message is received + - When a private message is received + - Added a "Mute sounds" option to the bottom of the Chat menu. This option will + temporarily disable sounds, but not permanently save this state to your config + file. + - Changed how action messages ("/me") and typo messages appear. The new style is: + Action Messages: ** Nickname performs an action ** + Typo Messages: [Nickname] *their typo correction + All the text is in the action text color except for the nickname, and in the case + of typo messages, the brackets around the nick. In typo corrections, the user's exact + message is shown as usual, just in yellow text instead of silver. + - Reprogrammed the entire help system. It now uses Tk::HyperText and renders HTML + documents from the "docs" folder. Also, added an "About" menu option to the Help menu, + which opens the appropriate page in the Help Viewer. Also, "Help" buttons on the + Preferences window will load the appropriate page in the Help Viewer too. + - Bug fix: when copying/pasting text from an outside source (e.g. from a web page) + into the typing space, the newline characters would be preserved when they shouldn't + be. Sending the message would result in getting banned from Cho. This has been fixed + now, as the characters \x0d (Cr) and \x0a (Lf) are filtered out of your message. + - Bug fix: got rid of the right-click context menus on the Who List. For Windows users, + right-clicking and bringing up this menu would pause the main program loop, effectively + preventing PCCC from polling the server for new events. The GUI would still work just fine, + but the loop wouldn't work anymore. + +2.8 Jun 1 2007 + - Removed the "highlight borders" on the widgets, so that Linux and Mac users don't + have to see those ugly borders around i.e. the "Autoscroll" check box, as well as + buttons and text boxes. + - Redesigned the preferences window. + - Added the option of *not* showing private messages in new IM windows. When the + option is disabled, private messages only show up in IM windows if an IM window + already exists, and the only way to create an IM window is to double-click a name + in the Who List. + - Added right-click context menus to the Who List. Right-clicking a user displays a + context menu along the lines of: + Username:address + ---------------- + Send private message + Ignore user + ... or "Unignore user" if you already ignored them. + - Added an "Ignored Users" tab to the Preferences window, where you can view your + ignore list, adding or removing users if necessary. + - Added "Notifications" -- when a new message arrives (in public chat or private + message windows), and the window is out of focus or minimized, the window title + will animate to get your attention. + - Added an "Auto-logging" option, which will automatically log all messages received + in chat. It saves them into "./logs/yyyy-mm-dd/yyyymmdd-x.html", where yyyymmdd is a + date stamp, and x is a session number starting from 1, which increments each time PCCC + is run. + - Bug Fixes: + - Fixed the "disappearing name" bug (where you'd log in to chat, open the Preferences + window, hit Cancel, and your nick in the Name: box would revert to the "default nick" + from the preferences, which is blank by default). + - Added configuration options: + - TimeStamps: show time stamps on all messages. + - IMWindows: show private messages in new "IM" windows + +2.7 May 23 2007 + - The client now assumes "htmlview" as the default "Browser Command" when you're not + on Windows and there is no config file yet. Otherwise, the default is "start" + +2.6 Apr 14 2007 + - Added the "Browser Command" option, to specify the console command used to open your + web browser. Windows users can just leave this as "start", but Linux users will have + to specify "firefox", "mozilla", or another command. + - Added a "Reverse Orientation" option. Users that are familiar with most traditional + chat programs, in which the message typing space is below the conversation space, + will want to enable this option (in conjunction with unchecking "Reverse chat dialog"). + - Made the Preferences and Enter Raw Command windows a little bit bigger. The "Ok" + button was being squished on Linux, and the Enter Raw Command's buttons weren't even + visible before. + - Updated the help file with information about the new options added. + +2.5 Mar 1 2007 + - Two more Frame widgets added to the user interface. Now the window "scales" better + (when you maximize the window, the input box stays at the top and the dialog window + stretches to fill all the remaining space; previously, the dialog window and input + box would fight for the new space, causing a lot of unnecessary padding above and below + the input box). + - Added hyperlinking support for the main chat dialog window (but not yet for private + message windows). + +2.4 Jan 29 2007 + - Added a checkbutton to enable/disable the automatic scrolling of the chat window when + new messages are received. + - The "Disconnect" menu option is disabled from the start if you are not connected yet, + like it should've been. + - The Who List gets wiped clean when you disconnect from the server. The lack of doing this + used to cause problems where people in the Who List weren't actually in the chat room, + so clearing the list fixes this problem. + - Made sure I don't forget to include the latest version of Net::CyanChat in the source + distribution this time. ;) + +2.3 Nov 7 2006 + - Minor bug fixes. + +2.2 Oct 30 2006 + - Added more color variables: the main window background/foreground and the button + background/foreground is now configurable separate from the rest of the screen. + The WhoList can have a different background than the dialog window. + - The "Save Transcript" now saves the conversation as XHTML, keeping the colors of the chat. + If you save it to a text file, it ignores the formatting (the old behavior of PCCC). + - Action messages have changed display formats: + Old Way: *** [username] action *** + New Way: [username] action in yellow ("action") text color + - Outgoing private messages are echoed in the chat dialog window, even if you sent them in + a separate PM window. + - Added some new configuration options: + - AutoAct: when a message starts and ends with *'s, it will be treated like a /me action. + - LoudTypo: when a message starts with a * (typically for typo corrections), a notification + will be shown about the typo being corrected. + - Added a full documentation system. Click "Help -> Contents" + - Bug fixes: + - Private message windows now auto-scroll. + +2.1 Oct 24 2006 + - Added new configuration options: + - AutoJoin: automatically join the room on connect (if Nickname has a length) + - BlockServer: ignore private messages from ChatServer (when on debug port 1813) + - LoudIgnore: show a notification when somebody blocks you + - SendIgnore: send the ignore command to the server when you ignore somebody + - IgnoreBack: perform a mutual ignore when ignored (ignore the one ingoring you) + - Added the ability to reset the configuration to the defaults. + - The entire window now recolors itself when you change color settings (rather than just + the conversation window) + - A disconnect handler has been added so the client knows when you've been disconnected + from the chat server. + - Added the ability to automatically reconnect on disconnect. This functionality is limited + though. It won't keep trying. But this will solve the quick temporary disconnects experienced + on wireless Internet connections. + - A few bugs have been fixed: + - The Preferences window now has a fixed default width and height. Previously, it + was leaving it up to the window contents to automatically adjust its size, but this + didn't work on *nix platforms and the window was too small. + - The "Connection Details" window has a fixed default width and height too, for same reasons. + - Private Message windows will come back now. Previously, if you opened a private message + window with somebody, then closed that window, you couldn't reopen it (unless the other + person sent you a message to open the window). + +2.0 Oct 1 2006 + - Initial release. diff --git a/PCCC.pl b/PCCC.pl new file mode 100755 index 0000000..73c7f6d --- /dev/null +++ b/PCCC.pl @@ -0,0 +1,3522 @@ +#!/usr/bin/perl -w + +# Perl CyanChat Client 3.0 - A complete rewrite from PCCC 1.x +# (C) 2006-07 Casey Kirsle + +use strict; +use warnings; +use threads; +use threads::shared; + +# Spawn a dedicated hyperlink-launching thread so we don't +# freeze up the MainWindow while a webpage loads. +our @HYPERLINKLIST : shared; +@HYPERLINKLIST = (); +our $HTTPBROWSER : shared; +our $linkthread = threads->create (sub { + print "LinkerThread activated.\n"; + while (1) { + select (undef,undef,undef,0.01); + if (@HYPERLINKLIST) { + my $next = shift @HYPERLINKLIST; + + print "Hyperlink: $next\n"; + + if ($next eq "+shutdown") { + # Shut things down. + print "shutting down link thread\n"; + last; + } + + system ("$HTTPBROWSER $next"); + } + } +}); + +# Spawn a dedicated sound effect playing thread. +our @PLAYSOUNDS : shared; +@PLAYSOUNDS = (); +our $MEDIAPLAYER : shared; +$MEDIAPLAYER = undef; +our $mediathread = threads->create (sub { + print "MediaThread activated.\n"; + + # If this is on Windows, create the media player. + my $win32mplayer = undef; + if ($^O =~ /win(32|64)/i) { + require Win32::MediaPlayer; + } + while (1) { + select (undef,undef,undef,0.01); + if (@PLAYSOUNDS) { + my $next = shift @PLAYSOUNDS; + + print "MPlayer: $next\n"; + + if ($next eq "+shutdown") { + # Shut this thread down. + print "shutting down media player\n"; + last; + } + + # If the play command is undef, we might be on Windows. + if (not defined $MEDIAPLAYER) { + # To see for sure we're on Windows, + # win32mplayer should have a value. + $win32mplayer = new Win32::MediaPlayer; + $win32mplayer->load ("./sfx/$next"); + $win32mplayer->play; + } + else { + # Send this directly to the play command. + system ("$MEDIAPLAYER ./sfx/$next"); + } + } + } +}); + +use lib "./lib"; +use Net::CyanChat; +use Tk; +use Tk::ROText; +use Tk::NoteBook; +use Tk::LabFrame; +use Tk::Pane; +use Tk::Dialog; +use Tk::Balloon; +use Tk::BrowseEntry; +use Tk::HyperText; + +our $MODIFIED = '21 June 2007'; +our $VERSION = '3.0'; # Program Version +our $mw = undef; # MainWindow Object +our %IMAGE = (); # Image Objects +our %menu = (); # Menu Items +our %config = (); # Configuration Data +our $homedir = '.'; # Home directory +our $FONT = []; # Reusable font definitions. +our $chat = undef; # Chat Dialog Object +our $wholist = undef; # WhoList Object +our $adminlist = undef; # Cyan Staff & Guests WhoList +our $connected = 0; # Not Connected +our $loggedin = 0; # Not Logged In +our $mutesfx = 0; # Temporarily mute all sounds +our $netcc = undef; # Net::CyanChat object. +our %online = (); # Online Users List +our %ignore = (); # Ignore List +our %windows = (); # Keep track of child windows. +our %private = (); # Private text widgets. +our %pmsg = (); # Private message variables. +our %pfocus = (); # focus status on private msg windows +our @xhtml = (); # keeps xhtml version for logging +our $dbgtext = undef; # Debug messages text widget +our $tipper = undef; # Tooltip balloon object +our %user = ( # Personal user stuff. + nick => '', + msg => '', +); +our $pOnlineList = undef; # Preferences/Ignore - online users +our $pIgnoreList = undef; # Preferences/Ignore - ignored users +our $hyperlink = 0; # Hyperlink ID incrementer +our $notification = [ # Window notification animation + [ '>', '<' ], + [ '>>', '<<' ], + [ '>>>', '<<<' ], + [ '', '' ], + #[ '==>', '<==' ], + #[ '===', '===' ], + #[ '>==', '==<' ], + #[ '=>=', '=<=' ], + #[ '>=>', '<=<' ], + #[ '=>=', '=<=' ], +]; +our $winanim = {}; # Window animation phases. +our $autologid = 0; # ID to stick with for autologging. +our $htmlhelp = undef; # Help page HTML widget +our @helphistory = (); # Help page history +our $helpPage = "index.html"; +our $controlFrame = undef; +our $mainFrame = undef; +our $rightFrame = undef; +our $btnFrame = undef; +our $whoFrame = undef; +our $chatFrame = undef; +our $msgboxFrame = undef; +our $dialogFrame = undef; + +############################################ +## Initialization ## +############################################ +&init(); + +sub init { + # Detect operating systems. + &initOS(); + + # Load configuration. + &initConfig(); + + # Draw the GUI. + &initGUI(); + + # Run the main loop. + &loop(); +} + +sub initOS { + # Find our operating system. + my $os = $^O; + + print "Detecting your OS... $os\n"; + + my $homename = '.pccc'; + if ($os =~ /win(32|64)/i) { # Microsoft Windows + # HTTP Browser command = `start` by default. + # MediaPlayer = undef (use Win32::MediaPlayer instead) + $HTTPBROWSER = "start"; + $MEDIAPLAYER = undef; + $homename = "PCCC"; + } + elsif ($os =~ /linux/i || $os =~ /unix/i) { # Linux, probably + # HTTP Browser command = `htmlview` by default. + # MediaPlayer = `play` by default. + $HTTPBROWSER = "htmlview"; + $MEDIAPLAYER = "play"; + $homename = ".pccc"; + } + else { + # Unknown OS (possibly Mac), use the same defaults as Linux. + $HTTPBROWSER = "htmlview"; + $MEDIAPLAYER = "play"; + $homename = ".pccc"; + } + + # Detect our home directory. + my $home = $ENV{HOME} || $ENV{HOMEDIR} || $ENV{USERPROFILE} || ''; + $home =~ s~\\~/~g; # Fix Win32 paths. + + print "Detecting your home directory... $home\n"; + + # If we have one... + if (length $home) { + # See if PCCC has a folder. + if (!-d "$home/$homename") { + # No. Make it. + print "Making home directory $home/$homename\n"; + mkdir ("$home/$homename") or warn "Can't create config directory at " + . "$home/$homename: $!"; + } + + # Now if it does... + if (-d "$home/$homename") { + # Set this as our home directory. + print "Setting home directory to $home/$homename\n"; + $homedir = "$home/$homename"; + } + } +} + +sub initGUI { + # Create a Tk MainWindow. + our $mw = MainWindow->new ( + -title => "Perl CyanChat Client", + ); + $mw->geometry ('640x480'); + $mw->optionAdd ('*tearOff','false'); + $mw->optionAdd ('*highlightThickness','0'); + $mw->protocol ('WM_DELETE_WINDOW', \&shutdown); + + # Load application icons. + foreach (qw(worlds web balloon)) { + $IMAGE{$_} = $mw->Photo (-file => "./$_\.gif", -format => 'GIF', -width => 32, -height => 32); + } + + # Set the appicon. + $mw->Icon (-image => $IMAGE{worlds}); + + # Create the tooltip object. + $tipper = $mw->Balloon ( + -balloonposition => 'mouse', + -foreground => '#000000', + -background => '#FFFFCC', + ); + + # Setup the notification animation states. + $winanim->{__mainwindow__} = { + title => 'Perl CyanChat Client', + focused => -1, + animating => 0, + phase => 0, + proceed => 0, + }; + $mw->bind ('', sub { + $winanim->{__mainwindow__}->{focused} = 1; + &animReset("__mainwindow__"); + }); + $mw->bind ('', sub { + $winanim->{__mainwindow__}->{focused} = 0; + }); + + # Create the debugging window (which shows all packets) + $windows{__debug__} = $mw->Toplevel ( + -title => 'Debug Window', + ); + $windows{__debug__}->geometry ('320x240'); + $windows{__debug__}->Icon (-image => $IMAGE{web}); + $windows{__debug__}->withdraw; + $windows{__debug__}->protocol ('WM_DELETE_WINDOW', sub { + return 0; + }); + my $dbgBtm = $windows{__debug__}->Frame->pack (-fill => 'x', -side => 'bottom'); + my $dbgTop = $windows{__debug__}->Frame->pack (-fill => 'both', -expand => 1, -side => 'top'); + + # Create the debug window's text viewer. + $dbgtext = $dbgTop->Scrolled ('ROText', + -scrollbars => 'e', + -foreground => '#000000', + -background => '#FFFFFF', + -wrap => 'word', + -font => [ + -family => 'Courier New', + -size => 10, + ], + )->pack (-fill => 'both', -expand => 1); + $dbgtext->tagConfigure ("server", -foreground => '#0000FF'); + $dbgtext->tagConfigure ("client", -foreground => '#FF0000'); + my $realtext = $dbgtext->Subwidget ('rotext'); + + # Create the debug window buttons. + $dbgBtm->Button ( + -text => 'Dismiss', + -command => sub { + $windows{__debug__}->withdraw; + }, + )->grid (-column => 0, -row => 0, -padx => 10, -pady => 2); + $dbgBtm->Button ( + -text => 'Clear', + -command => sub { + $dbgtext->delete ('0.0','end'); + }, + )->grid (-column => 1, -row => 0, -padx => 10, -pady => 2); + + # Create the menu bar. + $menu{master} = $mw->Menu ( + -type => 'menubar', + ); + $mw->configure (-menu => $menu{master}); + + $menu{filemenu} = $menu{master}->cascade ( + -label => '~File', + ); + + $menu{filemenu}->command (-label => '~Save Transcript', -accelerator => 'Ctrl+S', -command => sub { + #print "xhtml\n" . join ("\n",@xhtml); + my $file = $mw->getSaveFile ( + -initialdir => '.', + -defaultextension => '.html', + -filetypes => [ + [ 'HTML Document', '*.html' ], + [ 'Text Document', '*.txt' ], + [ 'All Files', '*.*' ], + ], + ); + + return unless defined $file; + + if ($file =~ /\.txt$/i) { + # Save as plain text. + open (SAVE, ">$file"); + print SAVE $chat->get('1.0','end'); + close (SAVE); + } + else { + # Save as HTML. + &saveHTML ($file); + } + }); + + $menu{filemenu}->command (-label => '~Clear Chat', -command => sub { + # Do autologging first. + &doAutolog(); + + # Reset our autolog ID (start a new session) + $autologid = 0; + + # Clear the chat and XHTML buffer. + $chat->see ('0.0'); + $chat->delete ('0.0','end'); + @xhtml = (); + }); + + $menu{filemenu}->separator; + + $menu{forcequit} = $menu{filemenu}->command (-label => '~Force Quit', -accelerator => 'Ctrl+Alt+Q', + -state => 'disabled', -command => sub { + exit(0); + }); + + $menu{filemenu}->command (-label => '~Exit', -accelerator => 'Alt+F4', -command => sub { + &shutdown(); + }); + + $menu{editmenu} = $menu{master}->cascade ( + -label => '~Edit', + ); + + $menu{editmenu}->command (-label => '~Copy', -accelerator => 'Ctrl+C', -command => sub { + $chat->Column_Copy_or_Cut (0); + }); + + $menu{editmenu}->command (-label => '~Find...', -accelerator => 'Ctrl+F', -command => sub { + $chat->findandreplacepopup (1); + }); + + $menu{editmenu}->command (-label => '~Select All', -accelerator => 'Ctrl+A', -command => sub { + $chat->selectAll(); + }); + + $menu{editmenu}->command (-label => '~Unselect All', -command => sub { + $chat->unselectAll(); + }); + + $menu{chatmenu} = $menu{master}->cascade ( + -label => '~Chat', + ); + + $menu{connect} = $menu{chatmenu}->command (-label => '~Connect', -command => sub { + &connect(); + }); + $menu{disconnect} = $menu{chatmenu}->command (-label => '~Disconnect', -state => 'disabled', -command => sub { + &disconnect(); + }); + + $menu{details} = $menu{chatmenu}->command (-label => 'Connection Detail~s', -state => 'disabled', -command => sub { + if (exists $windows{__condetails__}) { + $windows{__condetails__}->focusForce; + } + else { + $windows{__condetails__} = $mw->Toplevel ( + -title => 'Connection Details', + ); + $windows{__condetails__}->Icon (-image => $IMAGE{web}); + $windows{__condetails__}->bind ('', sub { + delete $windows{__condetails__}; + }); + + my $serv = '(Custom)'; + my $port = '(Custom)'; + + if ($config{chathost} eq 'cho.cyan.com') { + $serv = '(Cyan Worlds)'; + } + if ($config{chatport} == 1812) { + $port = '(Default)'; + } + elsif ($config{chatport} == 1813) { + $port = '(Testing)'; + } + + $windows{__condetails__}->Label ( + -text => 'Chat Server:', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 0, -row => 0, -sticky => 'e'); + + $windows{__condetails__}->Label ( + -textvariable => \$config{chathost}, + -font => $FONT, + )->grid (-column => 1, -row => 0, -sticky => 'w'); + + $windows{__condetails__}->Label ( + -textvariable => \$serv, + -font => $FONT, + )->grid (-column => 2, -row => 0, -sticky => 'w'); + + $windows{__condetails__}->Label ( + -text => 'Chat Port:', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 0, -row => 1, -sticky => 'e'); + + $windows{__condetails__}->Label ( + -textvariable => \$config{chatport}, + -font => $FONT, + )->grid (-column => 1, -row => 1, -sticky => 'w'); + + $windows{__condetails__}->Label ( + -textvariable => \$port, + -font => $FONT, + )->grid (-column => 2, -row => 1, -sticky => 'w'); + + $windows{__condetails__}->Label ( + -text => 'Status:', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 0, -row => 2, -sticky => 'e'); + + $windows{__condetails__}->Label ( + -text => 'Connected.', + -font => $FONT, + )->grid (-column => 1, -row => 2, -sticky => 'w'); + + $windows{__condetails__}->Button ( + -text => 'Close', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + -command => sub { + $windows{__condetails__}->destroy; + }, + )->grid (-column => 0, -columnspan => 3, -row => 3, -sticky => 'n'); + + $windows{__condetails__}->focusForce; + } + }); + + $menu{chatmenu}->separator; + + $menu{chatmenu}->command (-label => '~Open Console', -command => sub { + $windows{__debug__}->deiconify; + $dbgtext->see ('end'); + }); + + $menu{rawmenu} = $menu{chatmenu}->command (-label => '~Send Raw Command', -state => 'disabled', -command => sub { + my $win = $mw->Toplevel ( + -title => 'Send Raw Command', + ); + $win->geometry ('400x100'); + $win->Icon (-image => $IMAGE{web}); + + $win->Label ( + -text => "Use this tool to send a raw command directly to CyanChat.\n" + . "Only use this if you know what you're doing. If you get banned\n" + . "from CyanChat for sending a bad command, it's not my fault.", + )->pack; + my $packet = ''; + $win->Entry ( + -textvariable => \$packet, + )->pack (-fill => 'x'); + + my $frame = $win->Frame->pack (-fill => 'x'); + + $frame->Button ( + -text => 'Spawn Debug Window', + -command => sub { + $windows{__debug__}->deiconify; + $dbgtext->see ('end'); + }, + )->pack (-side => 'left'); + + $frame->Button ( + -text => 'Send Command', + -command => sub { + $netcc->send ($packet); + $packet = ''; + }, + )->pack (-side => 'left'); + + $frame->Button ( + -text => 'Close', + -command => sub { + $win->destroy; + }, + )->pack (-side => 'left'); + }); + + $menu{chatmenu}->separator; + + $menu{chatmenu}->command (-label => '~Preferences', -accelerator => 'F3', -command => sub { + &prefs(); + }); + + $menu{chatmenu}->separator; + + $menu{chatmenu}->checkbutton ( + -label => '~Mute Sounds', + -variable => \$mutesfx, + -onvalue => 1, + -offvalue => 0, + ); + + $menu{helpmenu} = $menu{master}->cascade ( + -label => '~Help', + ); + + $menu{helpmenu}->command (-label => '~About PCCC', -command => sub { + &help("about.html"); + }); + + $menu{helpmenu}->command (-label => '~Contents', -accelerator => 'F1', -command => sub { + &help(); + }); + + $menu{helpmenu}->separator; + + $menu{linkmenu} = $menu{helpmenu}->cascade ( + -label => '~Links', + ); + + $menu{linkmenu}->command (-label => '~PCCC Homepage', -command => sub { + push (@HYPERLINKLIST, "http://www.cuvou.com/?module=pccc"); + }); + + $menu{linkmenu}->command (-label => '~SourceForge Project Page', -command => sub { + push (@HYPERLINKLIST, "http://www.sourceforge.net/projects/perlccc"); + }); + + $menu{linkmenu}->command (-label => '~Cuvou.com', -command => sub { + push (@HYPERLINKLIST, "http://www.cuvou.com/"); + }); + + $menu{linkmenu}->separator; + + $menu{linkmenu}->command (-label => 'CyanChat ~Homepage', -command => sub { + push (@HYPERLINKLIST, "http://cho.cyan.com/chat/"); + }); + + $menu{linkmenu}->command (-label => 'CC P~rogrammers', -command => sub { + push (@HYPERLINKLIST, "http://cho.cyan.com/chat/programmers.html"); + }); + + $menu{linkmenu}->command (-label => 'Cyan ~Worlds', -command => sub { + push (@HYPERLINKLIST, "http://www.cyanworlds.com/"); + }); + + $menu{linkmenu}->separator; + + $menu{linkmenu}->command (-label => 'CC ~Quote Database', -command => sub { + push (@HYPERLINKLIST, "http://cyanchat.dnijazzclub.com/"); + }); + + # Create the layout Frames. + $controlFrame = $mw->Frame ( + -background => $config{windowbg}, + )->pack (-side => 'top', -fill => 'x'); + $mainFrame = $mw->Frame ( + -background => $config{windowbg}, + )->pack (-side => 'top', -fill => 'both', -expand => 1); + $rightFrame = $mainFrame->Frame ( + -background => $config{windowbg}, + )->pack (-side => 'right', -fill => 'y'); + $btnFrame = $rightFrame->Frame ( + -background => $config{windowbg}, + )->pack (-side => 'bottom', -fill => 'x'); + $whoFrame = $rightFrame->Frame ( + -background => $config{windowbg}, + )->pack (-side => 'bottom', -fill => 'both', -expand => 1); + + $chatFrame = $mainFrame->Frame ( + -background => $config{windowbg}, + )->pack (-side => 'right', -fill => 'both', -expand => 1); + + my $msgSide = $config{orientation} || 'top'; + $msgSide = 'top' unless $msgSide eq 'bottom'; + + if ($msgSide eq 'top') { + $msgboxFrame = $chatFrame->Frame ( + -background => $config{windowbg}, + )->pack (-side => 'top', -fill => 'x'); + $dialogFrame = $chatFrame->Frame ( + -background => $config{windowbg}, + )->pack (-side => 'top', -fill => 'both', -expand => 1); + } + else { + $msgboxFrame = $chatFrame->Frame ( + -background => $config{windowbg}, + )->pack (-side => 'bottom', -fill => 'x'); + $dialogFrame = $chatFrame->Frame ( + -background => $config{windowbg}, + )->pack (-side => 'bottom', -fill => 'both', -expand => 1); + } + + ########################## + # Control Frame # + ########################## + + $controlFrame->Label ( + -image => $IMAGE{worlds}, + -border => 2, + -relief => 'raised', + )->pack (-side => 'left', -pady => 0, -padx => 0); + + $menu{loginlabel} = $controlFrame->Label ( + -text => "Name:", + -foreground => $config{windowfg}, + -background => $config{windowbg}, + -font => $FONT, + )->pack (-side => 'left', -padx => 2); + + $menu{logintext} = $controlFrame->Entry ( + -textvariable => \$user{nick}, + -foreground => $config{inputfg}, + -background => $config{inputbg}, + -disabledforeground => $config{windowfg}, + -disabledbackground => $config{windowbg}, + -width => 20, + -font => $FONT, + -highlightthickness => 0, + )->pack (-side => 'left', -padx => 2); + + $menu{loginbttn} = $controlFrame->Button ( + -text => 'Join Chat', + -foreground => $config{buttonfg}, + -background => $config{buttonbg}, + -activeforeground => $config{buttonfg}, + -activebackground => $config{buttonbg}, + -disabledforeground => $config{disabledfg}, + -state => 'disabled', + -font => $FONT, + -command => \&enterChat, + -highlightthickness => 0, + )->pack (-side => 'left', -padx => 2); + + $menu{constatus} = $controlFrame->Label ( + -text => 'Not connected to CyanChat.', + -foreground => $config{clientcolor}, + -background => $config{windowbg}, + -font => $FONT, + )->pack (-side => 'left', -padx => 2); + + ########################## + # Who Frame # + ########################## + + my $autobttnFrame = $btnFrame->Frame ( + -background => $config{windowbg}, + )->pack (-fill => 'x'); + + $menu{autobttn} = $autobttnFrame->Checkbutton ( + -text => 'Autoscroll', + -foreground => $config{buttonfg}, + -background => $config{buttonbg}, + -activeforeground => $config{buttonfg}, + -activebackground => $config{buttonbg}, + -font => $FONT, + -variable => \$config{autoscroll}, + -highlightthickness => 0, + )->pack (-side => 'left', -fill => 'x', -padx => 2, -pady => 1); + + my $tsFrame = $btnFrame->Frame ( + -background => $config{windowbg}, + )->pack (-fill => 'x'); + + $menu{timebttn} = $tsFrame->Checkbutton ( + -text => 'Time stamps', + -foreground => $config{buttonfg}, + -background => $config{buttonbg}, + -activeforeground => $config{buttonfg}, + -activebackground => $config{buttonbg}, + -font => $FONT, + -variable => \$config{timestamps}, + -highlightthickness => 0, + -command => sub { + my @opts = ( + -foreground => $config{background}, + -elide => 1, + ); + if ($config{timestamps} == 1) { + @opts = ( + -foreground => $config{servercolor}, + -elide => 0, + ); + } + $chat->tagConfigure ("timestamp", + -font => [ + @{$FONT}, + -size => 8, + ], + @opts, + ); + }, + )->pack (-side => 'left', -fill => 'x', -padx => 2, -pady => 1); + + $menu{privatebttn} = $btnFrame->Button ( + -text => 'Send Private', + -foreground => $config{buttonfg}, + -background => $config{buttonbg}, + -activeforeground => $config{buttonfg}, + -activebackground => $config{buttonbg}, + -disabledforeground => $config{disabledfg}, + -state => 'disabled', + -font => $FONT, + -command => \&sendPrivate, + -highlightthickness => 0, + )->pack (-fill => 'x', -padx => 2, -pady => 1); + + $menu{ignorebttn} = $btnFrame->Button ( + -text => 'Ignore', + -foreground => $config{buttonfg}, + -background => $config{buttonbg}, + -activeforeground => $config{buttonfg}, + -activebackground => $config{buttonbg}, + -disabledforeground => $config{disabledfg}, + -state => 'disabled', + -font => $FONT, + -command => \&ignoreUser, + -highlightthickness => 0, + )->pack (-fill => 'x', -padx => 2, -pady => 1); + + my $admnFrame = $whoFrame->Frame ( + -background => $config{windowbg}, + )->pack (-side => 'bottom', -fill => 'x'); + + $admnFrame->Label ( + -text => 'Cyan & Guests:', + -foreground => $config{windowfg}, + -background => $config{windowbg}, + -font => $FONT, + )->pack (-side => 'top', -anchor => 'w'); + + $adminlist = $admnFrame->Scrolled ('Listbox', + -foreground => $config{foreground}, + -background => $config{whobg}, + -scrollbars => 'osoe', + -height => 5, + -font => $FONT, + -selectforeground => '#000000', + -selectbackground => '#CCCCFF', + -highlightthickness => 0, + )->pack (-side => 'top', -fill => 'x'); + + my $wholistFrame = $whoFrame->Frame ( + -background => $config{windowbg}, + )->pack (-side => 'bottom', -fill => 'both', -expand => 1); + + $menu{wholabel} = $wholistFrame->Label ( + -text => 'Who is online:', + -foreground => $config{windowfg}, + -background => $config{windowbg}, + -font => $FONT, + )->pack (-side => 'top', -anchor => 'w'); + + $wholist = $wholistFrame->Scrolled ('Listbox', + -foreground => $config{foreground}, + -background => $config{whobg}, + -scrollbars => 'osoe', + -font => $FONT, + -selectforeground => '#000000', + -selectbackground => '#CCCCFF', + -highlightthickness => 0, + )->pack (-side => 'top', -fill => 'both', -expand => 1); + + # Bind the Who List for right-clicking and middle-clicking. + $wholist->bind ('', \&wholistRightClick); + $wholist->bind ('', \&wholistMiddleClick); + $wholist->bind ('', \&sendIM); + + # Bind the special Who List too. + $adminlist->bind ('', [\&wholistRightClick,"admin"]); + $adminlist->bind ('', \&wholistMiddleClick); + $adminlist->bind ('', \&adminlistSendIM); + + $menu{msgbox} = $msgboxFrame->Entry ( + -textvariable => \$user{msg}, + -foreground => $config{inputfg}, + -background => $config{inputbg}, + -disabledforeground => $config{windowfg}, + -disabledbackground => $config{windowbg}, + -state => 'disabled', + -width => 20, + -font => $FONT, + -highlightthickness => 0, + )->pack (-fill => 'x', -expand => 1); + + $chat = $dialogFrame->Scrolled ('ROText', + -foreground => $config{foreground}, + -background => $config{background}, + -scrollbars => 'ose', + -wrap => 'word', + -font => $FONT, + -highlightthickness => 0, + )->pack (-fill => 'both', -expand => 1); + + # Bind all the tags. + &bindChatTags(); + + # Add some introductory messages. + &sendLine (from => 'ChatClient', color => 'client', message => "Welcome to Perl CyanChat Client v. $VERSION!"); + + ########################## + # Key Bindings # + ########################## + + $mw->bind ('', \&bind_return); + $mw->bind ('', sub { + my $file = $mw->getSaveFile ( + -initialdir => '.', + -defaultextension => '.html', + -filetypes => [ + [ 'HTML Document', '*.html' ], + [ 'Text Document', '*.txt' ], + [ 'All Files', '*.*' ], + ], + ); + + return unless defined $file; + + if ($file =~ /\.txt$/i) { + # Save as plain text. + open (SAVE, ">$file"); + print SAVE $chat->get('1.0','end'); + close (SAVE); + } + else { + # Save as HTML. + &saveHTML ($file); + } + }); + $mw->bind ('', \&shutdown); + $mw->bind ('', sub { + $chat->findandreplacepopup (1); + }); + $mw->bind ('', sub { + $chat->selectAll; + }); + $mw->bind ('', sub { + &help(); + }); + $mw->bind ('', \&prefs); + $mw->bind ('', sub { exit(0); }); + + if ($config{autoconnect} == 1) { + &connect(); + } +} + +sub initConfig { + my $skip = shift || 'no'; + + # Specify the default settings in case there is no config file present. + %config = ( + chathost => 'cho.cyan.com', # ChatHost = the CyanChat server hostname + chatport => 1812, # ChatPort = the CyanChat server port + autoconnect => 0, # AutoConnect = automatically connect on startup + reconnect => 1, # ReConnect = automatically reconnect on disconnect + dialogfont => 'Arial', # DialogFont = the font for the CyanChat dialog widgets + reversechat => 1, # ReverseChat = new messages on top (default) + fontsize => 10, # FontSize = font size + autoscroll => 1, # AutoScroll = automatically scroll on new messages + nickname => '', # Nickname = a default value for nick + autojoin => 0, # AutoJoin = automatically join the chat (if length Nickname) + blockserver => 0, # BlockServer = ignore ChatServer's messages + ignoreback => 1, # IgnoreBack = perform mutual ignore + loudignore => 1, # LoudIgnore = show messages when people ignore you + sendignore => 1, # SendIgnore = send the ignore command when ignoring + autoact => 1, # AutoAct = *..* messages are /me equivalents + loudtypo => 1, # LoudTypo = show notifications about typo's + browser => $HTTPBROWSER, # Browser = console command to link URLs + orientation => 'top', # Orientation = input box's position + timestamps => 0, # TimeStamps = show timestamps on messages + imwindows => 1, # IMWindows = show "IM" style windows for private messages + stickyignore => 0, # StickyIgnore = remember who I ignored + notifyanimate => 1, # NotifyAnimate = animate the window titles for notifications + autologging => 0, # Autologging = automatically log chat dialog + mediaplayer => "play", # MediaPlayer = MPlayer program (not applicable to Windows) + playsounds => 1, # PlaySounds = global sound playing switch + playjoin => 1, # PlayJoin = play sound when user joins + playleave => 1, # PlayLeave = play sound when user leaves + playpublic => 0, # PlayPublic = play sound on public message + playprivate => 1, # PlayPrivate = play sound on private message + joinsound => "link.wav", # JoinSound = sound effect when user enters the room + leavesound => "link.wav", # LeaveSound = sound effect when user leaves the room + publicsound => "ding.wav", # PublicSound = sound effect to play on public message + privatesound => "message.wav", # PrivateSound = sound effect to play on private message + windowbg => '#000000', # WindowBG = the BG color for MainWindow + windowfg => '#CCCCCC', # WindowFG = the FG color for MainWindow + buttonbg => '#000000', # ButtonBG = the BG color for buttons + buttonfg => '#CCCCCC', # ButtonFG = the FG color for buttons + whobg => '#000000', # WhoBG = the BG color for Who List + background => '#000000', # Background = the BG color for CyanChat + foreground => '#CCCCCC', # Foreground = the FG color + inputbg => '#FFFFFF', # InputBG = text box input BG + inputfg => '#000000', # InputFG = text box input FG + disabledfg => '#999999', # DisabledFG = foreground for disabled buttons + linkcolor => '#0099FF', # LinkColor = hyperlink colors + usercolor => '#FFFFFF', # UserColor = white + echocolor => '#FFFFFF', # EchoColor = white + admincolor => '#00FFFF', # AdminColor = cyan + guestcolor => '#FF9900', # GuestColor = yellow + servercolor => '#00FF00', # ServerColor = lime + clientcolor => '#FF0000', # ClientColor = red + privatecolor => '#FF99FF', # PrivateColor = pink (magenta on black = ugly) + actioncolor => '#FFFF00', # ActionColor = orange + ); + + if ($skip ne 'skip' && -f "$homedir/config.txt") { + print "Reading configuration from $homedir/config.txt\n"; + open (CFG, "$homedir/config.txt"); + my @cfg = ; + close (CFG); + chomp @cfg; + + foreach my $line (@cfg) { + next unless defined $line; + next if $line eq ''; + next unless length $line > 0; + + my ($label,$data) = split(/\s+/, $line, 2); + $label = lc($label); + + $config{$label} = $data; + } + } + + $FONT = [ + -family => $config{dialogfont}, + -size => $config{fontsize}, + ]; + + if ($skip ne 'cancel') { + $user{nick} = $config{nickname}; + } + + $HTTPBROWSER = $config{browser}; + + # Reload our saved ignore lists? + if (-f "$homedir/ignore.txt") { + print "Reading saved ignore list from $homedir/ignore.txt\n"; + open (READ, "$homedir/ignore.txt"); + my @read = ; + close (READ); + chomp @read; + + foreach my $line (@read) { + print "$line\n"; + $ignore{$line} = 1; + } + } +} + +############################################ +## Main Methods ## +############################################ + +sub bindChatTags { + foreach (qw(user admin guest server client private action echo)) { + my $var = $_ . "color"; + $chat->tagConfigure ($_, -foreground => $config{$var}); + } + + my @opts = ( + -foreground => $config{background}, + -elide => 1, + ); + if ($config{timestamps} == 1) { + @opts = ( + -foreground => $config{servercolor}, + -elide => 0, + ); + } + $chat->tagConfigure ("timestamp", + -font => [ + @{$FONT}, + -size => 8, + ], + @opts, + ); + + $chat->configure (-foreground => $config{foreground}, -background => $config{background}); + + # (Re)color the window. + $controlFrame->configure (-background => $config{windowbg}); + $mainFrame->configure (-background => $config{windowbg}); + $rightFrame->configure (-background => $config{windowbg}); + $btnFrame->configure (-background => $config{windowbg}); + $whoFrame->configure (-background => $config{windowbg}); + $chatFrame->configure (-background => $config{windowbg}); + + $menu{loginlabel}->configure (-foreground => $config{windowfg}, -background => $config{windowbg}); + $menu{logintext}->configure (-disabledforeground => $config{windowfg}, -disabledbackground => $config{windowbg}, + -foreground => $config{inputfg}, -background => $config{inputbg}); + $menu{loginbttn}->configure (-foreground => $config{buttonfg}, -background => $config{buttonbg}, + -activeforeground => $config{buttonfg}, -activebackground => $config{buttonbg}, -disabledforeground => $config{disabledfg}); + $menu{constatus}->configure (-background => $config{windowbg}); + $menu{privatebttn}->configure (-foreground => $config{buttonfg}, -background => $config{buttonbg}, + -activeforeground => $config{buttonfg}, -activebackground => $config{buttonbg}, -disabledforeground => $config{disabledfg}); + $menu{ignorebttn}->configure (-foreground => $config{buttonfg}, -background => $config{buttonbg}, + -activeforeground => $config{buttonfg}, -activebackground => $config{buttonbg}, -disabledforeground => $config{disabledfg}); + $menu{wholabel}->configure (-foreground => $config{windowfg}, -background => $config{windowbg}); + $wholist->configure (-foreground => $config{foreground}, -background => $config{whobg}); + $menu{msgbox}->configure (-disabledforeground => $config{windowfg}, -disabledbackground => $config{windowbg}, + -foreground => $config{inputfg}, -background => $config{inputbg}); + + # Refresh the Who List. + &updateWhoList; + + # Update the connection status label. + if ($connected) { + $menu{constatus}->configure (-foreground => $config{servercolor}); + } + else { + $menu{constatus}->configure (-foreground => $config{clientcolor}); + } +} + +sub sendMsgLine { + my ($where,$str,$deftag) = @_; # where = '0.0' or 'end' + $deftag = '' unless defined $deftag; + + #print "sendMsgLine ($where,$str)\n"; + + # This is a universal subroutine for sending the "message" part of a user's message + # to a chat or private message window. This allows the hyperlinking function to be + # easy and universal. + + # Isolate the hyperlinks. + $str =~ s~(\s*)((http|https|ftp)://[^\s]+)(\s*)~$1$2$4~ig; + + # Split the message at hyperlinks. + my @parts = split(/insert ($where,"\n"); + @parts = reverse(@parts); + } + + # Go through each one. + foreach my $part (@parts) { + #print "part: $part\n"; + + # If this part is to a hyperlink... + if ($part =~ /^httphyperlink>/) { + # Cut off the PCCC Hyperlink tag. + $part =~ s/^httphyperlink>//i; + + #print ":: Found a hyperlink: $part\n"; + + # Create a unique hyperlink tag. + my $tag = "hyperlink" . $hyperlink++; + $chat->tagConfigure ($tag, -underline => 1, -foreground => $config{linkcolor}); + + # Bind this tag to an anonymous function. + $chat->tagBind ($tag, "", [ + sub { + my $link = $_[1]; + #print "link clicked: $link\n"; + push (@HYPERLINKLIST, $link); + }, + $part, + ]); + $chat->tagBind ($tag,"", sub { + $chat->configure (-cursor => 'hand2'); + }); + $chat->tagBind ($tag,"", sub { + $chat->configure (-cursor => 'xterm'); + }); + + # Insert this. + $chat->insert ($where,$part,$tag); + } + else { + $part =~ s/^httpendhyperlink>//i; + $chat->insert ($where,$part,$deftag); + } + } + + if ($where eq 'end') { + $chat->insert ($where,"\n"); + } +} + +sub sendLine { + my (%data) = @_; + + if ($data{from} eq $user{nick}) { + $data{color} = 'echo'; + } + + my $stamp = ×tamp; + + push (@xhtml, "
" + . "$stamp [$data{from}] " + . &htmlEscape($data{message}) . "
"); + + #print "sendLine (" . each(%data) . ")\n"; + + if ($config{reversechat} == 1) { + &sendMsgLine ('0.0',$data{message}); + $chat->insert ('0.0', "[$data{from}] ",$data{color}); + $chat->insert ('0.0', "$stamp ","timestamp"); + if ($config{autoscroll} == 1) { + $chat->see ('0.0'); + } + } + else { + $chat->insert ('end', "$stamp ","timestamp"); + $chat->insert ('end', "[$data{from}] ",$data{color}); + &sendMsgLine ('end',$data{message}); + if ($config{autoscroll} == 1) { + $chat->see ('end'); + } + } + + if ($config{notifyanimate} == 1 && $winanim->{__mainwindow__}->{focused} == 0) { + $winanim->{__mainwindow__}->{animating} = 1; + } + &doAutolog(); +} +sub sendBlankLine { + push (@xhtml, "
 
"); + + if ($config{reversechat} == 1) { + $chat->insert ('0.0', "\n"); + if ($config{autoscroll} == 1) { + $chat->see ('0.0'); + } + } + else { + $chat->insert ('end',"\n"); + if ($config{autoscroll} == 1) { + $chat->see ('end'); + } + } + + if ($config{notifyanimate} == 1 && $winanim->{__mainwindow__}->{focused} == 0) { + $winanim->{__mainwindow__}->{animating} = 1; + } + &doAutolog(); +} +sub sendMoveLine { + my (%data) = @_; + + if ($data{from} eq $user{nick}) { + $data{color} = 'echo'; + } + + my $escape = &htmlEscape($data{message}); + my $stamp = ×tamp; + + push (@xhtml, "
$stamp " + . "$data{prefix}" + . "[$data{from}] $escape" + . "$data{suffix}
"); + + if ($config{reversechat} == 1) { + $chat->insert ('0.0', "$data{suffix}\n",'server'); + $chat->insert ('0.0', "$data{message}"); + $chat->insert ('0.0', "[$data{from}] ",$data{color}); + $chat->insert ('0.0', "$data{prefix}",'server'); + $chat->insert ('0.0', "$stamp ",'timestamp'); + if ($config{autoscroll} == 1) { + $chat->see ('0.0'); + } + } + else { + $chat->insert ('end', "$stamp ",'timestamp'); + $chat->insert ('end', "$data{prefix}",'server'); + $chat->insert ('end', "[$data{from}] ",$data{color}); + $chat->insert ('end', "$data{message}"); + $chat->insert ('end', "$data{suffix}\n",'server'); + if ($config{autoscroll} == 1) { + $chat->see ('end'); + } + } + + if ($config{notifyanimate} == 1 && $winanim->{__mainwindow__}->{focused} == 0) { + $winanim->{__mainwindow__}->{animating} = 1; + } + &doAutolog(); +} +sub sendActionLine { + my (%data) = @_; + + my ($typo) = (exists $data{typo} && $data{typo} eq "true") ? "true" : "false"; + + if ($data{from} eq $user{nick}) { + $data{color} = 'echo'; + } + + my $stamp = ×tamp; + + push (@xhtml, "
$stamp " + . "[$data{from}] " + . "" + . &htmlEscape($data{message}) . "
"); + + if ($config{reversechat} == 1) { + if ($typo eq "true") { + &sendMsgLine ('0.0',$data{message},'action'); + $chat->insert ('0.0', "[$data{from}] ",$data{color}); + } + else { + &sendMsgLine ('0.0',"$data{message} **",'action'); + $chat->insert ('0.0', "$data{from} ",$data{color}); + $chat->insert ('0.0', "** ",'action'); + } + $chat->insert ('0.0', "$stamp ",'timestamp'); + if ($config{autoscroll} == 1) { + $chat->see ('0.0'); + } + } + else { + $chat->insert ('end', "$stamp ",'timestamp'); + if ($typo eq "true") { + $chat->insert ('end', "[$data{from}] ",$data{color}); + &sendMsgLine ('end',$data{message},'action'); + } + else { + $chat->insert ('end', "** ",'action'); + $chat->insert ('end', "$data{from} ",$data{color}); + &sendMsgLine ('end',"$data{message} **",'action'); + } + if ($config{autoscroll} == 1) { + $chat->see ('end'); + } + } + + if ($config{notifyanimate} == 1 && $winanim->{__mainwindow__}->{focused} == 0) { + $winanim->{__mainwindow__}->{animating} = 1; + } + &doAutolog(); +} +sub sendPrivLine { + my (%data) = @_; + + my $stamp = ×tamp; + + if ($data{from} eq $user{nick}) { + $data{color} = 'echo'; + } + + my $popupImWindow = 0; + if ($config{imwindows} == 1) { + $popupImWindow = 1; + } + elsif (exists $data{popup} && $data{popup} == 1) { + $popupImWindow = 1; + } + + if ($popupImWindow == 1 && not exists $windows{$data{from}}) { + # Set us up for window animating. + $winanim->{$data{from}} = { + title => "$data{from} | CyanChat", + focused => -1, + animating => 0, + phase => 0, + proceed => 0, + }; + + $windows{$data{from}} = $mw->Toplevel ( + -title => "$data{from} | CyanChat", + ); + $windows{$data{from}}->geometry ('320x240'); + $windows{$data{from}}->Icon (-image => $IMAGE{balloon}); + $windows{$data{from}}->bind ('', [ sub { + my $id = $_[1]; + delete $winanim->{$id}; + delete $windows{$id}; + }, $data{from}]); + $windows{$data{from}}->bind ('', [ sub { + $windows{$data{from}}->configure (-title => "$_[1] | CyanChat"); + $pfocus{$_[1]} = 1; + $winanim->{$_[1]}->{focused} = 1; + &animReset($_[1]); + }, $data{from}]); + $windows{$data{from}}->bind ('', [ sub { + $pfocus{$_[1]} = 0; + $winanim->{$_[1]}->{focused} = 0; + }, $data{from}]); + + my $Frame = $windows{$data{from}}->Frame ( + -background => $config{background}, + )->pack (-side => 'top', -fill => 'both', -expand => 1); + + my $inputFrame = $Frame->Frame ( + -background => $config{background}, + )->pack (-side => 'top', -fill => 'x'); + my $dlgFrame = $Frame->Frame ( + -background => $config{background}, + )->pack (-side => 'top', -fill => 'both', -expand => 1); + + $inputFrame->Entry ( + -textvariable => \$pmsg{$data{from}}, + -foreground => $config{inputfg}, + -background => $config{inputbg}, + -font => $FONT, + -highlightthickness => 0, + )->pack (-fill => 'x', -expand => 1)->focusForce; + + $private{$data{from}} = $dlgFrame->Scrolled ('ROText', + -foreground => $config{foreground}, + -background => $config{background}, + -scrollbars => 'ose', + -wrap => 'word', + -font => $FONT, + -highlightthickness => 0, + )->pack (-fill => 'both', -expand => 1); + + $private{$data{from}}->tagConfigure ('user', -foreground => $config{usercolor}); + $private{$data{from}}->tagConfigure ('private', -foreground => $config{privatecolor}); + + if (defined $data{default}) { + $private{$data{from}}->insert ('end', "[$user{nick}] ",'user'); + $private{$data{from}}->insert ('end', "$data{default}\n"); + $private{$data{from}}->see ('end'); + } + + $windows{$data{from}}->focusForce; + $pfocus{$data{from}} = 1; + + $windows{$data{from}}->bind ('', [ sub { + my $user = $_[1]; + + if (length $pmsg{$user}) { + $private{$data{from}}->insert ('end', "[$user{nick}] ",'user'); + $private{$data{from}}->insert ('end', "$pmsg{$user}\n"); + $private{$data{from}}->see ('end'); + &sendLine (from => 'ChatClient', color => 'client', message => "Private message sent to: [$user] $pmsg{$user}"); + $netcc->sendPrivate ($user,$pmsg{$user}); + $pmsg{$user} = ''; + } + }, $data{from} ]); + } + + return unless length $data{message}; + + if (exists $windows{$data{from}}) { + $private{$data{from}}->insert ('end', "[$data{from}] ",'private'); + $private{$data{from}}->insert ('end', "$data{message}\n"); + + if ($pfocus{$data{from}} == 0) { + $windows{$data{from}}->configure (-title => ">>> $data{from} | CyanChat <<<"); + } + + $private{$data{from}}->see ('end'); + + if ($config{notifyanimate} == 1 && $winanim->{$data{from}}->{focused} == 0) { + $winanim->{$data{from}}->{animating} = 1; + } + } + + push (@xhtml, "
$stamp " + . "Private message from " + . "[$data{from}] " + . &htmlEscape($data{message}) . "
"); + + if ($config{reversechat} == 1) { + &sendMsgLine ('0.0',$data{message}); + $chat->insert ('0.0', "[$data{from}] ",$data{color}); + $chat->insert ('0.0', "Private message from ",'private'); + $chat->insert ('0.0', "$stamp ",'timestamp'); + if ($config{autoscroll} == 1) { + $chat->see ('0.0'); + } + } + else { + $chat->insert ('end', "$stamp ",'timestamp'); + $chat->insert ('end', "Private message from ",'private'); + $chat->insert ('end', "[$data{from}] ",$data{color}); + &sendMsgLine ('end',$data{message}); + if ($config{autoscroll} == 1) { + $chat->see ('end'); + } + } + + if ($config{notifyanimate} == 1 && $winanim->{__mainwindow__}->{focused} == 0) { + $winanim->{__mainwindow__}->{animating} = 1; + } + &doAutolog(); +} + +sub connect { + # Create a new Net::CyanChat object. + $netcc = new Net::CyanChat ( + host => $config{chathost}, + port => $config{chatport}, + proto => 1, + debug => 1, + ); + + # Set handlers. + $netcc->setHandler (Connected => \&on_connected); + $netcc->setHandler (Disconnected => \&on_disconnected); + $netcc->setHandler (Welcome => \&on_welcome); + $netcc->setHandler (Message => \&on_message); + $netcc->setHandler (Private => \&on_private); + $netcc->setHandler (Chat_Buddy_In => \&on_enter); + $netcc->setHandler (Chat_Buddy_Out => \&on_exit); + #$netcc->setHandler (Chat_Buddy_Here => \&on_here); + $netcc->setHandler (WhoList => \&on_wholist); + $netcc->setHandler (Name_Accepted => \&on_name_accepted); + $netcc->setHandler (Ignored => \&on_ignored); + $netcc->setHandler (Packet => \&on_packet); + $netcc->setHandler (Error => \&on_error); + + &sendBlankLine(); + &sendLine (from => 'ChatClient', color => 'client', message => "Connecting to CyanChat..."); + + $menu{constatus}->configure ( + -text => 'Connecting...', + -foreground => $config{clientcolor}, + ); + + # Connect. + $connected = 1; + $netcc->connect(); +} + +sub disconnect { + if ($loggedin) { + &exitChat; + } + + $netcc->{sock}->close(); + $netcc = undef; + + $connected = 0; + $menu{constatus}->configure ( + -text => 'Not connected.', + -foreground => $config{clientcolor}, + ); + $menu{connect}->configure (-state => 'normal'); + $menu{disconnect}->configure (-state => 'disabled'); + $menu{details}->configure (-state => 'disabled'); + $menu{rawmenu}->configure (-state => 'disabled'); + $menu{loginbttn}->configure (-state => 'disabled'); + $menu{privatebttn}->configure (-state => 'disabled'); + $menu{ignorebttn}->configure (-state => 'disabled'); + $menu{logintext}->focusForce; + + # Clear the who list. + $wholist->delete (0,'end'); + %online = (); + %ignore = (); +} + +sub enterChat { + my $nick = $user{nick}; + + if (length $nick) { + if (length $nick > 20 || $nick =~ /\|/) { + &sendLine (from => 'ChatClient', color => 'client', message => "Your nickname must be less than 20 characters " + . "and cannot contain a pipe symbol (\"|\")"); + } + else { + # It should be good. + $netcc->login ($nick); + } + } + else { + &sendLine (from => 'ChatClient', color => 'client', message => "Please enter a nickname before joining chat."); + } +} + +sub exitChat { + $netcc->logout; + + $loggedin = 0; + + $menu{loginbttn}->configure ( + -text => 'Join Chat', + -command => \&enterChat, + ); + $menu{logintext}->configure ( + -state => 'normal', + ); + $menu{msgbox}->configure ( + -state => 'disabled', + ); + $menu{logintext}->focusForce; +} + +sub sendMessage { + my $msg = $user{msg} || ''; + + # Filter line breaks from the message (they might've accidentally been pasted in). + $msg =~ s/\x0a//g; + $msg =~ s/\x0d//g; + + if (length $msg > 0 && $loggedin == 1) { + # Run commands. + if ($msg =~ /^\/(?:whisper|w|msg) (.+?)$/i) { + my ($to,$what) = split(/\s+/, $1, 2); + + if (length $to && length $what) { + if (not exists $private{$to}) { + &sendPrivLine (from => $to, color => 'server', message => '', default => $what); + } + &sendLine (from => 'ChatClient', color => 'client', message => "Private message sent to: [$to] $what"); + $netcc->sendPrivate ($to,$what); + } + else { + &sendLine (from => 'ChatClient', color => 'client', message => "Usage: /whisper "); + } + + $user{msg} = ''; + } + else { + $netcc->sendMessage ($msg); + $user{msg} = ''; + } + } +} + +sub sendPrivate { + # Get the selected user. + my $index = ($wholist->curselection)[0]; + + if (length $index) { + my $user = $wholist->get ($index); + my $msg = $user{msg} || ''; + + if (length $msg > 0 && length $user > 0 && $loggedin == 1) { + if (not exists $private{$user}) { + &sendPrivLine (from => $user, color => 'server', message => '', default => $user{msg}); + } + + &sendLine (from => 'ChatClient', color => 'client', message => "Private message sent to: [$user] $msg"); + $netcc->sendPrivate ($user,$msg); + $user{msg} = ''; + } + else { + &sendLine (from => 'ChatClient', color => 'client', message => "Select a user from the Who List and write a message."); + } + } + else { + &sendLine (from => 'ChatClient', color => 'client', message => "Select a user from the Who List and write a message."); + } +} + +sub sendIM { + # Get the selected user. + my $name = $_[1] || undef; + + my $user = undef; + + if (not defined $name) { + my $index = ($wholist->curselection)[0]; + $user = $wholist->get ($index); + } + else { + $user = $name; + } + + my $msg = $user{msg} || ''; + + if (exists $windows{$user}) { + $windows{$user}->focusForce; + } + else { + &sendPrivLine (from => $user, color => 'server', message => '', popup => 1); + } +} + +sub adminlistSendIM { + # Get the selected user. + my $index = ($adminlist->curselection)[0]; + + if (length $index) { + my $user = $adminlist->get ($index); + my $msg = $user{msg} || ''; + + if (exists $windows{$user}) { + $windows{$user}->focusForce; + } + else { + &sendPrivLine (from => $user, color => 'server', message => '', popup => 1); + } + } +} + +sub ignoreUser { + my $name = $_[1] || undef; + + #print "ignoreUser(@_)\n"; + + my $user = undef; + if (not defined $name) { + #print "name not defined\n"; + my $index = ($wholist->curselection)[0]; + + if (length $index) { + $user = $wholist->get ($index); + } + } + else { + $user = $name; + } + + return unless defined $user; + + if (exists $ignore{$user}) { + if ($config{sendignore} == 1) { + $netcc->unignore ($user); + } + delete $ignore{$user}; + &sendLine (from => 'ChatClient', color => 'client', message => "No longer ignoring messages from $user."); + } + else { + if ($config{sendignore} == 1) { + $netcc->ignore ($user); + } + $ignore{$user} = 1; + &sendLine (from => 'ChatClient', color => 'client', message => "Now ingoring messages from $user."); + } +} + +sub wholistRightClick { + my $listbox = shift; + my $admin = shift || ''; + + # Get the cursor position. + my $cursor = $Tk::event->y; + + # Find out what name we're over. + my $name = $listbox->get ($listbox->nearest ($cursor)); + + # Select this user. + $listbox->selectionClear (0,'end'); + $listbox->selectionSet ($listbox->nearest($cursor)); + + # Return if something went wrong. + return unless length $name; + + # Get their address. + my ($level,$addr) = split(/\;/, $online{$name}, 2); + + &sendLine ( + from => 'ChatClient', + color => 'client', + message => "$name is chatting from the address $addr", + ); +} + +sub wholistMiddleClick { + my $listbox = shift; + + # Get the cursor position. + my $cursor = $Tk::event->y; + + # Find out what name we're over. + my $name = $listbox->get ($listbox->nearest ($cursor)); + + # Select this user. + $listbox->selectionClear (0,'end'); + $listbox->selectionSet ($listbox->nearest($cursor)); + + # Return if something went wrong. + return unless length $name; + + # Add their name to our message. + $user{msg} .= $name; +} + +sub getColor { + my $code = shift; + + if ($code == 0) { + return 'user'; + } + elsif ($code == 1) { + return 'admin'; + } + elsif ($code == 2) { + return 'server'; + } + elsif ($code == 4) { + return 'guest'; + } + + return 'client'; +} + +sub savePrefs { + # Save preferences in a logical order. + my @order = ( + 'ChatHost', + 'ChatPort', + 'AutoConnect', + 'ReConnect', + 'DialogFont', + 'ReverseChat', + 'FontSize', + 'AutoScroll', + 'Nickname', + 'AutoJoin', + 'BlockServer', + 'IgnoreBack', + 'LoudIgnore', + 'SendIgnore', + 'AutoAct', + 'LoudTypo', + 'Browser', + 'Orientation', + 'TimeStamps', + 'IMWindows', + 'StickyIgnore', + 'NotifyAnimate', + 'Autologging', + 'MediaPlayer', + 'PlaySounds', + 'PlayJoin', + 'PlayLeave', + 'PlayPublic', + 'PlayPrivate', + 'JoinSound', + 'LeaveSound', + 'PublicSound', + 'PrivateSound', + 'WindowBG', + 'WindowFG', + 'ButtonBG', + 'ButtonFG', + 'WhoBG', + 'Background', + 'Foreground', + 'InputBG', + 'InputFG', + 'DisabledFG', + 'LinkColor', + 'UserColor', + 'EchoColor', + 'AdminColor', + 'GuestColor', + 'ServerColor', + 'ClientColor', + 'PrivateColor', + 'ActionColor', + ); + + $HTTPBROWSER = $config{browser}; + + my @lines = (); + #print "lines = @lines\n"; + foreach (@order) { + my $var = lc($_); + + $_ .= " " until length $_ == 15; + + push (@lines, $_ . $config{$var}); + } + + open (SAVE, ">$homedir/config.txt"); + print SAVE join ("\n",@lines); + close (SAVE); +} + +sub shutdown { + $menu{forcequit}->configure (-state => 'normal'); + + # Save our ignore list. + if ($config{stickyignore} == 1) { + #print "Save ignore list:\n"; + print Dumper(%ignore); + my @save = (); + foreach my $key (keys %ignore) { + push (@save,"$key"); + } + #print join ("\n",@save); + + open (IGNORE, ">$homedir/ignore.txt"); + print IGNORE join ("\n",@save); + close (IGNORE); + } + else { + # We no longer want to save ignores, so delete the file. + if (-f "$homedir/ignore.txt") { + #print "Delete the ignore list\n"; + unlink ("$homedir/ignore.txt"); + } + } + + # If we're connected... + if ($connected) { + my $dialog = $mw->Dialog ( + -title => 'Exit PCCC?', + -text => "You are currently connected to CyanChat. Disconnect and exit?", + -buttons => [ 'Yes', 'No' ], + -default_button => 'Yes', + ); + $dialog->Icon (-image => $IMAGE{worlds}); + + my $choice = $dialog->Show; + if ($choice =~ /yes/i) { + &disconnect(); + } + else { + return; + } + } + + $mw->destroy; + + # Send the link thread a signal to start wrapping things up. + push (@HYPERLINKLIST, "+shutdown"); + push (@PLAYSOUNDS, "+shutdown"); + + # Join the child threads. + $linkthread->join; + $mediathread->join; + + exit(0); +} + +sub loop { + $| = 1; + while (1) { + select (undef,undef,undef,0.001); + $mw->update; + + if ($connected) { + $netcc->do_one_loop; + } + + # Animate all windows. + foreach my $winName (keys %{$winanim}) { + if ($winanim->{$winName}->{animating} == 1) { + &animStep ($winName); + } + } + } +} + +sub animReset { + my $name = shift; + + if ($name eq '__mainwindow__') { + #print "Reset animation for MW\n"; + $mw->configure (-title => $winanim->{__mainwindow__}->{title}); + $winanim->{__mainwindow__} = { + title => $winanim->{__mainwindow__}->{title}, + focused => $winanim->{__mainwindow__}->{focused}, + phase => 0, + animating => 0, + proceed => 0, + }; + } + else { + #print "Reset animation for $name\n"; + $windows{$name}->configure (-title => $winanim->{$name}->{title}); + $winanim->{$name} = { + title => $winanim->{$name}->{title}, + focused => $winanim->{$name}->{focused}, + phase => 0, + animating => 0, + proceed => 0, + }; + } +} + +sub animStep { + my $name = shift; + + if ($name eq '__mainwindow__') { + if ($winanim->{$name}->{focused} == 1) { + &animReset('__mainwindow__'); + return; + } + + if ($winanim->{__mainwindow__}->{proceed} <= 0) { + # Up the phase. + $winanim->{__mainwindow__}->{phase}++; + if ($winanim->{__mainwindow__}->{phase} >= scalar @{$notification}) { + $winanim->{__mainwindow__}->{phase} = 0; + } + + my $suffix = $notification->[ $winanim->{__mainwindow__}->{phase} ]; + my ($left,$right) = @{$suffix}; + + #print "step: $left$winanim->{__mainwindow__}->{title}$right\n"; + + $mw->configure (-title => $left . $winanim->{__mainwindow__}->{title} . $right); + $winanim->{__mainwindow__}->{proceed} = 200; + } + $winanim->{__mainwindow__}->{proceed}--; + } + else { + if ($winanim->{$name}->{focused} == 1) { + &animReset($name); + return; + } + + if ($winanim->{$name}->{proceed} <= 0) { + # Up the phase. + $winanim->{$name}->{phase}++; + if ($winanim->{$name}->{phase} >= scalar @{$notification}) { + $winanim->{$name}->{phase} = 0; + } + + my $suffix = $notification->[ $winanim->{$name}->{phase} ]; + my ($left,$right) = @{$suffix}; + + #print "step: $left$winanim->{$name}->{title}$right\n"; + + $windows{$name}->configure (-title => $left . $winanim->{$name}->{title} . $right); + $winanim->{$name}->{proceed} = 200; + } + $winanim->{$name}->{proceed}--; + } +} + +############################################ +## Keyboard Bindings and Events ## +############################################ + +sub bind_return { + if ($connected) { + if (not $loggedin) { + &enterChat; + } + else { + &sendMessage; + } + } +} + +############################################ +## Handlers ## +############################################ + +sub on_connected { + my $cc = shift; + + $menu{constatus}->configure ( + -text => 'Connected to CyanChat.', + -foreground => $config{servercolor}, + ); + $menu{connect}->configure (-state => 'disabled'); + $menu{disconnect}->configure (-state => 'normal'); + $menu{details}->configure (-state => 'normal'); + $menu{rawmenu}->configure (-state => 'normal'); + $menu{loginbttn}->configure (-state => 'normal'); + $menu{privatebttn}->configure (-state => 'normal'); + $menu{ignorebttn}->configure (-state => 'normal'); + $menu{logintext}->focusForce; + + &sendLine (from => 'ChatClient', color => 'client', message => "Connection established!"); + + # If auto-login... + if ($config{autojoin} == 1) { + if (length $config{nickname}) { + $cc->login ($config{nickname}); + } + } +} + +sub on_disconnected { + my $cc = shift; + + $connected = 0; + $menu{constatus}->configure ( + -text => 'Not connected.', + -foreground => $config{clientcolor}, + ); + $menu{connect}->configure (-state => 'normal'); + $menu{disconnect}->configure (-state => 'disabled'); + $menu{details}->configure (-state => 'disabled'); + $menu{rawmenu}->configure (-state => 'disabled'); + $menu{loginbttn}->configure (-state => 'disabled'); + $menu{privatebttn}->configure (-state => 'disabled'); + $menu{ignorebttn}->configure (-state => 'disabled'); + + $loggedin = 0; + $menu{loginbttn}->configure ( + -text => 'Join Chat', + -command => \&enterChat, + ); + $menu{logintext}->configure ( + -state => 'normal', + ); + $menu{msgbox}->configure ( + -state => 'disabled', + ); + $menu{logintext}->focusForce; + + &sendLine (from => 'ChatClient', color => 'client', message => "You have been disconnected from the server."); + + # Clear the Who List. + $wholist->delete (0,'end'); + + if ($config{reconnect}) { + &connect(); + } +} + +sub on_packet { + my ($cc,$source,$packet) = @_; + + if ($source eq "incoming") { + $dbgtext->insert ('end',"$packet\n","server"); + } + else { + $dbgtext->insert ('end',"$packet\n","client"); + } +} + +sub on_welcome { + my ($cc,$msg) = @_; + + $msg =~ s/^\d//g; + $msg =~ s/\r//g; + + &sendLine (from => 'ChatServer', color => 'server', message => $msg); +} + +sub on_message { + my ($cc,$nick,$level,$addr,$msg) = @_; + + $msg =~ s/\r//g; + + if ($level == 2) { + # Ignoring server messages? + if ($config{blockserver} == 1) { + return; + } + } + + if (not exists $ignore{$nick}) { + &playSound ("public"); + if ($msg =~ /^\/me (.+?)$/i) { + &sendActionLine (from => $nick, color => &getColor($level), message => $1); + } + elsif ($config{autoact} == 1 && $msg =~ /^\*(.+?)\*$/i) { + &sendActionLine (from => $nick, color => &getColor($level), message => $1); + } + elsif ($config{loudtypo} == 1 && $msg =~ /^\*([^\*]+?)$/i) { + &sendActionLine (from => $nick, color => &getColor($level), message => $msg, typo => 'true'); + } + else { + &sendLine (time => time(), from => $nick, color => &getColor($level), message => $msg); + } + } +} + +sub on_private { + my ($cc,$nick,$level,$addr,$msg) = @_; + + $msg =~ s/\r//g; + + if ($level == 2) { + # Ignoring server messages? + if ($config{blockserver} == 1) { + return; + } + } + + if (not exists $ignore{$nick}) { + &playSound ("private"); + &sendPrivLine (from => $nick, color => &getColor($level), message => $msg); + } +} + +sub on_enter { + my ($cc,$nick,$level,$addr,$msg) = @_; + + &playSound ("join"); + + $msg =~ s/\r//g; + &sendMoveLine (from => $nick, color => &getColor($level), message => $msg, prefix => '\\\\\\\\\\', suffix => '/////'); + + $online{$nick} = join (";",$level,$addr); + &updateWhoList; + + # Play a SFX. + #push (@PLAYSOUNDS, "email.wav"); +} + +sub on_exit { + my ($cc,$nick,$level,$addr,$msg) = @_; + + &playSound ("leave"); + + $msg =~ s/\r//g; + &sendMoveLine (from => $nick, color => &getColor($level), message => $msg, prefix => '/////', suffix => '\\\\\\\\\\'); + + delete $online{$nick}; + &updateWhoList; +} + +sub on_here { + my ($cc,$nick,$level,$addr) = @_; + + my $user = $nick; + + if (exists $online{$user}) { + # Ignore. + } + else { + $online{$nick} = join (";",$level,$addr); + } + + &updateWhoList; +} + +sub on_wholist { + my ($cc,@users) = @_; + + #print "wholist: @users\n"; + + my %comp = (); + foreach my $name (@users) { + my ($nick,$addr) = split(/\,/, $name, 2); + my $user = $nick; + my ($level) = $user =~ /^(\d)/; + $user =~ s/^\d//; + + #print "check newuser $user\n"; + + if (exists $online{$user}) { + # They're already here. + #print "\tuser already here\n"; + } + else { + # They're new. + #print "\tthis is a new user!\n"; + } + + $online{$user} = join (";",$level,$addr); + + $comp{$user} = 1; + } + + # Look for missing users. + foreach my $nln (keys %online) { + #print "marked online user: $nln\n"; + if (not exists $comp{$nln}) { + #print "not exists in comp\n"; + # Delete them. + delete $online{$nln}; + } + } + + &updateWhoList(); +} + +sub updateWhoList { + $wholist->delete (0,'end'); + $adminlist->delete (0,'end'); + + foreach my $user (keys %online) { + my ($level,$addr) = split(/\;/, $online{$user}, 2); + my $color = &getColor($level); + my $type = join ('',$color,'color'); + + #print "Update wholists ($user; $level; $addr; $color; $type)\n"; + + if ($color eq 'admin' || $color eq 'guest') { + $adminlist->insert ('end',$user); + $adminlist->itemconfigure ('end', -foreground => $config{$type}); + } + else { + $wholist->insert ('end',$user); + $wholist->itemconfigure ('end', -foreground => $config{$type}); + } + } +} + +sub on_name_accepted { + my ($cc) = @_; + + $loggedin = 1; + + # Our name was accepted! + $menu{loginbttn}->configure ( + -text => 'Exit Chat', + -command => \&exitChat, + ); + $menu{logintext}->configure ( + -state => 'disabled', + ); + $menu{msgbox}->configure ( + -state => 'normal', + ); + + $menu{msgbox}->focusForce; +} + +sub on_ignored { + my ($cc,$ignore,$user) = @_; + + # Showing ignore notifications? + if ($config{loudignore} == 1) { + &sendLine (time => time(), from => 'ChatClient', color => 'client', message => "$user has ignored you."); + } + + # Doing mutual ignores? + if ($config{ignoreback} == 1) { + $cc->ignore ($user); + } +} + +sub on_error { + my ($cc,$code,$string) = @_; + + &sendLine (from => 'ChatServer', color => 'server', message => $string); +} + +sub htmlEscape { + my $str = shift; + + $str =~ s//>/g; + $str =~ s/\"/"/g; + $str =~ s/\'/'/g; + + return $str; +} + +sub timestamp { + # Generate the time stamp. + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time()); + $hour = "0" . $hour until length $hour == 2; + $min = "0" . $min until length $min == 2; + + return "$hour:$min"; +} + +sub doAutolog { + # Is autologging enabled? + if ($config{autologging} == 1) { + # Make log directories, if necessary. + my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime(time()); + $mon++; + $mon = "0" . $mon until length $mon == 2; + $day = "0" . $day until length $day == 2; + $year += 1900; + my $dir = join ("-",$year,$mon,$day); + + if (!-d "$homedir/logs") { + print "mkdir $homedir/logs\n"; + mkdir ("$homedir/logs") or warn "can't mkdir $homedir/logs: $!"; + } + if (!-d "$homedir/logs/$dir") { + print "mkdir $homedir/logs/$dir\n"; + mkdir ("$homedir/logs/$dir") or warn "can't mkdir $homedir/logs/$dir: $!"; + } + + # Does our filename already exist? + my $file = "error.html"; + if ($autologid == 0) { + my $i = 1; + $file = join ("",$year,$mon,$day) . "-$i.html"; + while (-f "$homedir/logs/$dir/$file") { + $i++; + $file = join ("",$year,$mon,$day) . "-$i.html"; + } + $autologid = $i; + } + else { + $file = join ("",$year,$mon,$day) . "-$autologid.html"; + } + + # Save the HTML. + &saveHTML ("$homedir/logs/$dir/$file"); + } +} + +sub saveHTML { + my $file = shift; + + # Save as HTML. + my (@lines) = reverse(@xhtml); + open (SAVE, ">$file"); + print SAVE "\n" + . "\n" + . "\n" + . "Cyan Chat Transcript | Perl CyanChat Client $VERSION\n" + . "\n" + . "\n" + . "\n" + . "\n" + . "\n" + . "
Transcript saved on " . localtime(time()) . "
\n\n" + . (join ("\n\n",@lines) ) + . "\n" + . ""; + close (SAVE); +} + +sub prefs { + if (exists $windows{__prefs__}) { + $windows{__prefs__}->focusForce; + } + else { + $helpPage = "general.html"; # The help page if we click for help. + + $windows{__prefs__} = $mw->Toplevel ( + -title => 'Preferences', + ); + $windows{__prefs__}->geometry ('580x400'); + $windows{__prefs__}->Icon (-image => $IMAGE{worlds}); + + $windows{__prefs__}->bind ('', sub { + delete $windows{__prefs__}; + }); + + # Create the button frame. + my $btnFrame = $windows{__prefs__}->Frame ( + )->pack (-side => 'bottom', -fill => 'x'); + my $prefsFrame = $windows{__prefs__}->Frame ( + )->pack (-side => 'bottom', -fill => 'both', -expand => 1); + + # Draw the window buttons. + $btnFrame->Button ( + -text => 'Help', + -command => sub { + &help ($helpPage); + }, + )->pack (-side => 'right', -padx => 10, -pady => 5); + $btnFrame->Button ( + -text => ' Apply ', + -command => sub { + # Save our configuration. + &savePrefs; + &bindChatTags; + }, + )->pack (-side => 'right', -padx => 15, -pady => 5); + $btnFrame->Button ( + -text => ' Cancel ', + -command => sub { + # Cancel anything we may have changed. + &initConfig("cancel"); + $windows{__prefs__}->destroy; + }, + )->pack (-side => 'right', -padx => 0, -pady => 5); + $btnFrame->Button ( + -text => ' OK ', + -command => sub { + # Commit the changes. + &savePrefs; + &bindChatTags; + $windows{__prefs__}->destroy; + }, + )->pack (-side => 'right', -padx => 5, -pady => 5); + + # Draw the tab frame. + my $tabFrame = $prefsFrame->NoteBook ( + -font => $FONT, + )->pack (-fill => 'both', -expand => 1); + + ###################### + ## General ## + ###################### + + my $genTab = $tabFrame->add ("general", + -label => "General", + -raisecmd => sub { + $helpPage = "general.html"; + }, + ); + + my $apLabFrame = $genTab->LabFrame ( + -labelside => 'acrosstop', + -label => 'Appearance', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->pack (-fill => 'x'); + + my $apFrame = $apLabFrame->Pane ( + )->pack (-side => 'left', -padx => 15); + + my $labMainFont = $apFrame->Label ( + -text => 'Main Font Face:', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 0, -row => 0, -sticky => 'ne'); + + $apFrame->Entry ( + -textvariable => \$config{dialogfont}, + -foreground => '#000000', + -background => '#FFFFFF', + -width => 20, + -font => $FONT, + -highlightthickness => 0, + )->grid (-column => 1, -row => 0, -sticky => 'nw'); + + # Balloon Tooltip. + $tipper->attach ($labMainFont, + -msg => "The font family used on most buttons and " + . "text entry boxes in the entire program.", + ); + + my $labFontSize = $apFrame->Label ( + -text => 'Font Size:', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 0, -row => 1, -sticky => 'ne'); + + $apFrame->Entry ( + -textvariable => \$config{fontsize}, + -foreground => '#000000', + -background => '#FFFFFF', + -width => 4, + -font => $FONT, + -highlightthickness => 0, + )->grid (-column => 1, -row => 1, -sticky => 'nw'); + + # Balloon Tooltip. + $tipper->attach ($labFontSize, + -msg => "The font size (in pixels) of most buttons " + . "and text boxes in this program.", + ); + + my $labDialogFlow = $apFrame->Label ( + -text => 'Dialog Flow:', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 0, -row => 2, -sticky => 'ne'); + + my $labReverse = $apFrame->Radiobutton ( + -variable => \$config{reversechat}, + -text => 'New messages on top (default CC behavior)', + -value => 1, + -font => $FONT, + -highlightthickness => 0, + )->grid (-column => 1, -row => 2, -sticky => 'nw'); + + my $labNormal = $apFrame->Radiobutton ( + -variable => \$config{reversechat}, + -text => 'New messages on bottom', + -value => 0, + -font => $FONT, + -highlightthickness => 0, + )->grid (-column => 1, -row => 3, -sticky => 'nw'); + + # Balloon Tooltip. + $tipper->attach ($labDialogFlow, + -msg => "These options control where new messages appear " + . "in the dialog window.", + ); + $tipper->attach ($labReverse, + -msg => "New messages will appear on top, which mimics " + . "the default CC behavior.", + ); + $tipper->attach ($labNormal, + -msg => "New messages will appear on bottom, which mimics " + . "most traditional chat programs.", + ); + + my $labDisplayOpts = $apFrame->Label ( + -text => 'Display Options:', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 0, -row => 4, -sticky => 'ne'); + + my $labOrientation = $apFrame->Checkbutton ( + -variable => \$config{orientation}, + -text => 'Reverse orientation (requires restart)', + -onvalue => 'bottom', + -offvalue => 'top', + -font => $FONT, + -highlightthickness => 0, + )->grid (-column => 1, -row => 4, -sticky => 'nw'); + + my $labNotify = $apFrame->Checkbutton ( + -variable => \$config{notifyanimate}, + -text => 'Animate the window titles when new messages arrive', + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + -highlightthickness => 0, + )->grid (-column => 1, -row => 5, -sticky => 'nw'); + + my $labAutolog = $apFrame->Checkbutton ( + -variable => \$config{autologging}, + -text => 'Automatically log all transcripts', + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + -highlightthickness => 0, + )->grid (-column => 1, -row => 6, -sticky => 'nw'); + + # Balloon Tooltip. + $tipper->attach ($labDisplayOpts, + -msg => "Miscellaneous display options.", + ); + $tipper->attach ($labOrientation, + -msg => "When enabled, the text-entry box will appear below " + . "the chat dialog window, instead of on top (this " + . "mimics traditional chat programs).", + ); + $tipper->attach ($labNotify, + -msg => "When a new message arrives and PCCC is minimized, " + . "the title will animate to get your attention.", + ); + $tipper->attach ($labAutolog, + -msg => "When checked, all messages get automatically logged to " + . "the \"logs\" folder,\n" + . "sorted by date (yyyy-mm-dd) format.", + ); + + my $loginLabFrame = $genTab->LabFrame ( + -labelside => 'acrosstop', + -label => 'Nickname Settings', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->pack (-fill => 'x'); + + my $loginFrame = $loginLabFrame->Pane ( + )->pack (-side => 'left', -padx => 15); + + my $labNickname = $loginFrame->Label ( + -text => "Default Nickname:", + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 0, -row => 0, -sticky => 'ne'); + + $loginFrame->Entry ( + -textvariable => \$config{nickname}, + -foreground => '#000000', + -background => '#FFFFFF', + -width => 20, + -font => $FONT, + -highlightthickness => 0, + )->grid (-column => 1, -row => 0, -sticky => 'nw'); + + # Balloon Tooltip. + $tipper->attach ($labNickname, + -msg => "This nickname will be pre-entered in the Name: " + . "box on the chat window.", + ); + + my $labAutoJoin = $loginFrame->Checkbutton ( + -variable => \$config{autojoin}, + -text => "Automatically join chat when connected", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + -highlightthickness => 0, + )->grid (-column => 0, -row => 1, -columnspan => 2, -sticky => 'nw'); + + # Balloon Tooltip. + $tipper->attach ($labAutoJoin, + -msg => "When enabled, and when there's a Name entered, " + . "you will automatically join the chat when you " + . "connect.", + ); + + ###################### + ## Connection ## + ###################### + + my $connTab = $tabFrame->add ("conn", + -label => "Connection", + -raisecmd => sub { + $helpPage = "connection.html"; + }, + ); + + my $servLabFrame = $connTab->LabFrame ( + -labelside => 'acrosstop', + -label => 'Server Settings', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->pack (-fill => 'x'); + + my $servFrame = $servLabFrame->Pane ( + )->pack (-side => 'left', -padx => 15); + + my $labHost = $servFrame->Label ( + -text => "CyanChat Host:", + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 0, -row => 0, -sticky => 'ne',); + + $servFrame->Entry ( + -textvariable => \$config{chathost}, + -foreground => '#000000', + -background => '#FFFFFF', + -width => 20, + -font => $FONT, + -highlightthickness => 0, + )->grid (-column => 1, -row => 0, -sticky => 'nw'); + + $servFrame->Label ( + -text => "Default: cho.cyan.com", + -font => $FONT, + )->grid (-column => 2, -row => 0, -sticky => 'nw'); + + # Balloon Tooltip. + $tipper->attach ($labHost, + -msg => "The server (host) name of a CyanChat server.", + ); + + my $labPort = $servFrame->Label ( + -text => "Port:", + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 0, -row => 1, -sticky => 'ne'); + + $servFrame->Entry ( + -textvariable => \$config{chatport}, + -foreground => '#000000', + -background => '#FFFFFF', + -width => 20, + -font => $FONT, + -highlightthickness => 0, + )->grid (-column => 1, -row => 1, -sticky => 'nw'); + + $servFrame->Label ( + -text => "Default: 1812\n" + . "Testing: 1813", + -font => $FONT, + )->grid (-column => 2, -row => 1, -sticky => 'nw'); + + # Balloon Tooltip. + $tipper->attach ($labPort, + -msg => "The port number that the CC server listens on.", + ); + + my $labAutoConnect = $servFrame->Checkbutton ( + -variable => \$config{autoconnect}, + -text => "Automatically connect when PCCC starts", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 0, -row => 2, -columnspan => 3, -sticky => 'nw'); + + my $labReconnect = $servFrame->Checkbutton ( + -variable => \$config{reconnect}, + -text => "Attempt to reconnect when disconnected", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 0, -row => 3, -columnspan => 3, -sticky => 'nw'); + + # Balloon Tooltips. + $tipper->attach ($labAutoConnect, + -msg => "When checked, PCCC will attempt to connect to CyanChat " + . "when it starts up.", + ); + $tipper->attach ($labReconnect, + -msg => "When checked, PCCC will attempt once to reconnect to the " + . "server is the connection is interrupted.", + ); + + ###################### + ## Color Scheme ## + ###################### + + my $colorTab = $tabFrame->add ("colors", + -label => "Colors", + -raisecmd => sub { + $helpPage = "colors.html"; + }, + ); + + my $colLabFrame = $colorTab->LabFrame ( + -labelside => 'acrosstop', + -label => 'Chat Colors', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->pack (-fill => 'both', -expand => 1); + + my $colFrame = $colLabFrame->Scrolled ("Pane", + -scrollbars => 'e', + )->pack (-side => 'top', -fill => 'both', -expand => 1, -pady => 2); + + # Draw the colors. + my @types = ( + "h::PCCC Interface", + + "Window Background Color::windowbg", + "Window Text Color::windowfg", + "Button Background Color::buttonbg", + "Button Text Color::buttonfg", + "Textbox Background Color::inputbg", + "Textbox Text Color::inputfg", + "Disabled Text Color::disabledfg", + + "h::Chat Colors", + "Dialog Window Background::background", + "Main Chat Text::foreground", + "Who List Background::whobg", + "Hyperlinks::linkcolor", + "Private Messages::privatecolor", + "Action Messages::actioncolor", + + "h::Nickname Colors", + + "Normal Nicknames::usercolor", + "My Nickname Echo::echocolor", + "Cyan Staff::admincolor", + "Special Guests::guestcolor", + "ChatServer::servercolor", + "ChatClient::clientcolor", + ); + + my $colorRow = 0; + my %colorButtons = (); + foreach my $type (@types) { + my ($label,$var) = split(/::/, $type, 2); + + # Headers? + if ($label eq "h") { + # Draw the header in a significant style. + $colFrame->Label ( + -text => $var, + -relief => 'sunken', + -border => 2, + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 0, -row => $colorRow, + -columnspan => 2, -sticky => 'ew', -ipady => 2); + } + else { + # Draw the label first. + $colFrame->Label ( + -text => "$label:", + -font => $FONT, + )->grid (-column => 0, -row => $colorRow, -sticky => 'e'); + + # Now draw the color preview. + $colorButtons{$var} = $colFrame->Button ( + -text => "xxxxxx", + -font => $FONT, + -foreground => $config{$var}, + -background => $config{$var}, + -activeforeground => $config{$var}, + -activebackground => $config{$var}, + -command => [ sub { + my $var = shift; + my $new = $windows{__prefs__}->chooseColor ( + -title => 'Choose Color', + -initialcolor => $config{$var}, + ); + + return unless defined $new; + $config{$var} = $new; + + $colorButtons{$var}->configure ( + -foreground => $new, + -background => $new, + -activeforeground => $new, + -activebackground => $new, + ); + }, $var ], + )->grid (-column => 1, -row => $colorRow, -sticky => 'nw'); + } + $colorRow++; + } + + ###################### + ## Ignored Users ## + ###################### + + my $ignoreTab = $tabFrame->add ("ignore", + -label => "Ignored Users", + -raisecmd => sub { + &refreshIgnoreLists(); + $helpPage = "ignorelist.html"; + }, + ); + + my $ignoreLabFrame = $ignoreTab->LabFrame ( + -labelside => 'acrosstop', + -label => 'Ignored Users', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->pack (-fill => 'x'); + + my $ignoreFrame = $ignoreLabFrame->Pane ( + )->pack (-side => 'left', -padx => 15); + + $ignoreFrame->Label ( + -text => 'Use this window to modify your ignore list.', + -font => $FONT, + )->grid (-column => 0, -row => 0, -sticky => 'w'); + + my $labOnlineUsers = $ignoreFrame->Label ( + -text => 'Online Users:', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 0, -row => 1, -sticky => 'n'); + + my $labIgnoredUsers = $ignoreFrame->Label ( + -text => 'Ignored Users:', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 1, -row => 1, -sticky => 'n'); + + $pOnlineList = $ignoreFrame->Scrolled ("Listbox", + -scrollbars => "e", + -background => '#FFFFFF', + -foreground => '#000000', + -highlightthickness => 0, + -selectbackground => '#FFFF00', + -selectforeground => '#000000', + -height => 6, + -width => 20, + -font => $FONT, + )->grid (-column => 0, -row => 2, -sticky => 'n'); + + $pIgnoreList = $ignoreFrame->Scrolled ("Listbox", + -scrollbars => "e", + -background => '#FFFFFF', + -foreground => '#000000', + -highlightthickness => 0, + -selectbackground => '#FFFF00', + -selectforeground => '#000000', + -height => 6, + -width => 20, + -font => $FONT, + )->grid (-column => 1, -row => 2, -sticky => 'n'); + + my $btnIgnore = $ignoreFrame->Button ( + -text => 'Ignore Selected', + -font => $FONT, + -command => sub { + my $selected = $pOnlineList->get ( + ($pOnlineList->curselection)[0] + ); + print "selected: $selected\n"; + my ($name,$addr) = split(/:/, $selected, 2); + &ignoreUser (undef,$name); + &refreshIgnoreLists(); + }, + )->grid (-column => 0, -row => 3, -sticky => 'n'); + + my $btnUnignore = $ignoreFrame->Button ( + -text => 'Unignore Selected', + -font => $FONT, + -command => sub { + my $selected = $pIgnoreList->get ( + ($pIgnoreList->curselection)[0] + ); + print "selected: $selected\n"; + my ($name,$addr) = split(/:/, $selected, 2); + &ignoreUser (undef,$name); + &refreshIgnoreLists(); + }, + )->grid (-column => 1, -row => 3, -sticky => 'n'); + + my $btnRefresh = $ignoreFrame->Button ( + -text => 'Refresh Lists', + -font => $FONT, + -command => \&refreshIgnoreLists, + )->grid (-column => 0, -row => 4, -sticky => 'w'); + + my $ignOpts = $ignoreFrame->Pane ( + )->grid (-column => 0, -row => 5, -columnspan => 2, -sticky => 'nw'); + + my $labStickyIgnore = $ignOpts->Checkbutton ( + -variable => \$config{stickyignore}, + -text => 'Remember my ignore list.', + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 0, -row => 1, -sticky => 'w'); + + my $labMutualIgnores = $ignOpts->Checkbutton ( + -variable => \$config{ignoreback}, + -text => "Perform mutual ignores", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 0, -row => 2, -sticky => 'w'); + + my $labLoudIgnore = $ignOpts->Checkbutton ( + -variable => \$config{loudignore}, + -text => "Tell me when somebody ignores me", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 1, -row => 1, -sticky => 'w'); + + my $labSendIgnore = $ignOpts->Checkbutton ( + -variable => \$config{sendignore}, + -text => "Send server ignore command when ignoring users", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 1, -row => 2, -sticky => 'w'); + + # Balloon Tooltips. + $tipper->attach ($labOnlineUsers, + -msg => "This listbox displays the current online users.", + ); + $tipper->attach ($labIgnoredUsers, + -msg => "This listbox displays the users you're currently ignoring.", + ); + $tipper->attach ($btnIgnore, + -msg => "Click this button to ignore the selected user.", + ); + $tipper->attach ($btnUnignore, + -msg => "Click this button to remove the selected user from your " + . "ignore list.", + ); + $tipper->attach ($btnRefresh, + -msg => "Click this button to refresh the lists on this page.", + ); + $tipper->attach ($labStickyIgnore, + -msg => "Enable this option to save your Ignore List after you " + . "shut down PCCC.", + ); + $tipper->attach ($labMutualIgnores, + -msg => "Automatically ignore everyone who ignores us.", + ); + $tipper->attach ($labLoudIgnore, + -msg => "When enabled, show a message in chat when somebody " + . "ignores you.", + ); + $tipper->attach ($labSendIgnore, + -msg => "When enabled, send the actual Ignore command to " + . "the CyanChat server (which can then notify the " + . "target that you are ignoring them).\n" + . "Server-side ignores can't be unignored without " + . "disconnecting from the server.", + ); + + ###################### + ## Sound Effects ## + ###################### + + my $sfxTab = $tabFrame->add ("sfx", + -label => "Sounds", + -raisecmd => sub { + $helpPage = "sounds.html"; + }, + ); + + my $sfxLabFrame = $sfxTab->LabFrame ( + -labelside => 'acrosstop', + -label => 'Sound Effects', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->pack (-fill => 'x'); + + my $sfxFrame = $sfxLabFrame->Pane ( + )->pack (-side => 'left', -padx => 15); + + my $labPlaySounds = $sfxFrame->Checkbutton ( + -variable => \$config{playsounds}, + -text => "Enable Sound Effects", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 0, -row => 0, -sticky => 'w'); + + my $eventLabFrame = $sfxTab->LabFrame ( + -labelside => 'acrosstop', + -label => 'Events', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->pack (-fill => 'x'); + + my $eventFrame = $eventLabFrame->Pane ( + )->pack (-side => 'left', -padx => 15); + + my $labJoinSound = $eventFrame->Checkbutton ( + -variable => \$config{playjoin}, + -text => "When a user joins the room...", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 0, -row => 0, -sticky => 'w'); + + my $labLeaveSound = $eventFrame->Checkbutton ( + -variable => \$config{playleave}, + -text => "When a user exits the room...", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 0, -row => 1, -sticky => 'w'); + + my $labPublicSound = $eventFrame->Checkbutton ( + -variable => \$config{playpublic}, + -text => "When a message is received...", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 0, -row => 2, -sticky => 'w'); + + my $labPrivateSound = $eventFrame->Checkbutton ( + -variable => \$config{playprivate}, + -text => "When a private message is received...", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 0, -row => 3, -sticky => 'w'); + + for (my $i = 0; $i <= 3; $i++) { + $eventFrame->Label ( + -text => "play", + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 1, -row => $i, -sticky => 'e'); + } + + # Create a list of wav files from the sfx folder. + opendir (DIR, "./sfx"); + my @wavs = sort(grep(/\.wav$/i, readdir(DIR))); + closedir (DIR); + + my $i = 0; + foreach (qw(joinsound leavesound publicsound privatesound)) { + my $tmp = $eventFrame->BrowseEntry ( + -variable => \$config{$_}, + -font => $FONT, + -options => [ + @wavs, + ], + )->grid (-column => 2, -row => $i, -sticky => 'w'); + $tmp->Subwidget("entry")->configure ( + -background => '#FFFFFF', + -foreground => '#000000', + -font => $FONT, + -width => 10, + ); + $eventFrame->Button ( + -text => 'Play', + -font => $FONT, + -command => [ sub { + my $sound = shift; + if (length $config{$sound}) { + push (@PLAYSOUNDS,$config{$sound}); + } + }, $_ ], + )->grid (-column => 3, -row => $i, -sticky => 'w'); + + $i++; + } + + ###################### + ## Miscellaneous ## + ###################### + + my $miscTab = $tabFrame->add ("misc", + -label => "Miscellaneous", + -raisecmd => sub { + $helpPage = "misc.html"; + }, + ); + + my $progLabFrame = $miscTab->LabFrame ( + -labelside => 'acrosstop', + -label => 'External Programs', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->pack (-fill => 'x'); + + my $progFrame = $progLabFrame->Pane ( + )->pack (-side => 'left', -padx => 15); + + my $labBrowser = $progFrame->Label ( + -text => "Web Browser Command:", + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 0, -row => 0, -sticky => 'e'); + + my $labBrowserCmd = $progFrame->BrowseEntry ( + -variable => \$config{browser}, + -options => [ + "start", + "htmlview", + "open", + ], + -font => $FONT, + )->grid (-column => 1, -row => 0, -sticky => 'w'); + $labBrowserCmd->Subwidget("entry")->configure ( + -background => '#FFFFFF', + -foreground => '#000000', + -font => $FONT, + -width => 20, + ); + + my $labMPlayer = $progFrame->Label ( + -text => "Command-line Media Player:", + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->grid (-column => 0, -row => 1, -sticky => 'e'); + + # For Windows users, don't even show this option. + if ($^O =~ /win(32|64)/i) { + $progFrame->Label ( + -text => "Win32::MediaPlayer", + -font => $FONT, + )->grid (-column => 1, -row => 1, -sticky => 'w'); + } + else { + my $labMPlayerCmd = $progFrame->Entry ( + -textvariable => \$config{mediaplayer}, + -width => 20, + -font => $FONT, + )->grid (-column => 1, -row => 1, -sticky => 'w'); + } + + # Balloon Tooltip. + $tipper->attach ($labBrowser, + -msg => "Type or select the command-line program for " + . "viewing web pages.\n" + . "Windows should use `start`\n" + . "Linux should use `htmlview`\n" + . "Mac should use `open`", + ); + + my $miscLabFrame = $miscTab->LabFrame ( + -labelside => 'acrosstop', + -label => 'Miscellaneous Options', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->pack (-fill => 'x'); + + my $miscFrame = $miscLabFrame->Pane ( + )->pack (-side => 'left', -padx => 15); + + my $labImWindows = $miscFrame->Checkbutton ( + -variable => \$config{imwindows}, + -text => "Show private messages in new windows", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 0, -row => 0, -sticky => 'w'); + + my $labIgnoreServer = $miscFrame->Checkbutton ( + -variable => \$config{blockserver}, + -text => "Ignore private messages from ChatServer", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 0, -row => 1, -sticky => 'w'); + + my $labAction = $miscFrame->Checkbutton ( + -variable => \$config{autoact}, + -text => "Show *...* messsages as /me actions", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 0, -row => 5, -sticky => 'w'); + + my $labTypo = $miscFrame->Checkbutton ( + -variable => \$config{loudtypo}, + -text => "Highlight typo corrections", + -onvalue => 1, + -offvalue => 0, + -font => $FONT, + )->grid (-column => 0, -row => 6, -sticky => 'w'); + + # Balloon Tooltip. + $tipper->attach ($labIgnoreServer, + -msg => "Ignores private messages sent by [ChatServer] " + . "(useful when on debug port 1813)", + ); + $tipper->attach ($labAction, + -msg => "Messages starting and ending with a * will get " + . "displayed as a \"/me\" style message.", + ); + $tipper->attach ($labTypo, + -msg => "Messages starting with * will get displayed as a " + . "\"typo correction\" message.", + ); + + my $defLabFrame = $miscTab->LabFrame ( + -labelside => 'acrosstop', + -label => 'Revert to Default Settings', + -font => [ + @{$FONT}, + -weight => 'bold', + ], + )->pack (-fill => 'x'); + + my $defFrame = $defLabFrame->Pane ( + )->pack (-side => 'top', -fill => 'x', -expand => 1, -padx => 15); + + $defFrame->Label ( + -text => "Click the button below to revert back to the " + . "default configuration:", + -font => $FONT, + )->pack; + + $defFrame->Button ( + -text => "Reset Configuration", + -font => $FONT, + -command => sub { + # Delete the config file. + if (-f "$homedir/config.txt") { + unlink ("$homedir/config.txt"); + } + # Reload configuration. + &initConfig("cancel"); + &bindChatTags(); + + # Destroy this window. + $windows{__prefs__}->destroy; + + # Reload this window. + &prefs(); + }, + )->pack; + } +} + +sub refreshIgnoreLists { + # Sort and populate the lists. + $pOnlineList->delete ('0','end'); + $pIgnoreList->delete ('0','end'); + + my @lsonline = sort { $a cmp $b } keys %online; + my @lsignore = sort { $a cmp $b } keys %ignore; + + # Populate the online users list, skip ignored users. + foreach my $nln (@lsonline) { + next if exists $ignore{$nln}; + + # Get the user's info. + my ($level,$addr) = split(/\;/, $online{$nln}, 2); + + $pOnlineList->insert ('end',"$nln:$addr"); + } + + # Populate the ignore users list. + foreach my $nln (@lsignore) { + print "add ignore: $nln ($online{$nln})\n"; + my ($level,$addr) = split(/\;/, $online{$nln}, 2); + $pIgnoreList->insert ('end',"$nln:$addr"); + } +} + +sub playSound { + my $option = shift; + my $sfx = join ("",$option,"sound"); + my $check = join ("","play",$option); + + # See if we're allowed to play this sound. + my $allowed = 1; + + # If the global configuration is disabled, don't allow. + if ($config{playsounds} == 0) { + $allowed = 0; + } + + # If we're muting the sounds temporarily, don't allow. + if ($mutesfx == 1) { + $allowed = 0; + } + + # If this particular event is disabled, don't allow. + if ($config{$check} == 0) { + $allowed = 0; + } + + # If the file doesn't exist, don't allow. + if (!-f "./sfx/$config{$sfx}") { + $allowed = 0; + } + + # If allowed, play it. + if ($allowed) { + push (@PLAYSOUNDS,$config{$sfx}); + } + + return $allowed; +} + +sub help { + my $page = shift || "index.html"; + + if (exists $windows{__help__}) { + $windows{__help__}->focusForce; + &helpPage ($page); + } + else { + @helphistory = (); + + $windows{__help__} = $mw->Toplevel ( + -title => 'PCCC Help', + ); + $windows{__help__}->geometry ('550x400'); + $windows{__help__}->Icon (-image => $IMAGE{worlds}); + + $windows{__help__}->bind ('', sub { + $htmlhelp = undef; + delete $windows{__help__}; + }); + + # Draw the toolbar frame. + my $tbFrame = $windows{__help__}->Frame ( + -borderwidth => 2, + -relief => 'raised', + )->pack (-side => 'top', -fill => 'x'); + + # Toolbar buttons. + my $btnContents = $tbFrame->Button ( + -text => "Contents", + -font => $FONT, + -command => sub { + &helpPage ("index.html"); + }, + )->pack (-side => 'left'); + my $btnBack = $tbFrame->Button ( + -text => "Back", + -font => $FONT, + -command => sub { + &helpBack; + }, + )->pack (-side => 'left'); + my $btnExit = $tbFrame->Button ( + -text => "Close", + -font => $FONT, + -command => sub { + $windows{__help__}->destroy; + }, + )->pack (-side => 'left'); + + # Main frame. + my $mainFrame = $windows{__help__}->Frame ( + )->pack (-fill => 'both', -expand => 1); + + # HTML widget. + $htmlhelp = $mainFrame->Scrolled ("HyperText", + -scrollbars => 'e', + -wrap => 'word', + -titlecommand => \&helpTitle, + -linkcommand => \&helpLink, + )->pack (-fill => 'both', -expand => 1); + + # Show the requested page. + &helpPage ($page); + } +} + +sub helpPage { + my $page = shift; + my $nohistory = shift || 0; + + if (!-f "./docs/$page") { + $page = "404.html"; + } + + open (PAGE, "./docs/$page"); + my @html = ; + close (PAGE); + chomp @html; + + my $code = join ("\n",@html); + $code =~ s/%VERSION%/$VERSION/ig; + $code =~ s/%DATE%/$MODIFIED/ig; + $code =~ s/%CC%/$Net::CyanChat::VERSION/ig; + $code =~ s/%HTML%/$Tk::HyperText::VERSION/ig; + + print "Load help document $page\n"; + unless ($nohistory) { + push (@helphistory, $page); + shift(@helphistory) until scalar(@helphistory) <= 25; + } + + if (defined $htmlhelp) { + $htmlhelp->clear; + $htmlhelp->insert ('end',$code); + } +} + +sub helpBack { + if (scalar(@helphistory)) { + my $back = pop(@helphistory); + &helpPage ($back,1); + } +} + +sub helpTitle { + my ($widget,$title) = @_; + if (defined $windows{__help__}) { + if (length $title) { + $windows{__help__}->title ("$title - PCCC Help"); + } + else { + $windows{__help__}->title ("PCCC Help"); + } + } +} + +sub helpLink { + my ($widget,$href,$target) = @_; + + if ($target eq "_blank") { + push (@HYPERLINKLIST, $href); + } + else { + &helpPage ($href); + } +} diff --git a/README.md b/README.md new file mode 100644 index 0000000..2b34902 --- /dev/null +++ b/README.md @@ -0,0 +1,140 @@ +# Perl CyanChat Client + +## I. About PCCC + +Perl CyanChat Client 2.x is a complete rewrite from the original +1.x versions. The new client uses `Net::CyanChat` to connect to +the CyanChat servers instead of having the code included within +PCCC's own code. + +PCCC 1.x was actually written prior to Net::CyanChat which I +created AFTER making PCCC 1.x, so the new PCCC makes up for that. + +## II. About CyanChat + +CyanChat is the name of a chat room which is owned by Cyan Worlds, +Inc. (formerly known simply as Cyan). They created some really good +adventure games named Myst and Riven (and Myst III and then Myst IV +and V too), as well as a few other spinoff games such as Uru and +RealMyst. + +The chat server was programmed by Mark Deforest of Cyan Worlds. The +chat room was created so that fans of Cyan could have a place to +meet and discuss their games and novels and interact with other fans. +The "CyanChat Community" is made up of a small number of members who +have been with CyanChat for years and years (I first went to CyanChat +like six years ago and the same group of people are still here today!) + +The official homepage to CyanChat is: http://cho.cyan.com/chat/ + +## III. CyanChat Rules and Policies + +Official Rules Page: http://cho.cyan.com/chat/rules.html + +* Be respectful of and sensitive to others. +* Please, no platform wars ("my computer is better than yours"). +* Keep it "G" rated; in other words, suitable for family viewing. +* No flooding, in other words, filling the screen with junk. +* But most of all HAVE FUN! + +### A. Impersonating + +No name or handle is reserved for any one person. +However, purposely impersonating someone for personal +gain or in disrespect of the person being impersonated +will not be tolerated. So, please try to find a +unique name for yourself. + +### B. Being Banned + +The CyanChat server has a bad language filter that +watches all the messages being sent. If it detects +that you have used bad language, depending how severe, +it might automatically ban you from using CyanChat, +ban you for a day or just censor the message. Once +you have been banned you will get a message when you +start CyanChat that your IP address has been blocked +from using CyanChat. + +### C. Getting Unbanned + +There are many reasons why an IP address might be banned +from CyanChat, some reasons are accidental, such as misspelling +a word. If you've gotten accidentally banned, e-mail markd@cyan.com +with the IP address that is banned. But one thing to +remember is that I have a log of all the bannings (and what +was said) and its usually quite obvious, so don't try the +"accident" angle unless it really was. + +## IV. Configuring PCCC + +After running PCCC for the first time, you can configure CyanChat +by choosing "Edit -> Preferences". The client assumes a number of default +preferences, which you can change. If you want to restore them to their +defaults, either delete "config.txt" and restart the program, or click +"Restore Defaults" in the preferences window. + +## V. Using PCCC + +When you open PCCC, it should connect automatically unless you specified +that it shouldn't. In that case, click "Connection -> Connect" on the menu +bar to connect to CyanChat. + +When connected, you will receive a lot of messages from ChatServer. These +are introduction messages. + +Type a nickname for yourself in the box next to the word "Name:" toward +the top of the window. Then click "Join Chat" to enter the room. Note that +nicknames can be no longer than 20 characters and that they can't contain +the pipe symbol `|`. + +Write messages into the long text box above the chat dialog space. To send +a private message to somebody, there are three options you can use: + +1. Write a message into the normal message space, then single-click + the target's name from the Who List, and click "Send Private" +2. Double-click a user's name from the Who List to open a Private + Message window. Type your message into this window and hit Enter. +3. In the normal message space, type `/whisper `, + substituting a user's name for `` and a message for ``. + +To exit the chat room, click the "Exit Chat" button. To disconnect from +CyanChat, click "Connection -> Disconnect". Doing this will also sign you +out if you are currently signed in to the chat room. + +Exiting PCCC via "File -> Exit" will also sign you out and disconnect you +where applicable. Closing out of the program in any other means will result +in a "disconnect", where CyanChat will simply tell the other users that you +were disconnected rather than that you signed out properly. + +## VI. Installation + +Perl CyanChat Client should work fine on all operating systems. It mostly +uses the standard Tk modules from Tk version 804.027 + +In addition to the standard Tk modules, the following nonstandard modules +may need to be installed: + + Net::CyanChat 0.04 or higher. + +These modules have been included in the standard distribution of +Perl CyanChat Client. + +## VII. License and Copyright + + Perl CyanChat Client + Copyright (C) 2006-13 Noah Petherbridge + + 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., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. diff --git a/balloon.gif b/balloon.gif new file mode 100644 index 0000000..083fbd7 Binary files /dev/null and b/balloon.gif differ diff --git a/docs/404.html b/docs/404.html new file mode 100644 index 0000000..e8dba80 --- /dev/null +++ b/docs/404.html @@ -0,0 +1,13 @@ + + +Error 404 + + + + +

404 Error

+ +The page you requested was not found. + + + diff --git a/docs/about.html b/docs/about.html new file mode 100644 index 0000000..556e742 --- /dev/null +++ b/docs/about.html @@ -0,0 +1,27 @@ + + +About PCCC + + + + +

About Perl CyanChat Client

+ +The Perl CyanChat Client (PCCC) is a program used for chatting on the + Cyan Worlds chat room. + It was written using the programming language + Perl, and the Tk graphical + user interface. + +

About CyanChat

+ +CyanChat is the name of the chat room of Cyan Worlds, Inc., where the fans of + Cyan's games and novels can meet and chat with one another. + +

PCCC Version

+ +You are running Perl CyanChat Client version %VERSION% (%DATE%).

+Running on Net::CyanChat v. %CC% and Tk::HyperText v. %HTML% + + + diff --git a/docs/action.html b/docs/action.html new file mode 100644 index 0000000..ae19431 --- /dev/null +++ b/docs/action.html @@ -0,0 +1,36 @@ + + +Action Messages + + + + +

Action Messages

+ +"Action Messages" are a bit of an extension to the CyanChat protocol. It's not + actually supported on the CC server, but several home-made CC clients support + this. + +

IRC-Style /me Actions

+ +Typing in "/me <action>" in the message space is the standard way of sending + an action message. To all clients who support the feature, your message should appear + special on their client. To those which don't support the feature, they'll simply + see "/me <action>" from you. + +

Automatic Actions

+ +There is an option on the Miscellaneous tab of the Preferences + window which will automatically display certain messages in the "action" format.

+ +When enabled, a message that begins and ends with asterisks (*) will automatically be + displayed as action messages. + +

Typo Messages

+ +Typo messages are similar to action messages in that they display in a special color. + When a message is received that begins with a * but doesn't end with one, the message + is displayed normally, but the text is displayed in the "action color" + + + diff --git a/docs/colors.html b/docs/colors.html new file mode 100644 index 0000000..ed45e51 --- /dev/null +++ b/docs/colors.html @@ -0,0 +1,33 @@ + + +Color Preferences + + + + +

Preferences: Colors

+ +

Chat Colors

+ +
+ PCCC Interface +
+ These colors will determine elements on the main window of PCCC, separate from + the chat dialog window within. +
+ + Chat Colors +
+ These control the general color scheme of the dialog window, such as text + colors related to private messages, actions, and hyperlinks. +
+ + Nickname Colors +
+ These control the colors of different nickname types within the dialog + window. +
+
+ + + diff --git a/docs/connection.html b/docs/connection.html new file mode 100644 index 0000000..aa907b8 --- /dev/null +++ b/docs/connection.html @@ -0,0 +1,36 @@ + + +Connection Preferences + + + + +

Preferences: Connection

+ +

Server Settings

+ +
+ CyanChat Host +
+ The name of the CC server. Default is cho.cyan.com +
+ + Port +
+ The port that the CC server will listen to you from. Default is 1812, + while port 1813 is used for testing. +
+ + Automatically connect when PCCC starts +
+ When checked, PCCC will automatically connect to the server when it starts. +
+ + Attempt to reconnect when disconnected +
+ When checked, PCCC will attempt to reconnect when it has been disconnected. +
+
+ + + diff --git a/docs/console.html b/docs/console.html new file mode 100644 index 0000000..5664772 --- /dev/null +++ b/docs/console.html @@ -0,0 +1,26 @@ + + +Chat Console + + + + +

Chat Console

+ +The Chat Console (also known as the Debug Window) is a small window that + monitors all incoming and outgoing TCP packets. It's useful as a debugging tool, + and to see what's really going on in the background during your CC connection.

+ +Messages sent from your client to the server appear in red + text, while messages received from the server are in blue.

+ +Note that the chat console does not automatically scroll so long as you have + the window opened. This is actually more useful for debugging purposes than having + the window keep scrolling to the bottom constantly. However, when you first open the + window, it will automatically jump to the bottom.

+ +To make the window disappear, click the "Dismiss" button. The "X" button on the title + bar won't close the window. + + + diff --git a/docs/cyan.html b/docs/cyan.html new file mode 100644 index 0000000..2da3600 --- /dev/null +++ b/docs/cyan.html @@ -0,0 +1,25 @@ + + +Cyan Staff + + + + +

Cyan Staff

+ +The Cyan Staff (also known as Cyanites or Cyantists) are the staff members of the + company Cyan Worlds. When they enter the chat room, their "link in" message will + read: "<links in from Cyan Worlds, Inc.>"

+ +Additionally, their nicknames will be placed in the "Cyan & Guests" list instead + of the standard Who List, and their names will appear in + cyan text. + +

Special Guests

+ +Occasionally, a Cyantist will promote a regular user to the level of "Special Guest". + Special Guests also appear in the special "Cyan & Guests" list, and their nicknames + will appear in orange text. + + + diff --git a/docs/details.html b/docs/details.html new file mode 100644 index 0000000..f59faac --- /dev/null +++ b/docs/details.html @@ -0,0 +1,15 @@ + + +Connection Details + + + + +

Connection Details

+ +This window is relatively useless. It lists the server, port, and connection + status. If it recognizes the server or the port to be CC standard, it will + display a notification next to it. + + + diff --git a/docs/general.html b/docs/general.html new file mode 100644 index 0000000..2c5dd22 --- /dev/null +++ b/docs/general.html @@ -0,0 +1,82 @@ + + +General Preferences + + + + +

Preferences: General

+ +

Appearance

+ +
+ Main Font Face +
+ This font face is used in the chat dialog window, as well as on all + of the GUI elements everywhere else in the program (on labels, buttons, + text boxes, etc.) +
+ + Font Size +
+ Specify the main font size, in pixels. +
+ + Dialog Flow +
+ New messages on top (default CC behavior) +
+ When new messages are received, they'll appear at the top + of the dialog window. This is how the standard client + behaves. +
+ New messages on bottom +
+ This mimics the behavior of most other chat programs. New + messages will appear on the bottom. +
+
+ + Display Options +
+ Reverse orientation +
+ When checked, the message space will start appearing beneath + the dialog window, like most other chat programs. Changing + this option requires a restart of the program. +
+ + Animate the window titles when new messages arrive +
+ When checked, the titles of the main window and message + windows will animate when a new message arrives while the + window is out of focus or minimized. +
+ + Automatically log all transcripts +
+ When checked, all messages are automatically logged to + HTML files. They're saved in your profile directory. See + User Profiles for more information. +
+
+
+ +

Nickname Settings

+ +
+ Default Nickname: +
+ This nickname will be automatically filled in to the "Name" box + when you start up PCCC. +
+ + Automatically join chat when connected +
+ When checked, you will automatically join the chat room when you + connect (provided you have a nickname entered at the time). +
+
+ + + diff --git a/docs/ignore.html b/docs/ignore.html new file mode 100644 index 0000000..edb6b22 --- /dev/null +++ b/docs/ignore.html @@ -0,0 +1,24 @@ + + +Ignoring Users + + + + +

Ignoring Users

+ +If a user is being annoying, you can ignore them by selecting their name on the + Who List and pressing the "Ignore" button below.

+ +You can also ignore/unignore users by going to the Ignored + Users tab on the Preferences window.

+ +You can unignore users by selecting their name on the Who List and pressing the + "Ignore" button again. + +

Advanced Ignore Options

+ +See the Ignored Users page for more information. + + + diff --git a/docs/ignorelist.html b/docs/ignorelist.html new file mode 100644 index 0000000..3d05ec6 --- /dev/null +++ b/docs/ignorelist.html @@ -0,0 +1,59 @@ + + +Ignored Users Preferences + + + + +

Preferences: Ignored Users

+ +

Ignored Users

+ +
+ Online Users +
+ This listbox displays all of the users currently signed in to CyanChat + (but not the ones you've ignored). Select a user from the list and press + "Ignore Selected" to move them to the Ignored Users list. +
+ + Ignored Users +
+ This listbox displays all of the users you've ignored. Select a user from + the list and choose "Unignore Selected" to stop ignoring them. +
+ + Refresh Lists +
+ This button will refresh the listboxes. The lists are also refreshed + each time you bring focus to the "Ignored Users" tab. +
+ + Remember my ignore list +
+ When checked, your ignore list will be saved when you exit PCCC and + be reloaded when you start it again. +
+ + Perform mutual ignores +
+ When checked, PCCC will automatically ignore any users who ignore us. +
+ + Tell me when somebody ignores me +
+ When checked, you will receive a notification in the dialog window + when somebody has ignored you. +
+ + Send server ignore command when ignoring users +
+ When checked, ignoring a user will send a standard CC ignore command + to the server. What this does is tells the server to relay your + ignore to the client in question, so that they may perform a mutual + ignore. +
+
+ + + diff --git a/docs/index.html b/docs/index.html new file mode 100644 index 0000000..2a049ad --- /dev/null +++ b/docs/index.html @@ -0,0 +1,41 @@ + + +Contents + + + + +

Perl CyanChat Client

+ +Getting Started

+ +> About Perl CyanChat Client
+> CyanChat Rules

+ +Using PCCC

+ +> General Usage
+> User Profiles
+> Private Messaging
+> Action Messages
+> Ignoring Users
+> Cyan Staff
+> Save Transcript

+ +Configuration

+ +> General
+> Connection
+> Colors
+> Ignored Users
+> Sounds
+> Miscellaneous

+ +Advanced Features

+ +> Chat Console
+> Send Raw Command
+> Connection Details + + + diff --git a/docs/misc.html b/docs/misc.html new file mode 100644 index 0000000..f8a2ea4 --- /dev/null +++ b/docs/misc.html @@ -0,0 +1,73 @@ + + +Miscellaneous Preferences + + + + +

Preferences: Miscellaneous

+ +

External Programs

+ +
+ Web Browser Command +
+ This is the command-line program used for launching your web + browser. The dropdown list includes the most likely programs + for each operating system, but you can type in a custom command + too (ex: "firefox")

+ + Windows users should be fine with start
+ Linux and Unix users should use htmlview
+ Mac OS users should use open +

+ + Command-line Media Player +
+ This is the command-line program used for playing sound effects. + This is only applicable to Linux and Mac users. On Windows, the + module Win32::MediaPlayer is used instead.

+ + Linux users should be fine with play +

+
+ +

Miscellaneous Options

+ +
+ Show private messages in new windows +
+ When checked, all private messages will appear in their own "IM" + windows. Disable this to get the standard CC behavior back. When + disabled, IM windows can only be created by double-clicking a user's + name in the list. +
+ + Ignore private messages from ChatServer +
+ Check this to ignore all private messages from ChatServer. This + is NOT RECOMMENDED. It's most useful on the test server, + where ChatServer echoes a confirmation of every little thing your + client does, but should not be used on the real server. +
+ + Show *...* messages as /me actions +
+ This option will automatically display messages as "/me" actions + if they start and end with asterisks. See + Action Messages. +
+ + Highlight typo corrections +
+ This option will automatically display "typo" messages uniquely. + See Action Messages. +
+
+ +

Revert to Default Settings

+ +This button will restore all of your configuration back to the defaults. + + + diff --git a/docs/pm.html b/docs/pm.html new file mode 100644 index 0000000..6b3b4d4 --- /dev/null +++ b/docs/pm.html @@ -0,0 +1,50 @@ + + +Private Messaging + + + + +

Private Messaging

+ +The CyanChat server supports the sending of private messages to other + participants of the chat room. There are three different ways to send private + messages: + +

The CyanChat Way

+ +The "CyanChat Way" is the method used in the standard CyanChat client. To send + a private message to somebody:

+ +1. Select the recipient's name from the Who List
+2. Type in a message to send to them.
+3. Press the "Send Private" button located beneath the Who List. + +

The IRC Way

+ +The "IRC Way" is the method that is used on IRC chat servers (CC is not based on + IRC, but IRC users might be more familiar with this method).

+ +1. Type in "/msg <recipeint> <message>" into the message space.
+Example: /msg Cuvou hello there!

+ +The aliases /whisper and /w may also be used. + +

The IM Way

+ +The final method, the "IM Way", is the method that is characteristic of Instant + Messaging programs. Simply double-click a user's name from the Who List and open + an Instant Message window with them. + +

Message Windows

+ +Unless you disable it, the sending or receiving of private messages will always + open a message window with that user. All later private messages received from + the same user will go to this same window.

+ +If you have disabled this, then the only way to open a message window is if you + open it yourself, by double-clicking a user's name. See + Miscellaneous Configuration Options. + + + diff --git a/docs/profile.html b/docs/profile.html new file mode 100644 index 0000000..445127e --- /dev/null +++ b/docs/profile.html @@ -0,0 +1,27 @@ + + +User Profiles + + + + +

User Profiles

+ +PCCC saves your configuration and logs to your "user profile directory". This directory + is your home directory, plus "PCCC" or ".pccc". To locate it, read on for a list of + common places for each operating system. + +

Windows XP

+ +
+C:\Documents and Settings\username\PCCC +
+ +

Linux and Unix

+ +
+/home/username/.pccc +
+ + + diff --git a/docs/raw.html b/docs/raw.html new file mode 100644 index 0000000..acf0364 --- /dev/null +++ b/docs/raw.html @@ -0,0 +1,29 @@ + + +Raw Commands + + + + +

Send Raw Command

+ +WARNING!!!

+ +This function of PCCC is VERY dangerous. The CyanChat server is very picky + about the messages it will receive from your client. If you send an improperly + formatted command, you may be banned from the server.

+ +I cannot be held responsible if you get yourself banned by using this feature. + +

Sending a Raw Command

+ +To send a raw command, type it into the text box on the "Send Raw Command" window. + Press "Send Command" to send it. The "Return" key will not send the command + (as of version 3.0), because accidentally tapping Return and sending an incomplete + command was an easy way to get banned.

+ +Press the "Spawn Debug Window" button to open the Chat + Console window. + + + diff --git a/docs/rules.html b/docs/rules.html new file mode 100644 index 0000000..be3349e --- /dev/null +++ b/docs/rules.html @@ -0,0 +1,44 @@ + + +Rules + + + + +

CyanChat Rules

+ +* Be respectful of and sensitive to others.
+* Please, no platform wars ("my computer is better than yours").
+* Keep it "G" rated; in other words, suitable for family viewing.
+* No flooding, in other words, filling the screen with junk.
+* But most of all HAVE FUN! + +

Impersonating

+ +No name or handle is reserved for any one person. However, purposely impersonating + someone for personal gain or in disrespect of the person being impersonated + will not be tolerated. So, please try to find a unique name for yourself. + +

Being Banned

+ +The CyanChat server has a bad language filter that watches all the messages being + sent. If it detects that you have used bad language, depending how severe, + it might automatically ban you from using CyanChat, ban you for a day + or just censor the message. Once you have been banned you will get a message + when you start CyanChat that your IP address has been blocked from using CyanChat. + +

Getting Unbanned

+ +There are many reasons why an IP address might be banned from CyanChat, some reasons + are accidental, such as misspelling a word. If you've gotten accidentally banned, + e-mail markd@cyan.com with the + IP address that is banned. But one thing to remember is that MarkD has a log of all + the bannings (and what was said) and it's usually quite obvious, so don't try the + "accident" angle unless it really was.

+ +Offical CC Rules Page: + +http://cho.cyan.com/chat/rules.html + + + diff --git a/docs/sounds.html b/docs/sounds.html new file mode 100644 index 0000000..cc812af --- /dev/null +++ b/docs/sounds.html @@ -0,0 +1,56 @@ + + +Sound Preferences + + + + +

Preferences: Sounds

+ +

Sound Effects

+ +
+ Enable Sound Effects +
+ Check this to enable the use of sound effects globally. Disable this + to globally disable found effects.

+ + NOTE: To mute sound effects temporarily, just choose "Mute sounds" + from the "Chat" menu. +

+
+ +

Events

+ +
+ When a user joins the room... +
+ Specify a sound effect to play when a user enters the room. +
+ + When a user exits the room... +
+ Specify a sound effect to play when a user leaves the room + (or is disconnected). +
+ + When a message is received... +
+ Specify a sound effect to play when a user sends a public + message in the chat room. +
+ + When a private message is received... +
+ Specify a sound effect to play when a private message is + received. +
+
+ +

Adding Sound Effects

+ +To add your own sound effects, drop the sound file into the "sfx" folder, + located within the PCCC folder. + + + diff --git a/docs/transcript.html b/docs/transcript.html new file mode 100644 index 0000000..0ccd9de --- /dev/null +++ b/docs/transcript.html @@ -0,0 +1,32 @@ + + +Save Transcript + + + + +

Save Transcript

+ +You can save the current chat conversation by choosing "File" from the menu bar, + and clicking "Save Transcript". You can save it either to an HTML document or to + a plain text file. + +

HTML Document

+ +When saved to an HTML document, the chat dialog is written as compliant XHTML + source code, keeping all of the chat colors intact. + +

Text Document

+ +When saved to a text document, the chat dialog is saved in plain text format, + without any of the colors and special formatting. + +

Automatic Logging

+ +In the General tab of the Preferences window, there's + an option to automatically save all transcripts. To review the saved logs, look + in your profile directory. See User Profiles for more + information. + + + diff --git a/docs/usage.html b/docs/usage.html new file mode 100644 index 0000000..fba7d3a --- /dev/null +++ b/docs/usage.html @@ -0,0 +1,65 @@ + + +Using PCCC + + + + +

Getting Started with PCCC

+ +When you start up the Perl CyanChat Client, you will be presented with the + Main Window, where a message by "ChatClient" is + already visible on screen, welcoming you to PCCC.

+ +To connect to the CyanChat room, select "Connection" from the menu bar, + and choose "Connect". This will attempt to connect you to the CyanChat server. + Once connected, you will see a lot of "lobby messages" sent by + "ChatServer", and moments later the Who List will + display the list of users logged into the chat room (if there are any logged in). + +

Chat Presence

+ +To enter the chat, type in a nickname for yourself in the "Name:" box, and + then press the "Join Chat" button. Note that your nickname must be less than + 20 characters long, and cannot contain a caret (^), pipe symbol ("|"), or a + comma. If your name is accepted by the server, you will "link in" to the room. Otherwise, + ChatServer will tell you that your nick was invalid.

+ +When a user links in to the chat room (in other words, enters the room), a message + will display similar to the following: + +

+ \\\\\[Nick] <links in from somewhere on the internet Age>//// +
+ +When a user links out of the chat room (in other words, exiting the room by + clicking the "Exit Chat" button), a message will display similar to the following: + +
+ /////[Nick] <links safely back to their home Age>\\\\\ +
+ +Finally, when a user disconnects from the chat room, the following message + is displayed: + +
+ /////[Nick] <mistakenly used an unsafe linking book without a maintainer's suit + *ZZZZZWHAP*>\\\\\ +
+ +All users in the chat room also have a unique address assigned to them. This + is a mangled up form of their IP address, so multiple nicks from the same computer + will probably have the same address. To see a user's address, right-click their name + in the Who List. + +

Standard Messaging

+ +To send a message to the chat room, simply type it into the entry box at the top of the + Main Window and press the Return key. Note that you must be logged in before you can + send messages!

+ +See Private Messaging and Action Messages + for information about different types of messaging. + + + diff --git a/lib/Net/CyanChat.pm b/lib/Net/CyanChat.pm new file mode 100644 index 0000000..eb9d539 --- /dev/null +++ b/lib/Net/CyanChat.pm @@ -0,0 +1,696 @@ +package Net::CyanChat; + +use strict; +use warnings; +use IO::Socket; +use IO::Select; + +our $VERSION = '0.06'; + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + + my $self = { + host => 'cho.cyan.com', # Default CC Host + port => 1812, # Default CC Port (1813=debugging) + debug => 0, # Debug Mode + proto => 1, # Use Protocol 1 (not 0) + sock => undef, # Socket Object + select => undef, # Select Object + pinged => 0, # Last Ping Time + refresh => 60, # Ping Rate = 60 Seconds + nickname => '', # Our Nickname + handlers => {}, # Handlers + connected => 0, # Are We Connected? + accepted => 0, # Logged in? + who => {}, # Who List + ignored => {}, # Ignored List + nicks => {}, # Nickname Lookup Table + @_, + }; + + # Protocol support numbers: 0 and 1. + if ($self->{proto} < 0 || $self->{proto} > 1) { + die "Unsupported protocol version: must be 0 or 1!"; + } + + bless ($self,$class); + return $self; +} + +sub version { + my ($self) = @_; + return $VERSION; +} + +sub debug { + my ($self,$msg) = @_; + + return unless $self->{debug} == 1; + print "Net::CyanChat::debug // $msg\n"; +} + +sub send { + my ($self,$data) = @_; + + # Send the data. + if (defined $self->{sock}) { + $self->_event ('Packet', 'outgoing', $data); + + # Send true CrLf + $self->{sock}->send ("$data\x0d\x0a") or do { + # We've been disconnected! + $self->{sock}->close(); + $self->{sock} = undef; + $self->{select} = undef; + $self->{connected} = 0; + $self->{nick} = ''; + $self->{pinged} = 0; + $self->{who} = {}; + $self->{nicks} = {}; + $self->_event ('Disconnected'); + }; + } + else { + warn "Could not send \"$data\" to CyanChat: connection not established!"; + } +} + +sub setHandler { + my ($self,$event,$code) = @_; + + # Set this handler. + $self->{handlers}->{$event} = $code; +} + +sub connect { + my ($self) = @_; + + # Connect to CyanChat. + $self->{sock} = new IO::Socket::INET ( + PeerAddr => $self->{host}, + PeerPort => $self->{port}, + Proto => 'tcp', + ); + + # Error? + if (!defined $self->{sock}) { + $self->_event ('Error', "00|Connection Error", "Net::CyanChat Connection Error: $!"); + } + + # Create a select object. + $self->{select} = IO::Select->new ($self->{sock}); + + # Send that we're ready. + $self->send ("40|$self->{proto}"); +} + +sub start { + my ($self) = @_; + + while (1) { + $self->do_one_loop or last; + } +} + +sub login { + my ($self,$nick) = @_; + + if (length $nick > 0) { + # Sign in. + $self->send ("10|$nick"); + $self->{nickname} = $nick; + return 1; + } + + return 0; +} + +sub logout { + my ($self) = @_; + + return 0 unless length $self->{nickname} > 0; + $self->{nickname} = ''; + $self->{accepted} = 0; + $self->send ("15"); + return 1; +} + +sub sendMessage { + my ($self,$msg) = @_; + + # Send the message. + return 0 unless length $msg > 0; + $self->send ("30|^1$msg"); +} + +sub sendPrivate { + my ($self,$to,$msg) = @_; + + return unless (length $to > 0 && length $msg > 0); + # Get the user's full nick. + my $nick = $self->{nicks}->{$to}; + + # Send this user a message. + $self->send ("20|$nick|^1$msg"); +} + +sub getBuddies { + my ($self) = @_; + + # Return the buddylist. + return $self->{who}; +} + +sub getFullName { + my ($self,$who) = @_; + + # Return this user's full name. + return $self->{full}->{$who} or 0; +} + +sub getAddress { + my ($self,$who) = @_; + + # Return this user's address. + return $self->{who}->{$who} or 0; +} + +sub protocol { + my ($self) = @_; + return $self->{proto}; +} + +sub nick { + my ($self) = @_; + + return $self->{nickname}; +} + +sub ignore { + my ($self,$who) = @_; + + # Ignore this user. + return unless length $who > 0; + $self->{ignored}->{$who} = 1; + $self->send ("70|$who"); +} +sub unignore { + my ($self,$who) = @_; + + # Unignore this user. + return unless length $who > 0; + delete $self->{ignored}->{$who}; + $self->send ("70|$who"); +} + +sub authenticate { + my ($self,$password) = @_; + + # Authenticate with a CC password. + $self->send ("50|$password"); +} + +sub promote { + my ($self,$user) = @_; + + # Promote this user to Special Guest. + $self->send ("60|$user|4"); +} + +sub demote { + my ($self,$user) = @_; + + # Demote this user. + $self->send ("60|$user|0"); +} + +sub _event { + my ($self,$event,@data) = @_; + + return unless exists $self->{handlers}->{$event}; + + &{$self->{handlers}->{$event}} ($self,@data); +} + +sub do_one_loop { + my ($self) = @_; + + # Time to ping again? + if ($self->{pinged} > 0) { + # If connected... + if ($self->{connected} == 1) { + # If logged in... + if ($self->{accepted} == 1) { + # If refresh time has passed... + if (time() - $self->{pinged} >= $self->{refresh}) { + # To ping, send a private message to nobody. + $self->send ("20||^1ping"); + $self->{pinged} = time(); + } + } + } + } + + return unless defined $self->{select}; + + # Loop with the server. + my @ready = $self->{select}->can_read(.001); + return unless(@ready); + + foreach my $socket (@ready) { + my $resp; + $self->{sock}->recv ($resp,2048,0); + my @in = split(/\n/, $resp); + + # The server has sent us a message! + foreach my $said (@in) { + $said =~ s/\r//ig; + my ($command,@args) = split(/\|/, $said); + + # The first message received? + if ($self->{connected} == 0) { + $self->{connected} = 1; + $self->_event ('Connected'); + $self->{pinged} = time(); + } + + $self->_event ('Packet', 'incoming', $said); + + # Go through the commands. + if ($command == 10) { + # 10 = Name is invalid. + $self->_event ('Error', 10, "Your name is invalid."); + } + elsif ($command == 11) { + # 11 = Name accepted. + $self->{accepted} = 1; + $self->_event ('Name_Accepted'); + } + elsif ($command == 21) { + # 21 = Private Message + my $type = 0; + my ($level) = $args[0] =~ /^(\d)/; + $type = $args[1] =~ /^\^(\d)/; + $args[0] =~ s/^(\d)//ig; + $args[1] =~ s/^\^(\d)//ig; + + # Get the sender's nick and address. + my ($nick,$addr) = split(/\,/, $args[0], 2); + + # Skip ignored users. + next if exists $self->{ignored}->{$nick}; + + shift (@args); + my $text = join ('|',@args); + + # Call the event. + $self->_event ('Private', $nick, $level, $addr, $text); + } + elsif ($command == 31) { + # 31 = Public Message. + my $type = 1; + my ($level) = $args[0] =~ /^(\d)/; + ($type) = $args[1] =~ /^\^(\d)/; + $args[0] =~ s/^(\d)//i; + $args[1] =~ s/^\^(\d)//i; + + # Get the sender's nick and address. + my ($nick,$addr) = split(/\,/, $args[0], 2); + + # Skip ignored users. + next if exists $self->{ignored}->{$nick}; + + # Chop off spaces. + $args[1] =~ s/^\s//ig; + + # Shift off data. + shift (@args); # nickname + my $text = join ('|',@args); + + # User has entered the room. + if ($type == 2) { + # Call the event. + $self->_event ('Chat_Buddy_In', $nick, $level, $addr, $text); + } + elsif ($type == 3) { + # Call the event. + $self->_event ('Chat_Buddy_Out', $nick, $level, $addr, $text); + } + else { + # Normal message. + $self->_event ('Message', $nick, $level, $addr, $text); + } + } + elsif ($command == 35) { + # 35 = Who List Update. + my %this = (); + foreach my $user (@args) { + my ($nick,$addr) = split(/\,/, $user, 2); + my $fullNick = $nick; + + # Get data about this user. + my ($level) = $nick =~ /^(\d)/; + $nick =~ s/^(\d)//i; + + # User is online. + $self->{who}->{$nick} = $addr; + $this{$nick} = 1; + + # Call the event. + $self->{nicks}->{$nick} = $fullNick; + $self->_event ('Chat_Buddy_Here', $nick, $level, $addr); + } + + # New event: WhoList = sends the entire Who List at once. + $self->_event ('WhoList', @args); + + # See if anybody should be dropped. + foreach my $who (keys %{$self->{who}}) { + if (!exists $this{$who}) { + # Buddy's gone. + delete $self->{who}->{$who}; + } + } + } + elsif ($command == 40) { + # 40 = Server welcome message (the "pong" of 40 from the client). + $self->_event ('Welcome', $args[0]); + } + elsif ($command == 70) { + # 70 = Ignored/Unignored a user. + my $user = $args[0]; + if (exists $self->{ignored}->{$user}) { + delete $self->{ignored}->{$user}; + $self->_event ('Ignored', 0, $user); + } + else { + $self->{ignored}->{$user} = 1; + $self->_event ('Ignored', 1, $user); + } + } + else { + $self->debug ("Unknown event code from server: $command|" + . join ('|', @args) ); + } + } + } + + return 1; +} + +1; +__END__ + +=head1 NAME + +Net::CyanChat - Perl interface for connecting to Cyan Worlds' chat room. + +=head1 SYNOPSIS + + use Net::CyanChat; + + my $cyan = new Net::CyanChat ( + host => 'cho.cyan.com', # default + port => 1812, # main port--1813 is for testing + proto => 1, # use protocol 1.0 + refresh => 60, # ping rate (default) + ); + + # Set up handlers. + $cyan->setHandler (foo => \&bar); + + # Connect + $cyan->start(); + +=head1 DESCRIPTION + +Net::CyanChat is a Perl module for object-oriented connections to Cyan Worlds, Inc.'s +chat room. + +=head1 NOTE TO DEVELOPERS + +Cyan Chat regulars really HATE bots! Recommended usage of this module is for developing +your own client, or a silent logging bot. Auto-Shorah (greeting users who enter the room) +is strongly advised against. + +=head1 METHODS + +=head2 new (ARGUMENTS) + +Constructor for a new CyanChat object. Pass in any arguments you need. Some standard arguments +are: host (defaults to cho.cyan.com), port (defaults to 1812), proto (protocol version--0 or 1--defaults +to 1), debug, or refresh. + +Returns a CyanChat object. + +=head2 version + +Returns the version number. + +=head2 debug (MESSAGE) + +Called by the module itself for debug messages. + +=head2 send (DATA) + +Send raw data to the CyanChat server. + +=head2 setHandler (EVENT_CODE => CODEREF) + +Set up a handler for the CyanChat connection. See below for a list of handlers. + +=head2 connect + +Connect to CyanChat's server. + +=head2 start + +Start a loop of do_one_loop's. + +=head2 do_one_loop + +Perform a single loop on the server. + +=head2 login (NICK) + +After receiving a "Connected" event from the server, it is okay to log in now. NICK +should be no more than 20 characters and cannot contain a pipe symbol "|". + +This method can be called even after you have logged in once, for example if you want +to change your nickname without logging out and then back in. + +=head2 logout + +Log out of CyanChat. Must be logged in first. + +=head2 sendMessage (MESSAGE) + +Broadcast a message publicly to the chat room. Can only be called after you have logged +in through $cyan->login. + +=head2 sendPrivate (TO, MESSAGE) + +Send a private message to recipient TO. Must be logged in first. + +=head2 getBuddies + +Returns a hashref containing each buddy's username as the keys and their addresses as the values. + +=head2 getFullName (NICK) + +Returns the full name of passed in NICK. If NICK is not in the room, returns 0. FullName is the +name that CyanChat recognizes NICK by (including their auth code, i.e. "0username" for normal +users and "1username" for Cyan staff). + +=head2 getAddress (NICK) + +Returns the address to NICK. This is not their IP address; CyanChat encrypts their IP into this +address, and it is basicly a unique identifier for a connection. Multiple users logged on from the +same IP address will have the same chat address. Ignoring users will ignore them by address. + +=head2 protocol + +Returns the protocol version you are using. Will return 0 or 1. + +=head2 ignore (USER), unignore (USER) + +Ignore and unignore a username. When a user is ignored, the Message and Private events will not +be called when they send a message. + +=head2 nick + +Returns the currently signed in nickname of the CyanChat object. + +=head1 ADVANCED METHODS + +B These methods are very dangerous to use if you don't know what you're doing. +Don't call authenticate() unless you know for sure what the CyanChat admin password is, +and don't call promote() or demote() unless you are already authenticated as a CyanChat +staff user. + +Calling the authenticate() command with the wrong password will most likely get you +banned from CyanChat, and calling promote() or demote() without being an admin user +will probably have the same effect. + +In other words, B + +=head2 authenticate (PASSWORD) + +Authenticate your connection as a Cyan Worlds staff member. Call this method before +entering the chat room. + +=head2 promote (USER) + +Promote USER to a Special Guest. + +=head2 demote (USER) + +Demote USER to a normal user level. + +=head1 HANDLERS + +=head2 Connected (CYANCHAT) + +Called when a connection has been established, and the server recognizes your client's +presence. At this point, you can call CYANCHAT->login (NICK) to log into the chat room. + +=head2 Disconnected (CYANCHAT) + +Called when a disconnect has been detected. + +=head2 Welcome (CYANCHAT, MESSAGE) + +Called after the server recognizes your client (almost simultaneously to Connected). +MESSAGE are messages that the CyanChat server sends--mostly just includes a list of the +chat room's rules. + +=head2 Message (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE) + +Called when a user sends a message publicly in chat. NICK is their nickname, LEVEL is their +auth level (0 = normal, 1 = Cyan employee, etc. - see below for full list). ADDRESS is their +chat address, and MESSAGE is their message. + +=head2 Private (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE) + +Called when a user sends a private message to your client. All the arguments are the same +as the Message handler. + +=head2 Ignored (CYANCHAT, IGNORE, NICK) + +Called when a user has been ignored or unignored. IGNORE will be 1 (ignoring) or +0 (unignoring). NICK is their nickname. + +=head2 Chat_Buddy_In (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE) + +Called when a buddy enters the chat room. NICK, LEVEL, and ADDRESS are the same as in the +Message and Private handlers. MESSAGE is their join message (i.e. "") + +=head2 Chat_Buddy_Out (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE) + +Called when a buddy exits. MESSAGE is their exit message (i.e. "" +for normal log out, or "" for +disconnected). + +=head2 Chat_Buddy_Here (CYANCHAT, NICK, LEVEL, ADDRESS) + +Called for each member currently in the room. Each time the Who List updates, this handler is called +for each buddy in the room. + +=head2 WhoList (CYANCHAT, USERS) + +This handler is called whenever a "35" (WhoList) event is received from the server. USERS is an array +of the raw user data the server sent. The array is full of elements of the format: + + #username,address + +Where # is the auth level. Unlike Chat_Buddy_Here, your program needs to loop and parse out info +from each of the users. + +=head2 Name_Accepted (CYANCHAT) + +The CyanChat server has accepted your name. + +=head2 Error (CYANCHAT, CODE, STRING) + +Handles errors issued by CyanChat. CODE is the exact server code issued that caused the error. +STRING is either an English description or the exact text the server sent. + +=head1 CYAN CHAT RULES + +The CyanChat server strictly enforces these rules: + + Be respectful and sensitive to others (please, no platform wars). + Keep it "G" rated (family viewing), both in language and content. + And HAVE FUN! + + Termination of use can happen without warning! + +=head1 CYAN CHAT AUTH LEVELS + +Auth levels (received as LEVEL to most handlers, or prefixed onto a user's FullName) are as follows: + + 0 is for regular chat user (should be in white) + 1 is for Cyan Worlds employee (should be in cyan) + 2 is for CyanChat Server message (should be in green) + 4 is for special guest (should be in gold) + Any other number is probably a client error message (and is in red) + +=head1 CHANGE LOG + +Version 0.05 + + - Fixed the end-of-line characters, it now sends a true CrLf. + - Added the WhoList handler. + - Added the authenticate(), promote(), and demote() methods. + +Version 0.04 + + - The enter/exit chat messages now go by the tag number (like it's supposed to), + not by the contained text. + - Messages can contain pipes in them and be read okay through the module. + - Added a "ping" function. Apparently Cho will disconnect clients who don't do + anything in 5 minutes. The "ping" function also helps detect disconnects! + - The Disconnected handler has been added to detect disconnects. + +Version 0.03 + + - Bug fix: the $level received to most handlers used to be 1 (cyan staff) even + though it should've been 0 (or any other number), so this has been fixed. + +Version 0.01 + + - Initial release. + - Fully supports both protocols 0 and 1 of CyanChat. + +=head1 SEE ALSO + +Net::CyanChat::Server + +CyanChat Protocol Documentation: http://cho.cyan.com/chat/programmers.html + +=head1 AUTHOR + +Cerone J. Kirsle + +=head1 COPYRIGHT AND LICENSE + + Net::CyanChat - Perl interface to CyanChat. + Copyright (C) 2005 Cerone J. Kirsle + + 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 + +=cut diff --git a/lib/Net/CyanChat.pm~ b/lib/Net/CyanChat.pm~ new file mode 100644 index 0000000..2b9f0d9 --- /dev/null +++ b/lib/Net/CyanChat.pm~ @@ -0,0 +1,700 @@ +package Net::CyanChat; + +use strict; +use warnings; +use IO::Socket; +use IO::Select; + +our $VERSION = '0.06'; + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + + my $self = { + host => 'cho.cyan.com', # Default CC Host + port => 1812, # Default CC Port (1813=debugging) + debug => 0, # Debug Mode + proto => 1, # Use Protocol 1 (not 0) + sock => undef, # Socket Object + select => undef, # Select Object + pinged => 0, # Last Ping Time + refresh => 60, # Ping Rate = 60 Seconds + nickname => '', # Our Nickname + handlers => {}, # Handlers + connected => 0, # Are We Connected? + accepted => 0, # Logged in? + who => {}, # Who List + ignored => {}, # Ignored List + nicks => {}, # Nickname Lookup Table + @_, + }; + + # Protocol support numbers: 0 and 1. + if ($self->{proto} < 0 || $self->{proto} > 1) { + die "Unsupported protocol version: must be 0 or 1!"; + } + + bless ($self,$class); + return $self; +} + +sub version { + my ($self) = @_; + return $VERSION; +} + +sub debug { + my ($self,$msg) = @_; + + return unless $self->{debug} == 1; + print "Net::CyanChat::debug // $msg\n"; +} + +sub send { + my ($self,$data) = @_; + + # Send the data. + if (defined $self->{sock}) { + $self->_event ('Packet', 'outgoing', $data); + + # Send true CrLf + $self->{sock}->send ("$data\x0d\x0a") or do { + # We've been disconnected! + $self->{sock}->close(); + $self->{sock} = undef; + $self->{select} = undef; + $self->{connected} = 0; + $self->{nick} = ''; + $self->{pinged} = 0; + $self->{who} = {}; + $self->{nicks} = {}; + $self->_event ('Disconnected'); + }; + } + else { + warn "Could not send \"$data\" to CyanChat: connection not established!"; + } +} + +sub setHandler { + my ($self,$event,$code) = @_; + + # Set this handler. + $self->{handlers}->{$event} = $code; +} + +sub connect { + my ($self) = @_; + + # Connect to CyanChat. + $self->{sock} = new IO::Socket::INET ( + PeerAddr => $self->{host}, + PeerPort => $self->{port}, + Proto => 'tcp', + ); + + # Error? + if (!defined $self->{sock}) { + $self->_event ('Error', "00|Connection Error", "Net::CyanChat Connection Error: $!"); + } + + # Create a select object. + $self->{select} = IO::Select->new ($self->{sock}); + + # Send that we're ready. + $self->send ("40|$self->{proto}"); +} + +sub start { + my ($self) = @_; + + while (1) { + $self->do_one_loop or last; + } +} + +sub login { + my ($self,$nick) = @_; + + if (length $nick > 0) { + # Sign in. + $self->send ("10|$nick"); + $self->{nickname} = $nick; + return 1; + } + + return 0; +} + +sub logout { + my ($self) = @_; + + return 0 unless length $self->{nickname} > 0; + $self->{nickname} = ''; + $self->{accepted} = 0; + $self->send ("15"); + return 1; +} + +sub sendMessage { + my ($self,$msg) = @_; + + # Send the message. + return 0 unless length $msg > 0; + $self->send ("30|^1$msg"); +} + +sub sendPrivate { + my ($self,$to,$msg) = @_; + + return unless (length $to > 0 && length $msg > 0); + # Get the user's full nick. + my $nick = $self->{nicks}->{$to}; + + # Send this user a message. + $self->send ("20|$nick|^1$msg"); +} + +sub getBuddies { + my ($self) = @_; + + # Return the buddylist. + return $self->{who}; +} + +sub getFullName { + my ($self,$who) = @_; + + # Return this user's full name. + return $self->{full}->{$who} or 0; +} + +sub getAddress { + my ($self,$who) = @_; + + # Return this user's address. + return $self->{who}->{$who} or 0; +} + +sub protocol { + my ($self) = @_; + return $self->{proto}; +} + +sub nick { + my ($self) = @_; + + return $self->{nickname}; +} + +sub ignore { + my ($self,$who) = @_; + + # Ignore this user. + return unless length $who > 0; + $self->{ignored}->{$who} = 1; + $self->send ("70|$who"); +} +sub unignore { + my ($self,$who) = @_; + + # Unignore this user. + return unless length $who > 0; + delete $self->{ignored}->{$who}; + $self->send ("70|$who"); +} + +sub authenticate { + my ($self,$password) = @_; + + # Authenticate with a CC password. + $self->send ("50|$password"); +} + +sub promote { + my ($self,$user) = @_; + + # Promote this user to Special Guest. + $self->send ("60|$user|4"); +} + +sub demote { + my ($self,$user) = @_; + + # Demote this user. + $self->send ("60|$user|0"); +} + +sub _event { + my ($self,$event,@data) = @_; + + print "_event: $event, @data\n"; + + return unless exists $self->{handlers}->{$event}; + + print "calling event for $event\n"; + &{$self->{handlers}->{$event}} ($self,@data); +} + +sub do_one_loop { + my ($self) = @_; + + # Time to ping again? + if ($self->{pinged} > 0) { + # If connected... + if ($self->{connected} == 1) { + # If logged in... + if ($self->{accepted} == 1) { + # If refresh time has passed... + if (time() - $self->{pinged} >= $self->{refresh}) { + # To ping, send a private message to nobody. + $self->send ("20||^1ping"); + $self->{pinged} = time(); + } + } + } + } + + return unless defined $self->{select}; + + # Loop with the server. + my @ready = $self->{select}->can_read(.001); + return unless(@ready); + + foreach my $socket (@ready) { + my $resp; + $self->{sock}->recv ($resp,2048,0); + my @in = split(/\n/, $resp); + + # The server has sent us a message! + foreach my $said (@in) { + $said =~ s/\r//ig; + my ($command,@args) = split(/\|/, $said); + + # The first message received? + if ($self->{connected} == 0) { + $self->{connected} = 1; + $self->_event ('Connected'); + $self->{pinged} = time(); + } + + $self->_event ('Packet', 'incoming', $said); + + # Go through the commands. + if ($command == 10) { + # 10 = Name is invalid. + $self->_event ('Error', 10, "Your name is invalid."); + } + elsif ($command == 11) { + # 11 = Name accepted. + $self->{accepted} = 1; + $self->_event ('Name_Accepted'); + } + elsif ($command == 21) { + # 21 = Private Message + my $type = 0; + my ($level) = $args[0] =~ /^(\d)/; + $type = $args[1] =~ /^\^(\d)/; + $args[0] =~ s/^(\d)//ig; + $args[1] =~ s/^\^(\d)//ig; + + # Get the sender's nick and address. + my ($nick,$addr) = split(/\,/, $args[0], 2); + + # Skip ignored users. + next if exists $self->{ignored}->{$nick}; + + shift (@args); + my $text = join ('|',@args); + + # Call the event. + $self->_event ('Private', $nick, $level, $addr, $text); + } + elsif ($command == 31) { + # 31 = Public Message. + my $type = 1; + my ($level) = $args[0] =~ /^(\d)/; + ($type) = $args[1] =~ /^\^(\d)/; + $args[0] =~ s/^(\d)//i; + $args[1] =~ s/^\^(\d)//i; + + # Get the sender's nick and address. + my ($nick,$addr) = split(/\,/, $args[0], 2); + + # Skip ignored users. + next if exists $self->{ignored}->{$nick}; + + # Chop off spaces. + $args[1] =~ s/^\s//ig; + + # Shift off data. + shift (@args); # nickname + my $text = join ('|',@args); + + # User has entered the room. + if ($type == 2) { + # Call the event. + $self->_event ('Chat_Buddy_In', $nick, $level, $addr, $text); + } + elsif ($type == 3) { + # Call the event. + $self->_event ('Chat_Buddy_Out', $nick, $level, $addr, $text); + } + else { + # Normal message. + $self->_event ('Message', $nick, $level, $addr, $text); + } + } + elsif ($command == 35) { + # 35 = Who List Update. + my %this = (); + foreach my $user (@args) { + my ($nick,$addr) = split(/\,/, $user, 2); + my $fullNick = $nick; + + # Get data about this user. + my ($level) = $nick =~ /^(\d)/; + $nick =~ s/^(\d)//i; + + # User is online. + $self->{who}->{$nick} = $addr; + $this{$nick} = 1; + + # Call the event. + $self->{nicks}->{$nick} = $fullNick; + $self->_event ('Chat_Buddy_Here', $nick, $level, $addr); + } + + # New event: WhoList = sends the entire Who List at once. + $self->_event ('WhoList', @args); + + # See if anybody should be dropped. + foreach my $who (keys %{$self->{who}}) { + if (!exists $this{$who}) { + # Buddy's gone. + delete $self->{who}->{$who}; + } + } + } + elsif ($command == 40) { + print "^^^ got 40 ($args[0])\n"; + # 40 = Server welcome message (the "pong" of 40 from the client). + $self->_event ('Welcome', $args[0]); + } + elsif ($command == 70) { + # 70 = Ignored/Unignored a user. + my $user = $args[0]; + if (exists $self->{ignored}->{$user}) { + delete $self->{ignored}->{$user}; + $self->_event ('Ignored', 0, $user); + } + else { + $self->{ignored}->{$user} = 1; + $self->_event ('Ignored', 1, $user); + } + } + else { + $self->debug ("Unknown event code from server: $command|" + . join ('|', @args) ); + } + } + } + + return 1; +} + +1; +__END__ + +=head1 NAME + +Net::CyanChat - Perl interface for connecting to Cyan Worlds' chat room. + +=head1 SYNOPSIS + + use Net::CyanChat; + + my $cyan = new Net::CyanChat ( + host => 'cho.cyan.com', # default + port => 1812, # main port--1813 is for testing + proto => 1, # use protocol 1.0 + refresh => 60, # ping rate (default) + ); + + # Set up handlers. + $cyan->setHandler (foo => \&bar); + + # Connect + $cyan->start(); + +=head1 DESCRIPTION + +Net::CyanChat is a Perl module for object-oriented connections to Cyan Worlds, Inc.'s +chat room. + +=head1 NOTE TO DEVELOPERS + +Cyan Chat regulars really HATE bots! Recommended usage of this module is for developing +your own client, or a silent logging bot. Auto-Shorah (greeting users who enter the room) +is strongly advised against. + +=head1 METHODS + +=head2 new (ARGUMENTS) + +Constructor for a new CyanChat object. Pass in any arguments you need. Some standard arguments +are: host (defaults to cho.cyan.com), port (defaults to 1812), proto (protocol version--0 or 1--defaults +to 1), debug, or refresh. + +Returns a CyanChat object. + +=head2 version + +Returns the version number. + +=head2 debug (MESSAGE) + +Called by the module itself for debug messages. + +=head2 send (DATA) + +Send raw data to the CyanChat server. + +=head2 setHandler (EVENT_CODE => CODEREF) + +Set up a handler for the CyanChat connection. See below for a list of handlers. + +=head2 connect + +Connect to CyanChat's server. + +=head2 start + +Start a loop of do_one_loop's. + +=head2 do_one_loop + +Perform a single loop on the server. + +=head2 login (NICK) + +After receiving a "Connected" event from the server, it is okay to log in now. NICK +should be no more than 20 characters and cannot contain a pipe symbol "|". + +This method can be called even after you have logged in once, for example if you want +to change your nickname without logging out and then back in. + +=head2 logout + +Log out of CyanChat. Must be logged in first. + +=head2 sendMessage (MESSAGE) + +Broadcast a message publicly to the chat room. Can only be called after you have logged +in through $cyan->login. + +=head2 sendPrivate (TO, MESSAGE) + +Send a private message to recipient TO. Must be logged in first. + +=head2 getBuddies + +Returns a hashref containing each buddy's username as the keys and their addresses as the values. + +=head2 getFullName (NICK) + +Returns the full name of passed in NICK. If NICK is not in the room, returns 0. FullName is the +name that CyanChat recognizes NICK by (including their auth code, i.e. "0username" for normal +users and "1username" for Cyan staff). + +=head2 getAddress (NICK) + +Returns the address to NICK. This is not their IP address; CyanChat encrypts their IP into this +address, and it is basicly a unique identifier for a connection. Multiple users logged on from the +same IP address will have the same chat address. Ignoring users will ignore them by address. + +=head2 protocol + +Returns the protocol version you are using. Will return 0 or 1. + +=head2 ignore (USER), unignore (USER) + +Ignore and unignore a username. When a user is ignored, the Message and Private events will not +be called when they send a message. + +=head2 nick + +Returns the currently signed in nickname of the CyanChat object. + +=head1 ADVANCED METHODS + +B These methods are very dangerous to use if you don't know what you're doing. +Don't call authenticate() unless you know for sure what the CyanChat admin password is, +and don't call promote() or demote() unless you are already authenticated as a CyanChat +staff user. + +Calling the authenticate() command with the wrong password will most likely get you +banned from CyanChat, and calling promote() or demote() without being an admin user +will probably have the same effect. + +In other words, B + +=head2 authenticate (PASSWORD) + +Authenticate your connection as a Cyan Worlds staff member. Call this method before +entering the chat room. + +=head2 promote (USER) + +Promote USER to a Special Guest. + +=head2 demote (USER) + +Demote USER to a normal user level. + +=head1 HANDLERS + +=head2 Connected (CYANCHAT) + +Called when a connection has been established, and the server recognizes your client's +presence. At this point, you can call CYANCHAT->login (NICK) to log into the chat room. + +=head2 Disconnected (CYANCHAT) + +Called when a disconnect has been detected. + +=head2 Welcome (CYANCHAT, MESSAGE) + +Called after the server recognizes your client (almost simultaneously to Connected). +MESSAGE are messages that the CyanChat server sends--mostly just includes a list of the +chat room's rules. + +=head2 Message (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE) + +Called when a user sends a message publicly in chat. NICK is their nickname, LEVEL is their +auth level (0 = normal, 1 = Cyan employee, etc. - see below for full list). ADDRESS is their +chat address, and MESSAGE is their message. + +=head2 Private (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE) + +Called when a user sends a private message to your client. All the arguments are the same +as the Message handler. + +=head2 Ignored (CYANCHAT, IGNORE, NICK) + +Called when a user has been ignored or unignored. IGNORE will be 1 (ignoring) or +0 (unignoring). NICK is their nickname. + +=head2 Chat_Buddy_In (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE) + +Called when a buddy enters the chat room. NICK, LEVEL, and ADDRESS are the same as in the +Message and Private handlers. MESSAGE is their join message (i.e. "") + +=head2 Chat_Buddy_Out (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE) + +Called when a buddy exits. MESSAGE is their exit message (i.e. "" +for normal log out, or "" for +disconnected). + +=head2 Chat_Buddy_Here (CYANCHAT, NICK, LEVEL, ADDRESS) + +Called for each member currently in the room. Each time the Who List updates, this handler is called +for each buddy in the room. + +=head2 WhoList (CYANCHAT, USERS) + +This handler is called whenever a "35" (WhoList) event is received from the server. USERS is an array +of the raw user data the server sent. The array is full of elements of the format: + + #username,address + +Where # is the auth level. Unlike Chat_Buddy_Here, your program needs to loop and parse out info +from each of the users. + +=head2 Name_Accepted (CYANCHAT) + +The CyanChat server has accepted your name. + +=head2 Error (CYANCHAT, CODE, STRING) + +Handles errors issued by CyanChat. CODE is the exact server code issued that caused the error. +STRING is either an English description or the exact text the server sent. + +=head1 CYAN CHAT RULES + +The CyanChat server strictly enforces these rules: + + Be respectful and sensitive to others (please, no platform wars). + Keep it "G" rated (family viewing), both in language and content. + And HAVE FUN! + + Termination of use can happen without warning! + +=head1 CYAN CHAT AUTH LEVELS + +Auth levels (received as LEVEL to most handlers, or prefixed onto a user's FullName) are as follows: + + 0 is for regular chat user (should be in white) + 1 is for Cyan Worlds employee (should be in cyan) + 2 is for CyanChat Server message (should be in green) + 4 is for special guest (should be in gold) + Any other number is probably a client error message (and is in red) + +=head1 CHANGE LOG + +Version 0.05 + + - Fixed the end-of-line characters, it now sends a true CrLf. + - Added the WhoList handler. + - Added the authenticate(), promote(), and demote() methods. + +Version 0.04 + + - The enter/exit chat messages now go by the tag number (like it's supposed to), + not by the contained text. + - Messages can contain pipes in them and be read okay through the module. + - Added a "ping" function. Apparently Cho will disconnect clients who don't do + anything in 5 minutes. The "ping" function also helps detect disconnects! + - The Disconnected handler has been added to detect disconnects. + +Version 0.03 + + - Bug fix: the $level received to most handlers used to be 1 (cyan staff) even + though it should've been 0 (or any other number), so this has been fixed. + +Version 0.01 + + - Initial release. + - Fully supports both protocols 0 and 1 of CyanChat. + +=head1 SEE ALSO + +Net::CyanChat::Server + +CyanChat Protocol Documentation: http://cho.cyan.com/chat/programmers.html + +=head1 AUTHOR + +Cerone J. Kirsle + +=head1 COPYRIGHT AND LICENSE + + Net::CyanChat - Perl interface to CyanChat. + Copyright (C) 2005 Cerone J. Kirsle + + 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 + +=cut diff --git a/lib/Tk/HyperText.pm b/lib/Tk/HyperText.pm new file mode 100644 index 0000000..bec51f1 --- /dev/null +++ b/lib/Tk/HyperText.pm @@ -0,0 +1,792 @@ +package Tk::HyperText; + +use strict; +use warnings; +use base qw(Tk::Derived Tk::ROText); +use Data::Dumper; + +our $VERSION = "0.03"; + +Construct Tk::Widget 'HyperText'; + +sub Populate { + my ($cw,$args) = @_; + + # Strip out the arguments we want before passing them to ROText. + my $opts = { + # -autorender => re-render the entire HTML document on update + # (otherwise, only render incoming HTML) + rerender => delete $args->{'-rerender'} || 1, + # -linkcommand => a callback when a user clicks a link + linkcommand => delete $args->{'-linkcommand'} || sub {}, + # -titlecommand => a callback when a page sets its title + titlecommand => delete $args->{'-titlecommand'} || sub {}, + # -attributes => define default attributes for each tag + attributes => { + body => { + bgcolor => '#FFFFFF', + text => '#000000', + link => '#0000FF', + vlink => '#990099', + alink => '#FF0000', + }, + font => { + family => 'Times New Roman', + size => 3, # HTML size; not point size. + color => '', # inherit from body + back => '', # inherit from body + }, + }, + }; + + # Copy attributes over. + if (exists $args->{'-attributes'}) { + my $attr = delete $args->{'-attributes'}; + foreach my $tag (keys %{$attr}) { + foreach my $name (keys %{$attr->{$tag}}) { + $opts->{attributes}->{$tag}->{$name} = $attr->{$tag}->{$name}; + } + } + } + + # Pass the remaining arguments to our ROText parent. + $args->{'-foreground'} = $opts->{attributes}->{body}->{text}; + $args->{'-background'} = $opts->{attributes}->{body}->{bgcolor}; + $cw->SUPER::Populate($args); + + # Reconfigure the ROText widget with our attributes. + $cw->SUPER::configure ( + -font => [ + -family => $opts->{attributes}->{font}->{family}, + -size => $cw->_size ($opts->{attributes}->{font}->{size}), + ], + ); + + $cw->{hypertext} = { + html => '', # holds HTML code + rerender => $opts->{rerender}, + attributes => $opts->{attributes}, + linkcommand => $opts->{linkcommand}, + titlecommand => $opts->{titlecommand}, + }; + +} + +sub insert { + my $cw = shift; + my $pos = shift; + $pos = $cw->index ($pos); + my $text = shift; + + # TODO: insert will only insert to the "end" + $cw->{hypertext}->{html} .= $text; + + + # If we're doing re-rendering, render the entire block of HTML at once. + if ($cw->{hypertext}->{rerender}) { + # Reset the title to blank. + &{$cw->{hypertext}->{titlecommand}} ($cw,""); + + # Render the whole entire page. + $cw->SUPER::delete ("0.0","end"); + $cw->render ($cw->{hypertext}->{html}); + } + else { + # Just render this text. + $cw->render ($text); + } +} + +sub delete { + my $cw = shift; + + # TODO: delete just deletes everything + $cw->{hypertext}->{html} = ''; + $cw->SUPER::delete ("0.0","end"); +} + +sub get { + my $cw = shift; + + # TODO: get just gets everything. + return $cw->{hypertext}->{html}; +} + +sub clear { + my $cw = shift; + + # Delete everything. + $cw->{hypertext}->{html} = ''; + $cw->SUPER::delete ("0.0","end"); +} + +sub render { + my ($cw,$html) = @_; + + # Make the HTML tags easier to find. + $html =~ s//%TK::HYPERTEXT::END::TAG%/g; + + # Split the tags apart. + my @parts = split(/%TK::HYPERTEXT/, $html); + + # Make an array of default styles for this render. + my %default = ( + bgcolor => $cw->{hypertext}->{body}->{bgcolor} || '#FFFFFF', + text => $cw->{hypertext}->{body}->{text} || '#000000', + link => $cw->{hypertext}->{body}->{link} || '#0000FF', + vlink => $cw->{hypertext}->{body}->{vlink} || '#990099', + alink => $cw->{hypertext}->{body}->{alink} || '#FF0000', + size => $cw->{hypertext}->{font}->{size} || 3, + font => $cw->{hypertext}->{font}->{family} || 'Times New Roman', + ); + + # Make an array of escape sequences. + my @escape = ( + '<' => '<', + '>' => '>', + '"' => '"', + ''' => "'", + ' ' => ' ', + '®' => chr(0x00ae), # registered trademark + '©' => chr(0x00a9), # copyright sign + '&' => '&', + ); + + # Reset the configuration of our ROText widget. + $cw->SUPER::configure ( + -background => $default{bgcolor}, + -foreground => $default{text}, + -font => [ + -family => $default{font}, + -size => $cw->_size ($default{size}), + ], + ); + + # Make an array of current styles for this render. + my %style = ( + weight => 'normal', # or 'bold' + slant => 'roman', # or 'italic' + underline => 0, # or 1 + overstrike => 0, # or 1 + family => '', + size => '', + foreground => '', + background => '', + justify => 'left', # or 'center' or 'right' + offset => 0, # changes for and + margin => 0, # for

s + titling => 0, # special--for title tags + title => '', # our page title + hyperlink => 0, # special--for hyperlinking + linktag => 0, # for hyperlinking + pre => 0, # special--for 
formatted text
+	);
+
+	# Stack the styles up.
+	my @stackFont   = ();
+	my @stackColor  = ();
+	my @stackBG     = ();
+	my @stackSize   = ();
+	my @stackAlign  = ();
+	my @stackOffset = ();
+	my @stackMargin = ();
+	my @stackLinks  = ();
+
+	# Set this to 1 when the first line of actual text has been written.
+	# Blocklevel elements like to know.
+	my $lineWritten = 0;
+
+	# Keep an array of hyperlinks.
+	my %hyperlinks = ();
+
+	# Start parsing through the HTML code.
+	foreach my $sector (@parts) {
+		# Is this a tag we're in?
+		if ($sector =~ /^::START::TAG%/i) {
+			$sector =~ s/^::START::TAG%//; # strip it
+
+			# Find out the name of this tag and its attributes.
+			my ($name,$attr) = split(/\s+/, $sector, 2);
+			$name = uc($name);
+
+			next unless defined $name && length $name;
+
+			# Handle the various types of tags.
+			if ($name eq "HTML" || $name eq "/HTML") { # , 
+				# That was nice of the programmer.
+			}
+			elsif ($name eq "HEAD" || $name eq "/HEAD") { # , 
+				# We don't need to do anything with this, either.
+			}
+			elsif ($name eq "TITLE") { # 
+				# They're about to tell us the title.
+				$style{titling} = 1;
+			}
+			elsif ($name eq "/TITLE") { # 
+				# Stop titling our page.
+				$style{titling} = 0;
+
+				# Call our title-setting callback.
+				&{$cw->{hypertext}->{titlecommand}} ($cw,$style{title});
+			}
+			elsif ($name eq "BODY") { # 
+				# Collect as much data as we can.
+				next unless defined $attr;
+				if ($attr =~ /bgcolor="(.+?)"/i) {
+					$cw->SUPER::configure (-background => $1);
+					$default{bgcolor} = $1;
+				}
+				if ($attr =~ /link="(.+?)"/i) {
+					$default{link} = $1;
+				}
+				if ($attr =~ /vlink="(.+?)"/i) {
+					$default{vlink} = $1;
+				}
+				if ($attr =~ /alink="(.+?)"/i) {
+					$default{alink} = $1;
+				}
+				if ($attr =~ /text="(.+?)"/i) {
+					$cw->SUPER::configure (-foreground => $1);
+					$default{text} = $1;
+				}
+			}
+			elsif ($name eq "/BODY") { # 
+				# Technically we shouldn't allow anymore HTML at this point,
+				# on account of the , but let's not be too picky.
+			}
+			elsif ($name eq "BASEFONT") { # 
+				# Collect as much data as we can.
+				if ($attr =~ /face="(.+?)"/i) {
+					$default{font} = $1;
+				}
+				if ($attr =~ /size="(.+?)"/i) {
+					$default{size} = $1;
+				}
+				if ($attr =~ /color="(.+?)"/i) {
+					$default{text} = $1;
+				}
+			}
+			elsif ($name eq "FONT") { # 
+				# Collect info.
+				if ($attr =~ /face="(.+?)"/i) {
+					push (@stackFont,$1);
+					$style{family} = $1;
+				}
+				if ($attr =~ /color="(.+?)"/i) {
+					push (@stackColor,$1);
+					$style{foreground} = $1;
+				}
+				if ($attr =~ /back="(.+?)"/i) {
+					push (@stackBG,$1);
+					$style{background} = $1;
+				}
+				if ($attr =~ /size="(.+?)"/i) {
+					push (@stackSize,$1);
+					$style{size} = $1;
+				}
+			}
+			elsif ($name eq "/FONT") { # 
+				# Revert to the previous font stack.
+				pop(@stackFont);
+				pop(@stackColor);
+				pop(@stackBG);
+				pop(@stackSize);
+				$style{family} = $stackFont[-1] || '';
+				$style{foreground} = $stackColor[-1] || '';
+				$style{background} = $stackBG[-1] || '';
+				$style{size} = $stackSize[-1] || '';
+			}
+			elsif ($name eq "A") { # 
+				# Make sure this link has an href.
+				if ($attr =~ /href="(.+?)"/i) {
+					my $href = $1;
+
+					# Find the target.
+					my $target = "_self";
+					if ($attr =~ /target="(.+?)"/i) {
+						$target = $1;
+					}
+
+					# Create a unique hyperlink tag.
+					my $linktag = join ("-",$target,$href);
+
+					# Store this tag.
+					$hyperlinks{$linktag} = {
+						href   => $href,
+						target => $target,
+					};
+
+					# Tell the tagger we're linking.
+					$style{hyperlink} = 1;
+					$style{linktag} = $linktag;
+				}
+			}
+			elsif ($name eq "/A") {
+				# We're not linking anymore.
+				$style{hyperlink} = 0;
+				$style{linktag} = '';
+			}
+			elsif ($name eq "BLOCKQUOTE") { # 

+				$cw->SUPER::insert ('end',"\x0a\x0a") if $lineWritten;
+				$style{margin} += 25;
+				push (@stackMargin,$style{margin});
+			}
+			elsif ($name eq "/BLOCKQUOTE") { # 

+				pop(@stackMargin);
+				$style{margin} = $stackMargin[-1] || 0;
+				$cw->SUPER::insert ('end',"\x0a\x0a");
+				$lineWritten = 0;
+			}
+			elsif ($name eq "P") { # 

+				$cw->SUPER::insert ('end',"\x0a\x0a") if $lineWritten;
+			}
+			elsif ($name eq "/P") { # 

+				$cw->SUPER::insert ('end',"\x0a\x0a");
+				$lineWritten = 0;
+			}
+			elsif ($name eq "BR") { # 

+				$cw->SUPER::insert ('end',"\x0a");
+			}
+			elsif ($name eq "PRE") { # 
+				$cw->SUPER::insert ('end',"\x0a") if $lineWritten;
+				push (@stackFont,"Courier New");
+				$style{family} = "Courier New";
+				$style{pre} = 1;
+			}
+			elsif ($name eq "/PRE") { # 

+				pop(@stackFont);
+				$style{family} = $stackFont[-1] || '';
+				$style{pre} = 0;
+				$cw->SUPER::insert ('end',"\x0a");
+			}
+			elsif ($name =~ /^(CODE|TT)$/) { # , 
+				push (@stackFont,"Courier New");
+				$style{family} = "Courier New";
+			}
+			elsif ($name =~ /^\/(CODE|TT)$/) { # , 
+				pop(@stackFont);
+				$style{family} = $stackFont[-1] || '';
+			}
+			elsif ($name =~ /^(CENTER|RIGHT|LEFT)$/) { # 
, , 
+				my $align = lc($name);
+				$cw->SUPER::insert ('end',"\x0a") if $lineWritten;
+				push (@stackAlign, $align);
+				$style{justify} = $align;
+			}
+			elsif ($name =~ /^\/(CENTER|RIGHT|LEFT)$/) { # 
, , 
+				pop(@stackAlign);
+				$style{justify} = $stackAlign[-1] || 'left';
+				$cw->SUPER::insert ('end',"\x0a");
+			}
+			elsif ($name =~ /^H(1|2|3|4|5|6|7)$/) { # 
 - 
+				my $size = $cw->_heading ($1);
+				$cw->SUPER::insert ('end',"\x0a\x0a") if $lineWritten;
+				push (@stackSize, $size);
+				$style{size} = $size;
+				$style{weight} = "bold";
+			}
+			elsif ($name =~ /^\/(H(1|2|3|4|5|6|7))$/) { # 
 - 
+				pop(@stackSize);
+				my $newSize = $stackSize[-1] || '';
+				$style{size} = $newSize;
+				$style{weight} = "normal";
+				$cw->SUPER::insert ('end',"\x0a\x0a");
+				$lineWritten = 0;
+			}
+			elsif ($name eq "SUP") { # 
+				if (not length $style{size}) {
+					$style{size} = $default{size} - 1;
+				}
+				else {
+					$style{size}--;
+				}
+				$style{size} = 0 if $style{size} < 0;
+				$style{offset} += 4;
+				push (@stackOffset,$style{offset});
+				push (@stackSize,$style{size});
+			}
+			elsif ($name eq "SUB") { # 
+				if (not length $style{size}) {
+					$style{size} = $default{size} - 1;
+				}
+				else {
+					$style{size}--;
+				}
+				$style{size} = 0 if $style{size} < 0;
+				$style{offset} -= 2;
+				push (@stackOffset,$style{offset});
+				push (@stackSize,$style{size});
+			}
+			elsif ($name =~ /^\/(SUP|SUB)$/) { # , 
+				pop(@stackOffset);
+				pop(@stackSize);
+				$style{size} = $stackSize[-1] || '';
+				$style{offset} = $stackOffset[-1] || 0;
+			}
+			elsif ($name =~ /^(B|STRONG)$/) { # , 
+				$style{weight} = "bold";
+			}
+			elsif ($name =~ /^\/(B|STRONG)$/) { # , 
+				$style{weight} = "normal";
+			}
+			elsif ($name =~ /^(I|EM)$/) { # , 
+				$style{slant} = "italic";
+			}
+			elsif ($name =~ /^\/(I|EM)$/) { # , 
+				$style{slant} = "roman";
+			}
+			elsif ($name =~ /^(U|INS)$/) { # , 
+				$style{underline} = 1;
+			}
+			elsif ($name =~ /^\/(U|INS)$/) { # , 
+				$style{underline} = 0;
+			}
+			elsif ($name =~ /^(S|DEL)$/) { # , 
+				$style{overstrike} = 1;
+			}
+			elsif ($name =~ /^\/(S|DEL)$/) { # , 
+				$style{overstrike} = 0;
+			}
+			next;
+		}
+		elsif ($sector =~ /^::END::TAG%/i) {
+			$sector =~ s/^::END::TAG%//i; # strip it
+		}
+
+		# If we're titling, don't bother with tags.
+		if ($style{titling} == 1) {
+			# Add this to our page title.
+			$style{title} .= $sector;
+			next;
+		}
+
+		# (Re)invent a new tag.
+		my $tag = join ("-",
+			$style{family} || $default{font},
+			$style{size} || $default{size},
+			$style{foreground} || $default{text},
+			$style{background} || $default{bgcolor},
+			$style{weight},
+			$style{slant},
+			$style{underline},
+			$style{overstrike},
+			$style{justify},
+			$style{offset},
+			$style{margin},
+			$style{hyperlink},
+			$style{linktag},
+			$style{pre},
+		);
+		$tag =~ s/\s+/+/ig; # convert spaces to +'s.
+
+		# Is this a special hyperlink tag?
+		my $color = $style{foreground} || $default{text};
+		my $uline = $style{underline};
+		my $size  = (length $style{size} > 0) ? $style{size} : $default{size};
+		my $ptsize = $cw->_size ($size);
+		if ($style{hyperlink} == 1) {
+			# Temporarily reset the color and underline.
+			$color = $default{link};
+			$uline = 1;
+		}
+
+		# Configure this tag.
+		$cw->SUPER::tagConfigure ($tag,
+			-foreground => $color,
+			-background => $style{background},
+			-font       => [
+				-family     => $style{family} || $default{font},
+				-weight     => $style{weight},
+				-slant      => $style{slant},
+				-size       => $ptsize,
+				-underline  => $uline,
+				-overstrike => $style{overstrike},
+			],
+			-offset     => $style{offset},
+			-justify    => $style{justify},
+			-lmargin1   => $style{margin},
+			-lmargin2   => $style{margin},
+		);
+
+		# If this was a hyperlink...
+		if ($style{hyperlink} == 1) {
+			# Bind this tag to an event.
+			my $href = $hyperlinks{$style{linktag}}->{href};
+			my $target = $hyperlinks{$style{linktag}}->{target};
+			$cw->SUPER::tagBind ($tag,"", [ sub {
+				my ($parent,$href,$target) = @_;
+
+				# Call our link command.
+				&{$cw->{hypertext}->{linkcommand}} ($parent,$href,$target);
+			}, $href, $target ]);
+
+			# Set up the hand cursor.
+			$cw->SUPER::tagBind ($tag,"", sub {
+				$cw->SUPER::configure (-cursor => 'hand2');
+			});
+			$cw->SUPER::tagBind ($tag,"", sub {
+				$cw->SUPER::configure (-cursor => 'xterm');
+			});
+		}
+
+		# If this was preformatted text, preserve the line endings and spacing.
+		if ($style{pre} == 1) {
+			# Leave it alone.
+		}
+		else {
+			$sector =~ s/\x0d//sg;
+			$sector =~ s/\x0a+//sg;
+			$sector =~ s/\s+/ /sg;
+		}
+
+		# If we wrote something here, inform the rest of the program.
+		if (length $sector) {
+			$lineWritten = 1;
+		}
+
+		# Filter escape codes.
+		while ($sector =~ /&#([^;]+?)\;/i) {
+			my $decimal = $1;
+			my $hex = sprintf ("%x", $decimal);
+			my $qm = quotemeta("&#$decimal;");
+			my $chr = eval "0x$hex";
+			my $char = chr($chr);
+			$sector =~ s~$qm~$char~i;
+		}
+		for (my $i = 0; $i < scalar(@escape) - 1; $i += 2) {
+			my $qm = quotemeta($escape[$i]);
+			my $rep = $escape[$i + 1];
+			$sector =~ s~$qm~$rep~ig;
+		}
+
+		# Finally, insert this bit of text.
+		$cw->SUPER::insert ('end',$sector,$tag);
+	}
+}
+
+sub _size {
+	my ($cw,$size) = @_;
+
+	# Calculate the point size based on the HTML size.
+	if ($size == 1) {
+		return 8;
+	}
+	elsif ($size == 2) {
+		return 9;
+	}
+	elsif ($size == 3) {
+		return 10;
+	}
+	elsif ($size == 4) {
+		return 12;
+	}
+	elsif ($size == 5) {
+		return 14;
+	}
+	elsif ($size <= 0) {
+		return 6;
+	}
+	elsif ($size >= 6) {
+		return 16;
+	}
+
+	return 6;
+}
+
+sub _heading {
+	my ($cw,$level) = @_;
+
+	# Calculate the point size for each H level.
+	my %sizes = (
+		1 => 6,
+		2 => 5,
+		3 => 4,
+		4 => 3,
+		5 => 2,
+		6 => 1,
+		7 => 0,
+	);
+
+	return $sizes{$level};
+}
+
+1;
+
+=head1 NAME
+
+Tk::HyperText - Create and manipulate ROText widgets which render HTML code.
+
+=head1 SYNOPSIS
+
+  my $hypertext = $mw->Scrolled ("HyperText",
+    -scrollbars   => 'e',
+    -wrap         => 'word',
+    -linkcommand  => \&onLink,  # what to do when  links are clicked
+    -titlecommand => \&onTitle, # what to do when s are found
+  )->pack (-fill => 'both', -expand => 1);
+
+  # insert some HTML code
+  $hypertext->insert ("end","<body bgcolor=\"black\" text=\"yellow\">"
+    . "Hello, <b>world!</b></body>");
+
+=head1 WIDGET-SPECIFIC OPTIONS
+
+=over 4
+
+=item B<-rerender>
+
+Boolean. When true (the default), the ENTIRE contents of your HyperText widget will
+be (re)rendered every time you modify it. In this way, if you insert, e.g. a "bold"
+tag and don't close it, then insert new text, the new text should logically still be
+in bold, and it would be when this flag is true.
+
+When false, only the newly inserted text will be rendered independently of what else
+is already there. If re-rendering the page is too slow for you, try disabling this flag.
+
+=item B<-titlecommand>
+
+This should be a CODEREF pointing to a subroutine that will handle changes in a
+page's title. While HTML code is being parsed, when a title tag is found, it will
+call this method.
+
+The callback will received the following variables:
+
+  $widget = a reference to the HyperText widget that wants to set a title.
+  $title  = the text in the <title> tag.
+
+=item B<-linkcommand>
+
+This should be a CODEREF pointing to a subroutine that will handle the clicking
+of hyperlinks.
+
+The callback will received the following variables:
+
+  $widget = a reference to the HyperText widget that invoked the link.
+  $href   = the value of the link's "href" attribute.
+  $target = the value of the link's "target" attribute.
+
+=item B<-attributes>
+
+This option will allow you to define all of the default settings for the display
+of HTML pages. Here's an example:
+
+  my $html = $mw->Scrolled ("HyperText",
+    -attributes => {
+      body => {
+        bgcolor => 'white',
+        text    => 'black',
+        link    => 'blue',
+        vlink   => 'purple',
+        alink   => 'red',
+      },
+      font => {
+        family => 'Arial',
+        size   => 3,
+        color  => '', # inherit from <body>
+        back   => '', # inherit from <body>
+      },
+    },
+  )->pack;
+
+=back
+
+=head1 DESCRIPTION
+
+Tk::HyperText is a derived Tk::ROText class which supports the automatic rendering
+of HTML code. It's designed to be easily useable as a drop-in replacement to any
+Tk::ROText widget. Rendering HTML code is as easy as B<insert>ing it as raw HTML,
+as shown in the synopsis.
+
+=head1 WIDGET METHODS
+
+In addition to all of the methods exported by Tk::ROText and Tk::Text, the following
+methods have special behaviors:
+
+=over 4
+
+=item I<$text-E<gt>>B<insert> I<(where, html-code)>
+
+Insert new HTML code, and render it automatically. Note that currently, only inserting
+to the "end" works. See L<"BUGS"> below.
+
+=item I<$text-E<gt>>B<delete> I<(start, end)>
+
+Delete content from the textbox. Note that currently you can only delete EVERYTHING.
+See L<"BUGS"> below.
+
+=item I<$text-E<gt>>B<get> I<(start, end)>
+
+Get the HTML code back out of the widget. Note that currently this gets ALL of the code.
+See L<"BUGS">. This returns the actual HTML code, not just the text that's been rendered.
+
+=item I<$text-E<gt>>B<clear>
+
+Clear the entire text widget display.
+
+=back
+
+=head1 SUPPORTED HTML
+
+The following HTML tags and attributes are fully supported by this module:
+
+  <html>, <head>
+  <title>      *calls -titlecommand when found
+  <body>       (bgcolor, link, vlink, alink, text)
+  <basefont>   (face, size, color)
+  <font>       (face, size, color, back)
+  <a>          (href, target)
+  <blockquote>
+  <p>, <br>
+  <pre>
+  <code>, <tt>
+  <center>, <right>, <left>
+  <h1> - <h6>
+  <sup>, <sub>
+  <b>, <strong>
+  <i>, <em>
+  <u>, <ins>
+  <s>, <del>
+
+=head1 EXAMPLE
+
+Run the `demo.pl` program included in the distribution for a demonstration. It's a
+kind of simple web browser that views HTML pages in the "demolib" directory, and
+supports hyperlinks that link from one page to another.
+
+=head1 BUGS
+
+As noted above, the B<insert> method only inserts at the end, B<delete> deletes
+everything, and B<get> gets everything. I plan on coming up with a way to fix this
+in a later version.
+
+There are some forms of HTML that might not render properly. For instance, if you
+set E<lt>font back="yellow"E<gt>, then set E<lt>font color="red"E<gt>, and then
+close the red font, it will also stop the yellow highlight color too. Situations
+like this aren't too serious, though. So, if you set one attribute, set them all. ;)
+
+=head1 SEE ALSO
+
+L<Tk::ROText> and L<Tk::Text>.
+
+=head1 CHANGES
+
+0.03 x
+  - Added support for the <basefont> tag.
+
+0.02 June 20, 2007
+
+  - Bugfix: on consecutive insert() commands (without clearing it in between),
+    the entire content of the HTML already in the widget would be inserted again,
+    in addition to the new content. This has been fixed.
+
+0.01 June 20, 2007
+
+  - Initial release.
+
+=head1 AUTHOR
+
+Casey Kirsle, E<lt>casey at cuvou.netE<gt>
+
+=cut
+
diff --git a/lib/Win32/MediaPlayer.pm b/lib/Win32/MediaPlayer.pm
new file mode 100644
index 0000000..e600c8d
--- /dev/null
+++ b/lib/Win32/MediaPlayer.pm
@@ -0,0 +1,253 @@
+package Win32::MediaPlayer;
+
+use strict;
+use warnings;
+use vars qw($VERSION $self $mciSendString $result);
+use Win32::API;
+$VERSION = '0.2';
+
+BEGIN {
+$mciSendString = new Win32::API(
+    "winmm",
+    "mciSendString",
+    ['P', 'P', 'N', 'N'], 'N'
+)|| die "Can't register mciSendString";
+}
+
+
+sub new {
+my $self = {};
+bless $self, $_[0];
+$self->{alias} = rand;
+$self->{pos} = 0;
+$self->{play} = 0;
+return $self;
+}
+
+sub load {
+my $self = shift;
+my $file = shift;
+$result = doMM("open \"$file\" type mpegvideo alias ".$self->{alias});
+return $result;
+}
+
+sub play {
+my $self = shift;
+my $pos = shift || $self->{pos};
+$self->{play} = 1;
+$result = doMM("play ".$self->{alias}." from $pos");
+return $result;
+}
+
+sub volume {
+my $self = shift;
+warn 'No File Loaded' if($self->{play}==0);
+my $vol = shift;
+if($vol ne '') {
+$vol*=10;
+$result = doMM("setaudio ".$self->{alias}." volume to $vol");
+return $result;
+}else{
+return 'Null';
+}
+}
+
+sub length {
+my $self = shift;
+my $flag = shift;
+warn 'No File Loaded' if($self->{play}==0);
+$result = doMM("status ".$self->{alias}." length");
+if($flag) {
+my @time = localtime(int($result/1000));
+$result = sprintf("%02d:%02d",$time[1],$time[0]);
+}
+return $result;
+}
+
+sub seek {
+my $self = shift;
+warn 'No File Loaded' if($self->{play}==0);
+my $seektime = shift;
+if($seektime=~/(\d{2}):(\d{2})/) {
+$seektime = ($1*60+$2)*1000;
+doMM("stop audiofile");
+$result = doMM("play ".$self->{alias}." from $seektime");
+}else{
+doMM("stop audiofile");
+$result = doMM("play ".$self->{alias}." from $seektime");
+}
+return $result;
+}
+
+sub pos {
+my $self = shift;
+my $flag = shift;
+warn 'No File Loaded' if($self->{play}==0);
+$result = doMM("status ".$self->{alias}." position");
+if($flag) {
+my @time = localtime(int($result/1000));
+$result = sprintf("%02d:%02d",$time[1],$time[0]);
+}
+return $result;
+}
+
+sub pause {
+my $self = shift;
+warn 'No File Loaded' if($self->{play}==0);
+$result = doMM("pause ".$self->{alias});
+return $result;
+}
+
+sub resume {
+my $self = shift;
+warn 'No File Loaded' if($self->{play}==0);
+$result = doMM("resume ".$self->{alias});
+return $result;
+}
+
+sub close {
+my $self = shift;
+$self->{play} = 0;
+$result = doMM("close ".$self->{alias});
+return $result;
+}
+
+
+
+sub doMM {
+    my($cmd) = @_;
+    my $ret = "\0" x 1025;
+    my $rc = $mciSendString->Call($cmd, $ret, 1024, 0);
+    if($rc == 0) {
+        $ret =~ s/\0*$//;
+        return $ret;
+    } else {
+        return "error '$cmd': $rc";
+    }
+}
+
+=pod
+
+=head1 NAME
+
+Win32::MediaPlayer - Module for playing sound MP3 / WMA / WAV / MIDI file on Win32 platforms
+
+=head1 SYNOPSIS
+
+    use Win32::MediaPlayer;
+
+    $winmm = new Win32::MediaPlayer;  # new an object
+    $winmm->load('d:/10.mp3');        # Load music file disk, or an URL
+    $winmm->play;                     # Play the music
+    $winmm->volume(100);              # Set volume after playing
+    $winmm->seek('00:32');            # seek to
+
+    #$winmm->pause;                   # Pause music playing
+    #$winmm->resume;                  # Resume music playing
+
+    print 'Total Length : '.$winmm->length(1),$/; # Show total time.
+    while(1) {
+          sleep 1;
+          print 'Now Position: '.$winmm->pos(1)."\r";   # Show now time.
+    };
+
+=head1 DESCRIPTION
+
+This module allows playing of sound format like MP3 / WMA / WAV / MIDI on Win32 platforms using the MCI interface (which
+depends on winmm.dll).
+
+=head1 REQUIREMENTS
+
+Only working on Win32, and you should installed the Win32::API
+
+if not you can install by ppm, in the console mode
+
+type command:
+
+  ppm install http://www.bribes.org/perl/ppm/Win32-API.ppd
+
+
+=head1 USAGE
+
+=head2 new
+
+The new method is the constructor. It will build a connection to the mci interface.
+
+$winmm = new Win32::MediaPlayer;  # new an object
+
+=head2 load()
+
+$winmm->load('d:/10.mp3');        # Load music from the disk, or Internet URL.
+
+=head2 play
+
+$winmm->play;                     # Play the music file.
+
+=head2 seek()
+
+The value should be a format like XX:XX, or you can fill the micro second integer of the music.
+
+$winmm->seek(100000);             # Seek the music file, at the 100 sec pos.
+
+
+$winmm->seek('01:40');            # Seek the music file, at the 01 min 40 sec pos.
+
+=head2 close
+
+$winmm->close;                    # Close the music file.
+
+=head2 volume()
+
+The value is from 0 to 100
+
+$winmm->volume(100);              # Set volume to 100 after playing
+
+
+=head2 length()
+
+Return the music total length
+
+
+$length = $winmm->length(1);      # Return the length in XX:XX format.
+
+$length = $winmm->length;         # Return the length in micro second integer.
+
+=head2 pos()
+
+Return the music now position
+
+$length = $winmm->pos(1);      # Return the Position in XX:XX format.
+
+$length = $winmm->pos;      # Return the Position in micro second integer.
+
+=head2 pause
+
+Pause the music play
+
+$length = $winmm->pause;      # Pause the music play.
+
+=head2 resume
+
+Resume the music play
+
+$length = $winmm->resume;      # Resume the music play.
+
+=head1 AUTHOR
+
+Lilo Huang
+
+kenwu@cpan.org
+
+http://blog.yam.com/kenwu/
+
+=head1 COPYRIGHT
+
+Copyright 2006 by Lilo Huang All Rights Reserved.
+
+You can use this module under the same terms as Perl itself.
+
+=cut
+
+__END__
+
+1;
\ No newline at end of file
diff --git a/sfx/ding.wav b/sfx/ding.wav
new file mode 100644
index 0000000..0ed7969
Binary files /dev/null and b/sfx/ding.wav differ
diff --git a/sfx/link.wav b/sfx/link.wav
new file mode 100644
index 0000000..4596b1e
Binary files /dev/null and b/sfx/link.wav differ
diff --git a/sfx/message.wav b/sfx/message.wav
new file mode 100644
index 0000000..d9abe74
Binary files /dev/null and b/sfx/message.wav differ
diff --git a/web.gif b/web.gif
new file mode 100644
index 0000000..3409d77
Binary files /dev/null and b/web.gif differ
diff --git a/worlds.gif b/worlds.gif
new file mode 100644
index 0000000..234802b
Binary files /dev/null and b/worlds.gif differ
diff --git a/worlds.ico b/worlds.ico
new file mode 100644
index 0000000..4fae27b
Binary files /dev/null and b/worlds.ico differ
diff --git a/worlds.png b/worlds.png
new file mode 100644
index 0000000..0f5397c
Binary files /dev/null and b/worlds.png differ