ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/pclient
Revision: 1.175
Committed: Mon Apr 24 06:57:39 2006 UTC (18 years, 1 month ago) by root
Branch: MAIN
Changes since 1.174: +6 -4 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.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.174 my $black = [0, 0, 0];
366    
367 root 1.168 $tbl->add (0, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
368     $tbl->add (0, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
369     $tbl->add (0, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
370     $tbl->add (0, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
371     $tbl->add (0, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
372     $tbl->add (0, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
373     $tbl->add (0, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
374    
375 root 1.174 $tbl->add (1, 0, $STATWIDS->{st_str_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Str");
376     $tbl->add (1, 1, $STATWIDS->{st_dex_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Dex");
377     $tbl->add (1, 2, $STATWIDS->{st_con_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Con");
378     $tbl->add (1, 3, $STATWIDS->{st_int_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Int");
379     $tbl->add (1, 4, $STATWIDS->{st_wis_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Wis");
380     $tbl->add (1, 5, $STATWIDS->{st_pow_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Pow");
381     $tbl->add (1, 6, $STATWIDS->{st_cha_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Cha");
382 root 1.168
383     $tbl->add (2, 0, $STATWIDS->{st_wc} = new CFClient::UI::Label valign => 0, align => +1, template => "-120");
384     $tbl->add (2, 1, $STATWIDS->{st_ac} = new CFClient::UI::Label valign => 0, align => +1, template => "-120");
385     $tbl->add (2, 2, $STATWIDS->{st_dam} = new CFClient::UI::Label valign => 0, align => +1, template => "120");
386     $tbl->add (2, 3, $STATWIDS->{st_arm} = new CFClient::UI::Label valign => 0, align => +1, template => "120");
387     $tbl->add (2, 4, $STATWIDS->{st_spd} = new CFClient::UI::Label valign => 0, align => +1, template => "10.54");
388     $tbl->add (2, 5, $STATWIDS->{st_wspd} = new CFClient::UI::Label valign => 0, align => +1, template => "9");
389    
390 root 1.174 $tbl->add (3, 0, $STATWIDS->{st_wc_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Wc");
391     $tbl->add (3, 1, $STATWIDS->{st_ac_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Ac");
392     $tbl->add (3, 2, $STATWIDS->{st_dam_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Dam");
393     $tbl->add (3, 3, $STATWIDS->{st_arm_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Arm");
394     $tbl->add (3, 4, $STATWIDS->{st_spd_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Sp");
395     $tbl->add (3, 5, $STATWIDS->{st_wspd_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "WSp");
396 root 1.155
397 elmex 1.158 $hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
398 root 1.155
399 elmex 1.156 my $row = 0;
400     my $col = 0;
401 root 1.155
402 elmex 1.166 my %resist_names = (
403     slow => "Slow",
404     holyw => "Holy Word",
405     conf => "Confusion",
406     fire => "Fire",
407     depl => "Depletion",
408     magic => "Magic",
409     drain => "Draining",
410     acid => "Acid",
411     pois => "Poison",
412     para => "Paralysation",
413     deat => "Death",
414     phys => "Physical",
415     blind => "Blind",
416     fear => "Fear",
417     tund => "Turn undead",
418     elec => "Electricity",
419     cold => "Cold",
420     ghit => "Ghost hit",
421     );
422 elmex 1.156 for (qw/slow holyw conf fire depl magic
423     drain acid pois para deat phys
424     blind fear tund elec cold ghit/)
425     {
426 root 1.164 $tbl2->add ($col, $row,
427 elmex 1.156 $STATWIDS->{"res_$_"} =
428 root 1.168 new CFClient::UI::Label
429     template => "-100%",
430     align => +1,
431     valign => 0,
432     tooltip => $resist_names{$_}
433     );
434     $tbl2->add ($col + 1, $row, new CFClient::UI::Image
435     can_hover => 1,
436     can_events => 1,
437     image => "ui/resist/resist_$_.png",
438     tooltip => $resist_names{$_}
439 elmex 1.156 );
440    
441     $row++;
442     if ($row % 6 == 0) {
443     $col += 2;
444     $row = 0;
445     }
446     }
447    
448 elmex 1.157 &set_stats_window_fontsize;
449 elmex 1.156 update_stats_window ({});
450 root 1.155
451 elmex 1.154 $tgw
452     }
453    
454 root 1.169 sub formsep {
455     reverse join ",", grep length, split /(...)/, reverse $_[0] * 1
456     }
457    
458 elmex 1.154 sub update_stats_window {
459     my ($stats) = @_;
460    
461 elmex 1.156 # i love text protocols!!!
462 root 1.169 my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;
463     my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;
464     my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;
465     my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;
466     my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;
467 elmex 1.156 my $fo_m = 999;
468 root 1.169 my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;
469     my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;
470 elmex 1.156
471     $GAUGES->{hp} ->set_value ($hp, $hp_m);
472     $GAUGES->{mana} ->set_value ($sp, $sp_m);
473     $GAUGES->{food} ->set_value ($fo, $fo_m);
474     $GAUGES->{grace} ->set_value ($gr, $gr_m);
475 root 1.169 $GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})
476     . " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");
477     my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};
478 elmex 1.159 $rng =~ s/^Range: //; # thank you so much dear server
479     $GAUGES->{range} ->set_text ("Rng: " . $rng);
480 root 1.169 my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};
481 elmex 1.165 $title =~ s/^Player: //;
482     $STATWIDS->{title} ->set_text ("Title: " . $title);
483 elmex 1.156
484 root 1.169 $STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});
485     $STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});
486     $STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});
487     $STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});
488     $STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});
489     $STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});
490     $STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});
491     $STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});
492     $STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});
493     $STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});
494     $STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});
495     $STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});
496     $STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP});
497 elmex 1.156
498     my %tbl = (
499     phys => 100,
500     magic => 101,
501     fire => 102,
502     elec => 103,
503     cold => 104,
504     conf => 105,
505     acid => 106,
506     drain => 107,
507     ghit => 108,
508     pois => 109,
509     slow => 110,
510     para => 111,
511     tund => 112,
512     fear => 113,
513 elmex 1.165 depl => 113,
514 elmex 1.156 deat => 115,
515     holyw => 116,
516     blind => 117
517 elmex 1.154 );
518 elmex 1.156
519     for (keys %tbl) {
520     $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});
521     }
522    
523 elmex 1.154 }
524    
525 root 1.112 sub metaserver_dialog {
526     my $dialog = new CFClient::UI::FancyFrame
527 root 1.150 title => "Metaserver",
528 root 1.112 child => (my $vbox = new CFClient::UI::VBox);
529    
530     $vbox->add ($dialog->{table} = new CFClient::UI::Table);
531    
532     $dialog
533     }
534    
535     sub update_metaserver {
536 root 1.114 my ($HOST) = @_;
537    
538 root 1.112 status "fetching metaserver list...";
539    
540     my $buf;
541    
542     my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
543    
544     Event->io (fd => $fh, poll => 'r', cb => sub {
545     my $res = sysread $fh, $buf, 8192, length $buf;
546    
547     if (!defined $res) {
548     $_[0]->w->cancel;
549     status "metaserver: $!";
550     } elsif ($res == 0) {
551     $_[0]->w->cancel;
552     status "server list retrieved";
553 root 1.113
554     my $table = $METASERVER->{table};
555    
556     $table->clear;
557    
558 root 1.114 my @col = qw(Use #Users Host Uptime Version Description);
559 root 1.113 $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
560     for 0 .. $#col;
561    
562     my @align = qw(1 0 1 1 -1);
563    
564     my $y = 0;
565 root 1.114 for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
566 root 1.113 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;
567    
568     for ($desc) {
569     s/<br>/\n/gi;
570     s/<li>/\n· /gi;
571     s/<.*?>//sgi;
572     s/&/&amp;/g;
573     s/</&lt;/g;
574     s/>/&gt;/g;
575     }
576    
577     $uptime = sprintf "%dd %02d:%02d:%02d",
578     (int $m->[8] / 86400),
579     (int $m->[8] / 3600) % 24,
580     (int $m->[8] / 60) % 60,
581     $m->[8] % 60;
582    
583     $m = [$users, $host, $uptime, $version, $desc];
584    
585     $y++;
586 root 1.114
587     $table->add (0, $y, new CFClient::UI::VBox children => [
588     (new CFClient::UI::Button text => " ", connect_activate => sub {
589     $HOST->set_text ($CFG->{host} = $host);
590     }),
591     (new CFClient::UI::Empty expand => 1),
592     ]);
593    
594 root 1.140 $table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => 0.8)
595 root 1.113 for 0 .. $#$m;
596     }
597 root 1.112 }
598     });
599     }
600    
601 root 1.111 sub server_setup {
602     my $dialog = new CFClient::UI::FancyFrame
603 root 1.150 title => "Server Setup",
604 root 1.111 child => (my $vbox = new CFClient::UI::VBox);
605 root 1.81
606 root 1.82 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
607 root 1.141 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
608 root 1.112
609     {
610     $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
611    
612 elmex 1.166 $vbox->add (
613     my $HOST = new CFClient::UI::Entry
614     expand => 1,
615     text => $CFG->{host},
616     tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
617     connect_changed => sub {
618     my ($self, $value) = @_;
619     $CFG->{host} = $value;
620     }
621     );
622 root 1.112
623     $METASERVER = metaserver_dialog;
624 elmex 1.101
625 elmex 1.166 $vbox->add (new CFClient::UI::Flopper
626     expand => 1,
627     text => "Metaserver",
628     other => $METASERVER,
629 root 1.167 tooltip => "Show a list of avaible crossfire servers",
630 elmex 1.166 connect_open => sub {
631     update_metaserver $HOST;
632     }
633     );
634 root 1.112 }
635 root 1.81
636 root 1.141 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
637 elmex 1.166 $table->add (1, 4, new CFClient::UI::Entry
638     text => $CFG->{user},
639     tooltip => "The name of your character on the server",
640     connect_changed => sub {
641     my ($self, $value) = @_;
642     $CFG->{user} = $value;
643     }
644     );
645 root 1.81
646 root 1.141 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
647 elmex 1.166 $table->add (1, 5, new CFClient::UI::Entry
648     text => $CFG->{password},
649     hidden => 1,
650     tooltip => "The password for your character",
651     connect_changed => sub {
652     my ($self, $value) = @_;
653     $CFG->{password} = $value;
654     }
655     );
656 elmex 1.101
657 root 1.141 $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");
658 elmex 1.166 $table->add (1, 6, my $saycmd = new CFClient::UI::Entry
659     text => $CFG->{say_command},
660     tooltip => "This is the command that will be used if you write a line in the message window entry. "
661     ."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
662 root 1.173 ."But you could also set it to 'tell &lt;playername&gt;' to only chat with that user.",
663 elmex 1.166 connect_changed => sub {
664     my ($self, $value) = @_;
665     $CFG->{say_command} = $value;
666     }
667     );
668 root 1.81
669 root 1.141 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
670 elmex 1.101 $table->add (1, 7, new CFClient::UI::Slider
671 root 1.81 req_w => 100,
672     range => [$CFG->{mapsize}, 10, 100 + 1, 1],
673 elmex 1.166 tooltip => "This is the size of the portion of the map update the server sends you. "
674     ."If you set this to a high value you will be able to see further for example.",
675 root 1.81 connect_changed => sub {
676     my ($self, $value) = @_;
677    
678     $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
679     },
680     );
681    
682 elmex 1.101 $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub {
683 root 1.84 start_game;
684 root 1.82 });
685    
686 root 1.98 $dialog
687 root 1.81 }
688 root 1.58
689 root 1.111 sub message_window {
690 root 1.99 my $window = new CFClient::UI::FancyFrame
691 root 1.150 title => "Messages",
692 root 1.99 border_bg => [1, 1, 1, 0.5],
693     bg => [0.3, 0.3, 0.3, 0.8],
694 root 1.124 user_w => int $::WIDTH / 3,
695     user_h => int $::HEIGHT / 5,
696 root 1.99 child => (my $vbox = new CFClient::UI::VBox);
697    
698 root 1.105 $vbox->add ($LOGVIEW = new CFClient::UI::TextView
699     expand => 1,
700 root 1.168 font => $FONT_FIXED,
701 root 1.105 fontsize => $::CFG->{log_fontsize},
702     );
703    
704 root 1.122 $vbox->add (my $input = new CFClient::UI::Entry
705 elmex 1.118 connect_focus_in => sub {
706     my ($input, $prev_focus) = @_;
707    
708     delete $input->{refocus_map};
709    
710     if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
711     $input->{refocus_map} = 1;
712     }
713     delete $input->{auto_activated};
714     },
715 root 1.116 connect_activate => sub {
716 elmex 1.100 my ($input, $text) = @_;
717     $input->set_text ('');
718    
719     if ($text =~ /^\/(.*)/) {
720 root 1.123 $::CONN->user_send ($1);
721 elmex 1.100 } else {
722 elmex 1.101 my $say_cmd = $::CFG->{say_command} || 'say';
723 root 1.123 $::CONN->user_send ("$say_cmd $text");
724 elmex 1.100 }
725 elmex 1.118 if ($input->{refocus_map}) {
726     delete $input->{refocus_map};
727     $MAPWIDGET->focus_in
728     }
729 root 1.116 },
730     connect_escape => sub {
731 elmex 1.102 $MAPWIDGET->focus_in
732 root 1.116 },
733     );
734 elmex 1.102
735     $CONSOLE = {
736     window => $window,
737     input => $input
738     };
739 root 1.99
740     $window
741     }
742    
743 root 1.89 sub sdl_init {
744 root 1.145 CFClient::SDL_Init
745 root 1.89 and die "SDL::Init failed!\n";
746     }
747    
748 root 1.134 sub video_init {
749 root 1.89 sdl_init;
750    
751 root 1.84 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
752     $FULLSCREEN = $CFG->{fullscreen};
753 root 1.89 $FAST = $CFG->{fast};
754 root 1.84
755 root 1.145 CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
756     or die "SDL_SetVideoMode failed!\n";
757 root 1.2
758 root 1.86 $SDL_ACTIVE = 1;
759    
760 root 1.87 $LAST_REFRESH = time - 0.01;
761 root 1.45
762 root 1.67 CFClient::gl_init;
763 root 1.30
764 root 1.140 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
765 root 1.39
766 root 1.52 #############################################################################
767    
768 root 1.99 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100;
769 root 1.140 $DEBUG_STATUS->show;
770 root 1.52
771 root 1.72 $STATUS_LINE = new CFClient::UI::Label
772 root 1.77 padding => 0,
773 root 1.140 y => $HEIGHT - $FONTSIZE * 1.8;
774     $STATUS_LINE->show;
775 root 1.51
776 root 1.72 $ALT_ENTER_MESSAGE = new CFClient::UI::Label
777 root 1.123 padding => 0,
778 root 1.140 fontsize => 0.8,
779 root 1.123 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
780 root 1.140 $ALT_ENTER_MESSAGE->show;
781     $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
782 root 1.30
783 root 1.141 $CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::MapWidget);
784 root 1.69 $MAPWIDGET->focus_in;
785 elmex 1.102 $MAPWIDGET->connect (activate_console => sub {
786 elmex 1.103 my ($mapwidget, $preset) = @_;
787    
788 elmex 1.102 if ($CONSOLE) {
789 elmex 1.118 $CONSOLE->{input}->{auto_activated} = 1;
790 elmex 1.102 $CONSOLE->{input}->focus_in;
791 elmex 1.103
792     if ($preset && $CONSOLE->{input}->get_text eq '') {
793     $CONSOLE->{input}->set_text ($preset);
794     }
795 elmex 1.102 }
796     });
797 root 1.81
798 root 1.111 $CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox);
799    
800     $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
801     $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
802     $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
803    
804 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
805     $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);
806    
807 root 1.111 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
808     CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
809     status "Configuration Saved";
810     });
811 root 1.98
812 root 1.119 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
813 root 1.2 }
814    
815 root 1.134 sub video_shutdown {
816 root 1.111 $CFClient::UI::ROOT->{children} = [];
817 root 1.86 undef $SDL_ACTIVE;
818 root 1.134 }
819    
820 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#
821 root 1.135 my $bgmusic;#TODO#hack#d#
822    
823 root 1.153 sub audio_music_finished {
824     return unless $CFG->{bgm_enable};
825    
826     # TODO: hack, do play loop and mood music
827     $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
828     $bgmusic->play (0);
829    
830     push @bgmusic, shift @bgmusic;
831     }
832    
833 root 1.134 sub audio_init {
834 root 1.139 if ($CFG->{audio_enable}) {
835 root 1.134 if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") {
836 root 1.146 $SDL_MIXER = !CFClient::Mix_OpenAudio;
837     CFClient::Mix_AllocateChannels 8;
838 root 1.149 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
839 root 1.134
840 root 1.153 audio_music_finished;
841 root 1.135
842 root 1.134 while (<$fh>) {
843     next if /^\s*#/;
844     next if /^\s*$/;
845    
846     my ($file, $volume, $event) = split /\s+/, $_, 3;
847    
848     push @SOUNDS, "$volume,$file";
849    
850     $AUDIO_CHUNKS{"$volume,$file"} ||= do {
851 root 1.146 my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
852 root 1.134 $chunk->volume ($volume * 128 / 100);
853     $chunk
854     };
855     }
856     } else {
857     status "unable to open sound config: $!";
858     }
859     }
860     }
861    
862     sub audio_shutdown {
863 root 1.146 CFClient::Mix_CloseAudio if $SDL_MIXER;
864 root 1.134 undef $SDL_MIXER;
865     @SOUNDS = ();
866     %AUDIO_CHUNKS = ();
867 root 1.62 }
868    
869 root 1.87 my %animate_object;
870     my $animate_timer;
871    
872     my $want_refresh;
873     my $can_refresh;
874    
875     my $fps = 9;
876    
877 root 1.30 sub force_refresh {
878 root 1.87 $fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05;
879     debug sprintf "%3.2f", $fps;
880    
881 root 1.96 $want_refresh = 0;
882 root 1.87 $can_refresh = 0;
883    
884 root 1.111 $CFClient::UI::ROOT->draw;
885 root 1.1
886 root 1.148 CFClient::SDL_GL_SwapBuffers;
887 root 1.87
888     $LAST_REFRESH = $NOW;
889 root 1.1 }
890    
891 root 1.87 my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
892     $NOW = time;
893    
894 root 1.147 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
895     for CFClient::SDL_PollEvent;
896 root 1.87
897     if (%animate_object) {
898     $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
899     $want_refresh++;
900     }
901    
902     if ($want_refresh) {
903     force_refresh;
904     } else {
905     $can_refresh = 1;
906     }
907     });
908 root 1.64
909 root 1.30 sub refresh {
910 root 1.87 $want_refresh++;
911 root 1.30 }
912    
913 root 1.45 sub animation_start {
914     my ($widget) = @_;
915 root 1.87 $animate_object{$widget} = $widget;
916 root 1.45 }
917    
918     sub animation_stop {
919     my ($widget) = @_;
920 root 1.87 delete $animate_object{$widget};
921 root 1.45 }
922    
923 root 1.2 @conn::ISA = Crossfire::Protocol::;
924 root 1.1
925 elmex 1.125 sub conn::stats_update {
926     my ($self, $stats) = @_;
927    
928 elmex 1.154 update_stats_window ($stats);
929 elmex 1.125 }
930    
931 root 1.89 sub conn::user_send {
932 root 1.88 my ($self, $command) = @_;
933    
934 root 1.123 $self->send_command ($command);
935 root 1.88 status $command;
936     }
937    
938 root 1.119 sub conn::map_scroll {
939     my ($self, $dx, $dy) = @_;
940    
941     $MAP->scroll ($dx, $dy);
942     }
943    
944 root 1.94 sub conn::feed_map1a {
945     my ($self, $data) = @_;
946    
947 root 1.95 # $self->Crossfire::Protocol::feed_map1a ($data);
948 root 1.1
949 root 1.95 $MAP->map1a_update ($data);
950 root 1.69 $MAPWIDGET->update;
951 root 1.1 }
952    
953 root 1.116 sub conn::flush_map {
954     my ($self) = @_;
955    
956     my $map_info = delete $self->{map_info}
957     or return;
958    
959     my ($hash, $x, $y, $w, $h) = @$map_info;
960    
961     my $data = $MAP->get_rect ($x, $y, $w, $h);
962     $MAPCACHE->put ($hash => Compress::LZF::compress $data);
963 root 1.152 #warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
964 root 1.116 }
965 root 1.1
966 root 1.2 sub conn::map_clear {
967 root 1.1 my ($self) = @_;
968    
969 root 1.116 $self->flush_map;
970 root 1.150 delete $self->{neigh_map};
971 root 1.116
972 root 1.95 $MAP->clear;
973 root 1.1 }
974    
975 root 1.116
976 root 1.119 sub conn::load_map($$$) {
977     my ($self, $hash, $x, $y) = @_;
978 root 1.115
979 root 1.116 if (defined (my $data = $MAPCACHE->get ($hash))) {
980     $data = Compress::LZF::decompress $data;
981 root 1.152 #warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
982 root 1.116 for my $id ($MAP->set_rect ($x, $y, $data)) {
983     my $data = $TILECACHE->get ($id)
984     or next;
985    
986     $self->set_texture ($id => $data);
987     }
988     }
989 root 1.115 }
990    
991 root 1.152 # this method does a "flood fill" into every tile direction
992     # it assumes that tiles are arranged in a rectangular grid,
993     # i.e. a map is the same as the left of the right map etc.
994     # failure to comply are harmless and result in display errors
995     # at worst.
996 root 1.119 sub conn::flood_fill {
997 root 1.150 my ($self, $gx, $gy, $path, $hash, $flags) = @_;
998 root 1.119
999 root 1.121 # the server does not allow map paths > 6
1000 root 1.120 return if 6 <= length $path;
1001    
1002 root 1.150 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
1003    
1004     for (
1005     [1, 0, -1],
1006     [2, 1, 0],
1007     [3, 0, 1],
1008     [4, -1, 0],
1009     ) {
1010     my ($tile, $dx, $dy) = @$_;
1011    
1012     my $gx = $gx + $dx;
1013     my $gy = $gy + $dy;
1014    
1015 root 1.119 next unless $flags & (1 << ($tile - 1));
1016 root 1.150 next if $self->{neigh_grid}{$gx, $gy}++;
1017 root 1.119
1018 root 1.150 my $neigh = $self->{neigh_map}{$hash} ||= [];
1019     if (my $info = $neigh->[$tile]) {
1020     my ($flags, $x, $y, $w, $h, $hash) = @$info;
1021 root 1.119
1022 root 1.150 $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
1023     if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1024    
1025     } else {
1026     $self->send_mapinfo ("spatial $path$tile", sub {
1027     my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
1028 root 1.119
1029 root 1.150 return if $mode ne "spatial";
1030 root 1.119
1031 root 1.150 $x += $MAP->ox;
1032     $y += $MAP->oy;
1033    
1034     $self->load_map ($hash, $x, $y)
1035     unless $self->{neigh_map}{$hash}[5]++;#d#
1036 root 1.119
1037 root 1.150 $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
1038 root 1.119
1039 root 1.150 $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
1040     if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1041     });
1042     }
1043 root 1.119 }
1044     }
1045    
1046     sub conn::map_change {
1047     my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
1048    
1049     $self->flush_map;
1050    
1051     my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
1052    
1053     my $mapmapw = 250;
1054     my $mapmaph = 250;
1055 root 1.150
1056     $self->{neigh_rect} = [
1057 root 1.152 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
1058     $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
1059 root 1.150 ];
1060 root 1.119
1061 root 1.150 delete $self->{neigh_grid};
1062     $self->flood_fill (0, 0, "", $hash, $flags);
1063 root 1.119
1064     $x += $ox;
1065     $y += $oy;
1066    
1067     $self->{map_info} = [$hash, $x, $y, $w, $h];
1068    
1069 elmex 1.158 my $map = $self->{map_info}[0];
1070     $map =~ s/^.*?\/([^\/]+)$/\1/;
1071     $STATWIDS->{map}->set_text ("Map: " . $map);
1072 elmex 1.157
1073 root 1.119 $self->load_map ($hash, $x, $y);
1074     }
1075    
1076 root 1.19 sub conn::face_find {
1077 root 1.116 my ($self, $facenum, $face) = @_;
1078    
1079     my $hash = "$face->{chksum},$face->{name}";
1080    
1081     my $id = $FACEMAP->get ($hash);
1082    
1083     unless ($id) {
1084     # create new id for face
1085     # i love transactions
1086     for (1..100) {
1087     my $txn = $CFClient::DB_ENV->txn_begin;
1088     my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
1089     if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
1090     $id++;
1091     if ($FACEMAP->put (id => $id) == 0
1092     && $FACEMAP->put ($hash => $id) == 0) {
1093     $txn->txn_commit;
1094    
1095     goto gotid;
1096     }
1097     }
1098     $txn->abort;
1099     }
1100 root 1.19
1101 root 1.116 CFClient::fatal "maximum number of transaction retries reached - database problems?";
1102     }
1103 root 1.114
1104 root 1.116 gotid:
1105     $face->{id} = $id;
1106     $MAP->set_face ($facenum => $id);
1107 root 1.173 $self->{faceid}[$facenum] = $id;#d#
1108 root 1.116 $TILECACHE->get ($id)
1109 root 1.19 }
1110    
1111 root 1.2 sub conn::face_update {
1112 root 1.95 my ($self, $facenum, $face) = @_;
1113 root 1.19
1114 root 1.116 $TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
1115    
1116     $self->set_texture ($face->{id} => delete $face->{image});
1117     }
1118 root 1.1
1119 root 1.116 sub conn::set_texture {
1120     my ($self, $id, $data) = @_;
1121 root 1.95
1122 root 1.116 $self->{texture}[$id] ||= do {
1123     my $tex =
1124     new_from_image CFClient::Texture
1125 root 1.173 $data, minify => 1, mipmap => 1;
1126 root 1.116
1127     $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1128     $MAPWIDGET->update;
1129    
1130     $tex
1131     };
1132 root 1.1 }
1133    
1134 root 1.134 sub conn::sound_play {
1135     my ($self, $x, $y, $soundnum, $type) = @_;
1136    
1137 root 1.139 $SDL_MIXER
1138     or return;
1139    
1140 root 1.134 my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
1141     or return;
1142    
1143 root 1.146 $chunk->play;
1144 root 1.143 # warn "sound $x,$y,$soundnum,$type\n";#d#
1145 root 1.134 }
1146    
1147 root 1.170 my $LAST_QUERY; # server is stupid, stupid, stupid
1148    
1149 root 1.33 sub conn::query {
1150     my ($self, $flags, $prompt) = @_;
1151    
1152 root 1.170 $prompt = $LAST_QUERY unless length $prompt;
1153     $LAST_QUERY = $prompt;
1154    
1155     my $dialog = new CFClient::UI::FancyFrame
1156     title => "Query",
1157     child => my $vbox = new CFClient::UI::VBox;
1158    
1159     $vbox->add (new CFClient::UI::Label
1160     max_w => $::WIDTH * 0.4,
1161     text => $prompt);
1162    
1163     if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
1164     $vbox->add (my $hbox = new CFClient::HBox);
1165     $hbox->add (new CFClient::Button
1166     text => "No",
1167     connect_activate => sub {
1168     $self->send ("reply n");
1169     $dialog->destroy;
1170     $MAPWIDGET->focus_in;
1171     }
1172     );
1173     $hbox->add (new CFClient::Button
1174     text => "Yes",
1175     connect_activate => sub {
1176     $self->send ("reply y");
1177     $dialog->destroy;
1178     $MAPWIDGET->focus_in;
1179     },
1180     );
1181    
1182     $dialog->focus_in;
1183    
1184     } elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
1185     $dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
1186     $vbox->add (my $entry = new CFClient::UI::Entry
1187     connect_changed => sub {
1188     $self->send ("reply $_[1]");
1189     $dialog->destroy;
1190     $MAPWIDGET->focus_in;
1191     },
1192     );
1193    
1194     $entry->focus_in;
1195    
1196     } else {
1197     $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
1198    
1199     $vbox->add (my $entry = new CFClient::UI::Entry
1200     $flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
1201     connect_activate => sub {
1202     $self->send ("reply $_[1]");
1203     $dialog->destroy;
1204     $MAPWIDGET->focus_in;
1205     },
1206     );
1207    
1208     $entry->focus_in;
1209     }
1210    
1211     $dialog->show;
1212 root 1.33 }
1213    
1214 root 1.99 sub conn::drawinfo {
1215     my ($self, $color, $text) = @_;
1216    
1217     my @color = (
1218     [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
1219     [1.00, 1.00, 1.00],
1220 root 1.117 [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
1221 root 1.99 [1.00, 0.00, 0.00],
1222     [1.00, 0.54, 0.00],
1223     [0.11, 0.56, 1.00],
1224     [0.93, 0.46, 0.00],
1225     [0.18, 0.54, 0.34],
1226     [0.56, 0.73, 0.56],
1227     [0.80, 0.80, 0.80],
1228     [0.55, 0.41, 0.13],
1229     [0.99, 0.77, 0.26],
1230     [0.74, 0.65, 0.41],
1231     );
1232    
1233     $LOGVIEW->add_paragraph ($color[$color], $text);
1234     }
1235    
1236 root 1.144 sub conn::spell_add {
1237 root 1.143 my ($self, $spell) = @_;
1238    
1239 root 1.171 # TODO
1240     # create a widget dynamically, using spell face (CF::Protocol downloads them)
1241     $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message});
1242     $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message});
1243 root 1.144 }
1244    
1245     sub conn::spell_delete {
1246     my ($self, $spell) = @_;
1247     }
1248    
1249     sub conn::addme_success {
1250     my ($self) = @_;
1251    
1252     for my $skill (values %{$self->{skill_info}}) {
1253 root 1.171 $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");
1254     $MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");
1255 root 1.144 }
1256 root 1.143 }
1257    
1258 root 1.173 sub update_floorbox {
1259     $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1260     $FLOORBOX->clear;
1261     $FLOORBOX->add (new CFClient::UI::Empty expand => 1);
1262    
1263     my @items = values %{ $CONN->{container}{0} };
1264    
1265     # we basically have to use the same sorting as everybody else
1266     @items = sort { $a->{type} <=> $b->{type} } @items;
1267    
1268     for my $item (reverse @items) {
1269     my $desc = $item->{nrof} < 2
1270     ? $item->{name}
1271     : "$item->{nrof} $item->{name_pl}";
1272     # todo: animation widget, face widget, weight(?) etc.
1273     $FLOORBOX->add (my $hbox = new CFClient::UI::HBox
1274     tooltip => (CFClient::UI::Label->escape ($desc)
1275     . "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
1276     can_hover => 1,
1277     can_events => 1,
1278 root 1.174 connect_button_down => sub {
1279     my ($self, $ev, $x, $y) = @_;
1280    
1281     # todo: maybe put examine on 1? but should just be a tooltip :(
1282     if ($ev->{button} == 1) {
1283     $CONN->send ("move $CONN->{player}{tag} $item->{tag} 0");
1284     } elsif ($ev->{button} == 2) {
1285     $CONN->send ("apply $item->{tag}");
1286     } elsif ($ev->{button} == 3) {
1287     # examine, lock, mark, maybe other things
1288     warn "MENU not implemented yet\n";
1289     }
1290    
1291     1
1292     },
1293 root 1.173 );
1294    
1295     $hbox->add (new CFClient::UI::Face
1296 root 1.175 can_events => 0,
1297     face => $item->{face},
1298     anim => $item->{anim},
1299     animspeed => $item->{animspeed},
1300 root 1.173 );
1301    
1302     $hbox->add (new CFClient::UI::Label
1303 root 1.175 can_events => 0,
1304     text => $desc,
1305 root 1.173 );
1306     }
1307     });
1308     refresh;
1309     }
1310    
1311 root 1.169 sub conn::container_add {
1312     my ($self, $id, $items) = @_;
1313    
1314 root 1.173 update_floorbox if $id == 0;
1315 root 1.169 # $self-<{player}{tag} => player inv
1316     #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1317     }
1318    
1319     sub conn::container_clear {
1320     my ($self, $id) = @_;
1321 root 1.173
1322     update_floorbox if $id == 0;
1323 root 1.169 # use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1324     }
1325    
1326 root 1.173 sub conn::item_delete {
1327     my ($self, @items) = @_;
1328    
1329     for (@items) {
1330     update_floorbox if $_->{container} == 0;
1331     }
1332     }
1333    
1334     sub conn::item_update {
1335     my ($self, $item) = @_;
1336    
1337     update_floorbox if $item->{container} == 0;
1338     }
1339    
1340 root 1.87 %SDL_CB = (
1341 root 1.145 CFClient::SDL_QUIT => sub {
1342 root 1.87 Event::unloop -1;
1343     },
1344 root 1.145 CFClient::SDL_VIDEORESIZE => sub {
1345 root 1.87 },
1346 root 1.153 CFClient::SDL_VIDEOEXPOSE => \&refresh,
1347     CFClient::SDL_ACTIVEEVENT => sub {
1348     # printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1349 root 1.87 },
1350 root 1.145 CFClient::SDL_KEYDOWN => sub {
1351 root 1.147 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
1352 root 1.87 # alt-enter
1353 root 1.134 video_shutdown;
1354 root 1.99 $CFG->{fullscreen} = !$CFG->{fullscreen};
1355 root 1.134 video_init;
1356 root 1.87 } else {
1357 root 1.147 CFClient::UI::feed_sdl_key_down_event ($_[0]);
1358 elmex 1.23 }
1359 root 1.87 },
1360 root 1.153 CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
1361     CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
1362     CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
1363     CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
1364     CFClient::SDL_USEREVENT => \&audio_music_finished,
1365 root 1.87 );
1366 elmex 1.23
1367 root 1.1 #############################################################################
1368    
1369 root 1.131 $SIG{INT} = $SIG{TERM} = sub { exit };
1370    
1371 root 1.116 $TILECACHE = CFClient::db_table "tilecache";
1372     $FACEMAP = CFClient::db_table "facemap";
1373 root 1.114
1374 root 1.67 CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1375 elmex 1.10
1376 root 1.90 my %DEF_CFG = (
1377 root 1.105 sdl_mode => 0,
1378 root 1.90 width => 640,
1379     height => 480,
1380 root 1.105 fullscreen => 0,
1381 root 1.90 fast => 0,
1382 root 1.169 map_scale => 0.5,
1383 root 1.97 fow_enable => 1,
1384 root 1.90 fow_intensity => 0.45,
1385 root 1.92 fow_smooth => 0,
1386 root 1.140 gui_fontsize => 1,
1387 elmex 1.157 log_fontsize => 1,
1388 elmex 1.158 gauge_fontsize => 1,
1389     gauge_size => 0.35,
1390 elmex 1.157 stat_fontsize => 1,
1391 root 1.90 mapsize => 100,
1392     host => "crossfire.schmorp.de",
1393 elmex 1.101 say_command => 'say',
1394 root 1.139 audio_enable => 1,
1395     bgm_enable => 1,
1396 root 1.149 bgm_volume => 0.25,
1397 root 1.90 );
1398    
1399     while (my ($k, $v) = each %DEF_CFG) {
1400     $CFG->{$k} = $v unless exists $CFG->{$k};
1401     }
1402 elmex 1.12
1403 root 1.89 sdl_init;
1404 root 1.87
1405 root 1.93 @SDL_MODES = reverse
1406     grep $_->[0] >= 640 && $_->[1] >= 480,
1407 root 1.145 CFClient::SDL_ListModes;
1408 root 1.87
1409 root 1.89 @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1410    
1411     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1412    
1413 root 1.65 {
1414 root 1.168 my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1415     DejaVuSans.ttf
1416     DejaVuSansMono.ttf
1417     DejaVuSans-Bold.ttf
1418     DejaVuSansMono-Bold.ttf
1419     DejaVuSans-Oblique.ttf
1420     DejaVuSansMono-Oblique.ttf
1421     DejaVuSans-BoldOblique.ttf
1422     DejaVuSansMono-BoldOblique.ttf
1423     );
1424 root 1.65
1425 root 1.67 CFClient::add_font $_ for @fonts;
1426 root 1.168
1427     $FONT_PROP = new_from_file CFClient::Font $fonts[0];
1428     $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1429    
1430     $FONT_PROP->make_default;
1431 root 1.65 }
1432 root 1.40
1433 root 1.134 video_init;
1434     audio_init;
1435 root 1.122
1436 root 1.87 Event::loop;
1437 root 1.19
1438 root 1.148 END { CFClient::SDL_Quit }
1439 root 1.131
1440 root 1.82