ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/pclient
Revision: 1.173
Committed: Mon Apr 24 06:05:36 2006 UTC (18 years, 1 month ago) by root
Branch: MAIN
Changes since 1.172: +73 -13 lines
Log Message:
misc improvements

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.87 use Time::HiRes 'time';
7     use Event;
8 root 1.13
9 elmex 1.11 use Crossfire;
10 root 1.2 use Crossfire::Protocol;
11    
12 root 1.116 use Compress::LZF;
13    
14 root 1.67 use CFClient;
15 root 1.72 use CFClient::UI;
16 root 1.141 use CFClient::MapWidget;
17 elmex 1.10
18 root 1.63 our $VERSION = '0.1';
19    
20 root 1.96 my $MAX_FPS = 60;
21 root 1.90 my $MIN_FPS = 5; # unused as of yet
22 root 1.63
23 root 1.112 our $META_SERVER = "crossfire.real-time.com:13326";
24    
25 root 1.116 our $FACEMAP;
26     our $TILECACHE;
27     our $MAPCACHE;
28 root 1.19
29 root 1.87 our $LAST_REFRESH;
30     our $NOW;
31    
32 elmex 1.10 our $CFG;
33 root 1.13 our $CONN;
34 root 1.85 our $FAST; # fast, low-quality mode, possibly useful for software-rendering
35 root 1.2
36 root 1.75 our @SDL_MODES;
37 root 1.30 our $WIDTH;
38     our $HEIGHT;
39     our $FULLSCREEN;
40 root 1.99 our $FONTSIZE;
41 root 1.30
42 root 1.168 our $FONT_PROP;
43     our $FONT_FIXED;
44    
45 root 1.95 our $MAP;
46 root 1.69 our $MAPWIDGET;
47 root 1.112 our $BUTTONBAR;
48     our $LOGVIEW;
49     our $CONSOLE;
50     our $METASERVER;
51 root 1.57
52 root 1.173 our $FLOORBOX;
53 elmex 1.125 our $GAUGES;
54 elmex 1.154 our $STATWIDS;
55 elmex 1.125
56 root 1.86 our $SDL_ACTIVE;
57 root 1.13 our %SDL_CB;
58 root 1.18
59 root 1.134 our $SDL_MIXER;
60     our @SOUNDS; # event => file mapping
61     our %AUDIO_CHUNKS; # audio files
62    
63 root 1.30 our $ALT_ENTER_MESSAGE;
64 root 1.51 our $STATUS_LINE;
65 root 1.64 our $DEBUG_STATUS;
66 root 1.30
67 root 1.82 sub status {
68     $STATUS_LINE->set_text ($_[0]);
69 root 1.128 $STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h});
70 root 1.82 }
71    
72     sub debug {
73     $DEBUG_STATUS->set_text ($_[0]);
74 root 1.128 $DEBUG_STATUS->move ($WIDTH - $DEBUG_STATUS->{w}, 0, $DEBUG_STATUS->{w}, $DEBUG_STATUS->{h});
75 root 1.82 }
76    
77 root 1.84 sub start_game {
78 root 1.85 status "logging in...";
79    
80 root 1.106 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
81 root 1.84
82 root 1.116 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
83    
84 root 1.95 $MAP = new CFClient::Map $mapsize, $mapsize;
85 root 1.112
86     my ($host, $port) = split /:/, $CFG->{host};
87 root 1.95
88 root 1.84 $CONN = new conn
89 root 1.112 host => $host,
90     port => $port || 13327,
91 root 1.84 user => $CFG->{user},
92     pass => $CFG->{password},
93     mapw => $mapsize,
94     maph => $mapsize,
95     ;
96    
97 root 1.85 status "login successful";
98    
99 root 1.84 CFClient::lowdelay fileno $CONN->{fh};
100     }
101    
102     sub stop_game {
103     undef $CONN;
104     }
105    
106 root 1.111 sub client_setup {
107 root 1.99 my $dialog = new CFClient::UI::FancyFrame
108 root 1.150 title => "Client Setup",
109 root 1.81 child => (my $vbox = new CFClient::UI::VBox);
110     $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
111    
112 root 1.140 $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
113 root 1.81 $table->add (1, 0, my $hbox = new CFClient::UI::HBox);
114    
115     $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);
116 root 1.150 $hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
117 root 1.81
118     $mode_slider->connect (changed => sub {
119     my ($self, $value) = @_;
120    
121     $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
122     $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
123     });
124     $mode_slider->emit (changed => $mode_slider->{range}[0]);
125 root 1.82
126 elmex 1.158 my $row = 1;
127    
128     $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
129 elmex 1.166 $table->add (1, $row++, new CFClient::UI::CheckBox
130     state => $CFG->{fullscreen},
131     tooltip => "Bring the client into fullscreen mode",
132     connect_changed => sub {
133     my ($self, $value) = @_;
134     $CFG->{fullscreen} = $value;
135     }
136     );
137 root 1.85
138 elmex 1.158 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
139 root 1.163 $table->add (1, $row++, new CFClient::UI::CheckBox
140     state => $CFG->{fast},
141     tooltip => "Lower the visual quality considerably to speed up rendering.",
142     connect_changed => sub {
143     my ($self, $value) = @_;
144     $CFG->{fast} = $value;
145     }
146     );
147 root 1.89
148 root 1.169 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
149     $table->add (1, $row++, new CFClient::UI::Slider
150     range => [$CFG->{map_scale}, 0.25, 2, 0.05],
151     tooltip => "Enlarge or shrink the displayed map",
152     connect_changed => sub {
153     my ($self, $value) = @_;
154     $CFG->{map_scale} = 0.05 * int $value / 0.05;
155     }
156     );
157    
158 elmex 1.158 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
159 root 1.163 $table->add (1, $row++, new CFClient::UI::CheckBox
160     state => $CFG->{fow_enable},
161     tooltip => "Fog-of-War marks areas that cannot be seen by the player",
162     connect_changed => sub {
163     my ($self, $value) = @_;
164     $CFG->{fow_enable} = $value;
165     }
166     );
167 root 1.97
168 elmex 1.158 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
169 root 1.163 $table->add (1, $row++, new CFClient::UI::Slider
170     range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001],
171     tooltip => "The higher the intensity, the lighter the Fog-of-War color",
172     connect_changed => sub {
173     my ($self, $value) = @_;
174     $CFG->{fow_intensity} = $value;
175     }
176     );
177 root 1.90
178 elmex 1.158 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
179 root 1.163 $table->add (1, $row++, new CFClient::UI::CheckBox
180     state => $CFG->{fow_smooth},
181     tooltip => "Smooth the Fog-of-War a bit to make it more realistic",
182     connect_changed => sub {
183     my ($self, $value) = @_;
184     $CFG->{fow_smooth} = $value;
185     status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;
186     }
187     );
188 root 1.91
189 elmex 1.158 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
190 root 1.163 $table->add (1, $row++, new CFClient::UI::Slider
191     range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1],
192     tooltip => "The font size used by most GUI elements",
193     connect_changed => sub {
194     $CFG->{gui_fontsize} = 0.1 * int $_[1] * 10;
195 root 1.140 # $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
196 root 1.163 }
197     );
198 root 1.140
199 elmex 1.158 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize");
200 root 1.163 $table->add (1, $row++, new CFClient::UI::Slider
201     range => [$CFG->{log_fontsize}, 0.5, 2, 0.1],
202     tooltip => "The font size used by the server log window only",
203     connect_changed => sub {
204     $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10);
205     }
206     );
207 root 1.105
208 elmex 1.158 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
209 root 1.163
210     $table->add (1, $row++, new CFClient::UI::Slider
211     range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1],
212     tooltip => "The font size used by the statistics window only",
213     connect_changed => sub {
214     $CFG->{stat_fontsize} = 0.1 * int $_[1] * 10;
215     &set_stats_window_fontsize;
216     }
217     );
218 elmex 1.157
219 root 1.163 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
220     $table->add (1, $row++, new CFClient::UI::Slider
221     range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],
222     tooltip => "Adjust the size of the stats gauges at the bottom right",
223     connect_changed => sub {
224     $CFG->{gauge_size} = $_[1];
225 root 1.164 my $h = int $HEIGHT * $CFG->{gauge_size};
226 root 1.163 $GAUGES->{win}->set_size ($WIDTH, $h);
227 root 1.164 $GAUGES->{win}->move (0, $HEIGHT - $h);
228 root 1.163 }
229     );
230 elmex 1.158
231     $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
232 root 1.163 $table->add (1, $row++, new CFClient::UI::Slider
233     range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1],
234 elmex 1.166 tooltip => "Adjusts the fontsize of the gauges at the bottom right",
235 root 1.163 connect_changed => sub {
236     $CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10;
237     &set_gauge_window_fontsize;
238     }
239     );
240 elmex 1.158
241 root 1.163 $table->add (1, $row++, new CFClient::UI::Button
242     expand => 1, align => 0, text => "Apply",
243 root 1.168 tooltip => "Apply the video settings",
244 root 1.163 connect_activate => sub {
245     video_shutdown ();
246     video_init ();
247     }
248     );
249 root 1.111
250 elmex 1.158 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
251 root 1.163 $table->add (1, $row++, new CFClient::UI::CheckBox
252     state => $CFG->{audio_enable},
253     tooltip => "If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
254     connect_changed => sub {
255     $CFG->{audio_enable} = $_[1];
256     }
257     );
258 root 1.140 # $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
259     # $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub {
260     # $CFG->{effects_volume} = $_[1];
261     # });
262 elmex 1.158 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
263     $table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
264 root 1.163 $hbox->add (new CFClient::UI::CheckBox
265     expand => 1, state => $CFG->{bgm_enable},
266     tooltip => "Enable background music playing",
267     connect_changed => sub {
268     $CFG->{bgm_enable} = $_[1];
269     }
270     );
271     $hbox->add (new CFClient::UI::Slider
272     expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1],
273     tooltip => "The volume of the background music",
274     connect_changed => sub {
275     $CFG->{bgm_volume} = $_[1];
276     CFClient::MixMusic::volume $_[1] * 128;
277     }
278     );
279 root 1.140
280 root 1.163 $table->add (1, $row++, new CFClient::UI::Button
281     expand => 1, align => 0, text => "Apply",
282 root 1.168 tooltip => "Apply the audio settings",
283 root 1.163 connect_activate => sub {
284     audio_shutdown ();
285     audio_init ();
286     }
287     );
288 elmex 1.137
289 root 1.111 $dialog
290     }
291    
292 elmex 1.157 sub set_stats_window_fontsize {
293 elmex 1.158 for (values %{$STATWIDS}) {
294 elmex 1.157 $_->set_fontsize ($::CFG->{stat_fontsize});
295     }
296     }
297    
298 elmex 1.158 sub set_gauge_window_fontsize {
299     for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
300     $_->set_fontsize ($::CFG->{gauge_fontsize});
301     }
302 root 1.169
303     # local $GAUGES->{win}{parent};#d#
304     # use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D;
305 elmex 1.158 }
306    
307     sub make_gauge_window {
308     my $gh = int ($HEIGHT * $CFG->{gauge_size});
309 elmex 1.161 # my $gw = int ($WIDTH * $CFG->{gauge_w_size});
310 elmex 1.158
311     my $win = new CFClient::UI::Frame (
312 root 1.169 y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh
313 elmex 1.158 );
314 root 1.173 $win->add (my $hbox = new CFClient::UI::HBox
315     children => [
316     (new CFClient::UI::HBox expand => 1),
317     ($FLOORBOX = new CFClient::UI::VBox),
318     (my $vbox = new CFClient::UI::VBox),
319     ],
320     );
321 elmex 1.158
322 root 1.173 $vbox->add (new CFClient::UI::HBox
323     expand => 1,
324     children => [
325     (new CFClient::UI::Empty expand => 1),
326     (my $hb = new CFClient::UI::HBox),
327     ],
328     );
329 elmex 1.161
330 root 1.172 $hb->add (my $hg = new CFClient::UI::Gauge type => 'hp',
331     tooltip => "Health points - depletes when you get wounded, refills when you heal or idle");
332     $hb->add (my $mg = new CFClient::UI::Gauge type => 'mana',
333     tooltip => "Spell points - deplete when you cast wizard spells, refills when you idle");
334     $hb->add (my $gg = new CFClient::UI::Gauge type => 'grace',
335     tooltip => "Grace points - deplete when you cast priest spells, refills when you pray");
336     $hb->add (my $fg = new CFClient::UI::Gauge type => 'food',
337     tooltip => "Food - depletes with time, faster when you heal or build mana, refills when you eat healthy food");
338    
339 root 1.173 $vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
340 root 1.172 tooltip => "Experience points and level - increases when you kill monsters or successfully use skills");
341 root 1.173 $vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
342 root 1.172 tooltip => "Ranged attack - how you attack when you press shift-cursor (spell, skill, weapon etc.)");
343 elmex 1.158
344     $GAUGES = {
345 elmex 1.166 exp => $exp, win => $win, range => $rng,
346 elmex 1.158 food => $fg, mana => $mg, hp => $hg, grace => $gg
347     };
348 root 1.169
349     &set_gauge_window_fontsize;
350    
351 elmex 1.158 $win
352     }
353    
354 elmex 1.154 sub make_stats_window {
355 elmex 1.156 my $tgw = new CFClient::UI::FancyFrame (x => $WIDTH * 2/5, y => 0, title => "Stats");
356 root 1.155
357     $tgw->add (my $vb = new CFClient::UI::VBox);
358 root 1.168 $vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);
359     $vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1);
360 elmex 1.156
361     $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
362    
363     $hb->add (my $tbl = new CFClient::UI::Table expand => 1);
364    
365 root 1.168 $tbl->add (0, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
366     $tbl->add (0, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
367     $tbl->add (0, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
368     $tbl->add (0, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
369     $tbl->add (0, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
370     $tbl->add (0, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
371     $tbl->add (0, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
372    
373     $tbl->add (1, 0, $STATWIDS->{st_str_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Str");
374     $tbl->add (1, 1, $STATWIDS->{st_dex_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Dex");
375     $tbl->add (1, 2, $STATWIDS->{st_con_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Con");
376     $tbl->add (1, 3, $STATWIDS->{st_int_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Int");
377     $tbl->add (1, 4, $STATWIDS->{st_wis_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Wis");
378     $tbl->add (1, 5, $STATWIDS->{st_pow_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Pow");
379     $tbl->add (1, 6, $STATWIDS->{st_cha_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Cha");
380    
381     $tbl->add (2, 0, $STATWIDS->{st_wc} = new CFClient::UI::Label valign => 0, align => +1, template => "-120");
382     $tbl->add (2, 1, $STATWIDS->{st_ac} = new CFClient::UI::Label valign => 0, align => +1, template => "-120");
383     $tbl->add (2, 2, $STATWIDS->{st_dam} = new CFClient::UI::Label valign => 0, align => +1, template => "120");
384     $tbl->add (2, 3, $STATWIDS->{st_arm} = new CFClient::UI::Label valign => 0, align => +1, template => "120");
385     $tbl->add (2, 4, $STATWIDS->{st_spd} = new CFClient::UI::Label valign => 0, align => +1, template => "10.54");
386     $tbl->add (2, 5, $STATWIDS->{st_wspd} = new CFClient::UI::Label valign => 0, align => +1, template => "9");
387    
388     $tbl->add (3, 0, $STATWIDS->{st_wc_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Wc");
389     $tbl->add (3, 1, $STATWIDS->{st_ac_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Ac");
390     $tbl->add (3, 2, $STATWIDS->{st_dam_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Dam");
391     $tbl->add (3, 3, $STATWIDS->{st_arm_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Arm");
392     $tbl->add (3, 4, $STATWIDS->{st_spd_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Sp");
393     $tbl->add (3, 5, $STATWIDS->{st_wspd_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "WSp");
394 root 1.155
395 elmex 1.158 $hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
396 root 1.155
397 elmex 1.156 my $row = 0;
398     my $col = 0;
399 root 1.155
400 elmex 1.166 my %resist_names = (
401     slow => "Slow",
402     holyw => "Holy Word",
403     conf => "Confusion",
404     fire => "Fire",
405     depl => "Depletion",
406     magic => "Magic",
407     drain => "Draining",
408     acid => "Acid",
409     pois => "Poison",
410     para => "Paralysation",
411     deat => "Death",
412     phys => "Physical",
413     blind => "Blind",
414     fear => "Fear",
415     tund => "Turn undead",
416     elec => "Electricity",
417     cold => "Cold",
418     ghit => "Ghost hit",
419     );
420 elmex 1.156 for (qw/slow holyw conf fire depl magic
421     drain acid pois para deat phys
422     blind fear tund elec cold ghit/)
423     {
424 root 1.164 $tbl2->add ($col, $row,
425 elmex 1.156 $STATWIDS->{"res_$_"} =
426 root 1.168 new CFClient::UI::Label
427     template => "-100%",
428     align => +1,
429     valign => 0,
430     tooltip => $resist_names{$_}
431     );
432     $tbl2->add ($col + 1, $row, new CFClient::UI::Image
433     can_hover => 1,
434     can_events => 1,
435     image => "ui/resist/resist_$_.png",
436     tooltip => $resist_names{$_}
437 elmex 1.156 );
438    
439     $row++;
440     if ($row % 6 == 0) {
441     $col += 2;
442     $row = 0;
443     }
444     }
445    
446 elmex 1.157 &set_stats_window_fontsize;
447 elmex 1.156 update_stats_window ({});
448 root 1.155
449 elmex 1.154 $tgw
450     }
451    
452 root 1.169 sub formsep {
453     reverse join ",", grep length, split /(...)/, reverse $_[0] * 1
454     }
455    
456 elmex 1.154 sub update_stats_window {
457     my ($stats) = @_;
458    
459 elmex 1.156 # i love text protocols!!!
460 root 1.169 my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;
461     my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;
462     my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;
463     my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;
464     my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;
465 elmex 1.156 my $fo_m = 999;
466 root 1.169 my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;
467     my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;
468 elmex 1.156
469     $GAUGES->{hp} ->set_value ($hp, $hp_m);
470     $GAUGES->{mana} ->set_value ($sp, $sp_m);
471     $GAUGES->{food} ->set_value ($fo, $fo_m);
472     $GAUGES->{grace} ->set_value ($gr, $gr_m);
473 root 1.169 $GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})
474     . " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");
475     my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};
476 elmex 1.159 $rng =~ s/^Range: //; # thank you so much dear server
477     $GAUGES->{range} ->set_text ("Rng: " . $rng);
478 root 1.169 my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};
479 elmex 1.165 $title =~ s/^Player: //;
480     $STATWIDS->{title} ->set_text ("Title: " . $title);
481 elmex 1.156
482 root 1.169 $STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});
483     $STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});
484     $STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});
485     $STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});
486     $STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});
487     $STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});
488     $STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});
489     $STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});
490     $STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});
491     $STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});
492     $STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});
493     $STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});
494     $STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP});
495 elmex 1.156
496     my %tbl = (
497     phys => 100,
498     magic => 101,
499     fire => 102,
500     elec => 103,
501     cold => 104,
502     conf => 105,
503     acid => 106,
504     drain => 107,
505     ghit => 108,
506     pois => 109,
507     slow => 110,
508     para => 111,
509     tund => 112,
510     fear => 113,
511 elmex 1.165 depl => 113,
512 elmex 1.156 deat => 115,
513     holyw => 116,
514     blind => 117
515 elmex 1.154 );
516 elmex 1.156
517     for (keys %tbl) {
518     $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});
519     }
520    
521 elmex 1.154 }
522    
523 root 1.112 sub metaserver_dialog {
524     my $dialog = new CFClient::UI::FancyFrame
525 root 1.150 title => "Metaserver",
526 root 1.112 child => (my $vbox = new CFClient::UI::VBox);
527    
528     $vbox->add ($dialog->{table} = new CFClient::UI::Table);
529    
530     $dialog
531     }
532    
533     sub update_metaserver {
534 root 1.114 my ($HOST) = @_;
535    
536 root 1.112 status "fetching metaserver list...";
537    
538     my $buf;
539    
540     my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
541    
542     Event->io (fd => $fh, poll => 'r', cb => sub {
543     my $res = sysread $fh, $buf, 8192, length $buf;
544    
545     if (!defined $res) {
546     $_[0]->w->cancel;
547     status "metaserver: $!";
548     } elsif ($res == 0) {
549     $_[0]->w->cancel;
550     status "server list retrieved";
551 root 1.113
552     my $table = $METASERVER->{table};
553    
554     $table->clear;
555    
556 root 1.114 my @col = qw(Use #Users Host Uptime Version Description);
557 root 1.113 $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
558     for 0 .. $#col;
559    
560     my @align = qw(1 0 1 1 -1);
561    
562     my $y = 0;
563 root 1.114 for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
564 root 1.113 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;
565    
566     for ($desc) {
567     s/<br>/\n/gi;
568     s/<li>/\n· /gi;
569     s/<.*?>//sgi;
570     s/&/&amp;/g;
571     s/</&lt;/g;
572     s/>/&gt;/g;
573     }
574    
575     $uptime = sprintf "%dd %02d:%02d:%02d",
576     (int $m->[8] / 86400),
577     (int $m->[8] / 3600) % 24,
578     (int $m->[8] / 60) % 60,
579     $m->[8] % 60;
580    
581     $m = [$users, $host, $uptime, $version, $desc];
582    
583     $y++;
584 root 1.114
585     $table->add (0, $y, new CFClient::UI::VBox children => [
586     (new CFClient::UI::Button text => " ", connect_activate => sub {
587     $HOST->set_text ($CFG->{host} = $host);
588     }),
589     (new CFClient::UI::Empty expand => 1),
590     ]);
591    
592 root 1.140 $table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => 0.8)
593 root 1.113 for 0 .. $#$m;
594     }
595 root 1.112 }
596     });
597     }
598    
599 root 1.111 sub server_setup {
600     my $dialog = new CFClient::UI::FancyFrame
601 root 1.150 title => "Server Setup",
602 root 1.111 child => (my $vbox = new CFClient::UI::VBox);
603 root 1.81
604 root 1.82 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
605 root 1.141 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
606 root 1.112
607     {
608     $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
609    
610 elmex 1.166 $vbox->add (
611     my $HOST = new CFClient::UI::Entry
612     expand => 1,
613     text => $CFG->{host},
614     tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
615     connect_changed => sub {
616     my ($self, $value) = @_;
617     $CFG->{host} = $value;
618     }
619     );
620 root 1.112
621     $METASERVER = metaserver_dialog;
622 elmex 1.101
623 elmex 1.166 $vbox->add (new CFClient::UI::Flopper
624     expand => 1,
625     text => "Metaserver",
626     other => $METASERVER,
627 root 1.167 tooltip => "Show a list of avaible crossfire servers",
628 elmex 1.166 connect_open => sub {
629     update_metaserver $HOST;
630     }
631     );
632 root 1.112 }
633 root 1.81
634 root 1.141 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
635 elmex 1.166 $table->add (1, 4, new CFClient::UI::Entry
636     text => $CFG->{user},
637     tooltip => "The name of your character on the server",
638     connect_changed => sub {
639     my ($self, $value) = @_;
640     $CFG->{user} = $value;
641     }
642     );
643 root 1.81
644 root 1.141 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
645 elmex 1.166 $table->add (1, 5, new CFClient::UI::Entry
646     text => $CFG->{password},
647     hidden => 1,
648     tooltip => "The password for your character",
649     connect_changed => sub {
650     my ($self, $value) = @_;
651     $CFG->{password} = $value;
652     }
653     );
654 elmex 1.101
655 root 1.141 $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");
656 elmex 1.166 $table->add (1, 6, my $saycmd = new CFClient::UI::Entry
657     text => $CFG->{say_command},
658     tooltip => "This is the command that will be used if you write a line in the message window entry. "
659     ."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
660 root 1.173 ."But you could also set it to 'tell &lt;playername&gt;' to only chat with that user.",
661 elmex 1.166 connect_changed => sub {
662     my ($self, $value) = @_;
663     $CFG->{say_command} = $value;
664     }
665     );
666 root 1.81
667 root 1.141 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
668 elmex 1.101 $table->add (1, 7, new CFClient::UI::Slider
669 root 1.81 req_w => 100,
670     range => [$CFG->{mapsize}, 10, 100 + 1, 1],
671 elmex 1.166 tooltip => "This is the size of the portion of the map update the server sends you. "
672     ."If you set this to a high value you will be able to see further for example.",
673 root 1.81 connect_changed => sub {
674     my ($self, $value) = @_;
675    
676     $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
677     },
678     );
679    
680 elmex 1.101 $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub {
681 root 1.84 start_game;
682 root 1.82 });
683    
684 root 1.98 $dialog
685 root 1.81 }
686 root 1.58
687 root 1.111 sub message_window {
688 root 1.99 my $window = new CFClient::UI::FancyFrame
689 root 1.150 title => "Messages",
690 root 1.99 border_bg => [1, 1, 1, 0.5],
691     bg => [0.3, 0.3, 0.3, 0.8],
692 root 1.124 user_w => int $::WIDTH / 3,
693     user_h => int $::HEIGHT / 5,
694 root 1.99 child => (my $vbox = new CFClient::UI::VBox);
695    
696 root 1.105 $vbox->add ($LOGVIEW = new CFClient::UI::TextView
697     expand => 1,
698 root 1.168 font => $FONT_FIXED,
699 root 1.105 fontsize => $::CFG->{log_fontsize},
700     );
701    
702 root 1.122 $vbox->add (my $input = new CFClient::UI::Entry
703 elmex 1.118 connect_focus_in => sub {
704     my ($input, $prev_focus) = @_;
705    
706     delete $input->{refocus_map};
707    
708     if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
709     $input->{refocus_map} = 1;
710     }
711     delete $input->{auto_activated};
712     },
713 root 1.116 connect_activate => sub {
714 elmex 1.100 my ($input, $text) = @_;
715     $input->set_text ('');
716    
717     if ($text =~ /^\/(.*)/) {
718 root 1.123 $::CONN->user_send ($1);
719 elmex 1.100 } else {
720 elmex 1.101 my $say_cmd = $::CFG->{say_command} || 'say';
721 root 1.123 $::CONN->user_send ("$say_cmd $text");
722 elmex 1.100 }
723 elmex 1.118 if ($input->{refocus_map}) {
724     delete $input->{refocus_map};
725     $MAPWIDGET->focus_in
726     }
727 root 1.116 },
728     connect_escape => sub {
729 elmex 1.102 $MAPWIDGET->focus_in
730 root 1.116 },
731     );
732 elmex 1.102
733     $CONSOLE = {
734     window => $window,
735     input => $input
736     };
737 root 1.99
738     $window
739     }
740    
741 root 1.89 sub sdl_init {
742 root 1.145 CFClient::SDL_Init
743 root 1.89 and die "SDL::Init failed!\n";
744     }
745    
746 root 1.134 sub video_init {
747 root 1.89 sdl_init;
748    
749 root 1.84 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
750     $FULLSCREEN = $CFG->{fullscreen};
751 root 1.89 $FAST = $CFG->{fast};
752 root 1.84
753 root 1.145 CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
754     or die "SDL_SetVideoMode failed!\n";
755 root 1.2
756 root 1.86 $SDL_ACTIVE = 1;
757    
758 root 1.87 $LAST_REFRESH = time - 0.01;
759 root 1.45
760 root 1.67 CFClient::gl_init;
761 root 1.30
762 root 1.140 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
763 root 1.39
764 root 1.52 #############################################################################
765    
766 root 1.99 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100;
767 root 1.140 $DEBUG_STATUS->show;
768 root 1.52
769 root 1.72 $STATUS_LINE = new CFClient::UI::Label
770 root 1.77 padding => 0,
771 root 1.140 y => $HEIGHT - $FONTSIZE * 1.8;
772     $STATUS_LINE->show;
773 root 1.51
774 root 1.72 $ALT_ENTER_MESSAGE = new CFClient::UI::Label
775 root 1.123 padding => 0,
776 root 1.140 fontsize => 0.8,
777 root 1.123 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
778 root 1.140 $ALT_ENTER_MESSAGE->show;
779     $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
780 root 1.30
781 root 1.141 $CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::MapWidget);
782 root 1.69 $MAPWIDGET->focus_in;
783 elmex 1.102 $MAPWIDGET->connect (activate_console => sub {
784 elmex 1.103 my ($mapwidget, $preset) = @_;
785    
786 elmex 1.102 if ($CONSOLE) {
787 elmex 1.118 $CONSOLE->{input}->{auto_activated} = 1;
788 elmex 1.102 $CONSOLE->{input}->focus_in;
789 elmex 1.103
790     if ($preset && $CONSOLE->{input}->get_text eq '') {
791     $CONSOLE->{input}->set_text ($preset);
792     }
793 elmex 1.102 }
794     });
795 root 1.81
796 root 1.111 $CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox);
797    
798     $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
799     $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
800     $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
801    
802 root 1.167 $CFClient::UI::ROOT->add (make_gauge_window); # XXX: this has to be set before make_stats_window as make_stats_window calls update_stats_window which updated the gauges also X-D
803     $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);
804    
805 root 1.111 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
806     CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
807     status "Configuration Saved";
808     });
809 root 1.98
810 root 1.119 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
811 root 1.2 }
812    
813 root 1.134 sub video_shutdown {
814 root 1.111 $CFClient::UI::ROOT->{children} = [];
815 root 1.86 undef $SDL_ACTIVE;
816 root 1.134 }
817    
818 root 1.153 my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
819 root 1.135 my $bgmusic;#TODO#hack#d#
820    
821 root 1.153 sub audio_music_finished {
822     return unless $CFG->{bgm_enable};
823    
824     # TODO: hack, do play loop and mood music
825     $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
826     $bgmusic->play (0);
827    
828     push @bgmusic, shift @bgmusic;
829     }
830    
831 root 1.134 sub audio_init {
832 root 1.139 if ($CFG->{audio_enable}) {
833 root 1.134 if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") {
834 root 1.146 $SDL_MIXER = !CFClient::Mix_OpenAudio;
835     CFClient::Mix_AllocateChannels 8;
836 root 1.149 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
837 root 1.134
838 root 1.153 audio_music_finished;
839 root 1.135
840 root 1.134 while (<$fh>) {
841     next if /^\s*#/;
842     next if /^\s*$/;
843    
844     my ($file, $volume, $event) = split /\s+/, $_, 3;
845    
846     push @SOUNDS, "$volume,$file";
847    
848     $AUDIO_CHUNKS{"$volume,$file"} ||= do {
849 root 1.146 my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
850 root 1.134 $chunk->volume ($volume * 128 / 100);
851     $chunk
852     };
853     }
854     } else {
855     status "unable to open sound config: $!";
856     }
857     }
858     }
859    
860     sub audio_shutdown {
861 root 1.146 CFClient::Mix_CloseAudio if $SDL_MIXER;
862 root 1.134 undef $SDL_MIXER;
863     @SOUNDS = ();
864     %AUDIO_CHUNKS = ();
865 root 1.62 }
866    
867 root 1.87 my %animate_object;
868     my $animate_timer;
869    
870     my $want_refresh;
871     my $can_refresh;
872    
873     my $fps = 9;
874    
875 root 1.30 sub force_refresh {
876 root 1.87 $fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05;
877     debug sprintf "%3.2f", $fps;
878    
879 root 1.96 $want_refresh = 0;
880 root 1.87 $can_refresh = 0;
881    
882 root 1.111 $CFClient::UI::ROOT->draw;
883 root 1.1
884 root 1.148 CFClient::SDL_GL_SwapBuffers;
885 root 1.87
886     $LAST_REFRESH = $NOW;
887 root 1.1 }
888    
889 root 1.87 my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
890     $NOW = time;
891    
892 root 1.147 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
893     for CFClient::SDL_PollEvent;
894 root 1.87
895     if (%animate_object) {
896     $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
897     $want_refresh++;
898     }
899    
900     if ($want_refresh) {
901     force_refresh;
902     } else {
903     $can_refresh = 1;
904     }
905     });
906 root 1.64
907 root 1.30 sub refresh {
908 root 1.87 $want_refresh++;
909 root 1.30 }
910    
911 root 1.45 sub animation_start {
912     my ($widget) = @_;
913 root 1.87 $animate_object{$widget} = $widget;
914 root 1.45 }
915    
916     sub animation_stop {
917     my ($widget) = @_;
918 root 1.87 delete $animate_object{$widget};
919 root 1.45 }
920    
921 root 1.2 @conn::ISA = Crossfire::Protocol::;
922 root 1.1
923 elmex 1.125 sub conn::stats_update {
924     my ($self, $stats) = @_;
925    
926 elmex 1.154 update_stats_window ($stats);
927 elmex 1.125 }
928    
929 root 1.89 sub conn::user_send {
930 root 1.88 my ($self, $command) = @_;
931    
932 root 1.123 $self->send_command ($command);
933 root 1.88 status $command;
934     }
935    
936 root 1.119 sub conn::map_scroll {
937     my ($self, $dx, $dy) = @_;
938    
939     $MAP->scroll ($dx, $dy);
940     }
941    
942 root 1.94 sub conn::feed_map1a {
943     my ($self, $data) = @_;
944    
945 root 1.95 # $self->Crossfire::Protocol::feed_map1a ($data);
946 root 1.1
947 root 1.95 $MAP->map1a_update ($data);
948 root 1.69 $MAPWIDGET->update;
949 root 1.1 }
950    
951 root 1.116 sub conn::flush_map {
952     my ($self) = @_;
953    
954     my $map_info = delete $self->{map_info}
955     or return;
956    
957     my ($hash, $x, $y, $w, $h) = @$map_info;
958    
959     my $data = $MAP->get_rect ($x, $y, $w, $h);
960     $MAPCACHE->put ($hash => Compress::LZF::compress $data);
961 root 1.152 #warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
962 root 1.116 }
963 root 1.1
964 root 1.2 sub conn::map_clear {
965 root 1.1 my ($self) = @_;
966    
967 root 1.116 $self->flush_map;
968 root 1.150 delete $self->{neigh_map};
969 root 1.116
970 root 1.95 $MAP->clear;
971 root 1.1 }
972    
973 root 1.116
974 root 1.119 sub conn::load_map($$$) {
975     my ($self, $hash, $x, $y) = @_;
976 root 1.115
977 root 1.116 if (defined (my $data = $MAPCACHE->get ($hash))) {
978     $data = Compress::LZF::decompress $data;
979 root 1.152 #warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
980 root 1.116 for my $id ($MAP->set_rect ($x, $y, $data)) {
981     my $data = $TILECACHE->get ($id)
982     or next;
983    
984     $self->set_texture ($id => $data);
985     }
986     }
987 root 1.115 }
988    
989 root 1.152 # this method does a "flood fill" into every tile direction
990     # it assumes that tiles are arranged in a rectangular grid,
991     # i.e. a map is the same as the left of the right map etc.
992     # failure to comply are harmless and result in display errors
993     # at worst.
994 root 1.119 sub conn::flood_fill {
995 root 1.150 my ($self, $gx, $gy, $path, $hash, $flags) = @_;
996 root 1.119
997 root 1.121 # the server does not allow map paths > 6
998 root 1.120 return if 6 <= length $path;
999    
1000 root 1.150 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
1001    
1002     for (
1003     [1, 0, -1],
1004     [2, 1, 0],
1005     [3, 0, 1],
1006     [4, -1, 0],
1007     ) {
1008     my ($tile, $dx, $dy) = @$_;
1009    
1010     my $gx = $gx + $dx;
1011     my $gy = $gy + $dy;
1012    
1013 root 1.119 next unless $flags & (1 << ($tile - 1));
1014 root 1.150 next if $self->{neigh_grid}{$gx, $gy}++;
1015 root 1.119
1016 root 1.150 my $neigh = $self->{neigh_map}{$hash} ||= [];
1017     if (my $info = $neigh->[$tile]) {
1018     my ($flags, $x, $y, $w, $h, $hash) = @$info;
1019 root 1.119
1020 root 1.150 $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
1021     if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1022    
1023     } else {
1024     $self->send_mapinfo ("spatial $path$tile", sub {
1025     my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
1026 root 1.119
1027 root 1.150 return if $mode ne "spatial";
1028 root 1.119
1029 root 1.150 $x += $MAP->ox;
1030     $y += $MAP->oy;
1031    
1032     $self->load_map ($hash, $x, $y)
1033     unless $self->{neigh_map}{$hash}[5]++;#d#
1034 root 1.119
1035 root 1.150 $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
1036 root 1.119
1037 root 1.150 $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
1038     if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1039     });
1040     }
1041 root 1.119 }
1042     }
1043    
1044     sub conn::map_change {
1045     my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
1046    
1047     $self->flush_map;
1048    
1049     my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
1050    
1051     my $mapmapw = 250;
1052     my $mapmaph = 250;
1053 root 1.150
1054     $self->{neigh_rect} = [
1055 root 1.152 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
1056     $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
1057 root 1.150 ];
1058 root 1.119
1059 root 1.150 delete $self->{neigh_grid};
1060     $self->flood_fill (0, 0, "", $hash, $flags);
1061 root 1.119
1062     $x += $ox;
1063     $y += $oy;
1064    
1065     $self->{map_info} = [$hash, $x, $y, $w, $h];
1066    
1067 elmex 1.158 my $map = $self->{map_info}[0];
1068     $map =~ s/^.*?\/([^\/]+)$/\1/;
1069     $STATWIDS->{map}->set_text ("Map: " . $map);
1070 elmex 1.157
1071 root 1.119 $self->load_map ($hash, $x, $y);
1072     }
1073    
1074 root 1.19 sub conn::face_find {
1075 root 1.116 my ($self, $facenum, $face) = @_;
1076    
1077     my $hash = "$face->{chksum},$face->{name}";
1078    
1079     my $id = $FACEMAP->get ($hash);
1080    
1081     unless ($id) {
1082     # create new id for face
1083     # i love transactions
1084     for (1..100) {
1085     my $txn = $CFClient::DB_ENV->txn_begin;
1086     my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
1087     if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
1088     $id++;
1089     if ($FACEMAP->put (id => $id) == 0
1090     && $FACEMAP->put ($hash => $id) == 0) {
1091     $txn->txn_commit;
1092    
1093     goto gotid;
1094     }
1095     }
1096     $txn->abort;
1097     }
1098 root 1.19
1099 root 1.116 CFClient::fatal "maximum number of transaction retries reached - database problems?";
1100     }
1101 root 1.114
1102 root 1.116 gotid:
1103     $face->{id} = $id;
1104     $MAP->set_face ($facenum => $id);
1105 root 1.173 $self->{faceid}[$facenum] = $id;#d#
1106 root 1.116 $TILECACHE->get ($id)
1107 root 1.19 }
1108    
1109 root 1.2 sub conn::face_update {
1110 root 1.95 my ($self, $facenum, $face) = @_;
1111 root 1.19
1112 root 1.116 $TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
1113    
1114     $self->set_texture ($face->{id} => delete $face->{image});
1115     }
1116 root 1.1
1117 root 1.116 sub conn::set_texture {
1118     my ($self, $id, $data) = @_;
1119 root 1.95
1120 root 1.116 $self->{texture}[$id] ||= do {
1121     my $tex =
1122     new_from_image CFClient::Texture
1123 root 1.173 $data, minify => 1, mipmap => 1;
1124 root 1.116
1125     $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1126     $MAPWIDGET->update;
1127    
1128     $tex
1129     };
1130 root 1.1 }
1131    
1132 root 1.134 sub conn::sound_play {
1133     my ($self, $x, $y, $soundnum, $type) = @_;
1134    
1135 root 1.139 $SDL_MIXER
1136     or return;
1137    
1138 root 1.134 my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
1139     or return;
1140    
1141 root 1.146 $chunk->play;
1142 root 1.143 # warn "sound $x,$y,$soundnum,$type\n";#d#
1143 root 1.134 }
1144    
1145 root 1.170 my $LAST_QUERY; # server is stupid, stupid, stupid
1146    
1147 root 1.33 sub conn::query {
1148     my ($self, $flags, $prompt) = @_;
1149    
1150 root 1.170 $prompt = $LAST_QUERY unless length $prompt;
1151     $LAST_QUERY = $prompt;
1152    
1153     my $dialog = new CFClient::UI::FancyFrame
1154     title => "Query",
1155     child => my $vbox = new CFClient::UI::VBox;
1156    
1157     $vbox->add (new CFClient::UI::Label
1158     max_w => $::WIDTH * 0.4,
1159     text => $prompt);
1160    
1161     if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
1162     $vbox->add (my $hbox = new CFClient::HBox);
1163     $hbox->add (new CFClient::Button
1164     text => "No",
1165     connect_activate => sub {
1166     $self->send ("reply n");
1167     $dialog->destroy;
1168     $MAPWIDGET->focus_in;
1169     }
1170     );
1171     $hbox->add (new CFClient::Button
1172     text => "Yes",
1173     connect_activate => sub {
1174     $self->send ("reply y");
1175     $dialog->destroy;
1176     $MAPWIDGET->focus_in;
1177     },
1178     );
1179    
1180     $dialog->focus_in;
1181    
1182     } elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
1183     $dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
1184     $vbox->add (my $entry = new CFClient::UI::Entry
1185     connect_changed => sub {
1186     $self->send ("reply $_[1]");
1187     $dialog->destroy;
1188     $MAPWIDGET->focus_in;
1189     },
1190     );
1191    
1192     $entry->focus_in;
1193    
1194     } else {
1195     $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
1196    
1197     $vbox->add (my $entry = new CFClient::UI::Entry
1198     $flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
1199     connect_activate => sub {
1200     $self->send ("reply $_[1]");
1201     $dialog->destroy;
1202     $MAPWIDGET->focus_in;
1203     },
1204     );
1205    
1206     $entry->focus_in;
1207     }
1208    
1209     $dialog->show;
1210 root 1.33 }
1211    
1212 root 1.99 sub conn::drawinfo {
1213     my ($self, $color, $text) = @_;
1214    
1215     my @color = (
1216     [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
1217     [1.00, 1.00, 1.00],
1218 root 1.117 [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
1219 root 1.99 [1.00, 0.00, 0.00],
1220     [1.00, 0.54, 0.00],
1221     [0.11, 0.56, 1.00],
1222     [0.93, 0.46, 0.00],
1223     [0.18, 0.54, 0.34],
1224     [0.56, 0.73, 0.56],
1225     [0.80, 0.80, 0.80],
1226     [0.55, 0.41, 0.13],
1227     [0.99, 0.77, 0.26],
1228     [0.74, 0.65, 0.41],
1229     );
1230    
1231     $LOGVIEW->add_paragraph ($color[$color], $text);
1232     }
1233    
1234 root 1.144 sub conn::spell_add {
1235 root 1.143 my ($self, $spell) = @_;
1236    
1237 root 1.171 # TODO
1238     # create a widget dynamically, using spell face (CF::Protocol downloads them)
1239     $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message});
1240     $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message});
1241 root 1.144 }
1242    
1243     sub conn::spell_delete {
1244     my ($self, $spell) = @_;
1245     }
1246    
1247     sub conn::addme_success {
1248     my ($self) = @_;
1249    
1250     for my $skill (values %{$self->{skill_info}}) {
1251 root 1.171 $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");
1252     $MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");
1253 root 1.144 }
1254 root 1.143 }
1255    
1256 root 1.173 sub update_floorbox {
1257     $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1258     $FLOORBOX->clear;
1259     $FLOORBOX->add (new CFClient::UI::Empty expand => 1);
1260    
1261     my @items = values %{ $CONN->{container}{0} };
1262    
1263     # we basically have to use the same sorting as everybody else
1264     @items = sort { $a->{type} <=> $b->{type} } @items;
1265    
1266     for my $item (reverse @items) {
1267     my $desc = $item->{nrof} < 2
1268     ? $item->{name}
1269     : "$item->{nrof} $item->{name_pl}";
1270     # todo: animation widget, face widget, weight(?) etc.
1271     $FLOORBOX->add (my $hbox = new CFClient::UI::HBox
1272     tooltip => (CFClient::UI::Label->escape ($desc)
1273     . "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
1274     can_hover => 1,
1275     can_events => 1,
1276     );
1277    
1278     $hbox->add (new CFClient::UI::Face
1279     face => $item->{face},
1280     anim => $item->{anim},
1281     animspeed => $item->{animspeed},
1282     );
1283    
1284     $hbox->add (new CFClient::UI::Label
1285     text => $desc,
1286     );
1287     }
1288     });
1289     refresh;
1290     }
1291    
1292 root 1.169 sub conn::container_add {
1293     my ($self, $id, $items) = @_;
1294    
1295 root 1.173 update_floorbox if $id == 0;
1296 root 1.169 # $self-<{player}{tag} => player inv
1297     #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1298     }
1299    
1300     sub conn::container_clear {
1301     my ($self, $id) = @_;
1302 root 1.173
1303     update_floorbox if $id == 0;
1304 root 1.169 # use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1305     }
1306    
1307 root 1.173 sub conn::item_delete {
1308     my ($self, @items) = @_;
1309    
1310     for (@items) {
1311     update_floorbox if $_->{container} == 0;
1312     }
1313     }
1314    
1315     sub conn::item_update {
1316     my ($self, $item) = @_;
1317    
1318     update_floorbox if $item->{container} == 0;
1319     }
1320    
1321 root 1.87 %SDL_CB = (
1322 root 1.145 CFClient::SDL_QUIT => sub {
1323 root 1.87 Event::unloop -1;
1324     },
1325 root 1.145 CFClient::SDL_VIDEORESIZE => sub {
1326 root 1.87 },
1327 root 1.153 CFClient::SDL_VIDEOEXPOSE => \&refresh,
1328     CFClient::SDL_ACTIVEEVENT => sub {
1329     # printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1330 root 1.87 },
1331 root 1.145 CFClient::SDL_KEYDOWN => sub {
1332 root 1.147 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
1333 root 1.87 # alt-enter
1334 root 1.134 video_shutdown;
1335 root 1.99 $CFG->{fullscreen} = !$CFG->{fullscreen};
1336 root 1.134 video_init;
1337 root 1.87 } else {
1338 root 1.147 CFClient::UI::feed_sdl_key_down_event ($_[0]);
1339 elmex 1.23 }
1340 root 1.87 },
1341 root 1.153 CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
1342     CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
1343     CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
1344     CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
1345     CFClient::SDL_USEREVENT => \&audio_music_finished,
1346 root 1.87 );
1347 elmex 1.23
1348 root 1.1 #############################################################################
1349    
1350 root 1.131 $SIG{INT} = $SIG{TERM} = sub { exit };
1351    
1352 root 1.116 $TILECACHE = CFClient::db_table "tilecache";
1353     $FACEMAP = CFClient::db_table "facemap";
1354 root 1.114
1355 root 1.67 CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1356 elmex 1.10
1357 root 1.90 my %DEF_CFG = (
1358 root 1.105 sdl_mode => 0,
1359 root 1.90 width => 640,
1360     height => 480,
1361 root 1.105 fullscreen => 0,
1362 root 1.90 fast => 0,
1363 root 1.169 map_scale => 0.5,
1364 root 1.97 fow_enable => 1,
1365 root 1.90 fow_intensity => 0.45,
1366 root 1.92 fow_smooth => 0,
1367 root 1.140 gui_fontsize => 1,
1368 elmex 1.157 log_fontsize => 1,
1369 elmex 1.158 gauge_fontsize => 1,
1370     gauge_size => 0.35,
1371 elmex 1.157 stat_fontsize => 1,
1372 root 1.90 mapsize => 100,
1373     host => "crossfire.schmorp.de",
1374 elmex 1.101 say_command => 'say',
1375 root 1.139 audio_enable => 1,
1376     bgm_enable => 1,
1377 root 1.149 bgm_volume => 0.25,
1378 root 1.90 );
1379    
1380     while (my ($k, $v) = each %DEF_CFG) {
1381     $CFG->{$k} = $v unless exists $CFG->{$k};
1382     }
1383 elmex 1.12
1384 root 1.89 sdl_init;
1385 root 1.87
1386 root 1.93 @SDL_MODES = reverse
1387     grep $_->[0] >= 640 && $_->[1] >= 480,
1388 root 1.145 CFClient::SDL_ListModes;
1389 root 1.87
1390 root 1.89 @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1391    
1392     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1393    
1394 root 1.65 {
1395 root 1.168 my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1396     DejaVuSans.ttf
1397     DejaVuSansMono.ttf
1398     DejaVuSans-Bold.ttf
1399     DejaVuSansMono-Bold.ttf
1400     DejaVuSans-Oblique.ttf
1401     DejaVuSansMono-Oblique.ttf
1402     DejaVuSans-BoldOblique.ttf
1403     DejaVuSansMono-BoldOblique.ttf
1404     );
1405 root 1.65
1406 root 1.67 CFClient::add_font $_ for @fonts;
1407 root 1.168
1408     $FONT_PROP = new_from_file CFClient::Font $fonts[0];
1409     $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1410    
1411     $FONT_PROP->make_default;
1412 root 1.65 }
1413 root 1.40
1414 root 1.134 video_init;
1415     audio_init;
1416 root 1.122
1417 root 1.87 Event::loop;
1418 root 1.19
1419 root 1.148 END { CFClient::SDL_Quit }
1420 root 1.131
1421 root 1.82