| … | |
… | |
| 21 | use strict; |
21 | use strict; |
| 22 | |
22 | |
| 23 | use AnyEvent; |
23 | use AnyEvent; |
| 24 | use IO::Socket::INET; |
24 | use IO::Socket::INET; |
| 25 | |
25 | |
| 26 | =item new Crossfire::Rptocol host => ..., port => ... |
26 | =item new Crossfire::Protocol host => ..., port => ... |
| 27 | |
27 | |
| 28 | =cut |
28 | =cut |
| 29 | |
29 | |
| 30 | sub new { |
30 | sub new { |
| 31 | my $class = shift; |
31 | my $class = shift; |
| 32 | my $self = bless { @_ }, $class; |
32 | my $self = bless { |
|
|
33 | mapw => 13, |
|
|
34 | maph => 13, |
|
|
35 | @_ |
|
|
36 | }, $class; |
| 33 | |
37 | |
| 34 | $self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port} |
38 | $self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port} |
| 35 | or die "$self->{host}:$self->{port}: $!"; |
39 | or die "$self->{host}:$self->{port}: $!"; |
| 36 | $self->{fh}->blocking (0); # stupid nonblock default |
40 | $self->{fh}->blocking (0); # stupid nonblock default |
| 37 | |
41 | |
| … | |
… | |
| 52 | close $self->{fh}; |
56 | close $self->{fh}; |
| 53 | } |
57 | } |
| 54 | }); |
58 | }); |
| 55 | |
59 | |
| 56 | $self->send ("version 1023 1027 perlclient"); |
60 | $self->send ("version 1023 1027 perlclient"); |
| 57 | $self->send ("setup sound 1 exp 1 map1acmd 1 itemcmd 2 darkness 1 mapsize 63x63 newmapcmd 1 facecache 1 extendedMapInfos 1 extendedTextInfos 1"); |
61 | $self->send ("setup sound 1 exp 1 map1acmd 1 itemcmd 2 darkness 1 mapsize $self->{mapw}x$self->{maph} " |
|
|
62 | . "newmapcmd 1 facecache 1 extendedMapInfos 1 extendedTextInfos 1"); |
| 58 | $self->send ("addme"); |
63 | $self->send ("addme"); |
| 59 | |
64 | |
| 60 | $self |
65 | $self |
| 61 | } |
66 | } |
| 62 | |
67 | |
| … | |
… | |
| 80 | |
85 | |
| 81 | $data =~ s/^ +//; |
86 | $data =~ s/^ +//; |
| 82 | |
87 | |
| 83 | $self->{setup} = { split / +/, $data }; |
88 | $self->{setup} = { split / +/, $data }; |
| 84 | |
89 | |
| 85 | ($self->{mapw}, $self->{maph}) = split /x/, $self->{setup}{mapsize}; |
90 | my ($mapw, $maph) = split /x/, $self->{setup}{mapsize}; |
|
|
91 | |
|
|
92 | if ($mapw != $self->{mapw} || $maph != $self->{maph}) { |
|
|
93 | ($self->{mapw}, $self->{maph}) = ($mapw, $maph); |
|
|
94 | $self->send ("setup mapsize ${mapw}x${maph}"); |
|
|
95 | } |
| 86 | |
96 | |
| 87 | $self->feed_newmap; |
97 | $self->feed_newmap; |
| 88 | } |
98 | } |
| 89 | |
99 | |
| 90 | =item $conn->query ($flags, $prompt) [OVERWRITE] |
100 | =item $conn->query ($flags, $prompt) [OVERWRITE] |
| … | |
… | |
| 221 | my ($coord, $x, $y, $darkness, $fa, $fb, $fc, $cell); |
231 | my ($coord, $x, $y, $darkness, $fa, $fb, $fc, $cell); |
| 222 | |
232 | |
| 223 | while (length $data) { |
233 | while (length $data) { |
| 224 | $coord = unpack "n", substr $data, 0, 2, ""; |
234 | $coord = unpack "n", substr $data, 0, 2, ""; |
| 225 | |
235 | |
| 226 | $x = ($coord >> 10) & 63; |
236 | $x = (($coord >> 10) & 63) + $self->{mapx}; |
| 227 | $y = ($coord >> 4) & 63; |
237 | $y = (($coord >> 4) & 63) + $self->{mapy}; |
| 228 | |
238 | |
| 229 | $cell = $map->[$x][$y] ||= []; |
239 | $cell = $map->[$x][$y] ||= []; |
| 230 | |
240 | |
|
|
241 | if ($coord & 15) { |
| 231 | $cell->[3] = $coord & 8 |
242 | $cell->[0] = $coord & 8 |
| 232 | ? unpack "C", substr $data, 0, 1, "" |
243 | ? unpack "C", substr $data, 0, 1, "" |
| 233 | : 255; |
244 | : 255; |
| 234 | |
245 | |
| 235 | $cell->[0] = unpack "n", substr $data, 0, 2, "" |
|
|
| 236 | if $coord & 4; |
|
|
| 237 | $cell->[1] = unpack "n", substr $data, 0, 2, "" |
246 | $cell->[1] = unpack "n", substr $data, 0, 2, "" |
| 238 | if $coord & 2; |
247 | if $coord & 4; |
| 239 | $cell->[2] = unpack "n", substr $data, 0, 2, "" |
248 | $cell->[2] = unpack "n", substr $data, 0, 2, "" |
|
|
249 | if $coord & 2; |
|
|
250 | $cell->[3] = unpack "n", substr $data, 0, 2, "" |
| 240 | if $coord & 1; |
251 | if $coord & 1; |
| 241 | |
252 | } else { |
| 242 | @$cell = () |
253 | $cell->[0] = -1; |
| 243 | unless $coord & 15; |
254 | $cell->[2] = undef; |
|
|
255 | $cell->[3] = undef; |
|
|
256 | } |
| 244 | |
257 | |
| 245 | push @dirty, [$x, $y]; |
258 | push @dirty, [$x, $y]; |
| 246 | } |
259 | } |
| 247 | |
260 | |
| 248 | $self->map_update (\@dirty); |
261 | $self->map_update (\@dirty); |
| … | |
… | |
| 256 | my $map = $self->{map} ||= []; |
269 | my $map = $self->{map} ||= []; |
| 257 | |
270 | |
| 258 | $self->{mapx} += $dx; |
271 | $self->{mapx} += $dx; |
| 259 | $self->{mapy} += $dy; |
272 | $self->{mapy} += $dy; |
| 260 | |
273 | |
| 261 | if ($dy < 0) { |
274 | if ($self->{mapy} < 0) { |
| 262 | unshift @$_, ([]) x -$dy for @$map; |
275 | unshift @$_, ([]) x -$self->{mapy} for @$map; |
| 263 | } elsif ($dy > 0) { |
276 | $self->{mapy} = 0; |
| 264 | splice @$_, 0, $dy, () for @$map; |
|
|
| 265 | } |
277 | } |
| 266 | |
278 | |
| 267 | if ($dx < 0) { |
279 | if ($self->{mapx} < 0) { |
| 268 | unshift @$map, ([]) x -$dx; |
280 | unshift @$map, ([]) x -$self->{mapx}; |
| 269 | } elsif ($dx > 0) { |
281 | $self->{mapx} = 0; |
| 270 | splice @$map, 0, $dx, (); |
|
|
| 271 | } |
282 | } |
| 272 | |
283 | |
| 273 | $self->map_scroll ($dx, $dy); |
284 | $self->map_scroll ($dx, $dy); |
| 274 | } |
285 | } |
| 275 | |
286 | |
