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::Rptocol host => ..., port => ...

=cut

sub new {
   my $class = shift;
   my $self = bless { @_ }, $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) {
         if (2 <= length $buf) {
            my $len = unpack "n", $buf;
            if ($len + 2 <= length $buf) {
               substr $buf, 0, 2, "";
               $self->feed (substr $buf, 0, $len, "");
            }
         }
      } else {
         delete $self->{w};
         close $self->{fh};
      }
   });

   $self->send ("version 1023 1027 perlclient");
   $self->send ("setup sound 1 exp 1 map1acmd 1 itemcmd 2 darkness 1 mapsize 63x63 newmapcmd 1 facecache 1 extendedMapInfos 1 extendedTextInfos 1");
   $self->send ("addme");

   $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 };

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

   $self->feed_newmap;
}

sub feed_query {
   my ($self, $data) = @_;
   warn "Q<$data>\n";
}

sub feed_stats {
   my ($self, $data) = @_;
#   warn "S<$data>\n";
}

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

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

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

sub feed_drawinfo {
   my ($self, $data) = @_;
#   warn "<$data>\n";
}

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

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

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

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

   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;
      $y = ($coord >>  4) & 63;

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

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

      @$cell = ()
         unless $coord & 15;

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

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

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

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

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

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

   if ($dx > 0) {
      unshift @$_, ([]) x $dx for @$map;
   } elsif ($dx < 0) {
      splice @$_, 0, -$dx, () for @$map;
   }

   if ($dy > 0) {
      unshift @$map, ([]) x $dy;
   } elsif ($dy < 0) {
      splice @$map, 0, -$dy, ();
   }

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

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

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

   $self->map_clear;
}

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

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

   $self->{face}[$face]{image} = $data;

   $self->face_update ($face, $self->{face}[$face]);
}

=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, $face) [OVERWRITE]

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

=cut

sub face_update { }

=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;
}

=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.1
Committed:	Thu Apr 6 16:33:14 2006 UTC (18 years, 2 months ago) by root
Branch:	MAIN
Log Message:	added protocol module
#	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			=item new Crossfire::Rptocol host => ..., port => ...
27
28			=cut
29
30			sub new {
31			my $class = shift;
32			my $self = bless { @_ }, $class;
33
34			$self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port}
35			or die "$self->{host}:$self->{port}: $!";
36			$self->{fh}->blocking (0); # stupid nonblock default
37
38			my $buf;
39
40			$self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub {
41			if (sysread $self->{fh}, $buf, 16384, length $buf) {
42			if (2 <= length $buf) {
43			my $len = unpack "n", $buf;
44			if ($len + 2 <= length $buf) {
45			substr $buf, 0, 2, "";
46			$self->feed (substr $buf, 0, $len, "");
47			}
48			}
49			} else {
50			delete $self->{w};
51			close $self->{fh};
52			}
53			});
54
55			$self->send ("version 1023 1027 perlclient");
56			$self->send ("setup sound 1 exp 1 map1acmd 1 itemcmd 2 darkness 1 mapsize 63x63 newmapcmd 1 facecache 1 extendedMapInfos 1 extendedTextInfos 1");
57			$self->send ("addme");
58
59			$self
60			}
61
62			sub feed {
63			my ($self, $data) = @_;
64
65			$data =~ s/^(\S+)\s//
66			or return;
67
68			my $command = "feed_$1";
69
70			$self->$command ($data);
71			}
72
73			sub feed_version {
74			my ($self, $version) = @_;
75			}
76
77			sub feed_setup {
78			my ($self, $data) = @_;
79
80			$data =~ s/^ +//;
81
82			$self->{setup} = { split / +/, $data };
83
84			($self->{mapw}, $self->{maph}) = split /x/, $self->{setup}{mapsize};
85
86			$self->feed_newmap;
87			}
88
89			sub feed_query {
90			my ($self, $data) = @_;
91			warn "Q<$data>\n";
92			}
93
94			sub feed_stats {
95			my ($self, $data) = @_;
96			# warn "S<$data>\n";
97			}
98
99			sub feed_face1 {
100			my ($self, $data) = @_;
101
102			my ($num, $chksum, $name) = unpack "nNa*", $data;
103
104			$self->{face}[$num] = { name => $name, chksum => $chksum };
105			}
106
107			sub feed_drawinfo {
108			my ($self, $data) = @_;
109			# warn "<$data>\n";
110			}
111
112			sub feed_delinv {
113			my ($self, $data) = @_;
114			}
115
116			sub feed_item2 {
117			my ($self, $data) = @_;
118			}
119
120			sub feed_map1a {
121			my ($self, $data) = @_;
122
123			my $map = $self->{map} \|\|= [];
124
125			my @dirty;
126			my ($coord, $x, $y, $darkness, $fa, $fb, $fc, $cell);
127
128			while (length $data) {
129			$coord = unpack "n", substr $data, 0, 2, "";
130
131			$x = ($coord >> 10) & 63;
132			$y = ($coord >> 4) & 63;
133
134			$cell = $map->[$x][$y] \|\|= [];
135
136			$cell->[3] = unpack "C", substr $data, 0, 1, ""
137			if $coord & 8;
138			$cell->[0] = unpack "n", substr $data, 0, 2, ""
139			if $coord & 4;
140			$cell->[1] = unpack "n", substr $data, 0, 2, ""
141			if $coord & 2;
142			$cell->[2] = unpack "n", substr $data, 0, 2, ""
143			if $coord & 1;
144
145			@$cell = ()
146			unless $coord & 15;
147
148			push @dirty, [$x, $y];
149			}
150
151			$self->map_update (\@dirty);
152			}
153
154			sub feed_map_scroll {
155			my ($self, $data) = @_;
156
157			my ($dx, $dy) = split / /, $data;
158
159			my $map = $self->{map} \|\|= [];
160
161			$self->{mapx} += $dx;
162			$self->{mapy} += $dy;
163
164			if ($dx > 0) {
165			unshift @$_, ([]) x $dx for @$map;
166			} elsif ($dx < 0) {
167			splice @$_, 0, -$dx, () for @$map;
168			}
169
170			if ($dy > 0) {
171			unshift @$map, ([]) x $dy;
172			} elsif ($dy < 0) {
173			splice @$map, 0, -$dy, ();
174			}
175
176			$self->map_scroll ($dx, $dy);
177			}
178
179			sub feed_newmap {
180			my ($self) = @_;
181
182			$self->{map} = [];
183			$self->{mapx} = 0;
184			$self->{mapy} = 0;
185
186			$self->map_clear;
187			}
188
189			sub feed_image {
190			my ($self, $data) = @_;
191
192			my ($face, $len, $data) = unpack "NNa*", $data;
193
194			$self->{face}[$face]{image} = $data;
195
196			$self->face_update ($face, $self->{face}[$face]);
197			}
198
199			=item $conn->map_clear [OVERWRITE]
200
201			Called whenever the map is to be erased completely.
202
203			=cut
204
205			sub map_clear { }
206
207			=item $conn->map_update ([ [x,y], [x,y], ...]) [OVERWRITE]
208
209			Called with a list of x\|y coordinate pairs (as arrayrefs) for cells that
210			have been updated and need refreshing.
211
212			=cut
213
214			sub map_update { }
215
216			=item $conn->map_scroll ($dx, $dy) [OVERWRITE]
217
218			Called whenever the map has been scrolled.
219
220			=cut
221
222			sub map_scroll { }
223
224			=item $conn->face_update ($facenum, $face) [OVERWRITE]
225
226			Called with the face number of face structure whenever a face image has
227			changed.
228
229			=cut
230
231			sub face_update { }
232
233			=item $conn->send ($data)
234
235			Send a single packet/line to the server.
236
237			=cut
238
239			sub send {
240			my ($self, $data) = @_;
241
242			$data = pack "na*", length $data, $data;
243
244			syswrite $self->{fh}, $data;
245			}
246
247			=back
248
249			=head1 AUTHOR
250
251			Marc Lehmann <schmorp@schmorp.de>
252			http://home.schmorp.de/
253
254			Robin Redeker <elmex@ta-sa.org>
255			http://www.ta-sa.org/
256
257			=cut
258
259			1