[ViewVC] Diff of: cvs/deliantra/Deliantra-Client/bin/cfplus

Comparing deliantra/Deliantra-Client/bin/cfplus (file contents):
Revision 1.3 by root, Thu May 25 16:54:29 2006 UTC vs.
Revision 1.11 by root, Fri May 26 18:56:14 2006 UTC

…		…
29	use Time::HiRes 'time';	29	use Time::HiRes 'time';
30	use Pod::POM;	30	use Pod::POM;
31	use Event;	31	use Event;
32		32
33	use Crossfire;	33	use Crossfire;
34	use Crossfire::Protocol;	34	use Crossfire::Protocol::Base;
35		35
36	use Compress::LZF;	36	use Compress::LZF;
37		37
38	use CFClient;	38	use CFClient;
		39	use CFClient::OpenGL ();
		40	use CFClient::Protocol;
39	use CFClient::UI;	41	use CFClient::UI;
40	use CFClient::MapWidget;	42	use CFClient::MapWidget;
41		43
42	$Event::DIED = sub {	44	$Event::DIED = sub {
43	# TODO: display dialog box or so	45	# TODO: display dialog box or so
…		…
50		52
51	my $MAX_FPS = 60;	53	my $MAX_FPS = 60;
52	my $MIN_FPS = 5; # unused as of yet	54	my $MIN_FPS = 5; # unused as of yet
53		55
54	our $META_SERVER = "crossfire.real-time.com:13326";	56	our $META_SERVER = "crossfire.real-time.com:13326";
55
56	our $FACEMAP;
57	our $TILECACHE;
58	our $MAPCACHE;
59		57
60	our $LAST_REFRESH;	58	our $LAST_REFRESH;
61	our $NOW;	59	our $NOW;
62		60
63	our $CFG;	61	our $CFG;
…		…
103		101
104	our $INVWIN;	102	our $INVWIN;
105	our $INV;	103	our $INV;
106	our $INVR;	104	our $INVR;
107	our $INVR_LBL;	105	our $INVR_LBL;
108	our $OPENCONT;
109		106
110	sub status {	107	sub status {
111	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);	108	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
112	}	109	}
113		110
…		…
120	sub start_game {	117	sub start_game {
121	status "logging in...";	118	status "logging in...";
122		119
123	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;	120	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
124		121
125	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";	122	my ($host, $port) = split /:/, $CFG->{host};
		123
126	$MAP = new CFClient::Map $mapsize, $mapsize;	124	$MAP = new CFClient::Map $mapsize, $mapsize;
127
128	my ($host, $port) = split /:/, $CFG->{host};
129		125
130	$CONN = eval {	126	$CONN = eval {
131	new conn	127	new CFClient::Protocol
132	host => $host,	128	host => $host,
133	port => $port \|\| 13327,	129	port => $port \|\| 13327,
134	user => $CFG->{user},	130	user => $CFG->{user},
135	pass => $CFG->{password},	131	pass => $CFG->{password},
136	mapw => $mapsize,	132	mapw => $mapsize,
137	maph => $mapsize,	133	maph => $mapsize,
138	;	134
		135	map_widget => $MAPWIDGET,
		136	logview => $LOGVIEW,
		137	statusbox => $STATUSBOX,
		138	map => $MAP,
		139	mapmap => $MAPMAP,
		140
		141	sound_play => sub {
		142	my ($x, $y, $soundnum, $type) = @_;
		143
		144	$SDL_MIXER
		145	or return;
		146
		147	my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
		148	or return;
		149
		150	$chunk->play;
		151	},
139	};	152	};
140		153
141	if ($CONN) {	154	if ($CONN) {
142	CFClient::lowdelay fileno $CONN->{fh};	155	CFClient::lowdelay fileno $CONN->{fh};
143		156
…		…
161	$CONN->destroy;	174	$CONN->destroy;
162	$CONN = 0; # false, does not autovivify	175	$CONN = 0; # false, does not autovivify
163		176
164	$BUTTONBAR->{children}[1]->emit ("activate")	177	$BUTTONBAR->{children}[1]->emit ("activate")
165	unless $BUTTONBAR->{children}[1]->{state};	178	unless $BUTTONBAR->{children}[1]->{state};
166
167	undef $MAPCACHE;
168	undef $MAP;
169	}	179	}
170		180
171	sub client_setup {	181	sub client_setup {
172	my $dialog = new CFClient::UI::FancyFrame	182	my $dialog = new CFClient::UI::FancyFrame
173	title => "Client Setup",	183	title => "Client Setup",
…		…
431	can_hover => 1, can_events => 1,	441	can_hover => 1, can_events => 1,
432	tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");	442	tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
433	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,	443	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
434	can_hover => 1, can_events => 1,	444	can_hover => 1, can_events => 1,
435	tooltip => "The map you are currently on (if supported by the server).");	445	tooltip => "The map you are currently on (if supported by the server).");
		446
		447	$vb->add (my $hb0 = new CFClient::UI::HBox);
		448	$hb0->add ($STATWIDS->{weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
		449	can_hover => 1, can_events => 1,
		450	tooltip => "This is the amount the Player weights.");
		451	$hb0->add ($STATWIDS->{m_weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
		452	can_hover => 1, can_events => 1,
		453	tooltip => "The weight limit, you can't carry more than this.");
		454
436		455
437	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	456	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
438	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);	457	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);
439		458
440	my $color2 = [1, 1, 0];	459	my $color2 = [1, 1, 0];
…		…
530		549
531	sub update_stats_window {	550	sub update_stats_window {
532	my ($stats) = @_;	551	my ($stats) = @_;
533		552
534	# i love text protocols!!!	553	# i love text protocols!!!
535	my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;	554	my $hp = $stats->{Crossfire::Protocol::Base::CS_STAT_HP} * 1;
536	my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;	555	my $hp_m = $stats->{Crossfire::Protocol::Base::CS_STAT_MAXHP} * 1;
537	my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;	556	my $sp = $stats->{Crossfire::Protocol::Base::CS_STAT_SP} * 1;
538	my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;	557	my $sp_m = $stats->{Crossfire::Protocol::Base::CS_STAT_MAXSP} * 1;
539	my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;	558	my $fo = $stats->{Crossfire::Protocol::Base::CS_STAT_FOOD} * 1;
540	my $fo_m = 999;	559	my $fo_m = 999;
541	my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;	560	my $gr = $stats->{Crossfire::Protocol::Base::CS_STAT_GRACE} * 1;
542	my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;	561	my $gr_m = $stats->{Crossfire::Protocol::Base::CS_STAT_MAXGRACE} * 1;
543		562
544	$GAUGES->{hp} ->set_value ($hp, $hp_m);	563	$GAUGES->{hp} ->set_value ($hp, $hp_m);
545	$GAUGES->{mana} ->set_value ($sp, $sp_m);	564	$GAUGES->{mana} ->set_value ($sp, $sp_m);
546	$GAUGES->{food} ->set_value ($fo, $fo_m);	565	$GAUGES->{food} ->set_value ($fo, $fo_m);
547	$GAUGES->{grace} ->set_value ($gr, $gr_m);	566	$GAUGES->{grace} ->set_value ($gr, $gr_m);
548	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})	567	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::Base::CS_STAT_EXP64})
549	. " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");	568	. " (lvl " . ($stats->{Crossfire::Protocol::Base::CS_STAT_LEVEL} * 1) . ")");
550	my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};	569	my $rng = $stats->{Crossfire::Protocol::Base::CS_STAT_RANGE};
551	$rng =~ s/^Range: //; # thank you so much dear server	570	$rng =~ s/^Range: //; # thank you so much dear server
552	$GAUGES->{range} ->set_text ("Rng: " . $rng);	571	$GAUGES->{range} ->set_text ("Rng: " . $rng);
553	my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};	572	my $title = $stats->{Crossfire::Protocol::Base::CS_STAT_TITLE};
554	$title =~ s/^Player: //;	573	$title =~ s/^Player: //;
555	$STATWIDS->{title} ->set_text ("Title: " . $title);	574	$STATWIDS->{title} ->set_text ("Title: " . $title);
556		575
557	$STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});	576	$STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});
558	$STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});	577	$STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});
…		…
563	$STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});	582	$STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});
564	$STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});	583	$STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});
565	$STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});	584	$STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});
566	$STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});	585	$STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});
567	$STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});	586	$STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});
568	$STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});	587	$STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::Base::CS_STAT_SPEED});
569	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP});	588	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::Base::CS_STAT_WEAP_SP});
		589
		590	$STATWIDS->{m_weight}->set_text (sprintf "Max weight: %.1fkg", $stats->{Crossfire::Protocol::Base::CS_STAT_WEIGHT_LIM} / 1000);
570		591
571	my %tbl = (	592	my %tbl = (
572	phys => 100,	593	phys => 100,
573	magic => 101,	594	magic => 101,
574	fire => 102,	595	fire => 102,
…		…
884	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory";	905	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory";
885		906
886	$invwin->add (my $hb = new CFClient::UI::HBox expand => 1);	907	$invwin->add (my $hb = new CFClient::UI::HBox expand => 1);
887		908
888	$hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);	909	$hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);
889	$vb1->add (my $lbl = new CFClient::UI::Label);	910	$vb1->add (my $lbl = new CFClient::UI::Label xalign => 0.5);
890	$lbl->set_text ("Player");	911	$lbl->set_text ("Player");
891	$vb1->add ($INV = new CFClient::UI::Inventory expand => 1);	912	$vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
892		913
893	$hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);	914	$hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);
894	$vb2->add ($INVR_LBL = new CFClient::UI::Label);	915	$vb2->add ($INVR_LBL = new CFClient::UI::Label xalign => 0.5);
895	$INVR_LBL->set_text ("Floor");	916	$INVR_LBL->set_text ("Floor");
896	$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);	917	$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
897		918
898	$invwin	919	$invwin
899	}	920	}
…		…
956	or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";	977	or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
957		978
958	$SDL_ACTIVE = 1;	979	$SDL_ACTIVE = 1;
959	$LAST_REFRESH = time - 0.01;	980	$LAST_REFRESH = time - 0.01;
960		981
961	CFClient::gl_init;	982	CFClient::OpenGL::init;
962		983
963	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};	984	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
964		985
965	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#	986	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
966		987
…		…
1235	sub animation_stop {	1256	sub animation_stop {
1236	my ($widget) = @_;	1257	my ($widget) = @_;
1237	delete $animate_object{$widget};	1258	delete $animate_object{$widget};
1238	}	1259	}
1239		1260
1240	@conn::ISA = Crossfire::Protocol::;
1241
1242	sub conn::new {
1243	my $class = shift;
1244
1245	my $self = $class->Crossfire::Protocol::new (@_);
1246
1247	$MAPWIDGET->clr_commands;
1248
1249	my $parser = new Pod::POM;
1250	my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod");
1251
1252	for my $head2 ($pod->head2) {
1253	$head2->title =~ /^(\S+) (?:\s+ $ ([^$]*) \) )?/x
1254	or next;
1255
1256	my $cmd = $1;
1257	my @args = split /\\|/, $2;
1258	@args = (".*") unless @args;
1259
1260	my $text = CFClient::pod_to_pango $head2->content;
1261
1262	for my $arg (@args) {
1263	$arg = $arg eq ".*" ? "" : " $arg";
1264
1265	$MAPWIDGET->add_command ("$cmd$arg", $text);
1266	}
1267	}
1268
1269	$self->{noface} = new_from_file CFClient::Texture
1270	CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1;
1271
1272	$self
1273	}
1274
1275	sub conn::stats_update {
1276	my ($self, $stats) = @_;
1277
1278	if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) {
1279	my $diff = $exp - $self->{prev_exp};
1280	$STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
1281	if exists $self->{prev_exp} && $diff;
1282	$self->{prev_exp} = $exp;
1283	}
1284
1285	update_stats_window ($stats);
1286	}
1287
1288	sub conn::user_send {
1289	my ($self, $command) = @_;
1290
1291	$self->send_command ($command);
1292	status $command;
1293	}
1294
1295	sub conn::map_scroll {
1296	my ($self, $dx, $dy) = @_;
1297
1298	$MAP->scroll ($dx, $dy);
1299	}
1300
1301	sub conn::feed_map1a {
1302	my ($self, $data) = @_;
1303
1304	# $self->Crossfire::Protocol::feed_map1a ($data);
1305
1306	$MAP->map1a_update ($data);
1307	$MAPWIDGET->update;
1308	}
1309
1310	sub conn::flush_map {
1311	my ($self) = @_;
1312
1313	my $map_info = delete $self->{map_info}
1314	or return;
1315
1316	my ($hash, $x, $y, $w, $h) = @$map_info;
1317
1318	my $data = $MAP->get_rect ($x, $y, $w, $h);
1319	$MAPCACHE->put ($hash => Compress::LZF::compress $data);
1320	#warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
1321	}
1322
1323	sub conn::map_clear {
1324	my ($self) = @_;
1325
1326	$self->flush_map;
1327	delete $self->{neigh_map};
1328
1329	$MAP->clear;
1330	}
1331
1332
1333	sub conn::load_map($$$) {
1334	my ($self, $hash, $x, $y) = @_;
1335
1336	if (defined (my $data = $MAPCACHE->get ($hash))) {
1337	$data = Compress::LZF::decompress $data;
1338	#warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
1339	for my $id ($MAP->set_rect ($x, $y, $data)) {
1340	my $data = $TILECACHE->get ($id)
1341	or next;
1342
1343	$self->set_texture ($id => $data);
1344	}
1345	}
1346	}
1347
1348	# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
1349	# (server resource,s latency, bandwidth), so this hack is warranted.
1350	# the right fix is to make real tiled maps with an overview file
1351	sub conn::send_mapinfo {
1352	my ($self, $data, $cb) = @_;
1353
1354	if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
1355	my ($wx, $wy) = ($1, $2);
1356
1357	if ($data =~ /^spatial ([1-4]+)$/) {
1358	my @dx = (0, 0, 1, 0, -1);
1359	my @dy = (0, -1, 0, 1, 0);
1360	my ($dx, $dy);
1361
1362	for (split //, $1) {
1363	$dx += $dx[$_];
1364	$dy += $dy[$_];
1365	}
1366
1367	$cb->(spatial => 15,
1368	$self->{map_info}[1] - $MAP->ox + $dx * 50,
1369	$self->{map_info}[2] - $MAP->oy + $dy * 50,
1370	50, 50,
1371	sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy
1372	);
1373
1374	return;
1375	}
1376	}
1377
1378	$self->Crossfire::Protocol::send_mapinfo ($data, $cb);
1379	}
1380
1381	# this method does a "flood fill" into every tile direction
1382	# it assumes that tiles are arranged in a rectangular grid,
1383	# i.e. a map is the same as the left of the right map etc.
1384	# failure to comply are harmless and result in display errors
1385	# at worst.
1386	sub conn::flood_fill {
1387	my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
1388
1389	# the server does not allow map paths > 6
1390	return if 7 <= length $path;
1391
1392	my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
1393
1394	for (
1395	[1, 3, 0, -1],
1396	[2, 4, 1, 0],
1397	[3, 1, 0, 1],
1398	[4, 2, -1, 0],
1399	) {
1400	my ($tile, $tile2, $dx, $dy) = @$_;
1401
1402	next if $block & (1 << $tile);
1403	my $block = $block \| (1 << $tile2);
1404
1405	my $gx = $gx + $dx;
1406	my $gy = $gy + $dy;
1407
1408	next unless $flags & (1 << ($tile - 1));
1409	next if $self->{neigh_grid}{$gx, $gy}++;
1410
1411	my $neigh = $self->{neigh_map}{$hash} \|\|= [];
1412	if (my $info = $neigh->[$tile]) {
1413	my ($flags, $x, $y, $w, $h, $hash) = @$info;
1414
1415	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1416	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1417
1418	} else {
1419	$self->send_mapinfo ("spatial $path$tile", sub {
1420	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
1421
1422	return if $mode ne "spatial";
1423
1424	$x += $MAP->ox;
1425	$y += $MAP->oy;
1426
1427	$self->load_map ($hash, $x, $y)
1428	unless $self->{neigh_map}{$hash}[5]++;#d#
1429
1430	$neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
1431
1432	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1433	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1434	});
1435	}
1436	}
1437	}
1438
1439	sub conn::map_change {
1440	my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
1441
1442	$self->flush_map;
1443
1444	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
1445
1446	my $mapmapw = $MAPMAP->{w};
1447	my $mapmaph = $MAPMAP->{h};
1448
1449	$self->{neigh_rect} = [
1450	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
1451	$ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
1452	];
1453
1454	delete $self->{neigh_grid};
1455
1456	$x += $ox;
1457	$y += $oy;
1458
1459	$self->{map_info} = [$hash, $x, $y, $w, $h];
1460
1461	(my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
1462	$STATWIDS->{map}->set_text ("Map: " . $map);
1463
1464	$self->load_map ($hash, $x, $y);
1465	$self->flood_fill (0, 0, 0, "", $hash, $flags);
1466	}
1467
1468	sub conn::face_find {
1469	my ($self, $facenum, $face) = @_;
1470
1471	my $hash = "$face->{chksum},$face->{name}";
1472
1473	my $id = $FACEMAP->get ($hash);
1474
1475	unless ($id) {
1476	# create new id for face
1477	# I love transactions
1478	for (1..100) {
1479	my $txn = $CFClient::DB_ENV->txn_begin;
1480	my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
1481	if ($status == 0 \|\| $status == BerkeleyDB::DB_NOTFOUND) {
1482	$id = ($id \|\| 16) + 1;
1483	if ($FACEMAP->put (id => $id) == 0
1484	&& $FACEMAP->put ($hash => $id) == 0) {
1485	$txn->txn_commit;
1486
1487	goto gotid;
1488	}
1489	}
1490	$txn->abort;
1491	}
1492
1493	CFClient::fatal "maximum number of transaction retries reached - database problems?";
1494	}
1495
1496	gotid:
1497	$face->{id} = $id;
1498	$MAP->set_face ($facenum => $id);
1499	$self->{faceid}[$facenum] = $id;#d#
1500
1501	my $face = $TILECACHE->get ($id);
1502
1503	if ($face) {
1504	#$self->face_prefetch;
1505	$face
1506	} else {
1507	my $tex = $self->{noface};
1508	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1509	undef
1510	};
1511	}
1512
1513	sub conn::face_update {
1514	my ($self, $facenum, $face) = @_;
1515
1516	$TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
1517
1518	$self->set_texture ($face->{id} => delete $face->{image});
1519	}
1520
1521	sub conn::set_texture {
1522	my ($self, $id, $data) = @_;
1523
1524	$self->{texture}[$id] \|\|= do {
1525	my $tex =
1526	new_from_image CFClient::Texture
1527	$data, minify => 1, mipmap => 1;
1528
1529	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1530	$MAPWIDGET->update;
1531
1532	$tex
1533	};
1534	}
1535
1536	sub conn::sound_play {
1537	my ($self, $x, $y, $soundnum, $type) = @_;
1538
1539	$SDL_MIXER
1540	or return;
1541
1542	my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
1543	or return;
1544
1545	$chunk->play;
1546	# warn "sound $x,$y,$soundnum,$type\n";#d#
1547	}
1548
1549	my $LAST_QUERY; # server is stupid, stupid, stupid
1550
1551	sub conn::query {
1552	my ($self, $flags, $prompt) = @_;
1553
1554	$prompt = $LAST_QUERY unless length $prompt;
1555	$LAST_QUERY = $prompt;
1556
1557	my $dialog = new CFClient::UI::FancyFrame
1558	title => "Query",
1559	child => my $vbox = new CFClient::UI::VBox;
1560
1561	$vbox->add (new CFClient::UI::Label
1562	max_w => $::WIDTH * 0.4,
1563	ellipsise => 0,
1564	text => $prompt);
1565
1566	if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
1567	$vbox->add (my $hbox = new CFClient::HBox);
1568	$hbox->add (new CFClient::Button
1569	text => "No",
1570	connect_activate => sub {
1571	$self->send ("reply n");
1572	$dialog->destroy;
1573	$MAPWIDGET->focus_in;
1574	}
1575	);
1576	$hbox->add (new CFClient::Button
1577	text => "Yes",
1578	connect_activate => sub {
1579	$self->send ("reply y");
1580	$dialog->destroy;
1581	},
1582	);
1583
1584	$dialog->focus_in;
1585
1586	} elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
1587	$dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
1588	$vbox->add (my $entry = new CFClient::UI::Entry
1589	connect_changed => sub {
1590	$self->send ("reply $_[1]");
1591	$dialog->destroy;
1592	},
1593	);
1594
1595	$entry->focus_in;
1596
1597	} else {
1598	$dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
1599
1600	$vbox->add (my $entry = new CFClient::UI::Entry
1601	$flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
1602	connect_activate => sub {
1603	$self->send ("reply $_[1]");
1604	$dialog->destroy;
1605	},
1606	);
1607
1608	$entry->focus_in;
1609	}
1610
1611	$dialog->show_centered;
1612	}
1613
1614	sub conn::drawinfo {
1615	my ($self, $color, $text) = @_;
1616
1617	my @color = (
1618	[1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
1619	[1.00, 1.00, 1.00],
1620	[0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
1621	[1.00, 0.00, 0.00],
1622	[1.00, 0.54, 0.00],
1623	[0.11, 0.56, 1.00],
1624	[0.93, 0.46, 0.00],
1625	[0.18, 0.54, 0.34],
1626	[0.56, 0.73, 0.56],
1627	[0.80, 0.80, 0.80],
1628	[0.55, 0.41, 0.13],
1629	[0.99, 0.77, 0.26],
1630	[0.74, 0.65, 0.41],
1631	);
1632
1633	my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
1634
1635	$text = CFClient::UI::Label::escape $text;
1636	$text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
1637	$text =~ s/\[color=(.?)\](.?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
1638
1639	$LOGVIEW->add_paragraph ($color[$color],
1640	join "\n", map "$time $_", split /\n/, $text);
1641
1642	$STATUSBOX->add ($text,
1643	group => $text,
1644	fg => $color[$color],
1645	timeout => 10,
1646	tooltip_font => $::FONT_FIXED,
1647	);
1648	}
1649
1650	sub conn::drawextinfo {
1651	my ($self, $color, $type, $subtype, $message) = @_;
1652
1653	$self->drawinfo ($color, $message);
1654	}
1655
1656	sub conn::spell_add {
1657	my ($self, $spell) = @_;
1658
1659	# TODO
1660	# create a widget dynamically, using spell face (CF::Protocol downloads them)
1661	$MAPWIDGET->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1662	$MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1663	}
1664
1665	sub conn::spell_delete {
1666	my ($self, $spell) = @_;
1667	}
1668
1669	sub conn::addme_success {
1670	my ($self) = @_;
1671
1672	$self->send ("command output-sync $CFG->{output_sync}");
1673	$self->send ("command output-count $CFG->{output_count}");
1674
1675	my $parser = new Pod::POM;
1676	my $pod = $parser->parse_file (CFClient::find_rcfile "pod/skill_help.pod");
1677
1678	my %skill_tooltip;
1679
1680	for my $head2 ($pod->head2) {
1681	$skill_tooltip{$head2->title} = CFClient::pod_to_pango $head2->content;
1682	}
1683
1684	for my $skill (values %{$self->{skill_info}}) {
1685	$MAPWIDGET->add_command ("ready_skill $skill",
1686	(CFClient::UI::Label::escape "Ready the skill '$skill'\n\n")
1687	. $skill_tooltip{$skill});
1688	$MAPWIDGET->add_command ("use_skill $skill",
1689	(CFClient::UI::Label::escape "Immediately use the skill '$skill'\n\n")
1690	. $skill_tooltip{$skill});
1691	}
1692	}
1693
1694	sub conn::eof {
1695	$MAPWIDGET->clr_commands;
1696
1697	stop_game;
1698	}
1699
1700	sub conn::image_info {
1701	my ($self, $numfaces) = @_;
1702
1703	$self->{num_faces} = $numfaces;
1704	$self->{face_prefetch} = [1 .. $numfaces];
1705	$self->face_prefetch;
1706	}
1707
1708	sub conn::face_prefetch {
1709	my ($self) = @_;
1710
1711	return unless $CFG->{face_prefetch};
1712
1713	if ($self->{num_faces}) {
1714	return if @{ $self->{send_queue} \|\| [] };
1715	my $todo = @{ $self->{face_prefetch} }
1716	or return;
1717
1718	my ($face) = splice @{ $self->{face_prefetch} }, + rand @{ $self->{face_prefetch} }, 1, ();
1719
1720	$self->send ("requestinfo image_sums $face $face");
1721
1722	$STATUSBOX->add (CFClient::UI::Label::escape "prefetching $todo",
1723	group => "prefetch", timeout => 2, fg => [1, 1, 0, 0.5]);
1724	} elsif (!exists $self->{num_faces}) {
1725	$self->send ("requestinfo image_info");
1726
1727	$self->{num_faces} = 0;
1728
1729	$STATUSBOX->add (CFClient::UI::Label::escape "starting to prefetch",
1730	group => "prefetch", timeout => 2, fg => [1, 1, 0, 0.5]);
1731	}
1732	}
1733
1734	# check once/second for faces that need to be prefetched	1261	# check once/second for faces that need to be prefetched
1735	# this should, of course, only run on demand, but	1262	# this should, of course, only run on demand, but
1736	# SDL forces worse things on us....	1263	# SDL forces worse things on us....
1737		1264
1738	Event->timer (after => 1, interval => 0.25, cb => sub {	1265	Event->timer (after => 1, interval => 0.25, cb => sub {
1739	$CONN->face_prefetch	1266	$CONN->face_prefetch
1740	if $CONN;	1267	if $CONN;
1741	});	1268	});
1742
1743	sub update_floorbox {
1744	$CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1745	return unless $CONN;
1746
1747	$FLOORBOX->clear;
1748	$FLOORBOX->add (0, 1, new CFClient::UI::Empty expand => 1);
1749
1750	my $row;
1751	for (@{ $CONN->{container}{0} }) {
1752	if (++$row < 7) {
1753	local $_->{face_widget}; # hack to force recreation of widget
1754	local $_->{desc_widget}; # hack to force recreation of widget
1755	CFClient::Item::update_widgets $_;
1756
1757	$FLOORBOX->add (0, $row, $_->{face_widget});
1758	$FLOORBOX->add (1, $row, $_->{desc_widget});
1759	} else {
1760	$FLOORBOX->add (new CFClient::UI::Label text => "More...");
1761	last;
1762	}
1763	}
1764	});
1765
1766	$WANT_REFRESH++;
1767	}
1768
1769	sub conn::container_add {
1770	my ($self, $tag, $items) = @_;
1771
1772	#d# print "container_add: container $tag ($self->{player}{tag})\n";
1773
1774	if ($tag == 0) {
1775	update_floorbox;
1776	$OPENCONT = 0;
1777	$INVR_LBL->set_text ("Floor");
1778	$INVR->set_items ($self->{container}{0});
1779	} elsif ($tag == $self->{player}{tag}) {
1780	$INVR_LBL->set_text ("Player");
1781	$INV->set_items ($self->{container}{$self->{player}{tag}})
1782	} else {
1783	$OPENCONT = $tag;
1784	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1785	$INVR->set_items ($self->{container}{$tag});
1786	}
1787
1788	# $self-<{player}{tag} => player inv
1789	#use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1790	}
1791
1792	sub conn::container_clear {
1793	my ($self, $tag) = @_;
1794
1795	#d# print "container_clear: container $tag ($self->{player}{tag})\n";
1796
1797	if ($tag == 0) {
1798	update_floorbox;
1799	$OPENCONT = 0;
1800	$INVR_LBL->set_text ("Floor");
1801	$INVR->set_items ($self->{container}{0});
1802	} elsif ($tag == $self->{player}{tag}) {
1803	$INVR_LBL->set_text ("Player");
1804	$INV->set_items ($self->{container}{$tag})
1805	} else {
1806	$OPENCONT = $tag;
1807	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1808	$INVR->set_items ($self->{container}{$tag});
1809	}
1810
1811	# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1812	}
1813
1814	sub conn::item_delete {
1815	my ($self, @items) = @_;
1816
1817	for (@items) {
1818	#d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
1819
1820	if ($_->{container} == 0) {
1821	update_floorbox;
1822	$OPENCONT = 0;
1823	$INVR_LBL->set_text ("Floor");
1824	$INVR->set_items ($self->{container}{0});
1825	} elsif ($_->{container} == $self->{player}{tag}) {
1826	$INVR_LBL->set_text ("Player");
1827	$INV->set_items ($self->{container}{$self->{player}{tag}})
1828	} else {
1829	$OPENCONT = $_->{container};
1830	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1831	$INVR->set_items ($self->{container}{$_->{container}});
1832	}
1833	}
1834	}
1835
1836	sub conn::item_update {
1837	my ($self, $item) = @_;
1838
1839	#d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n";
1840
1841	if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
1842	$OPENCONT = 0;
1843	$INVR_LBL->set_text ("Floor");
1844	$INVR->set_items ($self->{container}{0});
1845
1846	$item->{widget}->update_item
1847	if $item->{widget};
1848	} else {
1849	if ($item->{container} == 0) {
1850	update_floorbox;
1851	$OPENCONT = 0;
1852	$INVR_LBL->set_text ("Floor");
1853	$INVR->set_items ($self->{container}{0});
1854	} elsif ($item->{container} == $self->{player}{tag}) {
1855	$INV->set_items ($self->{container}{$item->{container}})
1856	}
1857	}
1858	}
1859		1269
1860	%SDL_CB = (	1270	%SDL_CB = (
1861	CFClient::SDL_QUIT => sub {	1271	CFClient::SDL_QUIT => sub {
1862	Event::unloop -1;	1272	Event::unloop -1;
1863	},	1273	},
…		…
1898		1308
1899	{	1309	{
1900	local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };	1310	local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };
1901		1311
1902	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";	1312	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1903
1904	$TILECACHE = CFClient::db_table "tilecache";
1905	$FACEMAP = CFClient::db_table "facemap";
1906		1313
1907	my %DEF_CFG = (	1314	my %DEF_CFG = (
1908	sdl_mode => 0,	1315	sdl_mode => 0,
1909	width => 640,	1316	width => 640,
1910	height => 480,	1317	height => 480,

Diff Legend

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

Comparing deliantra/Deliantra-Client/bin/cfplus (file contents): Revision 1.3 by root, Thu May 25 16:54:29 2006 UTC vs. Revision 1.11 by root, Fri May 26 18:56:14 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/bin/cfplus (file contents):
Revision 1.3 by root, Thu May 25 16:54:29 2006 UTC vs.
Revision 1.11 by root, Fri May 26 18:56:14 2006 UTC