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.42 by root, Thu May 25 02:38:17 2006 UTC vs.
Revision 1.43 by root, Fri May 26 18:56:44 2006 UTC

… …
14 14
15=cut 15=cut
16 16
17package Crossfire::Protocol; 17package Crossfire::Protocol;
18 18
19BGIN { die "FATAL: Crossfire::Protocol needs to be rewritten to be properly subclassed form Crossfire::Protocol::Base" }
20
19our $VERSION = '0.1'; 21our $VERSION = '0.1';
20 22
21use strict; 23use strict;
22
23use AnyEvent;
24use IO::Socket::INET;
25
26BEGIN {
27 my %CONSTANTS = (
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}
164
165=item new Crossfire::Protocol host => ..., port => ...
166
167=cut
168
169sub new {
170 my $class = shift;
171 my $self = bless {
172 mapw => 13,
173 maph => 13,
174 max_outstanding => 2,
175 token => "a0",
176 @_
177 }, $class;
178
179 $self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port}
180 or die "$self->{host}:$self->{port}: $!";
181 $self->{fh}->blocking (0); # stupid nonblock default
182
183 my $buf;
184
185 $self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub {
186 if (0 < sysread $self->{fh}, $buf, 16384, length $buf) {
187 for (;;) {
188 last unless 2 <= length $buf;
189 my $len = unpack "n", $buf;
190 last unless $len + 2 <= length $buf;
191
192 substr $buf, 0, 2, "";
193 $self->feed (substr $buf, 0, $len, "");
194 }
195 } else {
196 $self->feed_eof;
197 }
198 });
199
200 $self->{setup_req} = {
201 sound => 1,
202 exp64 => 1,
203 map1acmd => 1,
204 itemcmd => 2,
205 darkness => 1,
206 facecache => 1,
207 newmapcmd => 1,
208 mapinfocmd => 1,
209 plugincmd => 1,
210 extendedTextInfos => 1,
211 spellmon => 1,
212 };
213
214 $self->send ("version 1023 1027 perlclient");
215 $self->send_setup;
216 $self->send ("requestinfo skill_info");
217 $self->send ("requestinfo spell_paths");
218
219 $self
220}
221
222sub feed {
223 my ($self, $data) = @_;
224
225 $data =~ s/^(\S+)(?:\s|$)//
226 or return;
227
228 my $command = "feed_$1";
229
230 $self->$command ($data);
231}
232
233sub feed_version {
234 my ($self, $version) = @_;
235}
236
237sub feed_setup {
238 my ($self, $data) = @_;
239
240 $data =~ s/^ +//;
241
242 my $prev_setup = $self->{setup};
243
244 $self->{setup} = { split / +/, $data };
245
246 if ($self->{setup}{extendedTextInfos} > 0 && !$prev_setup) {
247 $self->send ("toggleextendedtext 1"); # books
248 $self->send ("toggleextendedtext 2"); # cards
249 $self->send ("toggleextendedtext 3"); # papers
250 $self->send ("toggleextendedtext 4"); # signs
251 $self->send ("toggleextendedtext 5"); # monuments
252 #$self->send ("toggleextendedtext 6"); # scripted dialogs (yeah)
253 $self->send ("toggleextendedtext 7"); # motd
254 }
255
256 my ($mapw, $maph) = split /x/, $self->{setup}{mapsize};
257
258 if ($mapw != $self->{mapw} || $maph != $self->{maph}) {
259 ($self->{mapw}, $self->{maph}) = ($mapw, $maph);
260 $self->send_setup;
261 } else {
262 $self->send ("addme");
263 }
264
265 $self->feed_newmap;
266}
267
268sub feed_eof {
269 my ($self) = @_;
270
271 delete $self->{w};
272 close delete $self->{fh};
273
274 for my $tag (sort { $b <=> $a } %{ $self->{container} || {} }) {
275 $self->_del_items (@{ $self->{container}{$tag} });
276 $self->container_clear ($tag);
277 }
278
279 $self->eof;
280}
281
282sub feed_addme_success {
283 my ($self, $data) = @_;
284
285 $self->addme_success ($data);
286}
287
288sub feed_addme_failure {
289 my ($self, $data) = @_;
290
291 $self->addme_failure ($data);
292}
293
294sub logout {
295 my ($self) = @_;
296
297 $self->{fh} or return;
298
299 $self->feed_eof;
300}
301
302sub destroy {
303 my ($self) = @_;
304
305 $self->logout;
306
307 %$self = ();
308}
309
310=back
311
312=head2 METHODS THAT CAN/MUST BE OVERWRITTEN
313
314=over 4
315
316=item $self->addme_success
317
318=item $self->addme_failure
319
320=item $self->eof
321
322=cut
323
324sub addme_success { }
325sub addme_failure { }
326sub eof { }
327
328sub feed_face1 {
329 my ($self, $data) = @_;
330
331 my ($num, $chksum, $name) = unpack "nNa*", $data;
332
333 $self->need_face ($num, $name, $chksum);
334}
335
336sub need_face {
337 my ($self, $num, $name, $chksum) = @_;
338
339 return if $self->{face}[$num];
340
341 my $face = $self->{face}[$num] = { name => $name, chksum => $chksum };
342
343 if (my $data = $self->face_find ($num, $face)) {
344 $face->{image} = $data;
345 $self->face_update ($num, $face);
346 } else {
347 $self->send_queue ("askface $num");
348 }
349}
350
351=item $conn->anim_update ($num) [OVERWRITE]
352
353=cut
354
355sub anim_update { }
356
357sub feed_anim {
358 my ($self, $data) = @_;
359
360 my ($num, $flags, @faces) = unpack "n*", $data;
361
362 $self->{anim}[$num] = \@faces;
363
364 $self->anim_update ($num);
365}
366
367=item $conn->sound_play ($x, $y, $soundnum, $type)
368
369=cut
370
371sub sound_play { }
372
373sub feed_sound {
374 my ($self, $data) = @_;
375
376 $self->sound_play (unpack "ccnC", $data);
377}
378
379=item $conn->query ($flags, $prompt)
380
381=cut
382
383sub query { }
384
385sub feed_query {
386 my ($self, $data) = @_;
387
388 my ($flags, $prompt) = split /\s+/, $data, 2;
389
390 if ($flags == 0 && $prompt =~ /^What is your name\?\s+:$/ && length $self->{user}) {
391 $self->send ("reply $self->{user}");
392 } elsif ($flags == 4 && $prompt =~ /^What is your password\?\s+:$/ && length $self->{pass}) {
393 $self->send ("reply $self->{pass}");
394 } elsif ($flags == 4 && $prompt =~ /^Please type your password again\.\s+:$/ && length $self->{pass}) {
395 $self->send ("reply $self->{pass}");
396 } else {
397 $self->query ($flags, $prompt);
398 }
399}
400
401=item $conn->drawextinfo ($color, $type, $subtype, $message)
402
403=item $conn->drawinfo ($color, $text)
404
405=cut
406
407sub drawextinfo { }
408
409sub drawinfo { }
410
411sub feed_ExtendedTextSet {
412 my ($self, $data) = @_;
413}
414
415sub feed_drawextinfo {
416 my ($self, $data) = @_;
417
418 my ($color, $type, $subtype, $message) = split /\s+/, $data, 4;
419
420 $self->drawextinfo ($color, $type, $subtype, $message);
421}
422
423sub feed_drawinfo {
424 my ($self, $data) = @_;
425
426 my ($flags, $text) = split / /, $data, 2;
427
428 utf8::decode $text if utf8::valid $text;
429
430 $self->drawinfo ($flags, $text);
431}
432
433=item $conn->player_update ($player)
434
435tag, weight, face, name
436
437=cut
438
439sub player_update { }
440
441sub feed_player {
442 my ($self, $data) = @_;
443
444 my ($tag, $weight, $face, $name) = unpack "NNN C/a", $data;
445
446 $self->player_update ($self->{player} = {
447 tag => $tag,
448 weight => $weight,
449 face => $face,
450 name => $name,
451 });
452}
453
454=item $conn->stats_update ($stats)
455
456=cut
457
458sub stats_update { }
459
460my %stat_32bit = map +($_ => 1),
461 CS_STAT_WEIGHT_LIM,
462 CS_STAT_SPELL_ATTUNE,
463 CS_STAT_SPELL_REPEL,
464 CS_STAT_SPELL_DENY,
465 CS_STAT_EXP;
466
467sub feed_stats {
468 my ($self, $data) = @_;
469
470 while (length $data) {
471 my $stat = unpack "C", substr $data, 0, 1, "";
472 my $value;
473
474 if ($stat_32bit{$stat}) {
475 $value = unpack "N", substr $data, 0, 4, "";
476 } elsif ($stat == CS_STAT_SPEED || $stat == CS_STAT_WEAP_SP) {
477 $value = (1 / FLOAT_MULTF) * unpack "N", substr $data, 0, 4, "";
478 } elsif ($stat == CS_STAT_RANGE || $stat == CS_STAT_TITLE) {
479 my $len = unpack "C", substr $data, 0, 1, "";
480 $value = substr $data, 0, $len, "";
481 } elsif ($stat == CS_STAT_EXP64) {
482 my ($hi, $lo) = unpack "NN", substr $data, 0, 8, "";
483 $value = $hi * 2**32 + $lo;
484 } elsif (($stat >= CS_STAT_SKILLEXP_START && $stat <= CS_STAT_SKILLEXP_END)
485 || ($stat >= CS_STAT_SKILLINFO && $stat < CS_STAT_SKILLINFO + CS_NUM_SKILLS)) {
486 my ($level, $lo, $hi) = unpack "CNN", substr $data, 0, 9, "";
487 $value = [$level, $hi * 2**32 + $lo];
488 } else {
489 $value = unpack "s", pack "S", unpack "n", substr $data, 0, 2, "";
490 }
491
492 $self->{stat}{$stat} = $value;
493 }
494
495 $self->stats_update ($self->{stat});
496}
497
498=item $conn->container_add ($id, $item...)
499
500=item $conn->container_clear ($id)
501
502=item $conn->item_update ($item)
503
504=item $conn->item_delete ($item...)
505
506=cut
507
508sub container_add { }
509sub container_clear { }
510sub item_delete { }
511sub item_update { }
512
513sub _del_items {
514 my ($self, @items) = @_;
515
516 for my $item (@items) {
517 delete $self->{item}{$item->{tag}};
518 $self->{container}{$item->{container}} = [
519 grep $_ != $item, @{ $self->{container}{$item->{container}} }
520 ];
521 }
522}
523
524sub feed_delinv {
525 my ($self, $data) = @_;
526
527 $self->_del_items (@{ $self->{container}{$data} });
528 $self->container_clear ($data);
529}
530
531sub feed_delitem {
532 my ($self, $data) = @_;
533
534 my @items = map $self->{item}{$_}, unpack "N*", $data;
535
536 $self->_del_items (@items);
537 $self->item_delete (@items);
538}
539
540sub feed_item2 {
541 my ($self, $data) = @_;
542
543 my ($location, @values) = unpack "N (NNNN C/a* nC Nn)*", $data;
544
545 my @items;
546
547 while (@values) {
548 my ($tag, $flags, $weight, $face, $names, $anim, $animspeed, $nrof, $type) =
549 splice @values, 0, 9, ();
550
551 $weight = unpack "l", pack "L", $weight; # weight can be -1
552
553 utf8::decode $names if utf8::valid $names;
554 my ($name, $name_pl) = split /\x00/, $names;
555
556 my $item = {
557 container => $location,
558 tag => $tag,
559 flags => $flags,
560 weight => $weight,
561 face => $face,
562 name => $name,
563 name_pl => $name_pl,
564 anim => $anim,
565 animspeed => $animspeed * TICK,
566 nrof => $nrof,
567 type => $type,
568 };
569
570 if (my $prev = $self->{item}{$tag}) {
571 $self->_del_items ($prev);
572 $self->item_delete ($prev);
573 }
574
575 $self->{item}{$tag} = $item;
576 push @{ $self->{container}{$location} }, $item;
577 push @items, $item;
578 }
579
580 $self->container_add ($location, \@items);
581}
582
583sub feed_upditem {
584 my ($self, $data) = @_;
585
586 my ($flags, $tag) = unpack "CN", substr $data, 0, 5, "";
587
588 my $item = $self->{item}{$tag};
589
590 if ($flags & UPD_LOCATION) {
591 $self->item_delete ($item);
592 $self->{container}{$item->{container}} = [
593 grep $_ != $item, @{ $self->{container}{$item->{container}} }
594 ];
595
596 $item->{container} = unpack "N", substr $data, 0, 4, "";
597
598 push @{ $self->{container}{$item->{container}} }, $item;
599 $self->container_add ($item->{location}, $item);
600 }
601
602 $item->{flags} = unpack "N", substr $data, 0, 4, "" if $flags & UPD_FLAGS;
603 $item->{weight} = unpack "l", pack "L", unpack "N", substr $data, 0, 4, "" if $flags & UPD_WEIGHT;
604 $item->{face} = unpack "N", substr $data, 0, 4, "" if $flags & UPD_FACE;
605
606 if ($flags & UPD_NAME) {
607 my $len = unpack "C", substr $data, 0, 1, "";
608
609 my $names = substr $data, 0, $len, "";
610 utf8::decode $names if utf8::valid $names;
611 @$item{qw(name name_pl)} = split /\x00/, $names;
612 }
613
614 $item->{anim} = unpack "n", substr $data, 0, 2, "" if $flags & UPD_ANIM;
615 $item->{animspeed} = TICK * unpack "C", substr $data, 0, 1, "" if $flags & UPD_ANIMSPEED;
616 $item->{nrof} = unpack "N", substr $data, 0, 4, "" if $flags & UPD_NROF;
617
618 $self->item_update ($item);
619}
620
621=item $conn->spell_add ($spell)
622
623 $spell = {
624 tag => ...,
625 level => ...,
626 casting_time => ...,
627 mana => ...,
628 grace => ...,
629 damage => ...,
630 skill => ...,
631 path => ...,
632 face => ...,
633 name => ...,
634 message => ...,
635 };
636
637=item $conn->spell_update ($spell)
638
639(the default implementation calls delete then add)
640
641=item $conn->spell_delete ($spell)
642
643=cut
644
645sub spell_add { }
646
647sub spell_update {
648 my ($self, $spell) = @_;
649
650 $self->spell_delete ($spell);
651 $self->spell_add ($spell);
652}
653
654sub spell_delete { }
655
656sub feed_addspell {
657 my ($self, $data) = @_;
658
659 my @data = unpack "(NnnnnnCNN C/a n/a)*", $data;
660
661 while (@data) {
662 my $spell = {
663 tag => (shift @data),
664 level => (shift @data),
665 casting_time => (shift @data),
666 mana => (shift @data),
667 grace => (shift @data),
668 damage => (shift @data),
669 skill => (shift @data),
670 path => (shift @data),
671 face => (shift @data),
672 name => (shift @data),
673 message => (shift @data),
674 };
675
676 $self->send ("requestinfo image_sums $spell->{face} $spell->{face}")
677 unless $self->{spell_face}[$spell->{face}]++;
678
679 $self->spell_add ($self->{spell}{$spell->{tag}} = $spell);
680 }
681}
682
683sub feed_updspell {
684 my ($self, $data) = @_;
685
686 my ($flags, $tag) = unpack "CN", substr $data, 0, 5, "";
687
688 # only 1, 2, 4 supported
689 # completely untested
690
691 my $spell = $self->{spell}{$tag};
692
693 $spell->{mana} = unpack "n", substr $data, 0, 2, "" if $flags & UPD_SP_MANA;
694 $spell->{grace} = unpack "n", substr $data, 0, 2, "" if $flags & UPD_SP_GRACE;
695 $spell->{damage} = unpack "n", substr $data, 0, 2, "" if $flags & UPD_SP_DAMAGE;
696
697 $self->spell_update ($spell);
698}
699
700sub feed_delspell {
701 my ($self, $data) = @_;
702
703 $self->spell_delete (delete $self->{spell}{unpack "N", $data});
704}
705 24
706sub feed_map1a { 25sub feed_map1a {
707 my ($self, $data) = @_; 26 my ($self, $data) = @_;
708 27
709 my $map = $self->{map} ||= []; 28 my $map = $self->{map} ||= [];
… …
817 delete $self->{delayed_scroll_y}; 136 delete $self->{delayed_scroll_y};
818 137
819 $self->map_clear; 138 $self->map_clear;
820} 139}
821 140
822sub feed_mapinfo {
823 my ($self, $data) = @_;
824
825 my ($token, @data) = split / /, $data;
826
827 (delete $self->{mapinfo_cb}{$token})->(@data)
828 if $self->{mapinfo_cb}{$token};
829
830 $self->map_change (@data) if $token eq "-";
831}
832
833sub send_mapinfo {
834 my ($self, $data, $cb) = @_;
835
836 my $token = ++$self->{token};
837
838 $self->{mapinfo_cb}{$token} = sub {
839 $self->send_queue;
840 $cb->(@_);
841 };
842 $self->send_queue ("mapinfo $token $data");
843}
844
845sub feed_image { 141sub feed_image {
846 my ($self, $data) = @_; 142 my ($self, $data) = @_;
847 143
144 $self->SUPER::feed_image ($data);
145
848 my ($num, $len, $data) = unpack "NNa*", $data; 146 my ($num, $len, $data) = unpack "NNa*", $data;
849
850 $self->send_queue;
851 $self->{face}[$num]{image} = $data;
852 $self->face_update ($num, $self->{face}[$num]);
853 147
854 my @dirty; 148 my @dirty;
855 149
856 for my $x (0..$self->{mapw} - 1) { 150 for my $x (0..$self->{mapw} - 1) {
857 for my $y (0..$self->{maph} - 1) { 151 for my $y (0..$self->{maph} - 1) {
… …
859 if grep $_ == $num, @{$self->{map}[$x][$y] || []}; 153 if grep $_ == $num, @{$self->{map}[$x][$y] || []};
860 } 154 }
861 } 155 }
862 156
863 $self->map_update (\@dirty); 157 $self->map_update (\@dirty);
864}
865
866=item $conn->image_info ($numfaces, $chksum, [...image-sets])
867
868=cut
869
870sub image_info { }
871
872sub feed_replyinfo {
873 my ($self, $data) = @_;
874
875 if ($data =~ s/^image_sums \d+ \d+ //) {
876 my ($num, $chksum, $faceset, $name) = unpack "n N C C/Z*", $data;
877
878 $self->need_face ($num, $name, $chksum);
879
880 } elsif ($data =~ s/^image_info\s+//) {
881 $self->image_info (split /\n/, $data);
882
883 } elsif ($data =~ s/^skill_info\s+//) {
884 for (split /\012/, $data) {
885 my ($id, $name) = split /:/, $_, 2;
886 $self->{skill_info}{$id} = $name;
887 }
888
889 } elsif ($data =~ s/^spell_paths\s+//) {
890 for (split /\012/, $data) {
891 my ($id, $name) = split /:/, $_, 2;
892 $self->{spell_paths}{$id} = $name;
893 }
894 }
895}
896
897=item $conn->map_change ($mode, ...) [OVERWRITE]
898
899 current <flags> <x> <y> <width> <height> <hashstring>
900
901=cut
902
903sub map_info { }
904
905=item $conn->map_clear [OVERWRITE]
906
907Called whenever the map is to be erased completely.
908
909=cut
910
911sub map_clear { }
912
913=item $conn->map_update ([ [x,y], [x,y], ...]) [OVERWRITE]
914
915Called with a list of x|y coordinate pairs (as arrayrefs) for cells that
916have been updated and need refreshing.
917
918=cut
919
920sub map_update { }
921
922=item $conn->map_scroll ($dx, $dy) [OVERWRITE]
923
924Called whenever the map has been scrolled.
925
926=cut
927
928sub map_scroll { }
929
930=item $conn->face_update ($facenum, $facedata) [OVERWRITE]
931
932Called with the face number of face structure whenever a face image has
933changed.
934
935=cut
936
937sub face_update { }
938
939=item $conn->face_find ($facenum, $facedata) [OVERWRITE]
940
941Find and return the png image for the given face, or the empty list if no
942face could be found, in which case it will be requested from the server.
943
944=cut
945
946sub face_find { }
947
948=item $conn->send ($data)
949
950Send a single packet/line to the server.
951
952=cut
953
954sub send {
955 my ($self, $data) = @_;
956
957 $data = pack "na*", length $data, $data;
958
959 syswrite $self->{fh}, $data;
960}
961
962=item $conn->send_command ($command)
963
964Uses either command or ncom to send a user-level command to the
965server. Encodes the command to UTF-8.
966
967=cut
968
969sub send_command {
970 my ($self, $command) = @_;
971
972 utf8::encode $command;
973 $self->send ("command $command");
974}
975
976sub send_queue {
977 my ($self, $cmd) = @_;
978
979 if (defined $cmd) {
980 push @{ $self->{send_queue} }, $cmd;
981 } else {
982 --$self->{outstanding};
983 }
984
985 if ($self->{outstanding} < $self->{max_outstanding} && @{ $self->{send_queue} }) {
986 ++$self->{outstanding};
987 $self->send (shift @{ $self->{send_queue} });
988 }
989}
990
991sub send_setup {
992 my ($self) = @_;
993
994 my $setup = join " ", setup => %{$self->{setup_req}},
995 mapsize => "$self->{mapw}x$self->{maph}";
996
997 $self->send ($setup);
998} 158}
999 159
1000=back 160=back
1001 161
1002=head1 AUTHOR 162=head1 AUTHOR

Diff Legend

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