Deliantra/Deliantra/Protocol.pm

=head1 NAME

Crossfire::Protocol - client protocol module

=head1 SYNOPSIS

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

=head1 DESCRIPTION

Base class to implement a corssfire client.

=over 4

=cut

package Crossfire::Protocol;

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

our $VERSION = '0.1';

use strict;

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_map_scroll {
   my ($self, $data) = @_;

   my ($dx, $dy) = split / /, $data;

   $self->{delayed_scroll_x} += $dx;
   $self->{delayed_scroll_y} += $dy;

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

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.43
Committed:	Fri May 26 18:56:44 2006 UTC (18 years ago) by root
Branch:	MAIN
Changes since 1.42:	+4 -844 lines
Log Message:	separated Crossfire::Protocol into Crossfire::Protocol::Base and ...
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Crossfire::Protocol - client protocol module
4
5			=head1 SYNOPSIS
6
7			use base Crossfire::Protocol; # you have to subclass
8
9			=head1 DESCRIPTION
10
11			Base class to implement a corssfire client.
12
13			=over 4
14
15			=cut
16
17			package Crossfire::Protocol;
18
19	root	1.43	BGIN { die "FATAL: Crossfire::Protocol needs to be rewritten to be properly subclassed form Crossfire::Protocol::Base" }
20
21	root	1.1	our $VERSION = '0.1';
22
23			use strict;
24
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_map_scroll {
118			my ($self, $data) = @_;
119
120			my ($dx, $dy) = split / /, $data;
121
122	root	1.14	$self->{delayed_scroll_x} += $dx;
123			$self->{delayed_scroll_y} += $dy;
124	root	1.24
125			$self->map_scroll ($dx, $dy);
126	root	1.1	}
127
128			sub feed_newmap {
129			my ($self) = @_;
130
131			$self->{map} = [];
132			$self->{mapx} = 0;
133			$self->{mapy} = 0;
134
135	root	1.14	delete $self->{delayed_scroll_x};
136			delete $self->{delayed_scroll_y};
137
138	root	1.1	$self->map_clear;
139			}
140
141	root	1.43	sub feed_image {
142	root	1.22	my ($self, $data) = @_;
143	root	1.24
144	root	1.43	$self->SUPER::feed_image ($data);
145	root	1.1
146	root	1.3	my ($num, $len, $data) = unpack "NNa*", $data;
147	root	1.1
148	root	1.3	my @dirty;
149	root	1.2
150			for my $x (0..$self->{mapw} - 1) {
151			for my $y (0..$self->{maph} - 1) {
152			push @dirty, [$x, $y]
153			if grep $_ == $num, @{$self->{map}[$x][$y] \|\| []};
154			}
155			}
156	root	1.6
157	root	1.2	$self->map_update (\@dirty);
158	root	1.1	}
159
160			=back
161
162			=head1 AUTHOR
163
164			Marc Lehmann <schmorp@schmorp.de>
165			http://home.schmorp.de/
166
167			Robin Redeker <elmex@ta-sa.org>
168			http://www.ta-sa.org/
169
170			=cut
171
172			1