| … | |
… | |
| 55 | delete $self->{w}; |
55 | delete $self->{w}; |
| 56 | close $self->{fh}; |
56 | close $self->{fh}; |
| 57 | } |
57 | } |
| 58 | }); |
58 | }); |
| 59 | |
59 | |
|
|
60 | $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 | |
| 60 | $self->send ("version 1023 1027 perlclient"); |
71 | $self->send ("version 1023 1027 perlclient"); |
| 61 | $self->send ("setup sound 1 exp 1 map1acmd 1 itemcmd 2 darkness 1 mapsize $self->{mapw}x$self->{maph} " |
72 | $self->send_setup; |
| 62 | . "newmapcmd 1 facecache 1 extendedMapInfos 1 extendedTextInfos 1"); |
|
|
| 63 | $self->send ("addme"); |
|
|
| 64 | |
73 | |
| 65 | $self |
74 | $self |
| 66 | } |
75 | } |
| 67 | |
76 | |
| 68 | sub feed { |
77 | sub feed { |
| 69 | my ($self, $data) = @_; |
78 | my ($self, $data) = @_; |
| 70 | |
79 | |
| 71 | $data =~ s/^(\S+)\s// |
80 | $data =~ s/^(\S+)(?:\s|$)// |
| 72 | or return; |
81 | or return; |
| 73 | |
82 | |
| 74 | my $command = "feed_$1"; |
83 | my $command = "feed_$1"; |
| 75 | |
84 | |
| 76 | $self->$command ($data); |
85 | $self->$command ($data); |
| … | |
… | |
| 89 | |
98 | |
| 90 | my ($mapw, $maph) = split /x/, $self->{setup}{mapsize}; |
99 | my ($mapw, $maph) = split /x/, $self->{setup}{mapsize}; |
| 91 | |
100 | |
| 92 | if ($mapw != $self->{mapw} || $maph != $self->{maph}) { |
101 | if ($mapw != $self->{mapw} || $maph != $self->{maph}) { |
| 93 | ($self->{mapw}, $self->{maph}) = ($mapw, $maph); |
102 | ($self->{mapw}, $self->{maph}) = ($mapw, $maph); |
| 94 | $self->send ("setup mapsize ${mapw}x${maph}"); |
103 | $self->send_setup; |
|
|
104 | } else { |
|
|
105 | $self->send ("addme"); |
| 95 | } |
106 | } |
| 96 | |
107 | |
| 97 | $self->feed_newmap; |
108 | $self->feed_newmap; |
|
|
109 | } |
|
|
110 | |
|
|
111 | sub feed_addme_success { |
|
|
112 | my ($self, $data) = @_; |
|
|
113 | } |
|
|
114 | |
|
|
115 | sub feed_addme_failure { |
|
|
116 | my ($self, $data) = @_; |
|
|
117 | # maybe should notify user |
|
|
118 | } |
|
|
119 | |
|
|
120 | =item $conn->play_sound ($x, $y, $soundnum, $type) [OVERWRITE] |
|
|
121 | |
|
|
122 | =cut |
|
|
123 | |
|
|
124 | sub sound_play { } |
|
|
125 | |
|
|
126 | sub feed_sound { |
|
|
127 | my ($self, $data) = @_; |
|
|
128 | |
|
|
129 | $self->sound_play (unpack "CCnC", $data); |
| 98 | } |
130 | } |
| 99 | |
131 | |
| 100 | =item $conn->query ($flags, $prompt) [OVERWRITE] |
132 | =item $conn->query ($flags, $prompt) [OVERWRITE] |
| 101 | |
133 | |
| 102 | =cut |
134 | =cut |
| … | |
… | |
| 136 | tag => $tag, |
168 | tag => $tag, |
| 137 | weight => $weight, |
169 | weight => $weight, |
| 138 | face => $face, |
170 | face => $face, |
| 139 | name => $name, |
171 | name => $name, |
| 140 | }); |
172 | }); |
| 141 | |
|
|
| 142 | $self->feed_newmap;#d# why??? |
|
|
| 143 | } |
173 | } |
| 144 | |
174 | |
| 145 | =item $conn->stats_update ($stats) [OVERWRITE] |
175 | =item $conn->stats_update ($stats) [OVERWRITE] |
| 146 | |
176 | |
| 147 | =cut |
177 | =cut |
| … | |
… | |
| 265 | my ($self, $data) = @_; |
295 | my ($self, $data) = @_; |
| 266 | |
296 | |
| 267 | my ($dx, $dy) = split / /, $data; |
297 | my ($dx, $dy) = split / /, $data; |
| 268 | |
298 | |
| 269 | my $map = $self->{map} ||= []; |
299 | my $map = $self->{map} ||= []; |
|
|
300 | |
|
|
301 | my ($mx, $my, $mw, $mh) = @$self{qw(mapx mapy mapw maph)}; |
|
|
302 | |
|
|
303 | # TODO: optimise this a lot, or maybe just do it on c-level |
|
|
304 | # set flag to -1 for spaces we scroll out |
|
|
305 | { |
|
|
306 | my @darkness; |
|
|
307 | |
|
|
308 | if ($dx > 0) { |
|
|
309 | push @darkness, [$mx, $my, $dx - 1, $mh]; |
|
|
310 | } elsif ($dx < 0) { |
|
|
311 | push @darkness, [$mx + $mw + $dx + 1, $my, 1 - $dx, $mh]; |
|
|
312 | } |
|
|
313 | |
|
|
314 | if ($dy > 0) { |
|
|
315 | push @darkness, [$mx, $my, $mw, $dy - 1]; |
|
|
316 | } elsif ($dy < 0) { |
|
|
317 | push @darkness, [$mx, $my + $mh + $dy + 1, $mw, 1 - $dy]; |
|
|
318 | } |
|
|
319 | |
|
|
320 | for (@darkness) { |
|
|
321 | my ($x0, $y0, $w, $h) = @$_; |
|
|
322 | warn "xxx $x0 $y0 $w $h\n";#d# |
|
|
323 | for my $x ($x0 .. $x0 + $w) { |
|
|
324 | for my $y ($y0 .. $y0 + $h) { |
|
|
325 | |
|
|
326 | warn "cell $x $y\n";#d# |
|
|
327 | my $cell = $map->[$x][$y] |
|
|
328 | or next; |
|
|
329 | |
|
|
330 | $cell->[0] = -1; $cell->[2] = 0; $cell->[3] = 0; |
|
|
331 | } |
|
|
332 | } |
|
|
333 | } |
|
|
334 | } |
|
|
335 | |
|
|
336 | # now scroll |
| 270 | |
337 | |
| 271 | $self->{mapx} += $dx; |
338 | $self->{mapx} += $dx; |
| 272 | $self->{mapy} += $dy; |
339 | $self->{mapy} += $dy; |
| 273 | |
340 | |
|
|
341 | # shift in new space if moving to "negative indices" |
| 274 | if ($self->{mapy} < 0) { |
342 | if ($self->{mapy} < 0) { |
| 275 | unshift @$_, ([]) x -$self->{mapy} for @$map; |
343 | unshift @$_, ([]) x -$self->{mapy} for @$map; |
| 276 | $self->{mapy} = 0; |
344 | $self->{mapy} = 0; |
| 277 | } |
345 | } |
| 278 | |
346 | |
| … | |
… | |
| 369 | $data = pack "na*", length $data, $data; |
437 | $data = pack "na*", length $data, $data; |
| 370 | |
438 | |
| 371 | syswrite $self->{fh}, $data; |
439 | syswrite $self->{fh}, $data; |
| 372 | } |
440 | } |
| 373 | |
441 | |
|
|
442 | sub send_setup { |
|
|
443 | my ($self) = @_; |
|
|
444 | |
|
|
445 | my $setup = join " ", setup => %{$self->{setup_req}}, |
|
|
446 | mapsize => "$self->{mapw}x$self->{maph}"; |
|
|
447 | warn "SET<$setup>\n";#d# |
|
|
448 | $self->send ($setup); |
|
|
449 | } |
|
|
450 | |
| 374 | =back |
451 | =back |
| 375 | |
452 | |
| 376 | =head1 AUTHOR |
453 | =head1 AUTHOR |
| 377 | |
454 | |
| 378 | Marc Lehmann <schmorp@schmorp.de> |
455 | Marc Lehmann <schmorp@schmorp.de> |
