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.8 by root, Fri Apr 7 08:42:56 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, 29 -flags => SDL_ANYFORMAT | SDL_HWSURFACE,
13 -title => "Crossfire+ Client", 30 -title => "Crossfire+ Client",
14 -width => 640, 31 -width => $WIDTH,
15 -height => 480, 32 -height => $HEIGHT,
16 -depth => 24, 33 -opengl => 1,
34 -red_size => 8,
35 -green_size => 8,
36 -blue_size => 8,
17 -double_buffer => 1, 37 -double_buffer => 1,
18 -resizeable => 1; 38 -resizeable => 0;
19 39
20sub redraw { 40 glEnable GL_TEXTURE_2D;
21 $map_surface or return; 41# glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
42 glShadeModel GL_FLAT;
43 glDisable GL_DEPTH_TEST;
44 glMatrixMode GL_PROJECTION;
45 glBlendFunc GL_SRC_ALPHA, GL_ZERO;
46 glEnable GL_BLEND;
22 47
23 $map_surface->blit (0, $app, 0); 48 glLoadIdentity;
24 $app->sync; 49 glOrtho 0, $WIDTH / 32, $HEIGHT / 32, 0, -1 , 1;
50
51 # re-bind all textures
52}
53
54sub refresh {
55 glClearColor 0, 0, 0, 0;
56 glClear GL_COLOR_BUFFER_BIT;
57
58 my $map = $conn->{map};
59
60 for my $x (0 .. $conn->{mapw} - 1) {
61 for my $y (0 .. $conn->{maph} - 1) {
62
63 my $cell = $map->[$x][$y]
64 or next;
65
66# my $darkness = $cell->[3] * (1 / 255);
67# glColor $darkness, $darkness, $darkness;
68
69 for my $num (grep $_, $cell->[0], $cell->[1], $cell->[2]) {
70 my $tex = $conn->{face}[$num]{texture} || 0;
71
72 glBindTexture GL_TEXTURE_2D, $tex;
73
74 glBegin GL_QUADS;
75 glTexCoord 0, 0; glVertex $x, $y;
76 glTexCoord 0, 1; glVertex $x, $y + 1;
77 glTexCoord 1, 1; glVertex $x + 1, $y + 1;
78 glTexCoord 1, 0; glVertex $x + 1, $y;
79 glEnd;
80 }
81 }
82 }
83
84 SDL::GLSwapBuffers;
25} 85}
26 86
27my $ev = new SDL::Event; 87my $ev = new SDL::Event;
28my %ev_cb; 88my %ev_cb;
29 89
… …
39 99
40event {SDL_VIDEORESIZE} does { 100event {SDL_VIDEORESIZE} does {
41 print "resize\n"; 101 print "resize\n";
42}; 102};
43 103
104event {SDL_VIDEOEXPOSE} does {
105 refresh;
106};
107
44event {SDL_KEYDOWN} does { 108event {SDL_KEYDOWN} does {
45 print "keypress\n"; 109 print "keypress\n";
46}; 110};
47 111
48event {SDL_KEYUP} does { 112event {SDL_KEYUP} does {
… …
63 127
64event {SDL_ACTIVEEVENT} does { 128event {SDL_ACTIVEEVENT} does {
65 print "active\n"; 129 print "active\n";
66}; 130};
67 131
68package Crossfire::Protocol; 132package Crossfire::Client;
69 133
70use AnyEvent; 134@conn::ISA = Crossfire::Protocol::;
71use IO::Socket::INET;
72 135
73sub new { 136sub 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) = @_; 137 my ($self, $dirty) = @_;
107 138
108 $data =~ s/^(\S+)\s// 139 refresh;
109 or return;
110
111 my $command = "feed_$1";
112
113 $self->$command ($data);
114} 140}
115 141
116sub feed_version { 142sub conn::map_scroll {
117 my ($self, $version) = @_;
118}
119
120sub feed_setup {
121 my ($self, $data) = @_; 143 my ($self, $dx, $dy) = @_;
122 144
123 $data =~ s/^ +//; 145 refresh;
124
125 $self->{setup} = { split / +/, $data };
126
127 ($self->{mapw}, $self->{maph}) = split /x/, $self->{setup}{mapsize};
128
129 $self->feed_newmap;
130} 146}
131 147
132sub feed_query { 148sub 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) = @_; 149 my ($self) = @_;
224 150
225 $self->{map} = []; 151 refresh;
226 $self->{mapx} = 0;
227 $self->{mapy} = 0;
228
229 $self->map_clear;
230} 152}
231 153
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 { 154sub conn::face_update {
324 my ($self, $num, $face) = @_; 155 my ($self, $num, $face) = @_;
325 156
326 warn "up face $self,$num,$face\n";#d# 157 warn "up face $self,$num,$face\n";#d#
327 #TODO 158 #TODO
328 open my $fh, ">:raw", "/tmp/x~"; 159 open my $fh, ">:raw", "/tmp/x~";
329 syswrite $fh, $face->{image}; 160 syswrite $fh, $face->{image};
330 close $fh; 161 close $fh;
331 162
332 $face->{surface} = (new SDL::Surface -name => "/tmp/x~")->display_format; 163 my $surface = new SDL::Surface -name => "/tmp/x~";
333 164
334 unlink "/tmp/x~"; 165 unlink "/tmp/x~";
335 166
336 my @dirty; 167 my ($tex) = @{glGenTextures 1};
168 glGetError();
337 169
338 for my $x (0..$self->{mapw} - 1) { 170 $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 } 171
344 $self->map_update (\@dirty); 172 glBindTexture GL_TEXTURE_2D, $tex;
345} 173 my $glerr=glGetError(); die "a: ".gluErrorString($glerr)."\n" if $glerr;
174
175 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
176 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR;#_MIPMAP_LINEAR;
177 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP;
178 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP;
179
180 $surface->rgba;
346 181
347package main; 182 glTexImage2D GL_TEXTURE_2D, 0,
183 4, # components
184 $surface->width, $surface->height,
185 0,
186 GL_RGBA,
187 GL_UNSIGNED_BYTE,
188 $surface->pixels;
189 my $glerr=glGetError(); die "Problem setting up 2d Texture (dimensions not a power of 2?)):".gluErrorString($glerr)."\n" if $glerr;
190}
348 191
349############################################################################# 192#############################################################################
350 193
351use Event; 194use Event;
195
196glinit;
352 197
353$conn = new conn 198$conn = new conn
354 host => "cf.schmorp.de", 199 host => "cf.schmorp.de",
355 port => 13327; 200 port => 13327;
356 201

Diff Legend

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