r5308 - in trunk/Docs/server: . rcon2irc
DONOTREPLY at icculus.org
DONOTREPLY at icculus.org
Thu Dec 25 12:43:41 EST 2008
Author: div0
Date: 2008-12-25 12:43:41 -0500 (Thu, 25 Dec 2008)
New Revision: 5308
Modified:
trunk/Docs/server/rcon.pl
trunk/Docs/server/rcon2irc/rcon2irc.pl
Log:
rcon, rcon2irc: support terrencehill's colors
Modified: trunk/Docs/server/rcon.pl
===================================================================
--- trunk/Docs/server/rcon.pl 2008-12-25 14:09:32 UTC (rev 5307)
+++ trunk/Docs/server/rcon.pl 2008-12-25 17:43:41 UTC (rev 5308)
@@ -23,8 +23,8 @@
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.
-
# parts copied from rcon2irc
+# MISC STRING UTILITY ROUTINES to convert between DarkPlaces and IRC conventions
# convert mIRC color codes to DP color codes
our @color_irc2dp_table = (7, 0, 4, 2, 1, 1, 6, 1, 3, 2, 5, 5, 4, 6, 7, 7);
@@ -95,60 +95,149 @@
$message = join '', map { $text_qfont_table[ord $_] } split //, $message;
}
+sub color_dp_transform(&$)
+{
+ my ($block, $message) = @_;
+
+ $message =~ s{(?:(\^\^)|\^x([0-9a-fA-F])([0-9a-fA-F])([0-9a-fA-F])|\^([0-9])|(.))(?=([0-9,]?))}{
+ defined $1 ? $block->(char => '^', $7) :
+ defined $2 ? $block->(rgb => [hex $2, hex $3, hex $4], $7) :
+ defined $5 ? $block->(color => $5, $7) :
+ defined $6 ? $block->(char => $6, $7) :
+ die "Invalid match";
+ }esg;
+
+ return $message;
+}
+
sub color_dp2none($)
{
my ($message) = @_;
- my $color = -1;
- $message =~ s{\^(.)(?=([0-9,]?))}{
- my $c = $1;
- $c eq '^' ? '^' :
- $c =~ /^[0-9]$/ ? '' : "^$c";
- }esg;
- return text_dp2ascii $message;
+
+ return color_dp_transform
+ {
+ my ($type, $data, $next) = @_;
+ print "$type $data\n";
+ $type eq 'char'
+ ? $text_qfont_table[ord $data]
+ : "";
+ }
+ $message;
}
+sub color_rgb2basic($)
+{
+ my ($data) = @_;
+ my ($r, $g, $b) = @$data;
+ my $min = [sort ($r, $g, $b)]->[0];
+ my $max = [sort ($r, $g, $b)]->[-1];
+
+ my $v = $max / 15;
+ my $s = ($max == $min) ? 0 : 1 - $min/$max;
+
+ if($s < 0.2)
+ {
+ return 0 if $v < 0.5;
+ return 7;
+ }
+
+ my $h;
+ if($max == $min)
+ {
+ $h = 0;
+ }
+ elsif($max == $r)
+ {
+ $h = (60 * ($g - $b) / ($max - $min)) % 360;
+ }
+ elsif($max == $g)
+ {
+ $h = (60 * ($b - $r) / ($max - $min)) + 120;
+ }
+ elsif($max == $b)
+ {
+ $h = (60 * ($r - $g) / ($max - $min)) + 240;
+ }
+
+ return 1 if $h < 36;
+ return 3 if $h < 80;
+ return 2 if $h < 150;
+ return 5 if $h < 200;
+ return 4 if $h < 270;
+ return 6 if $h < 330;
+ return 1;
+}
+
+sub color_dp_rgb2basic($)
+{
+ my ($message) = @_;
+ return color_dp_transform
+ {
+ my ($type, $data, $next) = @_;
+ print "$type $data\n";
+ $type eq 'char' ? ($data eq '^' ? '^^' : $data) :
+ $type eq 'color' ? "^$data" :
+ $type eq 'rgb' ? "^" . color_rgb2basic $data :
+ die "Invalid type";
+ }
+ $message;
+}
+
sub color_dp2irc($)
{
my ($message) = @_;
my $color = -1;
- $message =~ s{\^(.)(?=([0-9,]?))}{
- my $c = $1;
- my $f = $2;
- $c eq '^' ? '^' :
- $c =~ /^[0-9]$/ ? do {
+ return color_dp_transform
+ {
+ my ($type, $data, $next) = @_;
+
+ if($type eq 'rgb')
+ {
+ $type = 'color';
+ $data = color_rgb2basic $data;
+ }
+
+ $type eq 'char' ? $text_qfont_table[ord $data] :
+ $type eq 'color' ? do {
my $oldcolor = $color;
- $c = 0 if $c >= 7; # map 0, 7, 8, 9 to default (no bright white or such stuff)
- $color = $color_dp2irc_table[$c];
- ($color == $oldcolor) ? '' :
- $c == 0 ? "\0001" :
- $f eq ',' ? "\0003$color\0002\0002" :
- $f ne '' ? sprintf "\0003%02d", $color : "\0003$color";
- } : "^$c";
- }esg;
- $message = text_dp2ascii $message;
- $message =~ s/\0001/\017/g;
- $message =~ s/\0002/\002/g;
- $message =~ s/\0003/\003/g;
- return $message;
+ $data = 0 if $data >= 7; # map 0, 7, 8, 9 to default (no bright white or such stuff)
+ $color = $color_dp2irc_table[$data];
+
+ $color == $oldcolor ? '' :
+ $color == 0 ? "\017" :
+ $next eq ',' ? "\003$color\002\002" :
+ sprintf "\003%02d", $color;
+ } :
+ die "Invalid type";
+ }
+ $message;
}
sub color_dp2ansi($)
{
my ($message) = @_;
my $color = -1;
- $message =~ s{\^(.)}{
- my $c = $1;
- $c eq '^' ? '^' :
- $c =~ /^[0-9]$/ ? do {
+ return color_dp_transform
+ {
+ my ($type, $data, $next) = @_;
+
+ if($type eq 'rgb')
+ {
+ $type = 'color';
+ $data = color_rgb2basic $data;
+ }
+
+ $type eq 'char' ? $text_qfont_table[ord $data] :
+ $type eq 'color' ? do {
my $oldcolor = $color;
- $color = $color_dp2ansi_table[$c];
- ($color eq $oldcolor) ? '' :
- "\000[${color}" # "
- } : "^$c";
- }esg;
- $message = text_dp2ascii $message;
- $message =~ s/\000/\033/g;
- return $message;
+ $color = $color_dp2ansi_table[$data];
+
+ $color eq $oldcolor ? '' :
+ "\033[${color}"
+ } :
+ die "Invalid type";
+ }
+ $message;
}
sub color_dpfix($)
@@ -161,6 +250,7 @@
+
# Interfaces:
# Connection:
# $conn->sockname() returns a connection type specific representation
@@ -258,8 +348,18 @@
{
my ($self) = @_;
my $data = "";
- $self->{sock}->recv($data, 32768, 0);
- return $data;
+ if(defined $self->{sock}->recv($data, 32768, 0))
+ {
+ return $data;
+ }
+ elsif($!{EAGAIN})
+ {
+ return "";
+ }
+ else
+ {
+ return undef;
+ }
}
# $sock->fds() returns the socket file descriptor.
@@ -325,7 +425,10 @@
my ($self) = @_;
for(;;)
{
- length(my $s = $self->{connector}->recv())
+ my $s = $self->{connector}->recv();
+ die "read error\n"
+ if not defined $s;
+ length $s
or last;
next
if $s !~ /^\377\377\377\377n(.*)$/s;
Modified: trunk/Docs/server/rcon2irc/rcon2irc.pl
===================================================================
--- trunk/Docs/server/rcon2irc/rcon2irc.pl 2008-12-25 14:09:32 UTC (rev 5307)
+++ trunk/Docs/server/rcon2irc/rcon2irc.pl 2008-12-25 17:43:41 UTC (rev 5308)
@@ -25,6 +25,233 @@
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.
+# MISC STRING UTILITY ROUTINES to convert between DarkPlaces and IRC conventions
+
+# convert mIRC color codes to DP color codes
+our @color_irc2dp_table = (7, 0, 4, 2, 1, 1, 6, 1, 3, 2, 5, 5, 4, 6, 7, 7);
+our @color_dp2irc_table = (14, 4, 9, 8, 12, 11, 13, 14, 15, 15); # not accurate, but legible
+our @color_dp2ansi_table = ("m", "1;31m", "1;32m", "1;33m", "1;34m", "1;36m", "1;35m", "m", "1m", "1m"); # not accurate, but legible
+our %color_team2dp_table = (5 => 1, 14 => 4, 13 => 3, 10 => 6);
+our %color_team2irc_table = (5 => 4, 14 => 12, 13 => 8, 10 => 13);
+sub color_irc2dp($)
+{
+ my ($message) = @_;
+ $message =~ s/\^/^^/g;
+ my $color = 7;
+ $message =~ s{\003(\d\d?)(?:,(\d?\d?))?|(\017)}{
+ # $1 is FG, $2 is BG, but let's ignore BG
+ my $oldcolor = $color;
+ if($3)
+ {
+ $color = 7;
+ }
+ else
+ {
+ $color = $color_irc2dp_table[$1];
+ $color = $oldcolor if not defined $color;
+ }
+ ($color == $oldcolor) ? '' : '^' . $color;
+ }esg;
+ $message =~ s{[\000-\037]}{}gs; # kill bold etc. for now
+ return $message;
+}
+
+our @text_qfont_table = ( # ripped from DP console.c qfont_table
+ "\0", '#', '#', '#', '#', '.', '#', '#',
+ '#', 9, 10, '#', ' ', 13, '.', '.',
+ '[', ']', '0', '1', '2', '3', '4', '5',
+ '6', '7', '8', '9', '.', '<', '=', '>',
+ ' ', '!', '"', '#', '$', '%', '&', '\'',
+ '(', ')', '*', '+', ',', '-', '.', '/',
+ '0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', ':', ';', '<', '=', '>', '?',
+ '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
+ 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
+ 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
+ 'X', 'Y', 'Z', '[', '\\', ']', '^', '_',
+ '`', 'a', 'b', 'c', 'd', 'e', 'f', 'g',
+ 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',
+ 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
+ 'x', 'y', 'z', '{', '|', '}', '~', '<',
+ '<', '=', '>', '#', '#', '.', '#', '#',
+ '#', '#', ' ', '#', ' ', '>', '.', '.',
+ '[', ']', '0', '1', '2', '3', '4', '5',
+ '6', '7', '8', '9', '.', '<', '=', '>',
+ ' ', '!', '"', '#', '$', '%', '&', '\'',
+ '(', ')', '*', '+', ',', '-', '.', '/',
+ '0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', ':', ';', '<', '=', '>', '?',
+ '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
+ 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
+ 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
+ 'X', 'Y', 'Z', '[', '\\', ']', '^', '_',
+ '`', 'a', 'b', 'c', 'd', 'e', 'f', 'g',
+ 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',
+ 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
+ 'x', 'y', 'z', '{', '|', '}', '~', '<'
+);
+sub text_dp2ascii($)
+{
+ my ($message) = @_;
+ $message = join '', map { $text_qfont_table[ord $_] } split //, $message;
+}
+
+sub color_dp_transform(&$)
+{
+ my ($block, $message) = @_;
+
+ $message =~ s{(?:(\^\^)|\^x([0-9a-fA-F])([0-9a-fA-F])([0-9a-fA-F])|\^([0-9])|(.))(?=([0-9,]?))}{
+ defined $1 ? $block->(char => '^', $7) :
+ defined $2 ? $block->(rgb => [hex $2, hex $3, hex $4], $7) :
+ defined $5 ? $block->(color => $5, $7) :
+ defined $6 ? $block->(char => $6, $7) :
+ die "Invalid match";
+ }esg;
+
+ return $message;
+}
+
+sub color_dp2none($)
+{
+ my ($message) = @_;
+
+ return color_dp_transform
+ {
+ my ($type, $data, $next) = @_;
+ print "$type $data\n";
+ $type eq 'char'
+ ? $text_qfont_table[ord $data]
+ : "";
+ }
+ $message;
+}
+
+sub color_rgb2basic($)
+{
+ my ($data) = @_;
+ my ($r, $g, $b) = @$data;
+ my $min = [sort ($r, $g, $b)]->[0];
+ my $max = [sort ($r, $g, $b)]->[-1];
+
+ my $v = $max / 15;
+ my $s = ($max == $min) ? 0 : 1 - $min/$max;
+
+ if($s < 0.2)
+ {
+ return 0 if $v < 0.5;
+ return 7;
+ }
+
+ my $h;
+ if($max == $min)
+ {
+ $h = 0;
+ }
+ elsif($max == $r)
+ {
+ $h = (60 * ($g - $b) / ($max - $min)) % 360;
+ }
+ elsif($max == $g)
+ {
+ $h = (60 * ($b - $r) / ($max - $min)) + 120;
+ }
+ elsif($max == $b)
+ {
+ $h = (60 * ($r - $g) / ($max - $min)) + 240;
+ }
+
+ return 1 if $h < 36;
+ return 3 if $h < 80;
+ return 2 if $h < 150;
+ return 5 if $h < 200;
+ return 4 if $h < 270;
+ return 6 if $h < 330;
+ return 1;
+}
+
+sub color_dp_rgb2basic($)
+{
+ my ($message) = @_;
+ return color_dp_transform
+ {
+ my ($type, $data, $next) = @_;
+ print "$type $data\n";
+ $type eq 'char' ? ($data eq '^' ? '^^' : $data) :
+ $type eq 'color' ? "^$data" :
+ $type eq 'rgb' ? "^" . color_rgb2basic $data :
+ die "Invalid type";
+ }
+ $message;
+}
+
+sub color_dp2irc($)
+{
+ my ($message) = @_;
+ my $color = -1;
+ return color_dp_transform
+ {
+ my ($type, $data, $next) = @_;
+
+ if($type eq 'rgb')
+ {
+ $type = 'color';
+ $data = color_rgb2basic $data;
+ }
+
+ $type eq 'char' ? $text_qfont_table[ord $data] :
+ $type eq 'color' ? do {
+ my $oldcolor = $color;
+ $data = 0 if $data >= 7; # map 0, 7, 8, 9 to default (no bright white or such stuff)
+ $color = $color_dp2irc_table[$data];
+
+ $color == $oldcolor ? '' :
+ $color == 0 ? "\017" :
+ $next eq ',' ? "\003$color\002\002" :
+ sprintf "\003%02d", $color;
+ } :
+ die "Invalid type";
+ }
+ $message;
+}
+
+sub color_dp2ansi($)
+{
+ my ($message) = @_;
+ my $color = -1;
+ return color_dp_transform
+ {
+ my ($type, $data, $next) = @_;
+
+ if($type eq 'rgb')
+ {
+ $type = 'color';
+ $data = color_rgb2basic $data;
+ }
+
+ $type eq 'char' ? $text_qfont_table[ord $data] :
+ $type eq 'color' ? do {
+ my $oldcolor = $color;
+ $color = $color_dp2ansi_table[$data];
+
+ $color eq $oldcolor ? '' :
+ "\033[${color}"
+ } :
+ die "Invalid type";
+ }
+ $message;
+}
+
+sub color_dpfix($)
+{
+ my ($message) = @_;
+ # if the message ends with an odd number of ^, kill one
+ chop $message if $message =~ /(?:^|[^\^])\^(\^\^)*$/;
+ return $message;
+}
+
+
+
+
# Interfaces:
# Connection:
# $conn->sockname() returns a connection type specific representation
@@ -441,143 +668,6 @@
-# MISC STRING UTILITY ROUTINES to convert between DarkPlaces and IRC conventions
-
-# convert mIRC color codes to DP color codes
-our @color_irc2dp_table = (7, 0, 4, 2, 1, 1, 6, 1, 3, 2, 5, 5, 4, 6, 7, 7);
-our @color_dp2irc_table = (14, 4, 9, 8, 12, 11, 13, 14, 15, 15); # not accurate, but legible
-our @color_dp2ansi_table = ("m", "1;31m", "1;32m", "1;33m", "1;34m", "1;36m", "1;35m", "m", "1m", "1m"); # not accurate, but legible
-our %color_team2dp_table = (5 => 1, 14 => 4, 13 => 3, 10 => 6);
-our %color_team2irc_table = (5 => 4, 14 => 12, 13 => 8, 10 => 13);
-sub color_irc2dp($)
-{
- my ($message) = @_;
- $message =~ s/\^/^^/g;
- my $color = 7;
- $message =~ s{\003(\d\d?)(?:,(\d?\d?))?|(\017)}{
- # $1 is FG, $2 is BG, but let's ignore BG
- my $oldcolor = $color;
- if($3)
- {
- $color = 7;
- }
- else
- {
- $color = $color_irc2dp_table[$1];
- $color = $oldcolor if not defined $color;
- }
- ($color == $oldcolor) ? '' : '^' . $color;
- }esg;
- $message =~ s{[\000-\037]}{}gs; # kill bold etc. for now
- return $message;
-}
-
-our @text_qfont_table = ( # ripped from DP console.c qfont_table
- "\0", '#', '#', '#', '#', '.', '#', '#',
- '#', 9, 10, '#', ' ', 13, '.', '.',
- '[', ']', '0', '1', '2', '3', '4', '5',
- '6', '7', '8', '9', '.', '<', '=', '>',
- ' ', '!', '"', '#', '$', '%', '&', '\'',
- '(', ')', '*', '+', ',', '-', '.', '/',
- '0', '1', '2', '3', '4', '5', '6', '7',
- '8', '9', ':', ';', '<', '=', '>', '?',
- '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
- 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
- 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
- 'X', 'Y', 'Z', '[', '\\', ']', '^', '_',
- '`', 'a', 'b', 'c', 'd', 'e', 'f', 'g',
- 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',
- 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
- 'x', 'y', 'z', '{', '|', '}', '~', '<',
- '<', '=', '>', '#', '#', '.', '#', '#',
- '#', '#', ' ', '#', ' ', '>', '.', '.',
- '[', ']', '0', '1', '2', '3', '4', '5',
- '6', '7', '8', '9', '.', '<', '=', '>',
- ' ', '!', '"', '#', '$', '%', '&', '\'',
- '(', ')', '*', '+', ',', '-', '.', '/',
- '0', '1', '2', '3', '4', '5', '6', '7',
- '8', '9', ':', ';', '<', '=', '>', '?',
- '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
- 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
- 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
- 'X', 'Y', 'Z', '[', '\\', ']', '^', '_',
- '`', 'a', 'b', 'c', 'd', 'e', 'f', 'g',
- 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',
- 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
- 'x', 'y', 'z', '{', '|', '}', '~', '<'
-);
-sub text_dp2ascii($)
-{
- my ($message) = @_;
- $message = join '', map { $text_qfont_table[ord $_] } split //, $message;
-}
-
-sub color_dp2none($)
-{
- my ($message) = @_;
- my $color = -1;
- $message =~ s{\^(.)(?=([0-9,]?))}{
- my $c = $1;
- $c eq '^' ? '^' :
- $c =~ /^[0-9]$/ ? '' : "^$c";
- }esg;
- return text_dp2ascii $message;
-}
-
-sub color_dp2irc($)
-{
- my ($message) = @_;
- my $color = -1;
- $message =~ s{\^(.)(?=([0-9,]?))}{
- my $c = $1;
- my $f = $2;
- $c eq '^' ? '^' :
- $c =~ /^[0-9]$/ ? do {
- my $oldcolor = $color;
- $c = 0 if $c >= 7; # map 0, 7, 8, 9 to default (no bright white or such stuff)
- $color = $color_dp2irc_table[$c];
- ($color == $oldcolor) ? '' :
- $c == 0 ? "\0001" :
- $f eq ',' ? "\0003$color\0002\0002" :
- $f ne '' ? sprintf "\0003%02d", $color : "\0003$color";
- } : "^$c";
- }esg;
- $message = text_dp2ascii $message;
- $message =~ s/\0001/\017/g;
- $message =~ s/\0002/\002/g;
- $message =~ s/\0003/\003/g;
- return $message;
-}
-
-sub color_dp2ansi($)
-{
- my ($message) = @_;
- my $color = -1;
- $message =~ s{\^(.)}{
- my $c = $1;
- $c eq '^' ? '^' :
- $c =~ /^[0-9]$/ ? do {
- my $oldcolor = $color;
- $color = $color_dp2ansi_table[$c];
- ($color eq $oldcolor) ? '' :
- "\000[${color}" # "
- } : "^$c";
- }esg;
- $message = text_dp2ascii $message;
- $message =~ s/\000/\033/g;
- return $message;
-}
-
-sub color_dpfix($)
-{
- my ($message) = @_;
- # if the message ends with an odd number of ^, kill one
- chop $message if $message =~ /(?:^|[^\^])\^(\^\^)*$/;
- return $message;
-}
-
-
-
# Nexuiz specific parsing of some server messages
sub nex_is_teamplay($)
More information about the nexuiz-commits
mailing list