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,
      @_
   }, $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";

#   warn "$command\n";#d#]
   $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 ($face);
   } else {
      $self->send ("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)};

      # TODO: optimise this a lot, or maybe just do it on c-level
      # set flag to -1 for spaces we scroll out
      {
         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 @$_, ([]) x -$self->{mapy} for @$map;
         $self->{mapy} = 0;
      }

      if ($self->{mapx} < 0) {
         unshift @$map, ([]) 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) = @_;

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

   $self->{face}[$num]{image} = $data;
   $self->face_update ($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 ($face) [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_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.15
Committed:	Mon Apr 10 10:44:39 2006 UTC (18 years, 1 month ago) by root
Branch:	MAIN
Changes since 1.14:	+1 -1 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			mapw => 13,
34			maph => 13,
35			@_
36			}, $class;
37	root	1.1
38			$self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port}
39			or die "$self->{host}:$self->{port}: $!";
40			$self->{fh}->blocking (0); # stupid nonblock default
41
42			my $buf;
43
44			$self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub {
45			if (sysread $self->{fh}, $buf, 16384, length $buf) {
46	root	1.8	for (;;) {
47			last unless 2 <= length $buf;
48	root	1.1	my $len = unpack "n", $buf;
49	root	1.8	last unless $len + 2 <= length $buf;
50
51			substr $buf, 0, 2, "";
52			$self->feed (substr $buf, 0, $len, "");
53	root	1.1	}
54			} else {
55			delete $self->{w};
56			close $self->{fh};
57			}
58			});
59
60	root	1.11	$self->{setup_req} = {
61			sound => 1,
62			exp64 => 1,
63			map1acmd => 1,
64			itemcmd => 2,
65			darkness => 1,
66			facecache => 1,
67			newmapcmd => 1,
68			extendedTextInfos => 1,
69			};
70
71	root	1.1	$self->send ("version 1023 1027 perlclient");
72	root	1.11	$self->send_setup;
73	root	1.1
74			$self
75			}
76
77			sub feed {
78			my ($self, $data) = @_;
79
80	root	1.11	$data =~ s/^(\S+)(?:\s\|$)//
81	root	1.1	or return;
82
83			my $command = "feed_$1";
84
85	root	1.14	# warn "$command\n";#d#]
86	root	1.1	$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			$self->face_update ($face);
139			} else {
140			$self->send ("askface $num");
141			}
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			# TODO: optimise this a lot, or maybe just do it on c-level
347			# set flag to -1 for spaces we scroll out
348			{
349			my @darkness;
350
351			if ($dx > 0) {
352			push @darkness, [$mx, $my, $dx - 1, $mh];
353			} elsif ($dx < 0) {
354			push @darkness, [$mx + $mw + $dx + 1, $my, 1 - $dx, $mh];
355			}
356
357			if ($dy > 0) {
358			push @darkness, [$mx, $my, $mw, $dy - 1];
359			} elsif ($dy < 0) {
360			push @darkness, [$mx, $my + $mh + $dy + 1, $mw, 1 - $dy];
361			}
362
363			for (@darkness) {
364			my ($x0, $y0, $w, $h) = @$_;
365			for my $x ($x0 .. $x0 + $w) {
366			for my $y ($y0 .. $y0 + $h) {
367
368			my $cell = $map->[$x][$y]
369			or next;
370
371			$cell->[0] = -1;
372			}
373			}
374			}
375			}
376
377			# now scroll
378
379			$self->{mapx} += $dx;
380			$self->{mapy} += $dy;
381
382			# shift in new space if moving to "negative indices"
383			if ($self->{mapy} < 0) {
384			unshift @$_, ([]) x -$self->{mapy} for @$map;
385			$self->{mapy} = 0;
386			}
387
388			if ($self->{mapx} < 0) {
389			unshift @$map, ([]) x -$self->{mapx};
390			$self->{mapx} = 0;
391			}
392
393			$self->map_scroll ($dx, $dy);
394			}
395
396	root	1.1	my @dirty;
397			my ($coord, $x, $y, $darkness, $fa, $fb, $fc, $cell);
398
399			while (length $data) {
400			$coord = unpack "n", substr $data, 0, 2, "";
401
402	root	1.10	$x = (($coord >> 10) & 63) + $self->{mapx};
403			$y = (($coord >> 4) & 63) + $self->{mapy};
404	root	1.1
405			$cell = $map->[$x][$y] \|\|= [];
406
407	root	1.10	if ($coord & 15) {
408	root	1.14	@$cell = () if $cell->[0] < 0;
409
410	root	1.10	$cell->[0] = $coord & 8
411			? unpack "C", substr $data, 0, 1, ""
412			: 255;
413
414			$cell->[1] = unpack "n", substr $data, 0, 2, ""
415			if $coord & 4;
416			$cell->[2] = unpack "n", substr $data, 0, 2, ""
417			if $coord & 2;
418			$cell->[3] = unpack "n", substr $data, 0, 2, ""
419			if $coord & 1;
420			} else {
421			$cell->[0] = -1;
422			}
423	root	1.1
424			push @dirty, [$x, $y];
425			}
426
427			$self->map_update (\@dirty);
428			}
429
430			sub feed_map_scroll {
431			my ($self, $data) = @_;
432
433			my ($dx, $dy) = split / /, $data;
434
435	root	1.14	$self->{delayed_scroll_x} += $dx;
436			$self->{delayed_scroll_y} += $dy;
437	root	1.1	}
438
439			sub feed_newmap {
440			my ($self) = @_;
441
442			$self->{map} = [];
443			$self->{mapx} = 0;
444			$self->{mapy} = 0;
445
446	root	1.14	delete $self->{delayed_scroll_x};
447			delete $self->{delayed_scroll_y};
448
449	root	1.1	$self->map_clear;
450			}
451
452			sub feed_image {
453			my ($self, $data) = @_;
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.5	$self->face_update ($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.5	=item $conn->face_update ($face) [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.11	sub send_setup {
530			my ($self) = @_;
531
532			my $setup = join " ", setup => %{$self->{setup_req}},
533			mapsize => "$self->{mapw}x$self->{maph}";
534	root	1.15
535	root	1.11	$self->send ($setup);
536			}
537
538	root	1.1	=back
539
540			=head1 AUTHOR
541
542			Marc Lehmann <schmorp@schmorp.de>
543			http://home.schmorp.de/
544
545			Robin Redeker <elmex@ta-sa.org>
546			http://www.ta-sa.org/
547
548			=cut
549
550			1