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

Diff Legend

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