… | |
… | |
84 | ($self->{mapw}, $self->{maph}) = split /x/, $self->{setup}{mapsize}; |
84 | ($self->{mapw}, $self->{maph}) = split /x/, $self->{setup}{mapsize}; |
85 | |
85 | |
86 | $self->feed_newmap; |
86 | $self->feed_newmap; |
87 | } |
87 | } |
88 | |
88 | |
|
|
89 | =item $conn->query ($flags, $prompt) [OVERWRITE] |
|
|
90 | |
|
|
91 | =cut |
|
|
92 | |
|
|
93 | sub query { die "query is abstract" } |
|
|
94 | |
89 | sub feed_query { |
95 | sub feed_query { |
90 | my ($self, $data) = @_; |
96 | my ($self, $data) = @_; |
91 | warn "Q<$data>\n"; |
97 | |
|
|
98 | my ($flags, $prompt) = split /\s+/, $data, 2; |
|
|
99 | |
|
|
100 | if ($flags == 0 && $prompt =~ /^What is your name\?\s+:$/ && length $self->{user}) { |
|
|
101 | $self->send ("reply $self->{user}"); |
|
|
102 | } elsif ($flags == 4 && $prompt =~ /^What is your password\?\s+:$/ && length $self->{pass}) { |
|
|
103 | $self->send ("reply $self->{pass}"); |
|
|
104 | } elsif ($flags == 4 && $prompt =~ /^Please type your password again\.\s+:$/ && length $self->{pass}) { |
|
|
105 | $self->send ("reply $self->{pass}"); |
|
|
106 | } else { |
|
|
107 | $self->query ($flags, $prompt); |
|
|
108 | } |
92 | } |
109 | } |
|
|
110 | |
|
|
111 | =item $conn->player_update ($player) [OVERWRITE] |
|
|
112 | |
|
|
113 | tag, weight, face, name |
|
|
114 | |
|
|
115 | =cut |
|
|
116 | |
|
|
117 | sub player_update { } |
|
|
118 | |
|
|
119 | sub feed_player { |
|
|
120 | my ($self, $data) = @_; |
|
|
121 | |
|
|
122 | my ($tag, $weight, $face, $name) = unpack "NNN C/a", $data; |
|
|
123 | |
|
|
124 | $self->player_update ($self->{player} = { |
|
|
125 | tag => $tag, |
|
|
126 | weight => $weight, |
|
|
127 | face => $face, |
|
|
128 | name => $name, |
|
|
129 | }); |
|
|
130 | |
|
|
131 | $self->feed_newmap;#d# why??? |
|
|
132 | } |
|
|
133 | |
|
|
134 | =item $conn->stats_update ($stats) [OVERWRITE] |
|
|
135 | |
|
|
136 | =cut |
|
|
137 | |
|
|
138 | sub stats_update { } |
93 | |
139 | |
94 | sub feed_stats { |
140 | sub feed_stats { |
95 | my ($self, $data) = @_; |
141 | my ($self, $data) = @_; |
96 | # warn "S<$data>\n"; |
142 | |
|
|
143 | while (length $data) { |
|
|
144 | my $stat = unpack "C", substr $data, 0, 1, ""; |
|
|
145 | my $value; |
|
|
146 | |
|
|
147 | if ($stat == 26 || $stat == 29 || $stat == 30 || $stat == 31 || $stat == 11) { |
|
|
148 | $value = unpack "N", substr $data, 0, 4, ""; |
|
|
149 | } elsif ($stat == 17 || $stat == 19) { |
|
|
150 | $value = (1 / 100000) * unpack "N", substr $data, 0, 4, ""; |
|
|
151 | } elsif ($stat == 20 || $stat == 21) { |
|
|
152 | my $len = unpack "C", substr $data, 0, 1, ""; |
|
|
153 | $value = substr $data, 0, $len, ""; |
|
|
154 | } elsif ($stat == 28) { |
|
|
155 | my ($lo, $hi) = unpack "NN", substr $data, 0, 8, ""; |
|
|
156 | $value = $hi * 2**32 + $lo; |
|
|
157 | } elsif ($stat >= 118 && $stat <= 129) { |
|
|
158 | my ($level, $lo, $hi) = unpack "CNN", substr $data, 0, 9, ""; |
|
|
159 | $value = [$level, $hi * 2**32 + $lo]; |
|
|
160 | } else { |
|
|
161 | $value = unpack "n", substr $data, 0, 2, ""; |
|
|
162 | } |
|
|
163 | |
|
|
164 | $self->{stat}{$stat} = $value; |
|
|
165 | } |
|
|
166 | |
|
|
167 | $self->stats_update ($self->{stat}); |
97 | } |
168 | } |
98 | |
169 | |
99 | sub feed_face1 { |
170 | sub feed_face1 { |
100 | my ($self, $data) = @_; |
171 | my ($self, $data) = @_; |
101 | |
172 | |
… | |
… | |
107 | $face->{image} = $data; |
178 | $face->{image} = $data; |
108 | $self->face_update ($face); |
179 | $self->face_update ($face); |
109 | } else { |
180 | } else { |
110 | $self->send ("askface $num"); |
181 | $self->send ("askface $num"); |
111 | } |
182 | } |
|
|
183 | } |
|
|
184 | |
|
|
185 | =item $conn->anim_update ($num) [OVERWRITE] |
|
|
186 | |
|
|
187 | =cut |
|
|
188 | |
|
|
189 | sub anim_update { } |
|
|
190 | |
|
|
191 | sub feed_anim { |
|
|
192 | my ($self, $data) = @_; |
|
|
193 | |
|
|
194 | my ($num, @faces) = unpack "n*", $data; |
|
|
195 | |
|
|
196 | $self->{anim}[$num] = \@faces; |
|
|
197 | |
|
|
198 | $self->anim_update ($num); |
112 | } |
199 | } |
113 | |
200 | |
114 | sub feed_drawinfo { |
201 | sub feed_drawinfo { |
115 | my ($self, $data) = @_; |
202 | my ($self, $data) = @_; |
116 | # warn "<$data>\n"; |
203 | # warn "<$data>\n"; |
… | |
… | |
209 | for my $y (0..$self->{maph} - 1) { |
296 | for my $y (0..$self->{maph} - 1) { |
210 | push @dirty, [$x, $y] |
297 | push @dirty, [$x, $y] |
211 | if grep $_ == $num, @{$self->{map}[$x][$y] || []}; |
298 | if grep $_ == $num, @{$self->{map}[$x][$y] || []}; |
212 | } |
299 | } |
213 | } |
300 | } |
|
|
301 | |
214 | $self->map_update (\@dirty); |
302 | $self->map_update (\@dirty); |
215 | } |
303 | } |
216 | |
304 | |
217 | =item $conn->map_clear [OVERWRITE] |
305 | =item $conn->map_clear [OVERWRITE] |
218 | |
306 | |