ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/pclient
Revision: 1.85
Committed: Wed Apr 12 17:11:02 2006 UTC (18 years, 1 month ago) by root
Branch: MAIN
Changes since 1.84: +13 -2 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #!/opt/bin/perl
2 root 1.25
3 root 1.2 use strict;
4 root 1.25 use utf8;
5 root 1.2
6 root 1.13 use Glib;
7     use Gtk2 -init;
8    
9     use SDL;
10     use SDL::App;
11     use SDL::Event;
12     use SDL::Surface;
13     use SDL::OpenGL;
14     use SDL::OpenGL::Constants;
15    
16 elmex 1.11 use Crossfire;
17 root 1.2 use Crossfire::Protocol;
18    
19 root 1.67 use CFClient;
20 root 1.72 use CFClient::UI;
21 elmex 1.10
22 root 1.63 our $VERSION = '0.1';
23    
24 root 1.75 my $MAX_FPS = 60;
25 root 1.85 my $MIN_FPS = 5; # unused
26 root 1.63 my $TICKS_PER_FRAME = int 1000 / $MAX_FPS - 1; # min ticks per frame
27    
28 root 1.19 our $FACECACHE;
29    
30 elmex 1.10 our $CFG;
31 root 1.13 our $CONN;
32 root 1.85 our $FAST; # fast, low-quality mode, possibly useful for software-rendering
33 root 1.2
34 root 1.75 our @SDL_MODES;
35 root 1.30 our $WIDTH;
36     our $HEIGHT;
37     our $FULLSCREEN;
38    
39 root 1.71 our $NOW;
40    
41 root 1.69 our $MAPWIDGET;
42 root 1.39 our $FONTSIZE;
43 root 1.57
44 root 1.13 our $SDL_TIMER;
45     our $SDL_APP;
46 root 1.58 our $SDL_EV;
47 root 1.13 our %SDL_CB;
48 root 1.18
49 root 1.30 our $ALT_ENTER_MESSAGE;
50 root 1.51 our $STATUS_LINE;
51 root 1.64 our $DEBUG_STATUS;
52 root 1.30
53 root 1.45 my $last_refresh;
54 root 1.50 my %ANIMATE;
55     my $refresh_handler;
56 root 1.45
57 root 1.82 sub status {
58     $STATUS_LINE->set_text ($_[0]);
59     my ($w, $h) = $STATUS_LINE->size_request;
60     $STATUS_LINE->size_allocate (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $h, $w, $h);
61     }
62    
63     sub debug {
64     $DEBUG_STATUS->set_text ($_[0]);
65     my ($w, $h) = $DEBUG_STATUS->size_request;
66     $DEBUG_STATUS->size_allocate ($WIDTH - $w, 0, $w, $h);
67     }
68    
69 root 1.84 sub start_game {
70 root 1.85 status "logging in...";
71    
72 root 1.84 my $mapsize = List::Util::min 64, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
73    
74     $CONN = new conn
75     host => $CFG->{host},
76     port => $CFG->{port},
77     user => $CFG->{user},
78     pass => $CFG->{password},
79     mapw => $mapsize,
80     maph => $mapsize,
81     ;
82    
83 root 1.85 status "login successful";
84    
85 root 1.84 CFClient::lowdelay fileno $CONN->{fh};
86     }
87    
88     sub stop_game {
89     undef $CONN;
90     }
91    
92 root 1.81 sub config_dialog {
93     my $dialog = new CFClient::UI::FancyFrame x => 300, y => 100,
94     child => (my $vbox = new CFClient::UI::VBox);
95 root 1.82 $vbox->add (new CFClient::UI::Label align => 0, text => "Client Setup");
96 root 1.81 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
97    
98     $table->add (0, 0, new CFClient::UI::Label align => 1, text => "Video Mode");
99     $table->add (1, 0, my $hbox = new CFClient::UI::HBox);
100    
101     $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);
102     $hbox->add (my $mode_label = new CFClient::UI::Label height => $FONTSIZE * 0.8);
103    
104     $mode_slider->connect (changed => sub {
105     my ($self, $value) = @_;
106    
107     $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
108     $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
109     });
110     $mode_slider->emit (changed => $mode_slider->{range}[0]);
111 root 1.82
112 root 1.85 $table->add (0, 1, new CFClient::UI::Label align => 1, text => "Fullscreen");
113     $table->add (1, 1, new CFClient::UI::CheckBox state => $CFG->{fullscreen}, connect_changed => sub {
114     my ($self, $value) = @_;
115     $CFG->{fullscreen} = $value;
116     });
117    
118     $table->add (1, 2, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub {
119 root 1.83 destroy_screen ();
120     init_screen ();
121 root 1.82 });
122 root 1.81
123 root 1.82 $vbox->add (new CFClient::UI::Label align => 0, text => "Server");
124     $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
125     $table->add (0, 2, new CFClient::UI::Label align => 1, text => "Host");
126     $table->add (1, 2, my $host = new CFClient::UI::Entry text => $CFG->{host});
127 root 1.81
128 root 1.82 $table->add (0, 3, new CFClient::UI::Label align => 1, text => "Port");
129     $table->add (1, 3, my $port = new CFClient::UI::Entry text => $CFG->{port});
130 root 1.81
131 root 1.82 $table->add (0, 4, new CFClient::UI::Label align => 1, text => "Username");
132     $table->add (1, 4, my $user = new CFClient::UI::Entry text => $CFG->{user});
133 root 1.81
134 root 1.82 $table->add (0, 5, new CFClient::UI::Label align => 1, text => "Password");
135     $table->add (1, 5, my $pass = new CFClient::UI::Entry text => $CFG->{password}, hidden => 1);
136 root 1.81
137 root 1.82 $table->add (0, 6, new CFClient::UI::Label align => 1, text => "Map Size");
138     $table->add (1, 6, new CFClient::UI::Slider
139 root 1.81 req_w => 100,
140     range => [$CFG->{mapsize}, 10, 100 + 1, 1],
141     connect_changed => sub {
142     my ($self, $value) = @_;
143    
144     $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
145     },
146     );
147    
148 root 1.82 $table->add (1, 7, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub {
149 root 1.84 start_game;
150 root 1.82 });
151    
152 root 1.81 $vbox->add (my $hbox = new CFClient::UI::HBox);
153 root 1.82
154 root 1.81 $hbox->add (new CFClient::UI::Button expand => 1, align => 0, text => "Save", connect_activate => sub {
155 root 1.84 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
156 root 1.82 status "Configuration Saved";
157 root 1.81 });
158     $CFClient::UI::TOPLEVEL->add ($dialog);
159     }
160 root 1.58
161 root 1.13 sub init_screen {
162 root 1.84 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
163     $FULLSCREEN = $CFG->{fullscreen};
164    
165 root 1.13 $SDL_APP = new SDL::App
166 root 1.5 -flags => SDL_ANYFORMAT | SDL_HWSURFACE,
167     -title => "Crossfire+ Client",
168 root 1.30 -width => $WIDTH,
169     -height => $HEIGHT,
170 root 1.5 -opengl => 1,
171 root 1.51 -red_size => 5,
172     -green_size => 5,
173     -blue_size => 5,
174     -alpha_size => 0,
175 root 1.2 -double_buffer => 1,
176 root 1.30 -fullscreen => $FULLSCREEN,
177 root 1.5 -resizeable => 0;
178 root 1.2
179 root 1.58 $SDL_EV = new SDL::Event;
180     $SDL_EV->set_unicode (1);
181    
182 root 1.76 $SDL_TIMER = add Glib::Timeout 1000 / $MAX_FPS, sub {
183 root 1.62 ($SDL_CB{$SDL_EV->type} || sub { warn "unhandled event ", $SDL_EV->type })->()
184     while $SDL_EV->poll;
185    
186     1
187     };
188    
189 root 1.45 $last_refresh = SDL::GetTicks;
190    
191 root 1.67 CFClient::gl_init;
192 root 1.30
193 root 1.77 $FONTSIZE = int $HEIGHT / 40;
194 root 1.39
195 root 1.52 #############################################################################
196    
197 root 1.77 $DEBUG_STATUS = new CFClient::UI::Label padding => 0;
198 root 1.72 $CFClient::UI::TOPLEVEL->add ($DEBUG_STATUS);
199 root 1.52
200 root 1.72 $STATUS_LINE = new CFClient::UI::Label
201 root 1.77 padding => 0,
202     y => $HEIGHT * 49 / 50 - $FONTSIZE;
203 root 1.72 $CFClient::UI::TOPLEVEL->add ($STATUS_LINE);
204 root 1.51
205 root 1.72 $ALT_ENTER_MESSAGE = new CFClient::UI::Label
206 root 1.77 padding => 0,
207     y => $HEIGHT * 49 / 50,
208     height => $HEIGHT / 50,
209 root 1.68 text => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
210 root 1.72 $CFClient::UI::TOPLEVEL->add ($ALT_ENTER_MESSAGE);
211 root 1.30
212 root 1.72 $MAPWIDGET = new CFClient::UI::MapWidget;
213     $CFClient::UI::TOPLEVEL->add ($MAPWIDGET);
214 root 1.69 $MAPWIDGET->focus_in;
215 root 1.81
216     config_dialog;
217 root 1.2 }
218    
219 root 1.62 sub destroy_screen {
220 root 1.81 $CFClient::UI::TOPLEVEL->{children} = [];
221 root 1.62 remove Glib::Source $SDL_TIMER;
222 root 1.84 remove Glib::Source $refresh_handler if $refresh_handler;
223     undef $refresh_handler;
224 root 1.62 undef $SDL_APP;
225     undef $SDL_EV;
226     SDL::Quit;
227     }
228    
229 root 1.30 sub force_refresh {
230     glViewport 0, 0, $WIDTH, $HEIGHT;
231 root 1.35
232     glMatrixMode GL_PROJECTION;
233     glLoadIdentity;
234 root 1.59 glOrtho 0, $WIDTH, $HEIGHT, 0, -10000 , 10000;
235 root 1.35 glMatrixMode GL_MODELVIEW;
236 root 1.73 glLoadIdentity;
237 root 1.35
238 root 1.5 glClear GL_COLOR_BUFFER_BIT;
239 root 1.2
240 root 1.72 $CFClient::UI::TOPLEVEL->draw;
241 root 1.1
242 root 1.2 SDL::GLSwapBuffers;
243 root 1.1 }
244    
245 root 1.64 my $FPS;
246    
247 root 1.30 sub refresh {
248     $refresh_handler ||= add Glib::Idle sub {
249 root 1.58 if ($SDL_APP) {
250 root 1.71 $NOW = SDL::GetTicks;
251 root 1.63
252 root 1.71 if ($NOW - $last_refresh < $TICKS_PER_FRAME) {
253     SDL::Delay $TICKS_PER_FRAME - ($NOW - $last_refresh);
254     $NOW = SDL::GetTicks;
255 root 1.63 }
256    
257 root 1.71 my $interval = ($NOW - $last_refresh) * 0.001;
258     $last_refresh = $NOW;
259 root 1.58
260 root 1.64 if ($interval) {
261     $FPS ||= 1 / $interval;
262 root 1.77 $FPS = $FPS * 0.9 + (1 / $interval) * 0.1;
263 root 1.66 debug sprintf "%5.02f", $FPS;
264 root 1.64 }
265    
266 root 1.58 force_refresh;
267     $_->animate ($interval) for grep $_, values %ANIMATE;
268    
269     if (%ANIMATE) {
270     1
271     } else {
272     undef $refresh_handler;
273     0
274     }
275 root 1.45 } else {
276     undef $refresh_handler;
277     0
278     }
279 root 1.30 };
280     }
281    
282 root 1.45 sub animation_start {
283     my ($widget) = @_;
284     $ANIMATE{$widget} = $widget;
285     Scalar::Util::weaken $ANIMATE{$widget};
286    
287     refresh;
288     }
289    
290     sub animation_stop {
291     my ($widget) = @_;
292     delete $ANIMATE{$widget};
293     }
294    
295 root 1.13 %SDL_CB = (
296     SDL_QUIT() => sub {
297 root 1.19 main_quit Gtk2;
298 root 1.13 },
299     SDL_VIDEORESIZE() => sub {
300     },
301     SDL_VIDEOEXPOSE() => sub {
302     refresh;
303     },
304     SDL_KEYDOWN() => sub {
305 root 1.18 if ($SDL_EV->key_mod & KMOD_ALT && $SDL_EV->key_sym == SDLK_RETURN) {
306     # alt-enter
307 root 1.30 $FULLSCREEN = !$FULLSCREEN;
308 root 1.81 destroy_screen;
309 root 1.18 init_screen;
310     } else {
311 root 1.72 CFClient::UI::feed_sdl_key_down_event ($SDL_EV);
312 root 1.18 }
313 root 1.13 },
314     SDL_KEYUP() => sub {
315 root 1.72 CFClient::UI::feed_sdl_key_up_event ($SDL_EV);
316 root 1.13 },
317     SDL_MOUSEMOTION() => sub {
318 root 1.72 CFClient::UI::feed_sdl_motion_event ($SDL_EV);
319 root 1.13 },
320     SDL_MOUSEBUTTONDOWN() => sub {
321 root 1.72 CFClient::UI::feed_sdl_button_down_event ($SDL_EV);
322 root 1.13 },
323     SDL_MOUSEBUTTONUP() => sub {
324 root 1.72 CFClient::UI::feed_sdl_button_up_event ($SDL_EV);
325 root 1.13 },
326     SDL_ACTIVEEVENT() => sub {
327 root 1.70 # printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
328 root 1.13 },
329     );
330 root 1.1
331 root 1.2 @conn::ISA = Crossfire::Protocol::;
332 root 1.1
333 root 1.2 sub conn::map_update {
334 root 1.1 my ($self, $dirty) = @_;
335    
336 root 1.69 $MAPWIDGET->update;
337 root 1.1 }
338    
339 root 1.2 sub conn::map_scroll {
340 root 1.1 my ($self, $dx, $dy) = @_;
341    
342 root 1.45 # refresh;
343 root 1.1 }
344    
345 root 1.2 sub conn::map_clear {
346 root 1.1 my ($self) = @_;
347    
348 root 1.45 # refresh;
349 root 1.1 }
350    
351 root 1.19 sub conn::face_find {
352     my ($self, $face) = @_;
353    
354     $FACECACHE->{"$face->{chksum},$face->{name}"}
355     }
356    
357 root 1.2 sub conn::face_update {
358 root 1.19 my ($self, $face) = @_;
359    
360     $FACECACHE->{"$face->{chksum},$face->{name}"} = $face->{image};
361 root 1.1
362 root 1.67 $face->{texture} = new_from_image CFClient::Texture delete $face->{image};
363 root 1.1 }
364    
365 root 1.33 sub conn::query {
366     my ($self, $flags, $prompt) = @_;
367    
368     warn "<<<<QUERY:$flags:$prompt>>>\n";#d#
369     }
370    
371 elmex 1.23 sub gtk_add_cfg_field {
372     my ($tbl, $cfg, $klbl, $key, $value) = @_;
373     my $i = $cfg->{_i}++;
374     $tbl->attach_defaults (my $lbl = Gtk2::Label->new ($klbl), 0, 1, $i, $i + 1);
375     $tbl->attach_defaults (my $ent = Gtk2::Entry->new, 1, 2, $i, $i + 1);
376     if ($key eq 'password') {
377     $ent->set_invisible_char ("*");
378     $ent->set (visibility => 0)
379     }
380     $ent->set_text ($value);
381     $ent->signal_connect (changed => sub {
382     my ($ent) = @_;
383     $cfg->{$key} = $ent->get_text;
384 elmex 1.49 # TODO: Mapsize should be a slider in the game gui
385 elmex 1.47 if ($key eq 'mapsize' and $cfg->{$key} > 100) {
386     $cfg->{$key} = 100;
387 elmex 1.48 } elsif ($key eq 'mapsize' and $cfg->{$key} < 50) {
388     $cfg->{$key} = 50;
389 elmex 1.47 }
390 elmex 1.23 });
391     }
392    
393     sub run_config_dialog {
394     my (%events) = @_;
395    
396     my $w = Gtk2::Window->new;
397    
398     my @cfg = (
399     [qw/Host host/],
400     [qw/Port port/],
401 elmex 1.47 [qw/Mapsize% mapsize/],
402 elmex 1.23 [qw/Username user/],
403     [qw/Password password/],
404     );
405    
406     my $cfg = {};
407    
408     $w->add (my $vb = Gtk2::VBox->new);
409     $vb->pack_start (my $t = Gtk2::Table->new (2, scalar @cfg), 0, 0, 0);
410     my $selmode = $::CFG->{width} . 'x' . $::CFG->{height};
411     $t->attach_defaults (Gtk2::Label->new ("Modes"), 0, 1, 0, 1);
412     $t->attach_defaults (my $cb = Gtk2::ComboBox->new_text, 1, 2, 0, 1);
413     my $i = 0;
414     my $act = 0;
415 root 1.75 for (map { "$_->[0]x$_->[1]" } @SDL_MODES) {
416 elmex 1.23 if ($_ eq $selmode) { $act = $i }
417     $cb->append_text ($_);
418     $i++;
419     }
420     $cb->set_active ($act);
421     $cb->signal_connect (changed => sub {
422     my ($cb) = @_;
423     my $txt = $cb->get_active_text;
424     if ($txt =~ m/(\d+)x(\d+)/) {
425     $::CFG->{width} = $1;
426     $::CFG->{height} = $2;
427     }
428     });
429    
430     $cfg->{_i} = 1;
431     for (@cfg) {
432     gtk_add_cfg_field ($t, $cfg, $_->[0], $_->[1], $::CFG->{$_->[1]});
433     }
434    
435     $vb->pack_start (my $hb = Gtk2::HBox->new, 0, 0, 0);
436     $hb->pack_start (my $cb = Gtk2::Button->new ("save"), 1, 1, 5);
437     $cb->signal_connect (clicked => sub {
438     for (keys %$cfg) {
439     $::CFG->{$_} = $cfg->{$_}
440     if $_ ne '_i';
441     }
442 root 1.67 CFClient::write_cfg "$CFrossfire::VARDIR/pclientrc";
443 elmex 1.23 });
444     $hb->pack_start (my $cb = Gtk2::Button->new ("login"), 1, 1, 5);
445     $cb->signal_connect (clicked => sub {
446     for (keys %$cfg) {
447     $::CFG->{$_} = $cfg->{$_}
448     if $_ ne '_i';
449     }
450     my $cb = $events{login} || sub {};
451     $cb->($::CFG->{user}, $::CFG->{password});
452     });
453     $hb->pack_start (my $cb = Gtk2::Button->new ("logout"), 1, 1, 5);
454     $cb->signal_connect (clicked => sub {
455 root 1.50 my $cb = $events{logout} || sub {};
456 elmex 1.23 $cb->();
457     });
458     $hb->pack_start (my $cb = Gtk2::Button->new ("quit"), 1, 1, 5);
459     $cb->signal_connect (clicked => sub { $w->destroy });
460    
461     $w->show_all;
462    
463     $w->signal_connect (destroy => sub { Gtk2->main_quit });
464     }
465    
466    
467 root 1.1 #############################################################################
468    
469 root 1.24 SDL::Init SDL_INIT_EVERYTHING;
470 elmex 1.20
471 root 1.75 @SDL_MODES = reverse map [SDL::RectW ($_), SDL::RectH ($_)],
472     @{ SDL::ListModes 0, SDL_FULLSCREEN|SDL_HWSURFACE };
473    
474 root 1.67 CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
475 elmex 1.10
476 root 1.13 $CFG ||= {
477     width => 640,
478     height => 480,
479 root 1.82 fullscreen => 0,
480     sdl_mode => 0,
481 elmex 1.47 mapsize => 100,
482 root 1.13 host => "crossfire.schmorp.de",
483     port => 13327,
484     };
485 elmex 1.12
486 root 1.65 {
487 root 1.67 my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf);
488 root 1.65
489 root 1.67 CFClient::add_font $_ for @fonts;
490     CFClient::set_font $fonts[0];
491 root 1.65 }
492 root 1.40
493 root 1.24 $FACECACHE = eval { Crossfire::load_ref "$Crossfire::VARDIR/pclient.faces" } || {};
494    
495 root 1.84 init_screen;
496 root 1.1
497 root 1.13 main Gtk2;
498 root 1.19
499 root 1.68 Crossfire::save_ref $FACECACHE, "$Crossfire::VARDIR/pclient.faces";
500 root 1.82