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.2 by root, Thu Apr 6 20:00:23 2006 UTC vs.
Revision 1.116 by root, Sun Apr 16 07:25:30 2006 UTC

1#!/opt/bin/perl 1#!/opt/bin/perl
2 2
3use strict; 3use strict;
4use utf8;
4 5
5use Crossfire::Client; 6use Time::HiRes 'time';
6use Crossfire::Protocol; 7use Event;
7
8package Crossfire::Client; # uh, yeah
9
10use strict;
11 8
12use SDL; 9use SDL;
13use SDL::App; 10use SDL::App;
14use SDL::Event; 11use SDL::Event;
15use SDL::Surface; 12use SDL::Surface;
16use SDL::OpenGL; 13use SDL::OpenGL;
17use SDL::OpenGL::Constants;
18 14
19my $conn; 15use Crossfire;
20my $app; 16use Crossfire::Protocol;
21 17
22my $WIDTH = 640; 18use Compress::LZF;
23my $HEIGHT = 480;
24 19
25sub glinit { 20use CFClient;
26 # nuke all gl context data 21use CFClient::UI;
22
23our $VERSION = '0.1';
24
25my $MAX_FPS = 60;
26my $MIN_FPS = 5; # unused as of yet
27
28our $META_SERVER = "crossfire.real-time.com:13326";
29
30our $FACEMAP;
31our $TILECACHE;
32our $MAPCACHE;
33
34our $LAST_REFRESH;
35our $NOW;
36
37our $CFG;
38our $CONN;
39our $FAST; # fast, low-quality mode, possibly useful for software-rendering
40
41our @SDL_MODES;
42our $WIDTH;
43our $HEIGHT;
44our $FULLSCREEN;
45our $FONTSIZE;
46
47our $MAP;
48our $MAPWIDGET;
49our $BUTTONBAR;
50our $LOGVIEW;
51our $CONSOLE;
52our $METASERVER;
53
54our $SDL_ACTIVE;
55our $SDL_EV;
56our %SDL_CB;
57
58our $ALT_ENTER_MESSAGE;
59our $STATUS_LINE;
60our $DEBUG_STATUS;
61
62sub status {
63 $STATUS_LINE->set_text ($_[0]);
64 my ($w, $h) = $STATUS_LINE->size_request;
65 $STATUS_LINE->size_allocate (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $h, $w, $h);
66}
67
68sub debug {
69 $DEBUG_STATUS->set_text ($_[0]);
70 my ($w, $h) = $DEBUG_STATUS->size_request;
71 $DEBUG_STATUS->size_allocate ($WIDTH - $w, 0, $w, $h);
72}
73
74sub start_game {
75 status "logging in...";
76
77 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
78
79 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
80
81 $MAP = new CFClient::Map $mapsize, $mapsize;
82
83 my ($host, $port) = split /:/, $CFG->{host};
27 84
28 $app = new SDL::App 85 $CONN = new conn
29 -title => "Crossfire+ Client", 86 host => $host,
30 -width => $WIDTH, 87 port => $port || 13327,
31 -height => $HEIGHT, 88 user => $CFG->{user},
32 -depth => 24, 89 pass => $CFG->{password},
33 -opengl => 1, 90 mapw => $mapsize,
34 -double_buffer => 1, 91 maph => $mapsize,
35 -resizeable => 0; 92 ;
36 93
37 glEnable GL_TEXTURE_2D; 94 status "login successful";
38 glShadeModel GL_FLAT;
39 glDisable GL_DEPTH_TEST;
40 glMatrixMode GL_PROJECTION;
41 95
42 #glViewport 0, 0, $WIDTH, $HEIGHT; 96 CFClient::lowdelay fileno $CONN->{fh};
43 # re-bind all textures
44} 97}
45 98
46sub refresh { 99sub stop_game {
47 glClearColor 0.5, 0.5, 0.7, 0; 100 undef $CONN;
48 glClear GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT; 101}
49 102
50 glLoadIdentity; 103sub client_setup {
51 glOrtho 0, $WIDTH / 32, $HEIGHT / 32, 0, -1 , 1; 104 my $dialog = new CFClient::UI::FancyFrame
105 child => (my $vbox = new CFClient::UI::VBox);
106 $vbox->add (new CFClient::UI::Label align => 0, text => "Client Setup");
107 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
52 108
53 my $map = $conn->{map}; 109 $table->add (0, 0, new CFClient::UI::Label align => 1, text => "Video Mode");
110 $table->add (1, 0, my $hbox = new CFClient::UI::HBox);
54 111
55 for my $x (0 .. $conn->{mapw} - 1) { 112 $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);
56 for my $y (0 .. $conn->{maph} - 1) { 113 $hbox->add (my $mode_label = new CFClient::UI::Label height => $FONTSIZE * 0.8);
57 114
58 my $cell = $map->[$x][$y] 115 $mode_slider->connect (changed => sub {
59 or next; 116 my ($self, $value) = @_;
60 117
61 for my $num (grep $_, $cell->[0], $cell->[1], $cell->[2]) { 118 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
62 my $tex = $conn->{face}[$num]{texture} ||= do { 119 $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
63 $conn->send ("askface $num") unless $conn->{face}[$num]{askface}++; 120 });
121 $mode_slider->emit (changed => $mode_slider->{range}[0]);
64 122
65 0 123 $table->add (0, 1, new CFClient::UI::Label align => 1, text => "Fullscreen");
66 124 $table->add (1, 1, new CFClient::UI::CheckBox state => $CFG->{fullscreen}, connect_changed => sub {
125 my ($self, $value) = @_;
126 $CFG->{fullscreen} = $value;
127 });
128
129 $table->add (0, 2, new CFClient::UI::Label align => 1, text => "Fast & Ugly");
130 $table->add (1, 2, new CFClient::UI::CheckBox state => $CFG->{fast}, connect_changed => sub {
131 my ($self, $value) = @_;
132 $CFG->{fast} = $value;
133 });
134
135 $table->add (0, 3, new CFClient::UI::Label align => 1, text => "Fog of War");
136 $table->add (1, 3, new CFClient::UI::CheckBox state => $CFG->{fow_enable}, connect_changed => sub {
137 my ($self, $value) = @_;
138 $CFG->{fow_enable} = $value;
139 });
140
141 $table->add (0, 4, new CFClient::UI::Label align => 1, text => "FoW Intensity");
142 $table->add (1, 4, new CFClient::UI::Slider range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001], connect_changed => sub {
143 my ($self, $value) = @_;
144 $CFG->{fow_intensity} = $value;
145 });
146
147 $table->add (0, 5, new CFClient::UI::Label align => 1, text => "FoW Smooth");
148 $table->add (1, 5, new CFClient::UI::CheckBox state => $CFG->{fow_smooth}, connect_changed => sub {
149 my ($self, $value) = @_;
150 $CFG->{fow_smooth} = $value;
151 });
152
153 $table->add (0, 6, new CFClient::UI::Label align => 1, text => "Log Fontsize");
154 $table->add (1, 6, new CFClient::UI::Slider range => [$CFG->{log_fontsize}, 8, 30, 1], connect_changed => sub {
155 my ($self, $value) = @_;
156 $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = int $value);
157 });
158
159 $table->add (1, 7, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub {
160 destroy_screen ();
161 init_screen ();
162 });
163
164 $dialog
165}
166
167sub metaserver_dialog {
168 my $dialog = new CFClient::UI::FancyFrame
169 child => (my $vbox = new CFClient::UI::VBox);
170
171 $vbox->add ($dialog->{table} = new CFClient::UI::Table);
172
173 $dialog
174}
175
176sub update_metaserver {
177 my ($HOST) = @_;
178
179 status "fetching metaserver list...";
180
181 my $buf;
182
183 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
184
185 Event->io (fd => $fh, poll => 'r', cb => sub {
186 my $res = sysread $fh, $buf, 8192, length $buf;
187
188 if (!defined $res) {
189 $_[0]->w->cancel;
190 status "metaserver: $!";
191 } elsif ($res == 0) {
192 $_[0]->w->cancel;
193 status "server list retrieved";
194
195 my $table = $METASERVER->{table};
196
197 $table->clear;
198
199 my @col = qw(Use #Users Host Uptime Version Description);
200 $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
201 for 0 .. $#col;
202
203 my @align = qw(1 0 1 1 -1);
204
205 my $y = 0;
206 for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
207 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;
208
209 for ($desc) {
210 s/<br>/\n/gi;
211 s/<li>/\n· /gi;
212 s/<.*?>//sgi;
213 s/&/&amp;/g;
214 s/</&lt;/g;
215 s/>/&gt;/g;
67 }; 216 }
68
69 glBindTexture GL_TEXTURE_2D, $tex;
70 217
71 glBegin GL_QUADS; 218 $uptime = sprintf "%dd %02d:%02d:%02d",
72 glTexCoord 0, 0; glVertex $x, $y; 219 (int $m->[8] / 86400),
73 glTexCoord 1, 0; glVertex $x + 1, $y; 220 (int $m->[8] / 3600) % 24,
74 glTexCoord 1, 1; glVertex $x + 1, $y + 1; 221 (int $m->[8] / 60) % 60,
75 glTexCoord 0, 1; glVertex $x, $y + 1; 222 $m->[8] % 60;
223
224 $m = [$users, $host, $uptime, $version, $desc];
225
226 $y++;
227
228 $table->add (0, $y, new CFClient::UI::VBox children => [
229 (new CFClient::UI::Button text => " ", connect_activate => sub {
230 $HOST->set_text ($CFG->{host} = $host);
231 }),
232 (new CFClient::UI::Empty expand => 1),
233 ]);
76 glEnd; 234
235 $table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => $FONTSIZE * 0.8)
236 for 0 .. $#$m;
77 } 237 }
78 } 238 }
239 });
240}
241
242sub server_setup {
243 my $dialog = new CFClient::UI::FancyFrame
244 child => (my $vbox = new CFClient::UI::VBox);
245
246 $vbox->add (new CFClient::UI::Label align => 0, text => "Server Setup");
247 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
248 $table->add (0, 2, new CFClient::UI::Label align => 1, text => "Host:Port");
249
250 {
251 $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
252
253 $vbox->add (my $HOST = new CFClient::UI::Entry text => $CFG->{host}, connect_changed => sub {
254 my ($self, $value) = @_;
255 $CFG->{host} = $value;
256 });
257
258 $METASERVER = metaserver_dialog;
259
260 $vbox->add (new CFClient::UI::Flopper text => "Metaserver", other => $METASERVER, connect_open => sub {
261 update_metaserver $HOST;
262 });
79 } 263 }
80 264
265 $table->add (0, 4, new CFClient::UI::Label align => 1, text => "Username");
266 $table->add (1, 4, new CFClient::UI::Entry text => $CFG->{user}, connect_changed => sub {
267 my ($self, $value) = @_;
268 $CFG->{user} = $value;
269 });
270
271 $table->add (0, 5, new CFClient::UI::Label align => 1, text => "Password");
272 $table->add (1, 5, new CFClient::UI::Entry text => $CFG->{password}, hidden => 1, connect_changed => sub {
273 my ($self, $value) = @_;
274 $CFG->{password} = $value;
275 });
276
277 $table->add (0, 6, new CFClient::UI::Label align => 1, text => "Def. say cmd");
278 $table->add (1, 6, my $saycmd = new CFClient::UI::Entry text => $CFG->{say_command}, connect_changed => sub {
279 my ($self, $value) = @_;
280 $CFG->{say_command} = $value;
281 });
282
283 $table->add (0, 7, new CFClient::UI::Label align => 1, text => "Map Size");
284 $table->add (1, 7, new CFClient::UI::Slider
285 req_w => 100,
286 range => [$CFG->{mapsize}, 10, 100 + 1, 1],
287 connect_changed => sub {
288 my ($self, $value) = @_;
289
290 $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
291 },
292 );
293
294 $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub {
295 start_game;
296 });
297
298 $dialog
299}
300
301sub message_window {
302 my $window = new CFClient::UI::FancyFrame
303 border_bg => [1, 1, 1, 0.5],
304 bg => [0.3, 0.3, 0.3, 0.8],
305 user_w => $::WIDTH/4,
306 user_h => $::HEIGHT,
307 child => (my $vbox = new CFClient::UI::VBox);
308
309 $vbox->add ($LOGVIEW = new CFClient::UI::TextView
310 expand => 1,
311 fontsize => $::CFG->{log_fontsize},
312 );
313
314 $vbox->add (my $input = new CFClient::UI::LineEntry
315 connect_activate => sub {
316 my ($input, $text) = @_;
317 $input->set_text ('');
318
319 if ($text =~ /^\/(.*)/) {
320 $::CONN->user_send ("command $1");
321 } else {
322 my $say_cmd = $::CFG->{say_command} || 'say';
323 $::CONN->user_send ("command $say_cmd $text");
324 }
325 },
326 connect_escape => sub {
327 $MAPWIDGET->focus_in
328 },
329 );
330
331 $CONSOLE = {
332 window => $window,
333 input => $input
334 };
335
336 $window
337}
338
339sub sdl_init {
340 #SDL::Init SDL_INIT_AUDIO | SDL_INIT_VIDEO | SDL_INIT_NOPARACHUTE
341 SDL::Init SDL_INIT_AUDIO | SDL_INIT_VIDEO
342 and die "SDL::Init failed!\n";
343}
344
345sub init_screen {
346 sdl_init;
347
348 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
349 $FULLSCREEN = $CFG->{fullscreen};
350 $FAST = $CFG->{fast};
351
352 SDL::GLSetAttribute SDL_GL_RED_SIZE, 5;
353 SDL::GLSetAttribute SDL_GL_GREEN_SIZE, 5;
354 SDL::GLSetAttribute SDL_GL_BLUE_SIZE, 5;
355 SDL::GLSetAttribute SDL_GL_ALPHA_SIZE, 1;
356
357 SDL::GLSetAttribute SDL_GL_ACCUM_RED_SIZE, 0;
358 SDL::GLSetAttribute SDL_GL_ACCUM_GREEN_SIZE, 0;
359 SDL::GLSetAttribute SDL_GL_ACCUM_BLUE_SIZE, 0;
360 SDL::GLSetAttribute SDL_GL_ACCUM_ALPHA_SIZE, 0;
361
362 SDL::GLSetAttribute SDL_GL_DOUBLEBUFFER, 1;
363 SDL::GLSetAttribute SDL_GL_BUFFER_SIZE, 15;
364 SDL::GLSetAttribute SDL_GL_DEPTH_SIZE, 0;
365
366 SDL::SetVideoMode $WIDTH, $HEIGHT, 0,
367 SDL_HWSURFACE | SDL_ANYFORMAT | SDL_OPENGL | SDL_DOUBLEBUF
368 | ($FULLSCREEN ? SDL_FULLSCREEN : 0)
369 or die "SDL::SetVideoMode failed!\n";
370
371 SDL::WMSetCaption "Crossfire+ Client", "Crossfire+";
372
373 $SDL_EV = new SDL::Event;
374 $SDL_EV->set_unicode (1);
375
376 $SDL_ACTIVE = 1;
377
378 $LAST_REFRESH = time - 0.01;
379
380 CFClient::gl_init;
381
382 $FONTSIZE = int $HEIGHT / 40;
383
384 #############################################################################
385
386 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100;
387 $CFClient::UI::ROOT->add ($DEBUG_STATUS);
388
389 $STATUS_LINE = new CFClient::UI::Label
390 padding => 0,
391 y => $HEIGHT * 44 / 45 - $FONTSIZE;
392 $CFClient::UI::ROOT->add ($STATUS_LINE);
393
394 $ALT_ENTER_MESSAGE = new CFClient::UI::Label
395 padding => 0,
396 y => $HEIGHT * 44 / 45,
397 height => $HEIGHT / 45,
398 text => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
399 $CFClient::UI::ROOT->add ($ALT_ENTER_MESSAGE);
400
401 $CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::UI::MapWidget);
402 $MAPWIDGET->focus_in;
403 $MAPWIDGET->connect (activate_console => sub {
404 my ($mapwidget, $preset) = @_;
405
406 if ($CONSOLE) {
407 $CONSOLE->{input}->focus_in;
408
409 if ($preset && $CONSOLE->{input}->get_text eq '') {
410 $CONSOLE->{input}->set_text ($preset);
411 }
412 }
413 });
414
415 $CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox);
416
417 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
418 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
419 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
420
421 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
422 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
423 status "Configuration Saved";
424 });
425
426 $BUTTONBAR->{children}[0]->emit ("activate");
427}
428
429sub destroy_screen {
430 $CFClient::UI::ROOT->{children} = [];
431 undef $SDL_ACTIVE;
432 undef $SDL_EV;
433 SDL::Quit;
434}
435
436my %animate_object;
437my $animate_timer;
438
439my $want_refresh;
440my $can_refresh;
441
442my $fps = 9;
443
444sub force_refresh {
445 $fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05;
446 debug sprintf "%3.2f", $fps;
447
448 $want_refresh = 0;
449 $can_refresh = 0;
450
451 $CFClient::UI::ROOT->draw;
452
81 SDL::GLSwapBuffers; 453 SDL::GLSwapBuffers;
82}
83 454
84my $ev = new SDL::Event; 455 $LAST_REFRESH = $NOW;
85my %ev_cb;
86
87sub event(&$) {
88 $ev_cb{$_[0]->()} = $_[1];
89} 456}
90 457
91sub does(&) { shift } 458my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
459 $NOW = time;
92 460
93event {SDL_QUIT} does { 461 ($SDL_CB{$SDL_EV->type} || sub { warn "unhandled event ", $SDL_EV->type })->()
94 exit; 462 while $SDL_EV->poll;
463
464 if (%animate_object) {
465 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
466 $want_refresh++;
467 }
468
469 if ($want_refresh) {
470 force_refresh;
471 } else {
472 $can_refresh = 1;
473 }
95}; 474});
96 475
97event {SDL_VIDEORESIZE} does { 476sub refresh {
98 print "resize\n"; 477 $want_refresh++;
99}; 478}
100 479
101event {SDL_KEYDOWN} does { 480sub animation_start {
102 print "keypress\n"; 481 my ($widget) = @_;
103}; 482 $animate_object{$widget} = $widget;
483}
104 484
105event {SDL_KEYUP} does { 485sub animation_stop {
106 print "keyup\n";#d# 486 my ($widget) = @_;
107}; 487 delete $animate_object{$widget};
108 488}
109event {SDL_MOUSEMOTION} does {
110 print "motion\n";
111};
112
113event {SDL_MOUSEBUTTONDOWN} does {
114 print "button\n";
115};
116
117event {SDL_MOUSEBUTTONUP} does {
118 print "buttup\n";
119};
120
121event {SDL_ACTIVEEVENT} does {
122 print "active\n";
123};
124
125package Crossfire::Client;
126 489
127@conn::ISA = Crossfire::Protocol::; 490@conn::ISA = Crossfire::Protocol::;
128 491
129sub conn::map_update { 492sub conn::user_send {
493 my ($self, $command) = @_;
494
495 $self->send ($command);
496 status $command;
497}
498
499sub conn::feed_map1a {
130 my ($self, $dirty) = @_; 500 my ($self, $data) = @_;
131 501
132 refresh; 502# $self->Crossfire::Protocol::feed_map1a ($data);
133}
134 503
135sub conn::map_scroll { 504 $MAP->scroll (delete $self->{delayed_scroll_x}, delete $self->{delayed_scroll_y});
505 $MAP->map1a_update ($data);
506 $MAPWIDGET->update;
507}
508
509sub conn::flush_map {
136 my ($self, $dx, $dy) = @_; 510 my ($self) = @_;
137 511
138 refresh; 512 my $map_info = delete $self->{map_info}
513 or return;
514
515 my ($hash, $x, $y, $w, $h) = @$map_info;
516
517 my $data = $MAP->get_rect ($x, $y, $w, $h);
518 $MAPCACHE->put ($hash => Compress::LZF::compress $data);
519
520 warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
521
139} 522}
140 523
141sub conn::map_clear { 524sub conn::map_clear {
142 my ($self) = @_; 525 my ($self) = @_;
143 526
144 refresh; 527 $self->flush_map;
528
529 $MAP->clear;
530}
531
532sub conn::map_info {
533 my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
534
535 $self->flush_map;
536
537 $x = $::MAP->ox - $x;
538 $y = $::MAP->oy - $y;
539
540 $self->{map_info} = [$hash, $x, $y, $w, $h];
541
542 if (defined (my $data = $MAPCACHE->get ($hash))) {
543 $data = Compress::LZF::decompress $data;
544 warn sprintf "LOADmap[%s] length %d\n", $hash, length $data;#d#
545 for my $id ($MAP->set_rect ($x, $y, $data)) {
546 my $data = $TILECACHE->get ($id)
547 or next;
548
549 $self->set_texture ($id => $data);
550 }
551 }
552}
553
554sub conn::face_find {
555 my ($self, $facenum, $face) = @_;
556
557 my $hash = "$face->{chksum},$face->{name}";
558
559 my $id = $FACEMAP->get ($hash);
560
561 unless ($id) {
562 # create new id for face
563 # i love transactions
564 for (1..100) {
565 my $txn = $CFClient::DB_ENV->txn_begin;
566 my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
567 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
568 $id++;
569 if ($FACEMAP->put (id => $id) == 0
570 && $FACEMAP->put ($hash => $id) == 0) {
571 $txn->txn_commit;
572
573 goto gotid;
574 }
575 }
576 $txn->abort;
577 }
578
579 CFClient::fatal "maximum number of transaction retries reached - database problems?";
580 }
581
582gotid:
583 $face->{id} = $id;
584 $MAP->set_face ($facenum => $id);
585 $TILECACHE->get ($id)
145} 586}
146 587
147sub conn::face_update { 588sub conn::face_update {
148 my ($self, $num, $face) = @_; 589 my ($self, $facenum, $face) = @_;
149 590
150 warn "up face $self,$num,$face\n";#d# 591 $TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
592
593 $self->set_texture ($face->{id} => delete $face->{image});
594}
595
596sub conn::set_texture {
597 my ($self, $id, $data) = @_;
598
599 $self->{texture}[$id] ||= do {
600 my $tex =
601 new_from_image CFClient::Texture
602 $data, minify => 1;
603
604 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
605 $MAPWIDGET->update;
606
607 $tex
608 };
609}
610
611sub conn::query {
612 my ($self, $flags, $prompt) = @_;
613
151 #TODO 614 #TODO
152 open my $fh, ">:raw", "/tmp/x~"; 615 warn "<<<<QUERY:$flags:$prompt>>>\n";#d#
153 syswrite $fh, $face->{image}; 616}
154 close $fh;
155 617
156 my $surface = new SDL::Surface -name => "/tmp/x~"; 618sub conn::drawinfo {
619 my ($self, $color, $text) = @_;
157 620
158 unlink "/tmp/x~"; 621 my @color = (
159 622 [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
160 my ($tex) = @{glGenTextures 1}; 623 [1.00, 1.00, 1.00],
161 glGetError(); 624 [0.50, 0.50, 1.00], # changed
162 625 [1.00, 0.00, 0.00],
163 $face->{texture} = $tex; 626 [1.00, 0.54, 0.00],
627 [0.11, 0.56, 1.00],
628 [0.93, 0.46, 0.00],
629 [0.18, 0.54, 0.34],
630 [0.56, 0.73, 0.56],
631 [0.80, 0.80, 0.80],
632 [0.55, 0.41, 0.13],
633 [0.99, 0.77, 0.26],
634 [0.74, 0.65, 0.41],
164 635 );
165 glBindTexture GL_TEXTURE_2D, $tex; 636
166 my $glerr=glGetError(); die "a: ".gluErrorString($glerr)."\n" if $glerr; 637 $LOGVIEW->add_paragraph ($color[$color], $text);
167 638}
168# glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR; 639
169# glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR; 640%SDL_CB = (
641 SDL_QUIT() => sub {
642 Event::unloop -1;
170 643 },
171 $surface->rgba; 644 SDL_VIDEORESIZE() => sub {
172 645 },
173 glTexImage2D GL_TEXTURE_2D, 0, 646 SDL_VIDEOEXPOSE() => sub {
174 4, # components 647 refresh;
175 $surface->width, $surface->height, 648 },
176 0, 649 SDL_KEYDOWN() => sub {
177 GL_RGBA, 650 if ($SDL_EV->key_mod & KMOD_ALT && $SDL_EV->key_sym == SDLK_RETURN) {
178 GL_UNSIGNED_BYTE, 651 # alt-enter
179 $surface->pixels; 652 destroy_screen;
180 my $glerr=glGetError(); die "Problem setting up 2d Texture (dimensions not a power of 2?)):".gluErrorString($glerr)."\n" if $glerr; 653 $CFG->{fullscreen} = !$CFG->{fullscreen};
181} 654 init_screen;
655 } else {
656 CFClient::UI::feed_sdl_key_down_event ($SDL_EV);
657 }
658 },
659 SDL_KEYUP() => sub {
660 CFClient::UI::feed_sdl_key_up_event ($SDL_EV);
661 },
662 SDL_MOUSEMOTION() => sub {
663 CFClient::UI::feed_sdl_motion_event ($SDL_EV);
664 },
665 SDL_MOUSEBUTTONDOWN() => sub {
666 CFClient::UI::feed_sdl_button_down_event ($SDL_EV);
667 },
668 SDL_MOUSEBUTTONUP() => sub {
669 CFClient::UI::feed_sdl_button_up_event ($SDL_EV);
670 },
671 SDL_ACTIVEEVENT() => sub {
672# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
673 },
674);
182 675
183############################################################################# 676#############################################################################
184 677
185use Event; 678$TILECACHE = CFClient::db_table "tilecache";
679$FACEMAP = CFClient::db_table "facemap";
186 680
187glinit; 681CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
188 682
189$conn = new conn 683my %DEF_CFG = (
684 sdl_mode => 0,
685 width => 640,
686 height => 480,
687 fullscreen => 0,
688 fast => 0,
689 fow_enable => 1,
690 fow_intensity => 0.45,
691 fow_smooth => 0,
692 log_fontsize => 14,
693 mapsize => 100,
190 host => "cf.schmorp.de", 694 host => "crossfire.schmorp.de",
191 port => 13327; 695 say_command => 'say',
192
193Event->timer (after => 0, interval => 1/20, hard => 1, cb => sub {
194 while ($ev->poll) {
195 ($ev_cb{$ev->type} || sub { warn "unhandled event ", $ev->type })->();
196 }
197}); 696);
697
698while (my ($k, $v) = each %DEF_CFG) {
699 $CFG->{$k} = $v unless exists $CFG->{$k};
700}
701
702sdl_init;
703
704@SDL_MODES = reverse
705 grep $_->[0] >= 640 && $_->[1] >= 480,
706 map [SDL::RectW ($_), SDL::RectH ($_)],
707 @{ SDL::ListModes 0, SDL_FULLSCREEN | SDL_HWSURFACE | SDL_OPENGL };
708
709@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
710
711$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
712
713init_screen;
714
715{
716 my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf);
717
718 CFClient::add_font $_ for @fonts;
719 CFClient::set_font $fonts[0];
720}
198 721
199Event::loop; 722Event::loop;
200 723
201 724

Diff Legend

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