| … | |
… | |
| 28 | =cut |
28 | =cut |
| 29 | |
29 | |
| 30 | sub new { |
30 | sub new { |
| 31 | my $class = shift; |
31 | my $class = shift; |
| 32 | my $self = bless { |
32 | my $self = bless { |
| 33 | mapw => 13, |
33 | mapw => 13, |
| 34 | maph => 13, |
34 | maph => 13, |
|
|
35 | max_outstanding => 2, |
| 35 | @_ |
36 | @_ |
| 36 | }, $class; |
37 | }, $class; |
| 37 | |
38 | |
| 38 | $self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port} |
39 | $self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port} |
| 39 | or die "$self->{host}:$self->{port}: $!"; |
40 | or die "$self->{host}:$self->{port}: $!"; |
| … | |
… | |
| 135 | |
136 | |
| 136 | if (my $data = $self->face_find ($face)) { |
137 | if (my $data = $self->face_find ($face)) { |
| 137 | $face->{image} = $data; |
138 | $face->{image} = $data; |
| 138 | $self->face_update ($face); |
139 | $self->face_update ($face); |
| 139 | } else { |
140 | } else { |
| 140 | $self->send ("askface $num"); |
141 | $self->send_queue ("askface $num"); |
| 141 | } |
142 | } |
| 142 | } |
143 | } |
| 143 | |
144 | |
| 144 | =item $conn->anim_update ($num) [OVERWRITE] |
145 | =item $conn->anim_update ($num) [OVERWRITE] |
| 145 | |
146 | |
| … | |
… | |
| 450 | } |
451 | } |
| 451 | |
452 | |
| 452 | sub feed_image { |
453 | sub feed_image { |
| 453 | my ($self, $data) = @_; |
454 | my ($self, $data) = @_; |
| 454 | |
455 | |
|
|
456 | $self->send_queue; |
|
|
457 | |
| 455 | my ($num, $len, $data) = unpack "NNa*", $data; |
458 | my ($num, $len, $data) = unpack "NNa*", $data; |
| 456 | |
459 | |
| 457 | $self->{face}[$num]{image} = $data; |
460 | $self->{face}[$num]{image} = $data; |
| 458 | $self->face_update ($self->{face}[$num]); |
461 | $self->face_update ($self->{face}[$num]); |
| 459 | |
462 | |
| … | |
… | |
| 524 | $data = pack "na*", length $data, $data; |
527 | $data = pack "na*", length $data, $data; |
| 525 | |
528 | |
| 526 | syswrite $self->{fh}, $data; |
529 | syswrite $self->{fh}, $data; |
| 527 | } |
530 | } |
| 528 | |
531 | |
|
|
532 | sub send_queue { |
|
|
533 | my ($self, $cmd) = @_; |
|
|
534 | |
|
|
535 | warn "send_queue<$cmd>$self->{outstanding} <@{ $self->{send_queue} || [] }\n";#d# |
|
|
536 | if (defined $cmd) { |
|
|
537 | push @{ $self->{send_queue} }, $cmd; |
|
|
538 | } else { |
|
|
539 | --$self->{outstanding}; |
|
|
540 | } |
|
|
541 | |
|
|
542 | if ($self->{outstanding} < $self->{max_outstanding}) { |
|
|
543 | ++$self->{outstanding}; |
|
|
544 | $self->send (shift @{ $self->{send_queue} }); |
|
|
545 | } |
|
|
546 | } |
|
|
547 | |
| 529 | sub send_setup { |
548 | sub send_setup { |
| 530 | my ($self) = @_; |
549 | my ($self) = @_; |
| 531 | |
550 | |
| 532 | my $setup = join " ", setup => %{$self->{setup_req}}, |
551 | my $setup = join " ", setup => %{$self->{setup_req}}, |
| 533 | mapsize => "$self->{mapw}x$self->{maph}"; |
552 | mapsize => "$self->{mapw}x$self->{maph}"; |
