Deliantra/Deliantra/Protocol.pm

=head1 NAME

Deliantra::Protocol - client protocol module

=head1 SYNOPSIS

   use base Deliantra::Protocol; # you have to subclass

=head1 DESCRIPTION

Base class to implement a crossfire client.

=over 4

=cut

package Deliantra::Protocol;

BGIN { die "FATAL: Deliantra::Protocol needs to be rewritten to be properly subclassed form Deliantra::Protocol::Base" }

our $VERSION = '0.1';

use common::sense;

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

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

   my ($dx, $dy) = delete @$self{qw(delayed_scroll_x delayed_scroll_y)};

   if ($dx || $dy) {
      my ($mx, $my, $mw, $mh) = @$self{qw(mapx mapy mapw maph)};

      {
         my @darkness;

         if ($dx > 0) {
            push @darkness, [$mx, $my, $dx - 1, $mh];
         } elsif ($dx < 0) {
            push @darkness, [$mx + $mw + $dx + 1, $my, 1 - $dx, $mh];
         }

         if ($dy > 0) {
            push @darkness, [$mx, $my, $mw, $dy - 1];
         } elsif ($dy < 0) {
            push @darkness, [$mx, $my + $mh + $dy + 1, $mw, 1 - $dy];
         }

         for (@darkness) {
            my ($x0, $y0, $w, $h) = @$_;
            for my $x ($x0 .. $x0 + $w) {
               for my $y ($y0 .. $y0 + $h) {

                  my $cell = $map->[$x][$y]
                     or next;

                  $cell->[0] = -1;
               }
            }
         }
      }

      # now scroll

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

      # shift in new space if moving to "negative indices"
      if ($self->{mapy} < 0) {
         unshift @$_, (undef) x -$self->{mapy} for @$map;
         $self->{mapy} = 0;
      }

      if ($self->{mapx} < 0) {
         unshift @$map, (undef) x -$self->{mapx};
         $self->{mapx} = 0;
      }

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

   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) + $self->{mapx};
      $y = (($coord >>  4) & 63) + $self->{mapy};

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

      if ($coord & 15) {
         @$cell = () if $cell->[0] < 0;

         $cell->[0] = $coord & 8
                    ? unpack "C", substr $data, 0, 1, ""
                    : 255;

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

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

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

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

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

   delete $self->{delayed_scroll_x};
   delete $self->{delayed_scroll_y};

   $self->map_clear;
}

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

   $self->SUPER::feed_image ($data);

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

   my @dirty;

   for my $x (0..$self->{mapw} - 1) {
      for my $y (0..$self->{maph} - 1) {
         push @dirty, [$x, $y]
            if grep $_ == $num, @{$self->{map}[$x][$y] || []};
      }
   }

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

=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.47
Committed:	Tue Sep 1 21:37:25 2009 UTC (14 years, 9 months ago) by root
Branch:	MAIN
CVS Tags:	rel-2_01, rel-1_30, rel-1_29, rel-1_24, rel-1_25, HEAD
Changes since 1.46:	+1 -1 lines
Log Message:	1.24
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.46	Deliantra::Protocol - client protocol module
4	root	1.1
5			=head1 SYNOPSIS
6
7	root	1.46	use base Deliantra::Protocol; # you have to subclass
8	root	1.1
9			=head1 DESCRIPTION
10
11	root	1.45	Base class to implement a crossfire client.
12	root	1.1
13			=over 4
14
15			=cut
16
17	root	1.46	package Deliantra::Protocol;
18	root	1.1
19	root	1.46	BGIN { die "FATAL: Deliantra::Protocol needs to be rewritten to be properly subclassed form Deliantra::Protocol::Base" }
20	root	1.43
21	root	1.1	our $VERSION = '0.1';
22
23	root	1.47	use common::sense;
24	root	1.1
25			sub feed_map1a {
26			my ($self, $data) = @_;
27
28			my $map = $self->{map} \|\|= [];
29
30	root	1.14	my ($dx, $dy) = delete @$self{qw(delayed_scroll_x delayed_scroll_y)};
31
32			if ($dx \|\| $dy) {
33			my ($mx, $my, $mw, $mh) = @$self{qw(mapx mapy mapw maph)};
34
35			{
36			my @darkness;
37
38			if ($dx > 0) {
39			push @darkness, [$mx, $my, $dx - 1, $mh];
40			} elsif ($dx < 0) {
41			push @darkness, [$mx + $mw + $dx + 1, $my, 1 - $dx, $mh];
42			}
43
44			if ($dy > 0) {
45			push @darkness, [$mx, $my, $mw, $dy - 1];
46			} elsif ($dy < 0) {
47			push @darkness, [$mx, $my + $mh + $dy + 1, $mw, 1 - $dy];
48			}
49
50			for (@darkness) {
51			my ($x0, $y0, $w, $h) = @$_;
52			for my $x ($x0 .. $x0 + $w) {
53			for my $y ($y0 .. $y0 + $h) {
54
55			my $cell = $map->[$x][$y]
56			or next;
57
58			$cell->[0] = -1;
59			}
60			}
61			}
62			}
63
64			# now scroll
65
66			$self->{mapx} += $dx;
67			$self->{mapy} += $dy;
68
69			# shift in new space if moving to "negative indices"
70			if ($self->{mapy} < 0) {
71	root	1.16	unshift @$_, (undef) x -$self->{mapy} for @$map;
72	root	1.14	$self->{mapy} = 0;
73			}
74
75			if ($self->{mapx} < 0) {
76	root	1.16	unshift @$map, (undef) x -$self->{mapx};
77	root	1.14	$self->{mapx} = 0;
78			}
79
80			$self->map_scroll ($dx, $dy);
81			}
82
83	root	1.1	my @dirty;
84			my ($coord, $x, $y, $darkness, $fa, $fb, $fc, $cell);
85
86			while (length $data) {
87			$coord = unpack "n", substr $data, 0, 2, "";
88
89	root	1.10	$x = (($coord >> 10) & 63) + $self->{mapx};
90			$y = (($coord >> 4) & 63) + $self->{mapy};
91	root	1.1
92			$cell = $map->[$x][$y] \|\|= [];
93
94	root	1.10	if ($coord & 15) {
95	root	1.14	@$cell = () if $cell->[0] < 0;
96
97	root	1.10	$cell->[0] = $coord & 8
98			? unpack "C", substr $data, 0, 1, ""
99			: 255;
100
101			$cell->[1] = unpack "n", substr $data, 0, 2, ""
102			if $coord & 4;
103			$cell->[2] = unpack "n", substr $data, 0, 2, ""
104			if $coord & 2;
105			$cell->[3] = unpack "n", substr $data, 0, 2, ""
106			if $coord & 1;
107			} else {
108			$cell->[0] = -1;
109			}
110	root	1.1
111			push @dirty, [$x, $y];
112			}
113
114			$self->map_update (\@dirty);
115			}
116
117			sub feed_newmap {
118			my ($self) = @_;
119
120			$self->{map} = [];
121			$self->{mapx} = 0;
122			$self->{mapy} = 0;
123
124	root	1.14	delete $self->{delayed_scroll_x};
125			delete $self->{delayed_scroll_y};
126
127	root	1.1	$self->map_clear;
128			}
129
130	root	1.43	sub feed_image {
131	root	1.22	my ($self, $data) = @_;
132	root	1.24
133	root	1.43	$self->SUPER::feed_image ($data);
134	root	1.1
135	root	1.3	my ($num, $len, $data) = unpack "NNa*", $data;
136	root	1.1
137	root	1.3	my @dirty;
138	root	1.2
139			for my $x (0..$self->{mapw} - 1) {
140			for my $y (0..$self->{maph} - 1) {
141			push @dirty, [$x, $y]
142			if grep $_ == $num, @{$self->{map}[$x][$y] \|\| []};
143			}
144			}
145	root	1.6
146	root	1.2	$self->map_update (\@dirty);
147	root	1.1	}
148
149			=back
150
151			=head1 AUTHOR
152
153			Marc Lehmann <schmorp@schmorp.de>
154			http://home.schmorp.de/
155
156			Robin Redeker <elmex@ta-sa.org>
157			http://www.ta-sa.org/
158
159			=cut
160
161			1