ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra/Deliantra/Protocol.pm
(Generate patch)

Comparing deliantra/Deliantra/Deliantra/Protocol.pm (file contents):
Revision 1.32 by root, Thu Apr 20 07:13:09 2006 UTC vs.
Revision 1.33 by root, Sun Apr 23 23:57:13 2006 UTC

… …
21use strict; 21use strict;
22 22
23use AnyEvent; 23use AnyEvent;
24use IO::Socket::INET; 24use IO::Socket::INET;
25 25
26BEGIN {
27 my %CONSTANTS = (
26my $TICK = 0.120; # one server tick, not exposed through the protocol of course 28 TICK => 0.120, # one server tick, not exposed through the protocol of course
29 CS_QUERY_YESNO => 0x1,
30 CS_QUERY_SINGLECHAR => 0x2,
31 CS_QUERY_HIDEINPUT => 0x4,
32 CS_SAY_NORMAL => 0x1,
33 CS_SAY_SHOUT => 0x2,
34 CS_SAY_GSAY => 0x4,
35 FLOAT_MULTI => 100000,
36 FLOAT_MULTF => 100000.0,
37 CS_STAT_HP => 1,
38 CS_STAT_MAXHP => 2,
39 CS_STAT_SP => 3,
40 CS_STAT_MAXSP => 4,
41 CS_STAT_STR => 5,
42 CS_STAT_INT => 6,
43 CS_STAT_WIS => 7,
44 CS_STAT_DEX => 8,
45 CS_STAT_CON => 9,
46 CS_STAT_CHA => 10,
47 CS_STAT_EXP => 11,
48 CS_STAT_LEVEL => 12,
49 CS_STAT_WC => 13,
50 CS_STAT_AC => 14,
51 CS_STAT_DAM => 15,
52 CS_STAT_ARMOUR => 16,
53 CS_STAT_SPEED => 17,
54 CS_STAT_FOOD => 18,
55 CS_STAT_WEAP_SP => 19,
56 CS_STAT_RANGE => 20,
57 CS_STAT_TITLE => 21,
58 CS_STAT_POW => 22,
59 CS_STAT_GRACE => 23,
60 CS_STAT_MAXGRACE => 24,
61 CS_STAT_FLAGS => 25,
62 CS_STAT_WEIGHT_LIM => 26,
63 CS_STAT_EXP64 => 28,
64 CS_STAT_SPELL_ATTUNE => 29,
65 CS_STAT_SPELL_REPEL => 30,
66 CS_STAT_SPELL_DENY => 31,
67 CS_STAT_RESIST_START => 100,
68 CS_STAT_RESIST_END => 117,
69 CS_STAT_RES_PHYS => 100,
70 CS_STAT_RES_MAG => 101,
71 CS_STAT_RES_FIRE => 102,
72 CS_STAT_RES_ELEC => 103,
73 CS_STAT_RES_COLD => 104,
74 CS_STAT_RES_CONF => 105,
75 CS_STAT_RES_ACID => 106,
76 CS_STAT_RES_DRAIN => 107,
77 CS_STAT_RES_GHOSTHIT => 108,
78 CS_STAT_RES_POISON => 109,
79 CS_STAT_RES_SLOW => 110,
80 CS_STAT_RES_PARA => 111,
81 CS_STAT_TURN_UNDEAD => 112,
82 CS_STAT_RES_FEAR => 113,
83 CS_STAT_RES_DEPLETE => 114,
84 CS_STAT_RES_DEATH => 115,
85 CS_STAT_RES_HOLYWORD => 116,
86 CS_STAT_RES_BLIND => 117,
87 CS_STAT_SKILLEXP_START => 118,
88 CS_STAT_SKILLEXP_END => 129,
89 CS_STAT_SKILLEXP_AGILITY => 118,
90 CS_STAT_SKILLEXP_AGLEVEL => 119,
91 CS_STAT_SKILLEXP_PERSONAL => 120,
92 CS_STAT_SKILLEXP_PELEVEL => 121,
93 CS_STAT_SKILLEXP_MENTAL => 122,
94 CS_STAT_SKILLEXP_MELEVEL => 123,
95 CS_STAT_SKILLEXP_PHYSIQUE => 124,
96 CS_STAT_SKILLEXP_PHLEVEL => 125,
97 CS_STAT_SKILLEXP_MAGIC => 126,
98 CS_STAT_SKILLEXP_MALEVEL => 127,
99 CS_STAT_SKILLEXP_WISDOM => 128,
100 CS_STAT_SKILLEXP_WILEVEL => 129,
101 CS_STAT_SKILLINFO => 140,
102 CS_NUM_SKILLS => 50,
103 SF_FIREON => 0x01,
104 SF_RUNON => 0x02,
105 NDI_BLACK => 0,
106 NDI_WHITE => 1,
107 NDI_NAVY => 2,
108 NDI_RED => 3,
109 NDI_ORANGE => 4,
110 NDI_BLUE => 5,
111 NDI_DK_ORANGE => 6,
112 NDI_GREEN => 7,
113 NDI_LT_GREEN => 8,
114 NDI_GREY => 9,
115 NDI_BROWN => 10,
116 NDI_GOLD => 11,
117 NDI_TAN => 12,
118 NDI_MAX_COLOR => 12,
119 NDI_COLOR_MASK => 0xff,
120 NDI_UNIQUE => 0x100,
121 NDI_ALL => 0x200,
122 a_none => 0,
123 a_readied => 1,
124 a_wielded => 2,
125 a_worn => 3,
126 a_active => 4,
127 a_applied => 5,
128 F_APPLIED => 0x000F,
129 F_LOCATION => 0x00F0,
130 F_UNPAID => 0x0200,
131 F_MAGIC => 0x0400,
132 F_CURSED => 0x0800,
133 F_DAMNED => 0x1000,
134 F_OPEN => 0x2000,
135 F_NOPICK => 0x4000,
136 F_LOCKED => 0x8000,
137 CF_FACE_NONE => 0,
138 CF_FACE_BITMAP => 1,
139 CF_FACE_XPM => 2,
140 CF_FACE_PNG => 3,
141 CF_FACE_CACHE => 0x10,
142 FACE_FLOOR => 0x80,
143 FACE_COLOR_MASK => 0xf,
144 UPD_LOCATION => 0x01,
145 UPD_FLAGS => 0x02,
146 UPD_WEIGHT => 0x04,
147 UPD_FACE => 0x08,
148 UPD_NAME => 0x10,
149 UPD_ANIM => 0x20,
150 UPD_ANIMSPEED => 0x40,
151 UPD_NROF => 0x80,
152 UPD_SP_MANA => 0x01,
153 UPD_SP_GRACE => 0x02,
154 UPD_SP_DAMAGE => 0x04,
155 SOUND_NORMAL => 0,
156 SOUND_SPELL => 1,
157 );
158
159 while (my ($k, $v) = each %CONSTANTS) {
160 eval "sub $k () { $v } 1"
161 or die;
162 }
163}
27 164
28=item new Crossfire::Protocol host => ..., port => ... 165=item new Crossfire::Protocol host => ..., port => ...
29 166
30=cut 167=cut
31 168
32sub new { 169sub new {
33 my $class = shift; 170 my $class = shift;
34 my $self = bless { 171 my $self = bless {
35 mapw => 13, 172 mapw => 13,
36 maph => 13, 173 maph => 13,
37 max_outstanding => 6, 174 max_outstanding => 2,
38 token => "a0", 175 token => "a0",
39 @_ 176 @_
40 }, $class; 177 }, $class;
41 178
42 $self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port} 179 $self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port}
… …
258 395
259=cut 396=cut
260 397
261sub stats_update { } 398sub stats_update { }
262 399
400my %stat_32bit = map +($_ => 1),
401 CS_STAT_WEIGHT_LIM,
402 CS_STAT_SPELL_ATTUNE,
403 CS_STAT_SPELL_REPEL,
404 CS_STAT_SPELL_DENY,
405 CS_STAT_EXP;
406
263sub feed_stats { 407sub feed_stats {
264 my ($self, $data) = @_; 408 my ($self, $data) = @_;
265 409
266 while (length $data) { 410 while (length $data) {
267 my $stat = unpack "C", substr $data, 0, 1, ""; 411 my $stat = unpack "C", substr $data, 0, 1, "";
268 my $value; 412 my $value;
269 413
270 if ($stat == 26 || $stat == 29 || $stat == 30 || $stat == 31 || $stat == 11) { 414 if ($stat_32bit{$stat}) {
271 $value = unpack "N", substr $data, 0, 4, ""; 415 $value = unpack "N", substr $data, 0, 4, "";
272 } elsif ($stat == 17 || $stat == 19) { 416 } elsif ($stat == CS_STAT_SPEED || $stat == CS_STAT_WEAP_SP) {
273 $value = (1 / 100000) * unpack "N", substr $data, 0, 4, ""; 417 $value = (1 / FLOAT_MULTF) * unpack "N", substr $data, 0, 4, "";
274 } elsif ($stat == 20 || $stat == 21) { 418 } elsif ($stat == CS_STAT_RANGE || $stat == CS_STAT_TITLE) {
275 my $len = unpack "C", substr $data, 0, 1, ""; 419 my $len = unpack "C", substr $data, 0, 1, "";
276 $value = substr $data, 0, $len, ""; 420 $value = substr $data, 0, $len, "";
277 } elsif ($stat == 28) { 421 } elsif ($stat == CS_STAT_EXP64) {
278 my ($hi, $lo) = unpack "NN", substr $data, 0, 8, ""; 422 my ($hi, $lo) = unpack "NN", substr $data, 0, 8, "";
279 $value = $hi * 2**32 + $lo; 423 $value = $hi * 2**32 + $lo;
280 } elsif (($stat >= 118 && $stat <= 129) || ($stat >= 140 && $stat < 190)) { 424 } elsif (($stat >= CS_STAT_SKILLEXP_START && $stat <= CS_STAT_SKILLEXP_END)
425 || ($stat >= CS_STAT_SKILLINFO && $stat < CS_STAT_SKILLINFO + CS_NUM_SKILLS)) {
281 my ($level, $lo, $hi) = unpack "CNN", substr $data, 0, 9, ""; 426 my ($level, $lo, $hi) = unpack "CNN", substr $data, 0, 9, "";
282 $value = [$level, $hi * 2**32 + $lo]; 427 $value = [$level, $hi * 2**32 + $lo];
283 } else { 428 } else {
284 $value = unpack "s", pack "S", unpack "n", substr $data, 0, 2, ""; 429 $value = unpack "s", pack "S", unpack "n", substr $data, 0, 2, "";
285 } 430 }
… …
288 } 433 }
289 434
290 $self->stats_update ($self->{stat}); 435 $self->stats_update ($self->{stat});
291} 436}
292 437
438=item $conn->container_add ($id, $item...)
439
293=item $conn->inventory_clear ($id) 440=item $conn->container_clear ($id)
294 441
295=cut 442=item $conn->item_update ($item)
296 443
444=item $conn->item_delete ($item...)
445
446=cut
447
448sub container_add { }
297sub inventory_clear { } 449sub container_clear { }
450sub item_delete { }
451sub item_update { }
452
453sub _del_items {
454 my ($self, @items) = @_;
455
456 for my $item (@items) {
457 delete $self->{item}{$item->{tag}};
458 delete $self->{container}{$item->{container}}{$item->{tag}};
459 }
460}
298 461
299sub feed_delinv { 462sub feed_delinv {
300 my ($self, $data) = @_; 463 my ($self, $data) = @_;
301 464
465 $self->_del_items (values %{ $self->{container}{$data} });
302 $self->inventory_clear ($data); 466 $self->container_clear ($data);
303
304 delete $self->{inventory}[$data];
305} 467}
306
307=item $conn->items_delete ($tag...)
308
309=cut
310
311sub items_delete { }
312 468
313sub feed_delitem { 469sub feed_delitem {
314 my ($self, $data) = @_; 470 my ($self, $data) = @_;
315 471
316 $self->items_delete (unpack "n*", $data); 472 my @items = map $self->{item}{$_}, unpack "N*", $data;
317} 473 $self->_del_items (@items);
318 474 $self->item_delete (@items);
319=item $conn->inventory_add ($id, [\%item...])
320
321=cut
322
323sub inventory_add {
324} 475}
325 476
326sub feed_item2 { 477sub feed_item2 {
327 my ($self, $data) = @_; 478 my ($self, $data) = @_;
328 479
… …
332 483
333 while (@values) { 484 while (@values) {
334 my ($tag, $flags, $weight, $face, $names, $anim, $animspeed, $nrof, $type) = 485 my ($tag, $flags, $weight, $face, $names, $anim, $animspeed, $nrof, $type) =
335 splice @values, 0, 9, (); 486 splice @values, 0, 9, ();
336 487
488 utf8::decode $names if utf8::valid $names;
337 my ($name, $name_pl) = split /\x000/, $names; 489 my ($name, $name_pl) = split /\x00/, $names;
338 490
339 push @items, { 491 my $item = {
492 container => $location,
340 tag => $tag, 493 tag => $tag,
341 flags => $flags, 494 flags => $flags,
342 weight => $weight, 495 weight => $weight,
343 face => $face, 496 face => $face,
344 name => $name, 497 name => $name,
345 name_pl => $name_pl, 498 name_pl => $name_pl,
346 anim => $anim, 499 anim => $anim,
347 animspeed => $animspeed * $TICK, #??? 500 animspeed => $animspeed * TICK, #???
348 nrof => $nrof, 501 nrof => $nrof,
349 type => $type, 502 type => $type,
350 }; 503 };
351 }
352 504
505 $self->{item}{$tag} = $item;
506 $self->{container}{$location}{$tag} = $item;
507 push @items, $item;
508 }
509
353 $self->inventory_add ($location, \@items); 510 $self->container_add ($location, \@items);
354} 511}
355
356=item $conn->item_update ($tag)
357
358=cut
359
360sub item_update { }
361 512
362sub feed_upditem { 513sub feed_upditem {
363 #todo 514 my ($self, $data) = @_;
364#define UPD_LOCATION 0x01 515
365#define UPD_FLAGS 0x02 516 my ($flags, $tag) = unpack "NN", substr $data, 0, 8, "";
366#define UPD_WEIGHT 0x04 517
367#define UPD_FACE 0x08 518 my $item = $self->{item}{$tag};
368#define UPD_NAME 0x10 519
369#define UPD_ANIM 0x20 520 if ($flags & UPD_LOCATION) {
370#define UPD_ANIMSPEED 0x40 521 $self->item_delete ($item);
371#define UPD_NROF 0x80 522 delete $self->{container}{$item->{container}}{$tag};
523
524 $item->{container} = unpack "N", substr $data, 0, 4, "";
525
526 $self->{container}{$item->{container}}{$tag} = $item;
527 $self->container_add ($item->{location}, $item);
528 }
529
530 $item->{flags} = unpack "N", substr $data, 0, 4, "" if $flags & UPD_FLAGS;
531 $item->{weight} = unpack "N", substr $data, 0, 4, "" if $flags & UPD_WEIGHT;
532 $item->{face} = unpack "N", substr $data, 0, 4, "" if $flags & UPD_FACE;
533
534 if ($flags & UPD_NAME) {
535 my $len = unpack "C", substr $data, 0, 1, "";
536
537 my $names = substr $data, 0, $len, "";
538 utf8::decode $names if utf8::valid $names;
539 @$item{qw(name name_pl)} = split /\x00/, $names;
540 }
541
542 $item->{anim} = unpack "n", substr $data, 0, 2, "" if $flags & UPD_ANIM;
543 $item->{animspeed} = TICK * unpack "C", substr $data, 0, 1, "" if $flags & UPD_ANIMSPEED;
544 $item->{nrof} = unpack "N", substr $data, 0, 4, "" if $flags & UPD_NROF;
545
546 $self->item_update ($item);
372} 547}
373 548
374=item $conn->spell_add ($spell) 549=item $conn->spell_add ($spell)
375 550
376 $spell = { 551 $spell = {
… …
441 # only 1, 2, 4 supported 616 # only 1, 2, 4 supported
442 # completely untested 617 # completely untested
443 618
444 my $spell = $self->{spell}{$tag}; 619 my $spell = $self->{spell}{$tag};
445 620
446 $spell->{mana} = unpack "n", substr $data, 0, 2, "" if $flags & 1; 621 $spell->{mana} = unpack "n", substr $data, 0, 2, "" if $flags & UPD_SP_MANA;
447 $spell->{grace} = unpack "n", substr $data, 0, 2, "" if $flags & 2; 622 $spell->{grace} = unpack "n", substr $data, 0, 2, "" if $flags & UPD_SP_GRACE;
448 $spell->{damage} = unpack "n", substr $data, 0, 2, "" if $flags & 4; 623 $spell->{damage} = unpack "n", substr $data, 0, 2, "" if $flags & UPD_SP_DAMAGE;
449 624
450 $self->spell_update ($spell); 625 $self->spell_update ($spell);
451} 626}
452 627
453sub feed_delspell { 628sub feed_delspell {

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines