Deliantra/Deliantra/Protocol.pm

=head1 NAME

Crossfire::Protocol - client protocol module

=head1 SYNOPSIS

   use base Crossfire::Protocol; # you have to subclass

=head1 DESCRIPTION

Base class to implement a corssfire client.

=over 4

=cut

package Crossfire::Protocol;

our $VERSION = '0.1';

use strict;

use AnyEvent;
use IO::Socket::INET;

=item new Crossfire::Protocol host => ..., port => ...

=cut

sub new {
   my $class = shift;
   my $self = bless {
      mapw            => 13,
      maph            => 13,
      max_outstanding => 2,
      @_
   }, $class;

   $self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port}
      or die "$self->{host}:$self->{port}: $!";
   $self->{fh}->blocking (0); # stupid nonblock default

   my $buf;

   $self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub {
      if (sysread $self->{fh}, $buf, 16384, length $buf) {
         for (;;) {
            last unless 2 <= length $buf;
            my $len = unpack "n", $buf;
            last unless $len + 2 <= length $buf;

            substr $buf, 0, 2, "";
            $self->feed (substr $buf, 0, $len, "");
         }
      } else {
         delete $self->{w};
         close $self->{fh};
      }
   });

   $self->{setup_req} = {
      sound             => 1,
      exp64             => 1,
      map1acmd          => 1,
      itemcmd           => 2,
      darkness          => 1,
      facecache         => 1,
      newmapcmd         => 1,
      extendedTextInfos => 1,
   };

   $self->send ("version 1023 1027 perlclient");
   $self->send_setup;

   $self
}

sub feed {
   my ($self, $data) = @_;

   $data =~ s/^(\S+)(?:\s|$)//
      or return;

   my $command = "feed_$1";

   $self->$command ($data);
}

sub feed_version {
   my ($self, $version) = @_;
}

sub feed_setup {
   my ($self, $data) = @_;

   $data =~ s/^ +//;

   $self->{setup} = { split / +/, $data };

   my ($mapw, $maph) = split /x/, $self->{setup}{mapsize};

   if ($mapw != $self->{mapw} || $maph != $self->{maph}) {
      ($self->{mapw}, $self->{maph}) = ($mapw, $maph);
      $self->send_setup;
   } else {
      $self->send ("addme");
   }

   $self->feed_newmap;
}

sub feed_addme_success {
   my ($self, $data) = @_;
}

sub feed_addme_failure {
   my ($self, $data) = @_;
   # maybe should notify user
}

=back

=head2 METHODS THAT CAN/MUST BE OVERWRITTEN

=over 4

=cut

sub feed_face1 {
   my ($self, $data) = @_;

   my ($num, $chksum, $name) = unpack "nNa*", $data;

   my $face = $self->{face}[$num] = { name => $name, chksum => $chksum };

   if (my $data = $self->face_find ($face)) {
      $face->{image} = $data;
      $self->face_update ($num, $face);
   } else {
      $self->send_queue ("askface $num");
   }
}

=item $conn->anim_update ($num) [OVERWRITE]

=cut

sub anim_update { }

sub feed_anim {
   my ($self, $data) = @_;

   my ($num, @faces) = unpack "n*", $data;

   $self->{anim}[$num] = \@faces;

   $self->anim_update ($num);
}

=item $conn->play_sound ($x, $y, $soundnum, $type)

=cut

sub sound_play { }

sub feed_sound {
   my ($self, $data) = @_;

   $self->sound_play (unpack "CCnC", $data);
}

=item $conn->query ($flags, $prompt)

=cut

sub query { }

sub feed_query {
   my ($self, $data) = @_;

   my ($flags, $prompt) = split /\s+/, $data, 2;

   if ($flags == 0 && $prompt =~ /^What is your name\?\s+:$/ && length $self->{user}) {
      $self->send ("reply $self->{user}");
   } elsif ($flags == 4 && $prompt =~ /^What is your password\?\s+:$/ && length $self->{pass}) {
      $self->send ("reply $self->{pass}");
   } elsif ($flags == 4 && $prompt =~ /^Please type your password again\.\s+:$/ && length $self->{pass}) {
      $self->send ("reply $self->{pass}");
   } else {
      $self->query ($flags, $prompt);
   }
}

=item $conn->drawinfo ($color, $text)

=cut

sub drawinfo { }

sub feed_drawinfo {
   my ($self, $data) = @_;

   $self->drawinfo (split / /, $data, 2);
}

=item $conn->player_update ($player)

tag, weight, face, name

=cut

sub player_update { }

sub feed_player {
   my ($self, $data) = @_;

   my ($tag, $weight, $face, $name) = unpack "NNN C/a", $data;

   $self->player_update ($self->{player} = {
      tag    => $tag,
      weight => $weight,
      face   => $face,
      name   => $name,
   });
}

=item $conn->stats_update ($stats)

=cut

sub stats_update { }

sub feed_stats {
   my ($self, $data) = @_;

   while (length $data) {
      my $stat = unpack "C", substr $data, 0, 1, "";
      my $value;

      if ($stat == 26 || $stat == 29 || $stat == 30 || $stat == 31 || $stat == 11) {
         $value = unpack "N", substr $data, 0, 4, "";
      } elsif ($stat == 17 || $stat == 19) {
         $value = (1 / 100000) * unpack "N", substr $data, 0, 4, "";
      } elsif ($stat == 20 || $stat == 21) {
         my $len = unpack "C", substr $data, 0, 1, "";
         $value = substr $data, 0, $len, "";
      } elsif ($stat == 28) {
         my ($lo, $hi) = unpack "NN", substr $data, 0, 8, "";
         $value = $hi * 2**32 + $lo;
      } elsif ($stat >= 118 && $stat <= 129) {
         my ($level, $lo, $hi) = unpack "CNN", substr $data, 0, 9, "";
         $value = [$level, $hi * 2**32 + $lo];
      } else {
         $value = unpack "n", substr $data, 0, 2, "";
      }

      $self->{stat}{$stat} = $value;
   }

   $self->stats_update ($self->{stat});
}

=item $conn->inventory_clear ($id)

=cut

sub inventory_clear { }

sub feed_delinv {
   my ($self, $data) = @_;

   $self->inventory_clear ($data);

   delete $self->{inventory}[$data];
}

=item $conn->items_delete ($tag...)

=cut

sub items_delete { }

sub feed_delitem {
   my ($self, $data) = @_;

   $self->items_delete (unpack "n*", $data);
}

=item $conn->inventory_add ($id, [\%item...])

=cut

sub inventory_add {
}

sub feed_item2 {
   my ($self, $data) = @_;

   my ($location, @values) = unpack "N (NNNN C/a* nC Nn)*", $data;

   my @items;

   while (@values) {
      my ($tag, $flags, $weight, $face, $names, $anim, $animspeed, $nrof, $type) =
         splice @values, 0, 9, ();

      my ($name, $name_pl) = split /\x000/, $names;

      push @items, {
         tag       => $tag,
         flags     => $flags,
         weight    => $weight,
         face      => $face,
         name      => $name,
         name_pl   => $name_pl,
         anim      => $anim,
         animspeed => $animspeed * 0.120, #???
         nrof      => $nrof,
         type      => $type,
      };
   }

   $self->inventory_add ($location, \@items);
}

=item $conn->item_update ($tag)

=cut

sub item_update { }

sub feed_upditem {
   #todo
}

sub feed_map1a {
   my ($self, $data) = @_;

   my $map = $self->{map} ||= [];

   my ($dx, $dy) = delete @$self{qw(delayed_scroll_x delayed_scroll_y)};

   if ($dx || $dy) {
      my ($mx, $my, $mw, $mh) = @$self{qw(mapx mapy mapw maph)};

      {
         my @darkness;

         if ($dx > 0) {
            push @darkness, [$mx, $my, $dx - 1, $mh];
         } elsif ($dx < 0) {
            push @darkness, [$mx + $mw + $dx + 1, $my, 1 - $dx, $mh];
         }

         if ($dy > 0) {
            push @darkness, [$mx, $my, $mw, $dy - 1];
         } elsif ($dy < 0) {
            push @darkness, [$mx, $my + $mh + $dy + 1, $mw, 1 - $dy];
         }

         for (@darkness) {
            my ($x0, $y0, $w, $h) = @$_;
            for my $x ($x0 .. $x0 + $w) {
               for my $y ($y0 .. $y0 + $h) {

                  my $cell = $map->[$x][$y]
                     or next;

                  $cell->[0] = -1;
               }
            }
         }
      }

      # now scroll

      $self->{mapx} += $dx;
      $self->{mapy} += $dy;

      # shift in new space if moving to "negative indices"
      if ($self->{mapy} < 0) {
         unshift @$_, (undef) x -$self->{mapy} for @$map;
         $self->{mapy} = 0;
      }

      if ($self->{mapx} < 0) {
         unshift @$map, (undef) x -$self->{mapx};
         $self->{mapx} = 0;
      }

      $self->map_scroll ($dx, $dy);
   }

   my @dirty;
   my ($coord, $x, $y, $darkness, $fa, $fb, $fc, $cell);

   while (length $data) {
      $coord = unpack "n", substr $data, 0, 2, "";

      $x = (($coord >> 10) & 63) + $self->{mapx};
      $y = (($coord >>  4) & 63) + $self->{mapy};

      $cell = $map->[$x][$y] ||= [];

      if ($coord & 15) {
         @$cell = () if $cell->[0] < 0;

         $cell->[0] = $coord & 8
                    ? unpack "C", substr $data, 0, 1, ""
                    : 255;

         $cell->[1] = unpack "n", substr $data, 0, 2, ""
            if $coord & 4;
         $cell->[2] = unpack "n", substr $data, 0, 2, ""
            if $coord & 2;
         $cell->[3] = unpack "n", substr $data, 0, 2, ""
            if $coord & 1;
      } else {
         $cell->[0] = -1;
      }

      push @dirty, [$x, $y];
   }

   $self->map_update (\@dirty);
}

sub feed_map_scroll {
   my ($self, $data) = @_;

   my ($dx, $dy) = split / /, $data;

   $self->{delayed_scroll_x} += $dx;
   $self->{delayed_scroll_y} += $dy;
}

sub feed_newmap {
   my ($self) = @_;

   $self->{map}  = [];
   $self->{mapx} = 0;
   $self->{mapy} = 0;

   delete $self->{delayed_scroll_x};
   delete $self->{delayed_scroll_y};

   $self->map_clear;
}

sub feed_image {
   my ($self, $data) = @_;

   $self->send_queue;

   my ($num, $len, $data) = unpack "NNa*", $data;

   $self->{face}[$num]{image} = $data;
   $self->face_update ($num, $self->{face}[$num]);

   my @dirty;

   for my $x (0..$self->{mapw} - 1) {
      for my $y (0..$self->{maph} - 1) {
         push @dirty, [$x, $y]
            if grep $_ == $num, @{$self->{map}[$x][$y] || []};
      }
   }

   $self->map_update (\@dirty);
}

=item $conn->map_clear [OVERWRITE]

Called whenever the map is to be erased completely.

=cut

sub map_clear  { }

=item $conn->map_update ([ [x,y], [x,y], ...]) [OVERWRITE]

Called with a list of x|y coordinate pairs (as arrayrefs) for cells that
have been updated and need refreshing.

=cut

sub map_update { }

=item $conn->map_scroll ($dx, $dy) [OVERWRITE]

Called whenever the map has been scrolled.

=cut

sub map_scroll { }

=item $conn->face_update ($facenum, $facedata) [OVERWRITE]

Called with the face number of face structure whenever a face image has
changed.

=cut

sub face_update { }

=item $conn->face_find ($face) [OVERWRITE]

Find and return the png image for the given face, or the empty list if no
face could be found, in which case it will be requested from the server.

=cut

sub face_find { }

=item $conn->send ($data)

Send a single packet/line to the server.

=cut

sub send {
   my ($self, $data) = @_;

   $data = pack "na*", length $data, $data;

   syswrite $self->{fh}, $data;
}

sub send_queue {
   my ($self, $cmd) = @_;

   if (defined $cmd) {
      push @{ $self->{send_queue} }, $cmd;
   } else {
      --$self->{outstanding};
   }

   if ($self->{outstanding} < $self->{max_outstanding} && @{ $self->{send_queue} }) {
      ++$self->{outstanding};
      $self->send (pop @{ $self->{send_queue} });
   }
}

sub send_setup {
   my ($self) = @_;

   my $setup = join " ", setup => %{$self->{setup_req}},
                  mapsize => "$self->{mapw}x$self->{maph}";

   $self->send ($setup);
}

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

 Robin Redeker <elmex@ta-sa.org>
 http://www.ta-sa.org/

=cut

1
Revision:	1.21
Committed:	Thu Apr 13 23:56:14 2006 UTC (18 years, 1 month ago) by root
Branch:	MAIN
Changes since 1.20:	+0 -2 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Crossfire::Protocol - client protocol module
4
5			=head1 SYNOPSIS
6
7			use base Crossfire::Protocol; # you have to subclass
8
9			=head1 DESCRIPTION
10
11			Base class to implement a corssfire client.
12
13			=over 4
14
15			=cut
16
17			package Crossfire::Protocol;
18
19			our $VERSION = '0.1';
20
21			use strict;
22
23			use AnyEvent;
24			use IO::Socket::INET;
25
26	root	1.10	=item new Crossfire::Protocol host => ..., port => ...
27	root	1.1
28			=cut
29
30			sub new {
31			my $class = shift;
32	root	1.10	my $self = bless {
33	root	1.17	mapw => 13,
34			maph => 13,
35			max_outstanding => 2,
36	root	1.10	@_
37			}, $class;
38	root	1.1
39			$self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port}
40			or die "$self->{host}:$self->{port}: $!";
41			$self->{fh}->blocking (0); # stupid nonblock default
42
43			my $buf;
44
45			$self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub {
46			if (sysread $self->{fh}, $buf, 16384, length $buf) {
47	root	1.8	for (;;) {
48			last unless 2 <= length $buf;
49	root	1.1	my $len = unpack "n", $buf;
50	root	1.8	last unless $len + 2 <= length $buf;
51
52			substr $buf, 0, 2, "";
53			$self->feed (substr $buf, 0, $len, "");
54	root	1.1	}
55			} else {
56			delete $self->{w};
57			close $self->{fh};
58			}
59			});
60
61	root	1.11	$self->{setup_req} = {
62			sound => 1,
63			exp64 => 1,
64			map1acmd => 1,
65			itemcmd => 2,
66			darkness => 1,
67			facecache => 1,
68			newmapcmd => 1,
69			extendedTextInfos => 1,
70			};
71
72	root	1.1	$self->send ("version 1023 1027 perlclient");
73	root	1.11	$self->send_setup;
74	root	1.1
75			$self
76			}
77
78			sub feed {
79			my ($self, $data) = @_;
80
81	root	1.11	$data =~ s/^(\S+)(?:\s\|$)//
82	root	1.1	or return;
83
84			my $command = "feed_$1";
85
86			$self->$command ($data);
87			}
88
89			sub feed_version {
90			my ($self, $version) = @_;
91			}
92
93			sub feed_setup {
94			my ($self, $data) = @_;
95
96			$data =~ s/^ +//;
97
98			$self->{setup} = { split / +/, $data };
99
100	root	1.10	my ($mapw, $maph) = split /x/, $self->{setup}{mapsize};
101
102			if ($mapw != $self->{mapw} \|\| $maph != $self->{maph}) {
103			($self->{mapw}, $self->{maph}) = ($mapw, $maph);
104	root	1.11	$self->send_setup;
105			} else {
106			$self->send ("addme");
107	root	1.10	}
108	root	1.1
109			$self->feed_newmap;
110			}
111
112	root	1.11	sub feed_addme_success {
113			my ($self, $data) = @_;
114			}
115
116			sub feed_addme_failure {
117			my ($self, $data) = @_;
118			# maybe should notify user
119			}
120
121	root	1.14	=back
122
123			=head2 METHODS THAT CAN/MUST BE OVERWRITTEN
124
125			=over 4
126
127			=cut
128
129			sub feed_face1 {
130			my ($self, $data) = @_;
131
132			my ($num, $chksum, $name) = unpack "nNa*", $data;
133
134			my $face = $self->{face}[$num] = { name => $name, chksum => $chksum };
135
136			if (my $data = $self->face_find ($face)) {
137			$face->{image} = $data;
138	root	1.20	$self->face_update ($num, $face);
139	root	1.14	} else {
140	root	1.17	$self->send_queue ("askface $num");
141	root	1.14	}
142			}
143
144			=item $conn->anim_update ($num) [OVERWRITE]
145
146			=cut
147
148			sub anim_update { }
149
150			sub feed_anim {
151			my ($self, $data) = @_;
152
153			my ($num, @faces) = unpack "n*", $data;
154
155			$self->{anim}[$num] = \@faces;
156
157			$self->anim_update ($num);
158			}
159
160			=item $conn->play_sound ($x, $y, $soundnum, $type)
161	root	1.11
162			=cut
163
164			sub sound_play { }
165
166			sub feed_sound {
167			my ($self, $data) = @_;
168
169			$self->sound_play (unpack "CCnC", $data);
170			}
171
172	root	1.14	=item $conn->query ($flags, $prompt)
173	root	1.6
174			=cut
175
176	root	1.14	sub query { }
177	root	1.6
178	root	1.1	sub feed_query {
179			my ($self, $data) = @_;
180	root	1.6
181			my ($flags, $prompt) = split /\s+/, $data, 2;
182
183			if ($flags == 0 && $prompt =~ /^What is your name\?\s+:$/ && length $self->{user}) {
184			$self->send ("reply $self->{user}");
185			} elsif ($flags == 4 && $prompt =~ /^What is your password\?\s+:$/ && length $self->{pass}) {
186			$self->send ("reply $self->{pass}");
187			} elsif ($flags == 4 && $prompt =~ /^Please type your password again\.\s+:$/ && length $self->{pass}) {
188			$self->send ("reply $self->{pass}");
189			} else {
190			$self->query ($flags, $prompt);
191			}
192	root	1.1	}
193
194	root	1.14	=item $conn->drawinfo ($color, $text)
195
196			=cut
197
198			sub drawinfo { }
199
200			sub feed_drawinfo {
201			my ($self, $data) = @_;
202
203			$self->drawinfo (split / /, $data, 2);
204			}
205
206			=item $conn->player_update ($player)
207	root	1.6
208			tag, weight, face, name
209
210			=cut
211
212			sub player_update { }
213
214			sub feed_player {
215			my ($self, $data) = @_;
216
217			my ($tag, $weight, $face, $name) = unpack "NNN C/a", $data;
218
219			$self->player_update ($self->{player} = {
220			tag => $tag,
221			weight => $weight,
222			face => $face,
223			name => $name,
224			});
225			}
226
227	root	1.14	=item $conn->stats_update ($stats)
228	root	1.6
229			=cut
230
231			sub stats_update { }
232
233	root	1.1	sub feed_stats {
234			my ($self, $data) = @_;
235	root	1.6
236			while (length $data) {
237			my $stat = unpack "C", substr $data, 0, 1, "";
238			my $value;
239
240			if ($stat == 26 \|\| $stat == 29 \|\| $stat == 30 \|\| $stat == 31 \|\| $stat == 11) {
241			$value = unpack "N", substr $data, 0, 4, "";
242			} elsif ($stat == 17 \|\| $stat == 19) {
243			$value = (1 / 100000) * unpack "N", substr $data, 0, 4, "";
244			} elsif ($stat == 20 \|\| $stat == 21) {
245			my $len = unpack "C", substr $data, 0, 1, "";
246			$value = substr $data, 0, $len, "";
247			} elsif ($stat == 28) {
248			my ($lo, $hi) = unpack "NN", substr $data, 0, 8, "";
249			$value = $hi * 2**32 + $lo;
250			} elsif ($stat >= 118 && $stat <= 129) {
251			my ($level, $lo, $hi) = unpack "CNN", substr $data, 0, 9, "";
252			$value = [$level, $hi * 2**32 + $lo];
253			} else {
254			$value = unpack "n", substr $data, 0, 2, "";
255			}
256
257			$self->{stat}{$stat} = $value;
258			}
259
260			$self->stats_update ($self->{stat});
261	root	1.1	}
262
263	root	1.14	=item $conn->inventory_clear ($id)
264
265			=cut
266
267			sub inventory_clear { }
268
269			sub feed_delinv {
270	root	1.1	my ($self, $data) = @_;
271
272	root	1.14	$self->inventory_clear ($data);
273	root	1.3
274	root	1.14	delete $self->{inventory}[$data];
275	root	1.1	}
276
277	root	1.14	=item $conn->items_delete ($tag...)
278	root	1.6
279			=cut
280
281	root	1.14	sub items_delete { }
282	root	1.6
283	root	1.14	sub feed_delitem {
284	root	1.6	my ($self, $data) = @_;
285
286	root	1.14	$self->items_delete (unpack "n*", $data);
287			}
288
289			=item $conn->inventory_add ($id, [\%item...])
290	root	1.6
291	root	1.14	=cut
292	root	1.6
293	root	1.14	sub inventory_add {
294	root	1.6	}
295
296	root	1.14	sub feed_item2 {
297	root	1.1	my ($self, $data) = @_;
298	root	1.14
299			my ($location, @values) = unpack "N (NNNN C/a* nC Nn)*", $data;
300
301			my @items;
302
303			while (@values) {
304			my ($tag, $flags, $weight, $face, $names, $anim, $animspeed, $nrof, $type) =
305			splice @values, 0, 9, ();
306
307			my ($name, $name_pl) = split /\x000/, $names;
308
309			push @items, {
310			tag => $tag,
311			flags => $flags,
312			weight => $weight,
313			face => $face,
314			name => $name,
315			name_pl => $name_pl,
316			anim => $anim,
317			animspeed => $animspeed * 0.120, #???
318			nrof => $nrof,
319			type => $type,
320			};
321			}
322
323			$self->inventory_add ($location, \@items);
324	root	1.1	}
325
326	root	1.14	=item $conn->item_update ($tag)
327
328			=cut
329
330			sub item_update { }
331	root	1.1
332	root	1.14	sub feed_upditem {
333			#todo
334	root	1.1	}
335
336			sub feed_map1a {
337			my ($self, $data) = @_;
338
339			my $map = $self->{map} \|\|= [];
340
341	root	1.14	my ($dx, $dy) = delete @$self{qw(delayed_scroll_x delayed_scroll_y)};
342
343			if ($dx \|\| $dy) {
344			my ($mx, $my, $mw, $mh) = @$self{qw(mapx mapy mapw maph)};
345
346			{
347			my @darkness;
348
349			if ($dx > 0) {
350			push @darkness, [$mx, $my, $dx - 1, $mh];
351			} elsif ($dx < 0) {
352			push @darkness, [$mx + $mw + $dx + 1, $my, 1 - $dx, $mh];
353			}
354
355			if ($dy > 0) {
356			push @darkness, [$mx, $my, $mw, $dy - 1];
357			} elsif ($dy < 0) {
358			push @darkness, [$mx, $my + $mh + $dy + 1, $mw, 1 - $dy];
359			}
360
361			for (@darkness) {
362			my ($x0, $y0, $w, $h) = @$_;
363			for my $x ($x0 .. $x0 + $w) {
364			for my $y ($y0 .. $y0 + $h) {
365
366			my $cell = $map->[$x][$y]
367			or next;
368
369			$cell->[0] = -1;
370			}
371			}
372			}
373			}
374
375			# now scroll
376
377			$self->{mapx} += $dx;
378			$self->{mapy} += $dy;
379
380			# shift in new space if moving to "negative indices"
381			if ($self->{mapy} < 0) {
382	root	1.16	unshift @$_, (undef) x -$self->{mapy} for @$map;
383	root	1.14	$self->{mapy} = 0;
384			}
385
386			if ($self->{mapx} < 0) {
387	root	1.16	unshift @$map, (undef) x -$self->{mapx};
388	root	1.14	$self->{mapx} = 0;
389			}
390
391			$self->map_scroll ($dx, $dy);
392			}
393
394	root	1.1	my @dirty;
395			my ($coord, $x, $y, $darkness, $fa, $fb, $fc, $cell);
396
397			while (length $data) {
398			$coord = unpack "n", substr $data, 0, 2, "";
399
400	root	1.10	$x = (($coord >> 10) & 63) + $self->{mapx};
401			$y = (($coord >> 4) & 63) + $self->{mapy};
402	root	1.1
403			$cell = $map->[$x][$y] \|\|= [];
404
405	root	1.10	if ($coord & 15) {
406	root	1.14	@$cell = () if $cell->[0] < 0;
407
408	root	1.10	$cell->[0] = $coord & 8
409			? unpack "C", substr $data, 0, 1, ""
410			: 255;
411
412			$cell->[1] = unpack "n", substr $data, 0, 2, ""
413			if $coord & 4;
414			$cell->[2] = unpack "n", substr $data, 0, 2, ""
415			if $coord & 2;
416			$cell->[3] = unpack "n", substr $data, 0, 2, ""
417			if $coord & 1;
418			} else {
419			$cell->[0] = -1;
420			}
421	root	1.1
422			push @dirty, [$x, $y];
423			}
424
425			$self->map_update (\@dirty);
426			}
427
428			sub feed_map_scroll {
429			my ($self, $data) = @_;
430
431			my ($dx, $dy) = split / /, $data;
432
433	root	1.14	$self->{delayed_scroll_x} += $dx;
434			$self->{delayed_scroll_y} += $dy;
435	root	1.1	}
436
437			sub feed_newmap {
438			my ($self) = @_;
439
440			$self->{map} = [];
441			$self->{mapx} = 0;
442			$self->{mapy} = 0;
443
444	root	1.14	delete $self->{delayed_scroll_x};
445			delete $self->{delayed_scroll_y};
446
447	root	1.1	$self->map_clear;
448			}
449
450			sub feed_image {
451			my ($self, $data) = @_;
452
453	root	1.17	$self->send_queue;
454
455	root	1.3	my ($num, $len, $data) = unpack "NNa*", $data;
456	root	1.1
457	root	1.3	$self->{face}[$num]{image} = $data;
458	root	1.20	$self->face_update ($num, $self->{face}[$num]);
459	root	1.1
460	root	1.3	my @dirty;
461	root	1.2
462			for my $x (0..$self->{mapw} - 1) {
463			for my $y (0..$self->{maph} - 1) {
464			push @dirty, [$x, $y]
465			if grep $_ == $num, @{$self->{map}[$x][$y] \|\| []};
466			}
467			}
468	root	1.6
469	root	1.2	$self->map_update (\@dirty);
470	root	1.1	}
471
472			=item $conn->map_clear [OVERWRITE]
473
474			Called whenever the map is to be erased completely.
475
476			=cut
477
478			sub map_clear { }
479
480			=item $conn->map_update ([ [x,y], [x,y], ...]) [OVERWRITE]
481
482			Called with a list of x\|y coordinate pairs (as arrayrefs) for cells that
483			have been updated and need refreshing.
484
485			=cut
486
487			sub map_update { }
488
489			=item $conn->map_scroll ($dx, $dy) [OVERWRITE]
490
491			Called whenever the map has been scrolled.
492
493			=cut
494
495			sub map_scroll { }
496
497	root	1.20	=item $conn->face_update ($facenum, $facedata) [OVERWRITE]
498	root	1.1
499			Called with the face number of face structure whenever a face image has
500			changed.
501
502			=cut
503
504			sub face_update { }
505
506	root	1.5	=item $conn->face_find ($face) [OVERWRITE]
507	root	1.3
508			Find and return the png image for the given face, or the empty list if no
509			face could be found, in which case it will be requested from the server.
510
511			=cut
512
513			sub face_find { }
514
515	root	1.1	=item $conn->send ($data)
516
517			Send a single packet/line to the server.
518
519			=cut
520
521			sub send {
522			my ($self, $data) = @_;
523
524			$data = pack "na*", length $data, $data;
525
526			syswrite $self->{fh}, $data;
527			}
528
529	root	1.17	sub send_queue {
530			my ($self, $cmd) = @_;
531
532			if (defined $cmd) {
533			push @{ $self->{send_queue} }, $cmd;
534			} else {
535			--$self->{outstanding};
536			}
537
538	root	1.19	if ($self->{outstanding} < $self->{max_outstanding} && @{ $self->{send_queue} }) {
539	root	1.17	++$self->{outstanding};
540	root	1.19	$self->send (pop @{ $self->{send_queue} });
541	root	1.17	}
542			}
543
544	root	1.11	sub send_setup {
545			my ($self) = @_;
546
547			my $setup = join " ", setup => %{$self->{setup_req}},
548			mapsize => "$self->{mapw}x$self->{maph}";
549	root	1.15
550	root	1.11	$self->send ($setup);
551			}
552
553	root	1.1	=back
554
555			=head1 AUTHOR
556
557			Marc Lehmann <schmorp@schmorp.de>
558			http://home.schmorp.de/
559
560			Robin Redeker <elmex@ta-sa.org>
561			http://www.ta-sa.org/
562
563			=cut
564
565			1