ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/pclient
(Generate patch)

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.110 by root, Sat Apr 15 12:30:53 2006 UTC vs.
Revision 1.157 by elmex, Fri Apr 21 15:03:47 2006 UTC

… …
4use utf8; 4use utf8;
5 5
6use Time::HiRes 'time'; 6use Time::HiRes 'time';
7use Event; 7use Event;
8 8
9use SDL;
10use SDL::App;
11use SDL::Event;
12use SDL::Surface;
13use SDL::OpenGL;
14
15use Crossfire; 9use Crossfire;
16use Crossfire::Protocol; 10use Crossfire::Protocol;
17 11
12use Compress::LZF;
13
18use CFClient; 14use CFClient;
19use CFClient::UI; 15use CFClient::UI;
16use CFClient::MapWidget;
20 17
21our $VERSION = '0.1'; 18our $VERSION = '0.1';
22 19
23my $MAX_FPS = 60; 20my $MAX_FPS = 60;
24my $MIN_FPS = 5; # unused as of yet 21my $MIN_FPS = 5; # unused as of yet
25 22
23our $META_SERVER = "crossfire.real-time.com:13326";
24
25our $FACEMAP;
26our $TILECACHE;
26our $FACECACHE; 27our $MAPCACHE;
27 28
28our $LAST_REFRESH; 29our $LAST_REFRESH;
29our $NOW; 30our $NOW;
30 31
31our $CFG; 32our $CFG;
… …
38our $FULLSCREEN; 39our $FULLSCREEN;
39our $FONTSIZE; 40our $FONTSIZE;
40 41
41our $MAP; 42our $MAP;
42our $MAPWIDGET; 43our $MAPWIDGET;
44our $BUTTONBAR;
45our $LOGVIEW;
46our $CONSOLE;
47our $METASERVER;
48
49our $GAUGES;
50our $STATWIDS;
43 51
44our $SDL_ACTIVE; 52our $SDL_ACTIVE;
45our $SDL_EV;
46our %SDL_CB; 53our %SDL_CB;
54
55our $SDL_MIXER;
56our @SOUNDS; # event => file mapping
57our %AUDIO_CHUNKS; # audio files
47 58
48our $ALT_ENTER_MESSAGE; 59our $ALT_ENTER_MESSAGE;
49our $STATUS_LINE; 60our $STATUS_LINE;
50our $DEBUG_STATUS; 61our $DEBUG_STATUS;
51our $BUTTONBAR;
52our $LOGVIEW;
53our $CONSOLE;
54 62
55sub status { 63sub status {
56 $STATUS_LINE->set_text ($_[0]); 64 $STATUS_LINE->set_text ($_[0]);
57 my ($w, $h) = $STATUS_LINE->size_request;
58 $STATUS_LINE->size_allocate (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $h, $w, $h); 65 $STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h});
59} 66}
60 67
61sub debug { 68sub debug {
62 $DEBUG_STATUS->set_text ($_[0]); 69 $DEBUG_STATUS->set_text ($_[0]);
63 my ($w, $h) = $DEBUG_STATUS->size_request; 70 $DEBUG_STATUS->move ($WIDTH - $DEBUG_STATUS->{w}, 0, $DEBUG_STATUS->{w}, $DEBUG_STATUS->{h});
64 $DEBUG_STATUS->size_allocate ($WIDTH - $w, 0, $w, $h);
65} 71}
66 72
67sub start_game { 73sub start_game {
68 status "logging in..."; 74 status "logging in...";
69 75
70 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 76 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
71 77
78 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
79
72 $MAP = new CFClient::Map $mapsize, $mapsize; 80 $MAP = new CFClient::Map $mapsize, $mapsize;
81
82 my ($host, $port) = split /:/, $CFG->{host};
73 83
74 $CONN = new conn 84 $CONN = new conn
75 host => $CFG->{host}, 85 host => $host,
76 port => $CFG->{port}, 86 port => $port || 13327,
77 user => $CFG->{user}, 87 user => $CFG->{user},
78 pass => $CFG->{password}, 88 pass => $CFG->{password},
79 mapw => $mapsize, 89 mapw => $mapsize,
80 maph => $mapsize, 90 maph => $mapsize,
81 ; 91 ;
… …
87 97
88sub stop_game { 98sub stop_game {
89 undef $CONN; 99 undef $CONN;
90} 100}
91 101
92sub config_dialog { 102sub client_setup {
93 my $dialog = new CFClient::UI::FancyFrame 103 my $dialog = new CFClient::UI::FancyFrame
104 title => "Client Setup",
94 child => (my $vbox = new CFClient::UI::VBox); 105 child => (my $vbox = new CFClient::UI::VBox);
95 $vbox->add (new CFClient::UI::Label align => 0, text => "Client Setup");
96 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]); 106 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
97 107
98 $table->add (0, 0, new CFClient::UI::Label align => 1, text => "Video Mode"); 108 $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
99 $table->add (1, 0, my $hbox = new CFClient::UI::HBox); 109 $table->add (1, 0, my $hbox = new CFClient::UI::HBox);
100 110
101 $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]); 111 $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);
102 $hbox->add (my $mode_label = new CFClient::UI::Label height => $FONTSIZE * 0.8); 112 $hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
103 113
104 $mode_slider->connect (changed => sub { 114 $mode_slider->connect (changed => sub {
105 my ($self, $value) = @_; 115 my ($self, $value) = @_;
106 116
107 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value; 117 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
108 $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]}); 118 $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
109 }); 119 });
110 $mode_slider->emit (changed => $mode_slider->{range}[0]); 120 $mode_slider->emit (changed => $mode_slider->{range}[0]);
111 121
112 $table->add (0, 1, new CFClient::UI::Label align => 1, text => "Fullscreen"); 122 $table->add (0, 1, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
113 $table->add (1, 1, new CFClient::UI::CheckBox state => $CFG->{fullscreen}, connect_changed => sub { 123 $table->add (1, 1, new CFClient::UI::CheckBox state => $CFG->{fullscreen}, connect_changed => sub {
114 my ($self, $value) = @_; 124 my ($self, $value) = @_;
115 $CFG->{fullscreen} = $value; 125 $CFG->{fullscreen} = $value;
116 }); 126 });
117 127
118 $table->add (0, 2, new CFClient::UI::Label align => 1, text => "Fast & Ugly"); 128 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
119 $table->add (1, 2, new CFClient::UI::CheckBox state => $CFG->{fast}, connect_changed => sub { 129 $table->add (1, 2, new CFClient::UI::CheckBox state => $CFG->{fast}, connect_changed => sub {
120 my ($self, $value) = @_; 130 my ($self, $value) = @_;
121 $CFG->{fast} = $value; 131 $CFG->{fast} = $value;
122 }); 132 });
123 133
124 $table->add (0, 3, new CFClient::UI::Label align => 1, text => "Fog of War"); 134 $table->add (0, 3, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
125 $table->add (1, 3, new CFClient::UI::CheckBox state => $CFG->{fow_enable}, connect_changed => sub { 135 $table->add (1, 3, new CFClient::UI::CheckBox state => $CFG->{fow_enable}, connect_changed => sub {
126 my ($self, $value) = @_; 136 my ($self, $value) = @_;
127 $CFG->{fow_enable} = $value; 137 $CFG->{fow_enable} = $value;
128 }); 138 });
129 139
130 $table->add (0, 4, new CFClient::UI::Label align => 1, text => "FoW Intensity"); 140 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
131 $table->add (1, 4, new CFClient::UI::Slider range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001], connect_changed => sub { 141 $table->add (1, 4, new CFClient::UI::Slider range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001], connect_changed => sub {
132 my ($self, $value) = @_; 142 my ($self, $value) = @_;
133 $CFG->{fow_intensity} = $value; 143 $CFG->{fow_intensity} = $value;
134 }); 144 });
135 145
136 $table->add (0, 5, new CFClient::UI::Label align => 1, text => "FoW Smooth"); 146 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
137 $table->add (1, 5, new CFClient::UI::CheckBox state => $CFG->{fow_smooth}, connect_changed => sub { 147 $table->add (1, 5, new CFClient::UI::CheckBox state => $CFG->{fow_smooth}, connect_changed => sub {
138 my ($self, $value) = @_; 148 my ($self, $value) = @_;
139 $CFG->{fow_smooth} = $value; 149 $CFG->{fow_smooth} = $value;
150 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;
140 }); 151 });
141 152
142 $table->add (0, 5, new CFClient::UI::Label align => 1, text => "Log Fontsize"); 153 $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
154 $table->add (1, 6, new CFClient::UI::Slider range => [$CFG->{gui_fontsize}, 0.7, 1.7, 0.1], connect_changed => sub {
155 $CFG->{gui_fontsize} = 0.1 * int $_[1] * 10;
156# $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
157 });
158
159 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize");
143 $table->add (1, 5, new CFClient::UI::Slider range => [$CFG->{log_fontsize}, 8, 30, 1], connect_changed => sub { 160 $table->add (1, 7, new CFClient::UI::Slider range => [$CFG->{log_fontsize}, 0.7, 1.7, 0.1], connect_changed => sub {
144 my ($self, $value) = @_;
145 $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = int $value); 161 $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10);
146 }); 162 });
147 163
164 $table->add (0, 8, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
165 $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{stat_fontsize}, 0.7, 1.7, 0.1], connect_changed => sub {
166 $CFG->{stat_fontsize} = 0.1 * int $_[1] * 10;
167 &set_stats_window_fontsize;
168 });
169
170
148 $table->add (1, 6, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub { 171 $table->add (1, 9, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub {
149 destroy_screen (); 172 video_shutdown ();
150 init_screen (); 173 video_init ();
174 });
175
176 $table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
177 $table->add (1, 10, new CFClient::UI::CheckBox state => $CFG->{audio_enable}, connect_changed => sub {
178 $CFG->{audio_enable} = $_[1];
179 });
180# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
181# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub {
182# $CFG->{effects_volume} = $_[1];
151 }); 183# });
184 $table->add (0, 11, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
185 $table->add (1, 11, my $hbox = new CFClient::UI::HBox);
186 $hbox->add (new CFClient::UI::CheckBox expand => 1, state => $CFG->{bgm_enable}, connect_changed => sub {
187 $CFG->{bgm_enable} = $_[1];
188 });
189 $hbox->add (new CFClient::UI::Slider expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1], connect_changed => sub {
190 $CFG->{bgm_volume} = $_[1];
191 CFClient::MixMusic::volume $_[1] * 128;
192 });
193
194 $table->add (1, 12, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub {
195 audio_shutdown ();
196 audio_init ();
197 });
198
199 $dialog
200}
201
202sub set_stats_window_fontsize {
203 for (values %{$STATWIDS}, values %{$GAUGES}) {
204 $_->set_fontsize ($::CFG->{stat_fontsize});
205 }
206}
207
208sub make_stats_window {
209 my $tgw = new CFClient::UI::FancyFrame (x => $WIDTH * 2/5, y => 0, title => "Stats");
210
211 $tgw->add (my $vb = new CFClient::UI::VBox);
212 $vb->add (my $uhb = new CFClient::UI::HBox);
213 $uhb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);
214 $uhb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1);
215 $vb->add (my $dhb = new CFClient::UI::HBox);
216 $dhb->add ($STATWIDS->{exp} = new CFClient::UI::Label valign => 0, align => -1, text => "Exp:", expand => 1);
217 $dhb->add ($STATWIDS->{lvl} = new CFClient::UI::Label valign => 0, align => -1, text => "Level:", expand => 1);
218
219 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
220 $hb->add (my $hg = new CFClient::UI::Gauge type => 'hp', expand => 1);
221 $hb->add (my $mg = new CFClient::UI::Gauge type => 'mana', expand => 1);
222 $hb->add (my $gg = new CFClient::UI::Gauge type => 'grace', expand => 1);
223 $hb->add (my $fg = new CFClient::UI::Gauge type => 'food', expand => 1);
224 $GAUGES = { food => $fg, mana => $mg, hp => $hg, grace => $gg };
225
226 $hb->add (my $tbl = new CFClient::UI::Table expand => 1);
227
228 if (0) { # this code can vanish, just wanted to preserver it for a checkin
229 $tbl->add (0, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => -1, text => "S");
230 $tbl->add (0, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => -1, text => "D");
231 $tbl->add (0, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => -1, text => "Co");
232 $tbl->add (0, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => -1, text => "I");
233 $tbl->add (0, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => -1, text => "W");
234 $tbl->add (0, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => -1, text => "P");
235 $tbl->add (0, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => -1, text => "Ch");
236
237 $tbl->add (1, 0, $STATWIDS->{st_wc} = new CFClient::UI::Label valign => 0, align => -1, text => "Wc");
238 $tbl->add (1, 1, $STATWIDS->{st_ac} = new CFClient::UI::Label valign => 0, align => -1, text => "Ac");
239 $tbl->add (1, 2, $STATWIDS->{st_dam} = new CFClient::UI::Label valign => 0, align => -1, text => "Dam");
240 $tbl->add (1, 3, $STATWIDS->{st_arm} = new CFClient::UI::Label valign => 0, align => -1, text => "Arm");
241 $tbl->add (1, 4, $STATWIDS->{st_spd} = new CFClient::UI::Label valign => 0, align => -1, text => "Sp");
242 $tbl->add (1, 5, $STATWIDS->{st_wspd} = new CFClient::UI::Label valign => 0, align => -1, text => "WSp");
243 } else {
244 $tbl->add (0, 0, $STATWIDS->{st_str_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "S");
245 $tbl->add (0, 1, $STATWIDS->{st_dex_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "D");
246 $tbl->add (0, 2, $STATWIDS->{st_con_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Co");
247 $tbl->add (0, 3, $STATWIDS->{st_int_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "I");
248 $tbl->add (0, 4, $STATWIDS->{st_wis_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "W");
249 $tbl->add (0, 5, $STATWIDS->{st_pow_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "P");
250 $tbl->add (0, 6, $STATWIDS->{st_cha_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Ch");
251
252 $tbl->add (1, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => -1, text => "");
253 $tbl->add (1, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => -1, text => "");
254 $tbl->add (1, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => -1, text => "");
255 $tbl->add (1, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => -1, text => "");
256 $tbl->add (1, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => -1, text => "");
257 $tbl->add (1, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => -1, text => "");
258 $tbl->add (1, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => -1, text => "");
259
260 $tbl->add (2, 0, $STATWIDS->{st_wc_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Wc");
261 $tbl->add (2, 1, $STATWIDS->{st_ac_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Ac");
262 $tbl->add (2, 2, $STATWIDS->{st_dam_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Dam");
263 $tbl->add (2, 3, $STATWIDS->{st_arm_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Arm");
264 $tbl->add (2, 4, $STATWIDS->{st_spd_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Sp");
265 $tbl->add (2, 5, $STATWIDS->{st_wspd_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "WSp");
266
267 $tbl->add (3, 0, $STATWIDS->{st_wc} = new CFClient::UI::Label valign => 0, align => -1, text => "");
268 $tbl->add (3, 1, $STATWIDS->{st_ac} = new CFClient::UI::Label valign => 0, align => -1, text => "");
269 $tbl->add (3, 2, $STATWIDS->{st_dam} = new CFClient::UI::Label valign => 0, align => -1, text => "");
270 $tbl->add (3, 3, $STATWIDS->{st_arm} = new CFClient::UI::Label valign => 0, align => -1, text => "");
271 $tbl->add (3, 4, $STATWIDS->{st_spd} = new CFClient::UI::Label valign => 0, align => -1, text => "");
272 $tbl->add (3, 5, $STATWIDS->{st_wspd} = new CFClient::UI::Label valign => 0, align => -1, text => "");
273 }
274
275 $hb->add (my $tbl2 = new CFClient::UI::Table);
276
277 my $row = 0;
278 my $col = 0;
279
280 for (qw/slow holyw conf fire depl magic
281 drain acid pois para deat phys
282 blind fear tund elec cold ghit/)
283 {
284 $tbl2->add ($col, $row, new CFClient::UI::Image image => "ui/resist/resist_$_.png");
285 $tbl2->add ($col + 1, $row,
286 $STATWIDS->{"res_$_"} =
287 new CFClient::UI::Label text => "0", align => -1, valign => 0
288 );
289
290 $row++;
291 if ($row % 6 == 0) {
292 $col += 2;
293 $row = 0;
294 }
295 }
296
297 &set_stats_window_fontsize;
298 update_stats_window ({});
299
300 $tgw
301}
302
303sub update_stats_window {
304 my ($stats) = @_;
305
306 # i love text protocols!!!
307 my $hp = $stats->{1} * 1;
308 my $hp_m = $stats->{2} * 1;
309 my $sp = $stats->{3} * 1;
310 my $sp_m = $stats->{4} * 1;
311 my $fo = $stats->{18} * 1;
312 my $fo_m = 999;
313 my $gr = $stats->{23} * 1;
314 my $gr_m = $stats->{24} * 1;
315
316 $GAUGES->{hp} ->set_value ($hp, $hp_m);
317 $GAUGES->{mana} ->set_value ($sp, $sp_m);
318 $GAUGES->{food} ->set_value ($fo, $fo_m);
319 $GAUGES->{grace} ->set_value ($gr, $gr_m);
320 $STATWIDS->{title} ->set_text ("Title: " . $stats->{21});
321 $STATWIDS->{exp} ->set_text ("Exp.: " . ($stats->{11} || $stats->{28}));
322 $STATWIDS->{lvl} ->set_text ("Level: " . $stats->{12});
323
324 if (0) { # this code can vanish, just wanted to preserver it for a checkin
325 $STATWIDS->{st_str} ->set_text (sprintf "S%d", $stats->{5});
326 $STATWIDS->{st_dex} ->set_text (sprintf "D%d", $stats->{8});
327 $STATWIDS->{st_con} ->set_text (sprintf "Co%d", $stats->{9});
328 $STATWIDS->{st_int} ->set_text (sprintf "I%d", $stats->{6});
329 $STATWIDS->{st_wis} ->set_text (sprintf "W%d", $stats->{7});
330 $STATWIDS->{st_pow} ->set_text (sprintf "P%d", $stats->{22});
331 $STATWIDS->{st_cha} ->set_text (sprintf "Ch%d", $stats->{10});
332 $STATWIDS->{st_wc} ->set_text (sprintf "Wc%d", $stats->{13});
333 $STATWIDS->{st_ac} ->set_text (sprintf "Ac%d", $stats->{14});
334 $STATWIDS->{st_dam} ->set_text (sprintf "Dam%d", $stats->{15});
335 $STATWIDS->{st_arm} ->set_text (sprintf "Arm%d", $stats->{16});
336 $STATWIDS->{st_spd} ->set_text (sprintf "Sp%.1f", $stats->{17});
337 $STATWIDS->{st_wspd}->set_text (sprintf "WSp%.1f", $stats->{19});
338 } else {
339 $STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});
340 $STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});
341 $STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});
342 $STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});
343 $STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});
344 $STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});
345 $STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});
346 $STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});
347 $STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});
348 $STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});
349 $STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});
350 $STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{17});
351 $STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{19});
352 }
353
354 my %tbl = (
355 phys => 100,
356 magic => 101,
357 fire => 102,
358 elec => 103,
359 cold => 104,
360 conf => 105,
361 acid => 106,
362 drain => 107,
363 ghit => 108,
364 pois => 109,
365 slow => 110,
366 para => 111,
367 tund => 112,
368 fear => 113,
369 deat => 115,
370 holyw => 116,
371 blind => 117
372 );
373
374 for (keys %tbl) {
375 $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});
376 }
377
378}
379
380sub metaserver_dialog {
381 my $dialog = new CFClient::UI::FancyFrame
382 title => "Metaserver",
383 child => (my $vbox = new CFClient::UI::VBox);
384
385 $vbox->add ($dialog->{table} = new CFClient::UI::Table);
386
387 $dialog
388}
389
390sub update_metaserver {
391 my ($HOST) = @_;
392
393 status "fetching metaserver list...";
394
395 my $buf;
396
397 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
398
399 Event->io (fd => $fh, poll => 'r', cb => sub {
400 my $res = sysread $fh, $buf, 8192, length $buf;
401
402 if (!defined $res) {
403 $_[0]->w->cancel;
404 status "metaserver: $!";
405 } elsif ($res == 0) {
406 $_[0]->w->cancel;
407 status "server list retrieved";
408
409 my $table = $METASERVER->{table};
410
411 $table->clear;
412
413 my @col = qw(Use #Users Host Uptime Version Description);
414 $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
415 for 0 .. $#col;
416
417 my @align = qw(1 0 1 1 -1);
418
419 my $y = 0;
420 for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
421 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;
422
423 for ($desc) {
424 s/<br>/\n/gi;
425 s/<li>/\n· /gi;
426 s/<.*?>//sgi;
427 s/&/&amp;/g;
428 s/</&lt;/g;
429 s/>/&gt;/g;
430 }
431
432 $uptime = sprintf "%dd %02d:%02d:%02d",
433 (int $m->[8] / 86400),
434 (int $m->[8] / 3600) % 24,
435 (int $m->[8] / 60) % 60,
436 $m->[8] % 60;
437
438 $m = [$users, $host, $uptime, $version, $desc];
439
440 $y++;
441
442 $table->add (0, $y, new CFClient::UI::VBox children => [
443 (new CFClient::UI::Button text => " ", connect_activate => sub {
444 $HOST->set_text ($CFG->{host} = $host);
445 }),
446 (new CFClient::UI::Empty expand => 1),
447 ]);
448
449 $table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => 0.8)
450 for 0 .. $#$m;
451 }
452 }
453 });
454}
455
456sub server_setup {
457 my $dialog = new CFClient::UI::FancyFrame
458 title => "Server Setup",
459 child => (my $vbox = new CFClient::UI::VBox);
152 460
153 $vbox->add (new CFClient::UI::Label align => 0, text => "Server Setup");
154 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]); 461 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
155 $table->add (0, 2, new CFClient::UI::Label align => 1, text => "Host"); 462 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
463
464 {
465 $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
466
156 $table->add (1, 2, my $host = new CFClient::UI::Entry text => $CFG->{host}, connect_changed => sub { 467 $vbox->add (my $HOST = new CFClient::UI::Entry expand => 1, text => $CFG->{host}, connect_changed => sub {
157 my ($self, $value) = @_; 468 my ($self, $value) = @_;
158 $CFG->{host} = $value; 469 $CFG->{host} = $value;
159 }); 470 });
160 471
161 $table->add (0, 3, new CFClient::UI::Label align => 1, text => "Port"); 472 $METASERVER = metaserver_dialog;
162 $table->add (1, 3, my $port = new CFClient::UI::Entry text => $CFG->{port}, connect_changed => sub { 473
163 my ($self, $value) = @_; 474 $vbox->add (new CFClient::UI::Flopper expand => 1, text => "Metaserver", other => $METASERVER, connect_open => sub {
164 $CFG->{port} = $value; 475 update_metaserver $HOST;
165 }); 476 });
477 }
166 478
167 $table->add (0, 4, new CFClient::UI::Label align => 1, text => "Username"); 479 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
168 $table->add (1, 4, my $user = new CFClient::UI::Entry text => $CFG->{user}, connect_changed => sub { 480 $table->add (1, 4, new CFClient::UI::Entry text => $CFG->{user}, connect_changed => sub {
169 my ($self, $value) = @_; 481 my ($self, $value) = @_;
170 $CFG->{user} = $value; 482 $CFG->{user} = $value;
171 }); 483 });
172 484
173 $table->add (0, 5, new CFClient::UI::Label align => 1, text => "Password"); 485 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
174 $table->add (1, 5, my $pass = new CFClient::UI::Entry text => $CFG->{password}, hidden => 1, connect_changed => sub { 486 $table->add (1, 5, new CFClient::UI::Entry text => $CFG->{password}, hidden => 1, connect_changed => sub {
175 my ($self, $value) = @_; 487 my ($self, $value) = @_;
176 $CFG->{password} = $value; 488 $CFG->{password} = $value;
177 }); 489 });
178 490
179 $table->add (0, 6, new CFClient::UI::Label align => 1, text => "Def. say cmd"); 491 $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");
180 $table->add (1, 6, my $saycmd = new CFClient::UI::Entry text => $CFG->{say_command}, connect_changed => sub { 492 $table->add (1, 6, my $saycmd = new CFClient::UI::Entry text => $CFG->{say_command}, connect_changed => sub {
181 my ($self, $value) = @_; 493 my ($self, $value) = @_;
182 $CFG->{say_command} = $value; 494 $CFG->{say_command} = $value;
183 }); 495 });
184 496
185 $table->add (0, 7, new CFClient::UI::Label align => 1, text => "Map Size"); 497 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
186 $table->add (1, 7, new CFClient::UI::Slider 498 $table->add (1, 7, new CFClient::UI::Slider
187 req_w => 100, 499 req_w => 100,
188 range => [$CFG->{mapsize}, 10, 100 + 1, 1], 500 range => [$CFG->{mapsize}, 10, 100 + 1, 1],
189 connect_changed => sub { 501 connect_changed => sub {
190 my ($self, $value) = @_; 502 my ($self, $value) = @_;
… …
195 507
196 $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub { 508 $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub {
197 start_game; 509 start_game;
198 }); 510 });
199 511
200 $vbox->add (my $hbox = new CFClient::UI::HBox);
201
202 $hbox->add (new CFClient::UI::Button expand => 1, align => 0, text => "Save", connect_activate => sub {
203 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
204 status "Configuration Saved";
205 });
206
207 $dialog 512 $dialog
208} 513}
209 514
210sub console_window { 515sub message_window {
211 my $window = new CFClient::UI::FancyFrame 516 my $window = new CFClient::UI::FancyFrame
517 title => "Messages",
212 border_bg => [1, 1, 1, 0.5], 518 border_bg => [1, 1, 1, 0.5],
213 bg => [0.3, 0.3, 0.3, 0.8], 519 bg => [0.3, 0.3, 0.3, 0.8],
214 user_w => $::WIDTH/4, 520 user_w => int $::WIDTH / 3,
215 user_h => $::HEIGHT, 521 user_h => int $::HEIGHT / 5,
216 child => (my $vbox = new CFClient::UI::VBox); 522 child => (my $vbox = new CFClient::UI::VBox);
217 523
218 $vbox->add ($LOGVIEW = new CFClient::UI::TextView 524 $vbox->add ($LOGVIEW = new CFClient::UI::TextView
219 expand => 1, 525 expand => 1,
220 fontsize => $::CFG->{log_fontsize}, 526 fontsize => $::CFG->{log_fontsize},
221 ); 527 );
222 528
223 $vbox->add (my $input = new CFClient::UI::LineEntry); 529 $vbox->add (my $input = new CFClient::UI::Entry
530 connect_focus_in => sub {
531 my ($input, $prev_focus) = @_;
532
533 delete $input->{refocus_map};
534
535 if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
536 $input->{refocus_map} = 1;
537 }
538 delete $input->{auto_activated};
539 },
224 $input->connect (activate => sub { 540 connect_activate => sub {
225 my ($input, $text) = @_; 541 my ($input, $text) = @_;
226 $input->set_text (''); 542 $input->set_text ('');
227 543
228 if ($text =~ /^\/(.*)/) { 544 if ($text =~ /^\/(.*)/) {
229 $::CONN->user_send ("command $1"); 545 $::CONN->user_send ($1);
230 } else { 546 } else {
231 my $say_cmd = $::CFG->{say_command} || 'say'; 547 my $say_cmd = $::CFG->{say_command} || 'say';
232 $::CONN->user_send ("command $say_cmd $text"); 548 $::CONN->user_send ("$say_cmd $text");
233 } 549 }
550 if ($input->{refocus_map}) {
551 delete $input->{refocus_map};
552 $MAPWIDGET->focus_in
234 1 553 }
235 }); 554 },
236 $input->connect (escape => sub { 555 connect_escape => sub {
237 $MAPWIDGET->focus_in 556 $MAPWIDGET->focus_in
238 }); 557 },
239 $input->focus_in; 558 );
240 559
241 $CONSOLE = { 560 $CONSOLE = {
242 window => $window, 561 window => $window,
243 input => $input 562 input => $input
244 }; 563 };
245 564
246 $window 565 $window
247} 566}
248 567
249sub sdl_init { 568sub sdl_init {
250 #SDL::Init SDL_INIT_AUDIO | SDL_INIT_VIDEO | SDL_INIT_NOPARACHUTE 569 CFClient::SDL_Init
251 SDL::Init SDL_INIT_AUDIO | SDL_INIT_VIDEO
252 and die "SDL::Init failed!\n"; 570 and die "SDL::Init failed!\n";
253} 571}
254 572
255sub init_screen { 573sub video_init {
256 sdl_init; 574 sdl_init;
257 575
258 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] }; 576 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
259 $FULLSCREEN = $CFG->{fullscreen}; 577 $FULLSCREEN = $CFG->{fullscreen};
260 $FAST = $CFG->{fast}; 578 $FAST = $CFG->{fast};
261 579
262 SDL::GLSetAttribute SDL_GL_RED_SIZE, 5; 580 CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
263 SDL::GLSetAttribute SDL_GL_GREEN_SIZE, 5;
264 SDL::GLSetAttribute SDL_GL_BLUE_SIZE, 5;
265 SDL::GLSetAttribute SDL_GL_ALPHA_SIZE, 0;
266
267 SDL::GLSetAttribute SDL_GL_ACCUM_RED_SIZE, 0;
268 SDL::GLSetAttribute SDL_GL_ACCUM_GREEN_SIZE, 0;
269 SDL::GLSetAttribute SDL_GL_ACCUM_BLUE_SIZE, 0;
270 SDL::GLSetAttribute SDL_GL_ACCUM_ALPHA_SIZE, 0;
271
272 SDL::GLSetAttribute SDL_GL_DOUBLEBUFFER, 1;
273 SDL::GLSetAttribute SDL_GL_BUFFER_SIZE, 15;
274 SDL::GLSetAttribute SDL_GL_DEPTH_SIZE, 0;
275
276 SDL::SetVideoMode $WIDTH, $HEIGHT, 0,
277 SDL_HWSURFACE | SDL_ANYFORMAT | SDL_OPENGL | SDL_DOUBLEBUF
278 | ($FULLSCREEN ? SDL_FULLSCREEN : 0)
279 or die "SDL::SetVideoMode failed!\n"; 581 or die "SDL_SetVideoMode failed!\n";
280
281 SDL::WMSetCaption "Crossfire+ Client", "Crossfire+";
282
283 $SDL_EV = new SDL::Event;
284 $SDL_EV->set_unicode (1);
285 582
286 $SDL_ACTIVE = 1; 583 $SDL_ACTIVE = 1;
287 584
288 $LAST_REFRESH = time - 0.01; 585 $LAST_REFRESH = time - 0.01;
289 586
290 CFClient::gl_init; 587 CFClient::gl_init;
291 588
292 $FONTSIZE = int $HEIGHT / 40; 589 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
293 590
294 ############################################################################# 591 #############################################################################
295 592
296 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100; 593 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100;
297 $CFClient::UI::TOPLEVEL->add ($DEBUG_STATUS); 594 $DEBUG_STATUS->show;
298 595
299 $STATUS_LINE = new CFClient::UI::Label 596 $STATUS_LINE = new CFClient::UI::Label
300 padding => 0, 597 padding => 0,
301 y => $HEIGHT * 44 / 45 - $FONTSIZE; 598 y => $HEIGHT - $FONTSIZE * 1.8;
302 $CFClient::UI::TOPLEVEL->add ($STATUS_LINE); 599 $STATUS_LINE->show;
303 600
304 $ALT_ENTER_MESSAGE = new CFClient::UI::Label 601 $ALT_ENTER_MESSAGE = new CFClient::UI::Label
305 padding => 0, 602 padding => 0,
306 y => $HEIGHT * 44 / 45, 603 fontsize => 0.8,
307 height => $HEIGHT / 45,
308 text => "Use <b>Alt-Enter</b> to toggle fullscreen mode"; 604 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
309 $CFClient::UI::TOPLEVEL->add ($ALT_ENTER_MESSAGE); 605 $ALT_ENTER_MESSAGE->show;
606 $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
310 607
311 $CFClient::UI::TOPLEVEL->add ($MAPWIDGET = new CFClient::UI::MapWidget); 608 $CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::MapWidget);
312 $MAPWIDGET->focus_in; 609 $MAPWIDGET->focus_in;
313 $MAPWIDGET->connect (activate_console => sub { 610 $MAPWIDGET->connect (activate_console => sub {
314 my ($mapwidget, $preset) = @_; 611 my ($mapwidget, $preset) = @_;
315 612
316 if ($CONSOLE) { 613 if ($CONSOLE) {
614 $CONSOLE->{input}->{auto_activated} = 1;
317 $CONSOLE->{input}->focus_in; 615 $CONSOLE->{input}->focus_in;
318 616
319 if ($preset && $CONSOLE->{input}->get_text eq '') { 617 if ($preset && $CONSOLE->{input}->get_text eq '') {
320 $CONSOLE->{input}->set_text ($preset); 618 $CONSOLE->{input}->set_text ($preset);
321 } 619 }
322 } 620 }
323 }); 621 });
324 622
325 $CFClient::UI::TOPLEVEL->add ($BUTTONBAR = new CFClient::UI::HBox); 623 $CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox);
326 624
327 $BUTTONBAR->add (my $setup = new CFClient::UI::Flopper text => "Client Setup", other => config_dialog, state => 1); 625 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
328 $BUTTONBAR->add (my $setup = new CFClient::UI::Flopper text => "Server", other => config_dialog, state => 1); 626 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
329 $BUTTONBAR->add (my $setup = new CFClient::UI::Flopper text => "Console", other => console_window); 627 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
330 $BUTTONBAR->add (my $setup = new CFClient::UI::Button text => "Save Config", other => console_window);
331}
332 628
333sub destroy_screen { 629 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
630 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
631 status "Configuration Saved";
632 });
633
634 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
635
636
637 $CFClient::UI::ROOT->add (make_stats_window);
638}
639
640sub video_shutdown {
334 $CFClient::UI::TOPLEVEL->{children} = []; 641 $CFClient::UI::ROOT->{children} = [];
335 undef $SDL_ACTIVE; 642 undef $SDL_ACTIVE;
643}
644
645my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
646my $bgmusic;#TODO#hack#d#
647
648sub audio_music_finished {
649 return unless $CFG->{bgm_enable};
650
651 # TODO: hack, do play loop and mood music
652 $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
653 $bgmusic->play (0);
654
655 push @bgmusic, shift @bgmusic;
656}
657
658sub audio_init {
659 if ($CFG->{audio_enable}) {
660 if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") {
661 $SDL_MIXER = !CFClient::Mix_OpenAudio;
662 CFClient::Mix_AllocateChannels 8;
663 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
664
665 audio_music_finished;
666
667 while (<$fh>) {
668 next if /^\s*#/;
669 next if /^\s*$/;
670
671 my ($file, $volume, $event) = split /\s+/, $_, 3;
672
673 push @SOUNDS, "$volume,$file";
674
675 $AUDIO_CHUNKS{"$volume,$file"} ||= do {
676 my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
677 $chunk->volume ($volume * 128 / 100);
678 $chunk
679 };
680 }
681 } else {
682 status "unable to open sound config: $!";
683 }
684 }
685}
686
687sub audio_shutdown {
688 CFClient::Mix_CloseAudio if $SDL_MIXER;
336 undef $SDL_EV; 689 undef $SDL_MIXER;
337 SDL::Quit; 690 @SOUNDS = ();
691 %AUDIO_CHUNKS = ();
338} 692}
339 693
340my %animate_object; 694my %animate_object;
341my $animate_timer; 695my $animate_timer;
342 696
… …
350 debug sprintf "%3.2f", $fps; 704 debug sprintf "%3.2f", $fps;
351 705
352 $want_refresh = 0; 706 $want_refresh = 0;
353 $can_refresh = 0; 707 $can_refresh = 0;
354 708
355 $CFClient::UI::TOPLEVEL->draw; 709 $CFClient::UI::ROOT->draw;
356 710
357 SDL::GLSwapBuffers; 711 CFClient::SDL_GL_SwapBuffers;
358 712
359 $LAST_REFRESH = $NOW; 713 $LAST_REFRESH = $NOW;
360} 714}
361 715
362my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub { 716my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
363 $NOW = time; 717 $NOW = time;
364 718
365 ($SDL_CB{$SDL_EV->type} || sub { warn "unhandled event ", $SDL_EV->type })->() 719 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
366 while $SDL_EV->poll; 720 for CFClient::SDL_PollEvent;
367 721
368 if (%animate_object) { 722 if (%animate_object) {
369 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object; 723 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
370 $want_refresh++; 724 $want_refresh++;
371 } 725 }
… …
391 delete $animate_object{$widget}; 745 delete $animate_object{$widget};
392} 746}
393 747
394@conn::ISA = Crossfire::Protocol::; 748@conn::ISA = Crossfire::Protocol::;
395 749
750sub conn::stats_update {
751 my ($self, $stats) = @_;
752
753 update_stats_window ($stats);
754}
755
396sub conn::user_send { 756sub conn::user_send {
397 my ($self, $command) = @_; 757 my ($self, $command) = @_;
398 758
399 $self->send ($command); 759 $self->send_command ($command);
400 status $command; 760 status $command;
761}
762
763sub conn::map_scroll {
764 my ($self, $dx, $dy) = @_;
765
766 $MAP->scroll ($dx, $dy);
401} 767}
402 768
403sub conn::feed_map1a { 769sub conn::feed_map1a {
404 my ($self, $data) = @_; 770 my ($self, $data) = @_;
405 771
406# $self->Crossfire::Protocol::feed_map1a ($data); 772# $self->Crossfire::Protocol::feed_map1a ($data);
407 773
408 $MAP->scroll (delete $self->{delayed_scroll_x}, delete $self->{delayed_scroll_y});
409 $MAP->map1a_update ($data); 774 $MAP->map1a_update ($data);
410 $MAPWIDGET->update; 775 $MAPWIDGET->update;
411} 776}
412 777
413#sub conn::map_update { 778sub conn::flush_map {
414# my ($self, $dirty) = @_; 779 my ($self) = @_;
415# 780
416# $MAPWIDGET->update; 781 my $map_info = delete $self->{map_info}
417#} 782 or return;
783
784 my ($hash, $x, $y, $w, $h) = @$map_info;
785
786 my $data = $MAP->get_rect ($x, $y, $w, $h);
787 $MAPCACHE->put ($hash => Compress::LZF::compress $data);
788 #warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
789}
418 790
419sub conn::map_clear { 791sub conn::map_clear {
420 my ($self) = @_; 792 my ($self) = @_;
421 793
794 $self->flush_map;
795 delete $self->{neigh_map};
796
422 $MAP->clear; 797 $MAP->clear;
798}
423 799
424# refresh; 800
801sub conn::load_map($$$) {
802 my ($self, $hash, $x, $y) = @_;
803
804 if (defined (my $data = $MAPCACHE->get ($hash))) {
805 $data = Compress::LZF::decompress $data;
806 #warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
807 for my $id ($MAP->set_rect ($x, $y, $data)) {
808 my $data = $TILECACHE->get ($id)
809 or next;
810
811 $self->set_texture ($id => $data);
812 }
813 }
814}
815
816# this method does a "flood fill" into every tile direction
817# it assumes that tiles are arranged in a rectangular grid,
818# i.e. a map is the same as the left of the right map etc.
819# failure to comply are harmless and result in display errors
820# at worst.
821sub conn::flood_fill {
822 my ($self, $gx, $gy, $path, $hash, $flags) = @_;
823
824 # the server does not allow map paths > 6
825 return if 6 <= length $path;
826
827 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
828
829 for (
830 [1, 0, -1],
831 [2, 1, 0],
832 [3, 0, 1],
833 [4, -1, 0],
834 ) {
835 my ($tile, $dx, $dy) = @$_;
836
837 my $gx = $gx + $dx;
838 my $gy = $gy + $dy;
839
840 next unless $flags & (1 << ($tile - 1));
841 next if $self->{neigh_grid}{$gx, $gy}++;
842
843 my $neigh = $self->{neigh_map}{$hash} ||= [];
844 if (my $info = $neigh->[$tile]) {
845 my ($flags, $x, $y, $w, $h, $hash) = @$info;
846
847 $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
848 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
849
850 } else {
851 $self->send_mapinfo ("spatial $path$tile", sub {
852 my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
853
854 return if $mode ne "spatial";
855
856 $x += $MAP->ox;
857 $y += $MAP->oy;
858
859 $self->load_map ($hash, $x, $y)
860 unless $self->{neigh_map}{$hash}[5]++;#d#
861
862 $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
863
864 $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
865 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
866 });
867 }
868 }
869}
870
871sub conn::map_change {
872 my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
873
874 $self->flush_map;
875
876 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
877
878 my $mapmapw = 250;
879 my $mapmaph = 250;
880
881 $self->{neigh_rect} = [
882 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
883 $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
884 ];
885
886 delete $self->{neigh_grid};
887 $self->flood_fill (0, 0, "", $hash, $flags);
888
889 $x += $ox;
890 $y += $oy;
891
892 $self->{map_info} = [$hash, $x, $y, $w, $h];
893
894 $STATWIDS->{map}->set_text ("Map: " . $self->{map_info}[0]);
895
896 $self->load_map ($hash, $x, $y);
425} 897}
426 898
427sub conn::face_find { 899sub conn::face_find {
428 my ($self, $face) = @_; 900 my ($self, $facenum, $face) = @_;
429 901
430 $FACECACHE->{"$face->{chksum},$face->{name}"} 902 my $hash = "$face->{chksum},$face->{name}";
903
904 my $id = $FACEMAP->get ($hash);
905
906 unless ($id) {
907 # create new id for face
908 # i love transactions
909 for (1..100) {
910 my $txn = $CFClient::DB_ENV->txn_begin;
911 my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
912 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
913 $id++;
914 if ($FACEMAP->put (id => $id) == 0
915 && $FACEMAP->put ($hash => $id) == 0) {
916 $txn->txn_commit;
917
918 goto gotid;
919 }
920 }
921 $txn->abort;
922 }
923
924 CFClient::fatal "maximum number of transaction retries reached - database problems?";
925 }
926
927gotid:
928 $face->{id} = $id;
929 $MAP->set_face ($facenum => $id);
930 $TILECACHE->get ($id)
431} 931}
432 932
433sub conn::face_update { 933sub conn::face_update {
434 my ($self, $facenum, $face) = @_; 934 my ($self, $facenum, $face) = @_;
435 935
436 $FACECACHE->{"$face->{chksum},$face->{name}"} = $face->{image}; 936 $TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
437 937
438 my $tex = $face->{texture} = 938 $self->set_texture ($face->{id} => delete $face->{image});
939}
940
941sub conn::set_texture {
942 my ($self, $id, $data) = @_;
943
944 $self->{texture}[$id] ||= do {
945 my $tex =
439 new_from_image CFClient::Texture 946 new_from_image CFClient::Texture
440 delete $face->{image}, minify => 1; 947 $data, minify => 1;
441 948
442 $MAP->set_texture ($facenum, @$tex{qw(name w h s t)}, @{$tex->{minified}}); 949 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
443 $MAPWIDGET->update; 950 $MAPWIDGET->update;
951
952 $tex
953 };
954}
955
956sub conn::sound_play {
957 my ($self, $x, $y, $soundnum, $type) = @_;
958
959 $SDL_MIXER
960 or return;
961
962 my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
963 or return;
964
965 $chunk->play;
966# warn "sound $x,$y,$soundnum,$type\n";#d#
444} 967}
445 968
446sub conn::query { 969sub conn::query {
447 my ($self, $flags, $prompt) = @_; 970 my ($self, $flags, $prompt) = @_;
448 971
449 #TODO 972 #TODO, display dialog with relevant information
450 warn "<<<<QUERY:$flags:$prompt>>>\n";#d# 973 warn "<<<<QUERY:$flags:$prompt>>>\n";#d#
451} 974}
452 975
453sub conn::drawinfo { 976sub conn::drawinfo {
454 my ($self, $color, $text) = @_; 977 my ($self, $color, $text) = @_;
455 978
456 my @color = ( 979 my @color = (
457 [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00], 980 [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
458 [1.00, 1.00, 1.00], 981 [1.00, 1.00, 1.00],
459 [0.00, 0.00, 0.55], 982 [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
460 [1.00, 0.00, 0.00], 983 [1.00, 0.00, 0.00],
461 [1.00, 0.54, 0.00], 984 [1.00, 0.54, 0.00],
462 [0.11, 0.56, 1.00], 985 [0.11, 0.56, 1.00],
463 [0.93, 0.46, 0.00], 986 [0.93, 0.46, 0.00],
464 [0.18, 0.54, 0.34], 987 [0.18, 0.54, 0.34],
… …
470 ); 993 );
471 994
472 $LOGVIEW->add_paragraph ($color[$color], $text); 995 $LOGVIEW->add_paragraph ($color[$color], $text);
473} 996}
474 997
998sub conn::spell_add {
999 my ($self, $spell) = @_;
1000
1001 $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message}, sub {
1002 });
1003 $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message}, sub {
1004 });
1005}
1006
1007sub conn::spell_delete {
1008 my ($self, $spell) = @_;
1009}
1010
1011sub conn::addme_success {
1012 my ($self) = @_;
1013
1014 for my $skill (values %{$self->{skill_info}}) {
1015 $MAPWIDGET->add_command ("ready_skill $skill", "", sub {
1016 });
1017 $MAPWIDGET->add_command ("use_skill $skill", "", sub {
1018 });
1019 }
1020}
1021
475%SDL_CB = ( 1022%SDL_CB = (
476 SDL_QUIT() => sub { 1023 CFClient::SDL_QUIT => sub {
477 Event::unloop -1; 1024 Event::unloop -1;
478 }, 1025 },
479 SDL_VIDEORESIZE() => sub { 1026 CFClient::SDL_VIDEORESIZE => sub {
480 }, 1027 },
481 SDL_VIDEOEXPOSE() => sub { 1028 CFClient::SDL_VIDEOEXPOSE => \&refresh,
482 refresh; 1029 CFClient::SDL_ACTIVEEVENT => sub {
1030# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
483 }, 1031 },
484 SDL_KEYDOWN() => sub { 1032 CFClient::SDL_KEYDOWN => sub {
485 if ($SDL_EV->key_mod & KMOD_ALT && $SDL_EV->key_sym == SDLK_RETURN) { 1033 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
486 # alt-enter 1034 # alt-enter
487 destroy_screen; 1035 video_shutdown;
488 $CFG->{fullscreen} = !$CFG->{fullscreen}; 1036 $CFG->{fullscreen} = !$CFG->{fullscreen};
489 init_screen; 1037 video_init;
490 } else { 1038 } else {
491 CFClient::UI::feed_sdl_key_down_event ($SDL_EV); 1039 CFClient::UI::feed_sdl_key_down_event ($_[0]);
492 } 1040 }
493 }, 1041 },
494 SDL_KEYUP() => sub { 1042 CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
495 CFClient::UI::feed_sdl_key_up_event ($SDL_EV); 1043 CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
496 }, 1044 CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
497 SDL_MOUSEMOTION() => sub { 1045 CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
498 CFClient::UI::feed_sdl_motion_event ($SDL_EV); 1046 CFClient::SDL_USEREVENT => \&audio_music_finished,
499 },
500 SDL_MOUSEBUTTONDOWN() => sub {
501 CFClient::UI::feed_sdl_button_down_event ($SDL_EV);
502 },
503 SDL_MOUSEBUTTONUP() => sub {
504 CFClient::UI::feed_sdl_button_up_event ($SDL_EV);
505 },
506 SDL_ACTIVEEVENT() => sub {
507# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
508 },
509); 1047);
510 1048
511############################################################################# 1049#############################################################################
1050
1051$SIG{INT} = $SIG{TERM} = sub { exit };
1052
1053$TILECACHE = CFClient::db_table "tilecache";
1054$FACEMAP = CFClient::db_table "facemap";
512 1055
513CFClient::read_cfg "$Crossfire::VARDIR/pclientrc"; 1056CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
514 1057
515my %DEF_CFG = ( 1058my %DEF_CFG = (
516 sdl_mode => 0, 1059 sdl_mode => 0,
… …
519 fullscreen => 0, 1062 fullscreen => 0,
520 fast => 0, 1063 fast => 0,
521 fow_enable => 1, 1064 fow_enable => 1,
522 fow_intensity => 0.45, 1065 fow_intensity => 0.45,
523 fow_smooth => 0, 1066 fow_smooth => 0,
1067 gui_fontsize => 1,
524 log_fontsize => 14, 1068 log_fontsize => 1,
1069 stat_fontsize => 1,
525 mapsize => 100, 1070 mapsize => 100,
526 host => "crossfire.schmorp.de", 1071 host => "crossfire.schmorp.de",
527 port => 13327,
528 say_command => 'say', 1072 say_command => 'say',
1073 audio_enable => 1,
1074 bgm_enable => 1,
1075 bgm_volume => 0.25,
529); 1076);
530 1077
531while (my ($k, $v) = each %DEF_CFG) { 1078while (my ($k, $v) = each %DEF_CFG) {
532 $CFG->{$k} = $v unless exists $CFG->{$k}; 1079 $CFG->{$k} = $v unless exists $CFG->{$k};
533} 1080}
534 1081
535sdl_init; 1082sdl_init;
536 1083
537@SDL_MODES = reverse 1084@SDL_MODES = reverse
538 grep $_->[0] >= 640 && $_->[1] >= 480, 1085 grep $_->[0] >= 640 && $_->[1] >= 480,
539 map [SDL::RectW ($_), SDL::RectH ($_)], 1086 CFClient::SDL_ListModes;
540 @{ SDL::ListModes 0, SDL_FULLSCREEN | SDL_HWSURFACE | SDL_OPENGL };
541 1087
542@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)"; 1088@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
543 1089
544$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES; 1090$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
545
546init_screen;
547 1091
548{ 1092{
549 my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf); 1093 my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf);
550 1094
551 CFClient::add_font $_ for @fonts; 1095 CFClient::add_font $_ for @fonts;
552 CFClient::set_font $fonts[0]; 1096 CFClient::set_font $fonts[0];
553} 1097}
554 1098
555$FACECACHE = eval { Crossfire::load_ref "$Crossfire::VARDIR/pclient.faces" } || {}; 1099video_init;
1100audio_init;
556 1101
557Event::loop; 1102Event::loop;
558 1103
559Crossfire::save_ref $FACECACHE, "$Crossfire::VARDIR/pclient.faces"; 1104END { CFClient::SDL_Quit }
560 1105
1106

Diff Legend

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