ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/pclient
(Generate patch)

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.1 by root, Thu Apr 6 15:30:09 2006 UTC vs.
Revision 1.2 by root, Thu Apr 6 20:00:23 2006 UTC

1#!/opt/bin/perl 1#!/opt/bin/perl
2
3use strict;
4
5use Crossfire::Client;
6use Crossfire::Protocol;
7
8package Crossfire::Client; # uh, yeah
9
10use strict;
2 11
3use SDL; 12use SDL;
4use SDL::App; 13use SDL::App;
5use SDL::Event; 14use SDL::Event;
6use SDL::Surface; 15use SDL::Surface;
16use SDL::OpenGL;
17use SDL::OpenGL::Constants;
7 18
8my $conn; 19my $conn;
9my $map_surface; 20my $app;
10 21
22my $WIDTH = 640;
23my $HEIGHT = 480;
24
25sub glinit {
26 # nuke all gl context data
27
11my $app = new SDL::App 28 $app = new SDL::App
12 -flags => SDL_HWSURFACE | SDL_ANYFORMAT | SDL_HWACCEL | SDL_ASYNCBLIT,
13 -title => "Crossfire+ Client", 29 -title => "Crossfire+ Client",
14 -width => 640, 30 -width => $WIDTH,
15 -height => 480, 31 -height => $HEIGHT,
16 -depth => 24, 32 -depth => 24,
33 -opengl => 1,
17 -double_buffer => 1, 34 -double_buffer => 1,
18 -resizeable => 1; 35 -resizeable => 0;
19 36
20sub redraw { 37 glEnable GL_TEXTURE_2D;
21 $map_surface or return; 38 glShadeModel GL_FLAT;
39 glDisable GL_DEPTH_TEST;
40 glMatrixMode GL_PROJECTION;
22 41
23 $map_surface->blit (0, $app, 0); 42 #glViewport 0, 0, $WIDTH, $HEIGHT;
24 $app->sync; 43 # re-bind all textures
44}
45
46sub refresh {
47 glClearColor 0.5, 0.5, 0.7, 0;
48 glClear GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT;
49
50 glLoadIdentity;
51 glOrtho 0, $WIDTH / 32, $HEIGHT / 32, 0, -1 , 1;
52
53 my $map = $conn->{map};
54
55 for my $x (0 .. $conn->{mapw} - 1) {
56 for my $y (0 .. $conn->{maph} - 1) {
57
58 my $cell = $map->[$x][$y]
59 or next;
60
61 for my $num (grep $_, $cell->[0], $cell->[1], $cell->[2]) {
62 my $tex = $conn->{face}[$num]{texture} ||= do {
63 $conn->send ("askface $num") unless $conn->{face}[$num]{askface}++;
64
65 0
66
67 };
68
69 glBindTexture GL_TEXTURE_2D, $tex;
70
71 glBegin GL_QUADS;
72 glTexCoord 0, 0; glVertex $x, $y;
73 glTexCoord 1, 0; glVertex $x + 1, $y;
74 glTexCoord 1, 1; glVertex $x + 1, $y + 1;
75 glTexCoord 0, 1; glVertex $x, $y + 1;
76 glEnd;
77 }
78 }
79 }
80
81 SDL::GLSwapBuffers;
25} 82}
26 83
27my $ev = new SDL::Event; 84my $ev = new SDL::Event;
28my %ev_cb; 85my %ev_cb;
29 86
… …
63 120
64event {SDL_ACTIVEEVENT} does { 121event {SDL_ACTIVEEVENT} does {
65 print "active\n"; 122 print "active\n";
66}; 123};
67 124
68package Crossfire::Protocol; 125package Crossfire::Client;
69 126
70use AnyEvent; 127@conn::ISA = Crossfire::Protocol::;
71use IO::Socket::INET;
72 128
73sub new { 129sub conn::map_update {
74 my $class = shift;
75 my $self = bless { @_ }, $class;
76
77 $self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port}
78 or die "$self->{host}:$self->{port}: $!";
79 $self->{fh}->blocking (0); # stupid nonblock default
80
81 my $buf;
82
83 $self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub {
84 if (sysread $self->{fh}, $buf, 16384, length $buf) {
85 if (2 <= length $buf) {
86 my $len = unpack "n", $buf;
87 if ($len + 2 <= length $buf) {
88 substr $buf, 0, 2, "";
89 $self->feed (substr $buf, 0, $len, "");
90 }
91 }
92 } else {
93 delete $self->{w};
94 close $self->{fh};
95 }
96 });
97
98 $self->send ("version 1023 1027 perlclient");
99 $self->send ("setup sound 1 exp 1 map1acmd 1 itemcmd 2 darkness 1 mapsize 63x63 newmapcmd 1 facecache 1 extendedMapInfos 1 extendedTextInfos 1");
100 $self->send ("addme");
101
102 $self
103}
104
105sub feed {
106 my ($self, $data) = @_; 130 my ($self, $dirty) = @_;
107 131
108 $data =~ s/^(\S+)\s// 132 refresh;
109 or return;
110
111 my $command = "feed_$1";
112
113 $self->$command ($data);
114} 133}
115 134
116sub feed_version { 135sub conn::map_scroll {
117 my ($self, $version) = @_;
118}
119
120sub feed_setup {
121 my ($self, $data) = @_; 136 my ($self, $dx, $dy) = @_;
122 137
123 $data =~ s/^ +//; 138 refresh;
124
125 $self->{setup} = { split / +/, $data };
126
127 ($self->{mapw}, $self->{maph}) = split /x/, $self->{setup}{mapsize};
128
129 $self->feed_newmap;
130} 139}
131 140
132sub feed_query { 141sub conn::map_clear {
133 my ($self, $data) = @_;
134 warn "Q<$data>\n";
135}
136
137sub feed_stats {
138 my ($self, $data) = @_;
139# warn "S<$data>\n";
140}
141
142sub feed_face1 {
143 my ($self, $data) = @_;
144
145 my ($num, $chksum, $name) = unpack "nNa*", $data;
146
147 $self->{face}[$num] = { name => $name, chksum => $chksum };
148}
149
150sub feed_drawinfo {
151 my ($self, $data) = @_;
152# warn "<$data>\n";
153}
154
155sub feed_delinv {
156 my ($self, $data) = @_;
157}
158
159sub feed_item2 {
160 my ($self, $data) = @_;
161}
162
163sub feed_map1a {
164 my ($self, $data) = @_;
165
166 my $map = $self->{map} ||= [];
167
168 my @dirty;
169 my ($coord, $x, $y, $darkness, $fa, $fb, $fc, $cell);
170
171 while (length $data) {
172 $coord = unpack "n", substr $data, 0, 2, "";
173
174 $x = ($coord >> 10) & 63;
175 $y = ($coord >> 4) & 63;
176
177 $cell = $map->[$x][$y] ||= [];
178
179 $cell->[3] = unpack "C", substr $data, 0, 1, ""
180 if $coord & 8;
181 $cell->[0] = unpack "n", substr $data, 0, 2, ""
182 if $coord & 4;
183 $cell->[1] = unpack "n", substr $data, 0, 2, ""
184 if $coord & 2;
185 $cell->[2] = unpack "n", substr $data, 0, 2, ""
186 if $coord & 1;
187
188 @$cell = ()
189 unless $coord & 15;
190
191 push @dirty, [$x, $y];
192 }
193
194 $self->map_update (\@dirty);
195}
196
197sub feed_map_scroll {
198 my ($self, $data) = @_;
199
200 my ($dx, $dy) = split / /, $data;
201
202 my $map = $self->{map} ||= [];
203
204 $self->{mapx} += $dx;
205 $self->{mapy} += $dy;
206
207 if ($dx > 0) {
208 unshift @$_, ([]) x $dx for @$map;
209 } elsif ($dx < 0) {
210 splice @$_, 0, -$dx, () for @$map;
211 }
212
213 if ($dy > 0) {
214 unshift @$map, ([]) x $dy;
215 } elsif ($dy < 0) {
216 splice @$map, 0, -$dy, ();
217 }
218
219 $self->map_scroll ($dx, $dy);
220}
221
222sub feed_newmap {
223 my ($self) = @_; 142 my ($self) = @_;
224 143
225 $self->{map} = []; 144 refresh;
226 $self->{mapx} = 0;
227 $self->{mapy} = 0;
228
229 $self->map_clear;
230} 145}
231 146
232sub feed_image {
233 my ($self, $data) = @_;
234
235 my ($face, $len, $data) = unpack "NNa*", $data;
236
237 $self->{face}[$face]{image} = $data;
238
239 $self->face_update ($face, $self->{face}[$face]);
240}
241
242sub map_clear { }
243sub map_update { }
244sub map_scroll { }
245
246sub face_update { }
247
248sub send {
249 my ($self, $data) = @_;
250
251 $data = pack "na*", length $data, $data;
252
253 syswrite $self->{fh}, $data;
254}
255
256package conn;
257
258@ISA = Crossfire::Protocol::;
259
260sub map_update {
261 my ($self, $dirty) = @_;
262
263 for (@$dirty) {
264 my ($x, $y) = @$_;
265
266 my $px = $x * 32;
267 my $py = $y * 32;
268
269 my $dst = new SDL::Rect -x => $px, -y => $py, -width => 32, -height => 32;
270
271 my $cell = $self->{map}[$x][$y];
272
273 if ($cell) {
274 $cell->[0] or $map_surface->fill ($dst, new SDL::Color -r => 0, -g => 0, -b => 0); # is_floor is opaque, I hope
275
276 for my $num (grep $_, $cell->[0], $cell->[1], $cell->[2]) {
277 my $surface = $self->{face}[$num]{surface} ||= do {
278 $self->send ("askface $num");
279
280 # TODO: fog of "war"
281 my $surface = new SDL::Surface
282 -flags => SDL::SDL_HWSURFACE | SDL::SDL_ANYFORMAT | SDL::SDL_HWACCEL | SDL::SDL_ASYNCBLIT,
283 -width => 32,
284 -height => 32,
285 -depth => 32;
286
287 $surface->fill (0, new SDL::Color -r => 128, -g => 128, -b => 128);
288
289 $surface
290 };
291
292 $surface->blit (0, $map_surface, $dst);
293 }
294 } else {
295 $map_surface->fill ($dst, new SDL::Color -r => 0, -g => 0, -b => 0);
296 }
297 }
298
299 ::redraw;
300}
301
302sub map_scroll {
303 my ($self, $dx, $dy) = @_;
304
305 ::redraw;
306}
307
308sub map_clear {
309 my ($self) = @_;
310
311 $map_surface = new SDL::Surface
312 -flags => SDL::HWSURFACE,
313 -width => $self->{mapw} * 32,
314 -height => $self->{maph} * 32,
315 -depth => 32;
316
317 SDL::SetClipRect $$map_surface, 0;
318 $map_surface->fill (0, new SDL::Color -r => 0, -g => 0, -b => 0);
319
320 ::redraw;
321}
322
323sub face_update { 147sub conn::face_update {
324 my ($self, $num, $face) = @_; 148 my ($self, $num, $face) = @_;
325 149
326 warn "up face $self,$num,$face\n";#d# 150 warn "up face $self,$num,$face\n";#d#
327 #TODO 151 #TODO
328 open my $fh, ">:raw", "/tmp/x~"; 152 open my $fh, ">:raw", "/tmp/x~";
329 syswrite $fh, $face->{image}; 153 syswrite $fh, $face->{image};
330 close $fh; 154 close $fh;
331 155
332 $face->{surface} = (new SDL::Surface -name => "/tmp/x~")->display_format; 156 my $surface = new SDL::Surface -name => "/tmp/x~";
333 157
334 unlink "/tmp/x~"; 158 unlink "/tmp/x~";
335 159
336 my @dirty; 160 my ($tex) = @{glGenTextures 1};
161 glGetError();
337 162
338 for my $x (0..$self->{mapw} - 1) { 163 $face->{texture} = $tex;
339 for my $y (0..$self->{maph} - 1) {
340 push @dirty, [$x, $y]
341 if grep $_ == $num, @{$self->{map}[$x][$y] || []};
342 }
343 } 164
344 $self->map_update (\@dirty); 165 glBindTexture GL_TEXTURE_2D, $tex;
345} 166 my $glerr=glGetError(); die "a: ".gluErrorString($glerr)."\n" if $glerr;
167
168# glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
169# glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR;
170
171 $surface->rgba;
346 172
347package main; 173 glTexImage2D GL_TEXTURE_2D, 0,
174 4, # components
175 $surface->width, $surface->height,
176 0,
177 GL_RGBA,
178 GL_UNSIGNED_BYTE,
179 $surface->pixels;
180 my $glerr=glGetError(); die "Problem setting up 2d Texture (dimensions not a power of 2?)):".gluErrorString($glerr)."\n" if $glerr;
181}
348 182
349############################################################################# 183#############################################################################
350 184
351use Event; 185use Event;
186
187glinit;
352 188
353$conn = new conn 189$conn = new conn
354 host => "cf.schmorp.de", 190 host => "cf.schmorp.de",
355 port => 13327; 191 port => 13327;
356 192

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines