Updated events.pl

[AMadMonk]

This includes chat hooks and more polished timers.

Still to come: user-defined events (why? because we love you)

copy n paste over your existing events.pl for supah powah
--------

Code: Select all

package TIESTDOUT;

sub TIEHANDLE {
	my $val;
	bless \$val, shift;
}

sub PRINT {
	my $r = shift;
	my $flatprint = join("", @_);
	realoutput($flatprint);
}

sub PRINTF {
	my $r = shift;
	my $fmt = shift;
	my $flatprint = sprintf($fmt, @_);
	realoutput($flatprint);
}

sub realoutput {
	my $cmd = '/echo ' . join("", @_);
	MQPerl::DoCommand($cmd) if (defined &MQPerl::DoCommand);
}	

sub status {
	realoutput("PACKAGE TIESTDOUT version 1.0 loaded");
}

tie (*STDOUT, 'TIESTDOUT');
tie (*STDERR, 'TIESTDOUT');

status();
package DB;

$debugspew = 0;

sub DB::DB {
	if ($die_now) {
		$die_now = 0;
		die "MQPerl interpreter interrupted";
	}
	MQPerl::Pulse() if (!$events_running);
}

sub status {
	print "PACKAGE DB version 1.0 loaded";
}

sub timer_hook {
	timers::timer_hook(@_);
}

sub chat_hook {
	chathooks::chat_hook(@_);
}

status();

package timers;

@timer_hooks = ();

sub set_timer {
	my $timer_interval = shift;
	if ($timer_interval < 50) {
		print "timers::set_timer:  error, minimum timer interval is 50ms";
		return;
	}
	my $timer_firecount = shift;
	my $timer_callback = shift;
	
	if (!defined &$timer_callback) {
		print "timers::set_timer:  error, must define callback function first";
		return;
	}
	
	my $timer_id = MQPerl::SetTimer($timer_interval, $timer_firecount);
	# print "Set timer ID $timer_id (interval: $timer_interval, firecount: $timer_firecount)"; 
	$timer_hooks[$timer_id] = $timer_callback;
	return $timer_id;
}
	
sub kill_timer {
	my $timer_id = shift;
	MQPerl::KillTimer($timer_id);
	if (exists $timer_hooks[$timer_id]) { delete $timer_hooks[$timer_id]; }
}

sub timer_hook {
	my $timer_id = shift;
	my ($timer_firecount, $timer_interval) = (shift, shift);
	
	if (exists $timer_hooks[$timer_id]) {
		my $ref_fn = $timer_hooks[$timer_id];
		DB::dbout("timer_hook() calling hook fn '$ref_fn'");
		&$ref_fn($timer_firecount, $timer_interval);
		if ($timer_firecount == 0) { delete $timer_hooks[$timer_id]; }
	}
}

sub status {
	print "PACKAGE timers version 1.0 loaded";
}

status();

package chathooks;

%registered_chathooks = (
	"(.*) ([^ ]+) YOU for (\\d+) points of damage\\.", ["utils::we_got_hit"],
	"You have slain (.*)!", ["utils::killed_it_hook"]
	);

sub set_chathook {
	my $hook_regx = shift || return;
	my $hook_fn = shift || return;
	
	$registered_chathooks{$hook_regx} = [] unless (exists $registered_chathooks{$hook_regx});
	my $rarray = $registered_chathooks{$hook_regx};
	push(@$rarray, $hook_fn);
}

sub list_chathooks {
	foreach my $key (keys %registered_chathooks) {
		my $rarray = $registered_chathooks{$key};
		print "REGEX '$key', " . join(", ", @$rarray);
	}			
}

sub remove_chathook {
	my $hook_regx = shift || return;
	my $hook_fn = shift || return;
	return unless (exists $registered_chathooks{$hook_regx});
	my $rarray = $registered_chathooks{$hook_regx};
	
	my $countbefore = $#$rarray;
	@$rarray = grep { $_ ne $hook_fn } @$rarray;
	my $countafter = $#$rarray;
	delete $registered_chathooks{$hook_regx} unless (scalar @$rarray);

	print "ERROR:  couldn't find chathook '$hook_regx'/'$hook_fn' pair\n" unless ($countafter < $countbefore);
}

sub chat_hook {
	my $chatline = shift;

	# print "Chat hook called, raw chat: '$chatline'";
	foreach my $hookregx (keys %registered_chathooks) {
		# print "Checking against '$hookregx'";
		if ($chatline =~ /$hookregx/) {
			my $funclistref = $registered_chathooks{$hookregx};
			foreach my $funcref (@$funclistref) {
				&$funcref if (defined &$funcref);
			}
		}			
	}	
}

package main;

sub sendkey {
	if (scalar(@_) != 2) {
		print "ERROR: sendkey called with incorrect parameters";
		return; 
	}
	# print "Sendkey called with params: " . join(", ", @_);
	my $keystate = shift;
	$keystate = lc($keystate);
	my $keyname = shift;
	if (($keystate ne 'up') && ($keystate ne 'down')) {
		print "ERROR: sendkey second parameter should be 'up' or 'down', not '$keystate'";
		return; 
	}
	
	MQPerl::DoCommand("/sendkey $keystate $keyname");
}

1;

[AMadMonk]

BB wanted to mangle the lines a bit, so use common sense. Hopefully copy and paste will resurrect the correct end-of-lines.

[Lurker_005]

Making my browser window wider keps it from wrapping lines...

Also should there be a
1;
at the end of that?

[Stargazer]

The "1" should be there.

Anything that is considered an includable package in Perl should return a 1 or "true" at the end of it.

[AMadMonk]

So what this lets you do is set up chat hooks.

Chat hooks are basically regular expressions that, when a "chat line" comes through that matches that regex, will call a function.

This is similar to the #event lines in MQ# (the old scripting language), but much, much more flexible. Check out this for instance, that I "built in" to the events.pl:

Code: Select all

%registered_chathooks = ( 
   "(.*) ([^ ]+) YOU for (\\d+) points of damage\\.", ["utils::we_got_hit"], 
   "You have slain (.*)!", ["utils::killed_it_hook"] 
   ); 

This means, for example, that when the second regex is matched, the framework will call the routine "utils::killed_it_hook".

utils::killed_it_hook isn't in your utils module by default -- so add it!

Code: Select all

package utils;

sub killed_it_hook {
    print "Hooray!  We killed $1!!";
}

Note that the $1 (first matched parameter) is passed in complete from the hook call. This means that you can make regular expressions that return matches and use those matches in your hook functions.

So now when EQ says something like "You have slain a moss snake!", the framework will recognize that this matches the second pattern and call utils::we_killed_it. utils::we_killed_it plucks out the first match variable (the "(.*)" in the regular expression) and plops it into a print. So you should see:

You have slain a moss snake!
[MacroQuest] Hooray! We killed a moss snake!!

What you do with this complexity is up to you :)

NOTE: you can hardcode in hooks in events.pl, but I highly recommend you call chathooks::set_chathook instead.