[ViewVC] Diff of: cvs/deliantra/Deliantra-Client/DC.pm

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.88 by root, Mon Jun 5 05:31:13 2006 UTC vs.
Revision 1.102 by root, Sat Jul 22 13:20:33 2006 UTC

…		…
24	use utf8;	24	use utf8;
25		25
26	use Carp ();	26	use Carp ();
27	use AnyEvent ();	27	use AnyEvent ();
28	use BerkeleyDB;	28	use BerkeleyDB;
29	use Pod::POM;	29	use Pod::POM ();
		30	use Scalar::Util ();
		31	use Storable (); # finally
		32
		33	our %STAT_TOOLTIP = (
		34	Str => "<b>Physical Strength</b>, determines damage dealt with weapons, how much you can carry, and how often you can attack",
		35	Dex => "<b>Dexterity</b>, your physical agility. Determines chance of being hit and affects armor class and speed",
		36	Con => "<b>Constitution</b>, physical health and toughness. Determines how many healthpoints you can have",
		37	Int => "<b>Intelligence</b>, your ability to learn and use skills and incantations (both prayers and magic) and determines how much spell points you can have",
		38	Wis => "<b>Wisdom</b>, the ability to learn and use divine magic (prayers). Determines how many grace points you can have",
		39	Pow => "<b>Power</b>, your magical potential. Influences the strength of spell effects, and also how much your spell and grace points increase when leveling up",
		40	Cha => "<b>Charisma</b>, how well you are received by NPCs. Affects buying and selling prices in shops.",
		41
		42	Wc => "<b>Weapon Class</b>, effectiveness of melee/missile attacks. Lower is more potent. Current weapon, level and Str are some things which effect the value of Wc. The value of Wc may range between 25 and -72.",
		43	Ac => "<b>Armour Class</b>, how protected you are from being hit by any attack. Lower values are better. Ac is based on your race and is modified by the Dex and current armour worn. For characters that cannot wear armour, Ac improves as their level increases.",
		44	Dam => "<b>Damage</b>, how much damage your melee/missile attack inflicts. Higher values indicate a greater amount of damage will be inflicted with each attack.",
		45	Arm => "<b>Armour</b>, how much damage (from physical attacks) will be subtracted from successful hits made upon you. This value ranges between 0 to 99%. Current armour worn primarily determines Arm value. This is the same as the physical resistance.",
		46	Spd => "<b>Speed</b>, how fast you can move. The value of speed may range between nearly 0 (\"very slow\") to higher than 5 (\"lightning fast\"). Base speed is determined from the Dex and modified downward proportionally by the amount of weight carried which exceeds the Max Carry limit. The armour worn also sets the upper limit on speed.",
		47	WSp => "<b>Weapon Speed</b>, how many attacks you may make per unit of time (0.120s). Higher values indicate faster attack speed. Current weapon and Dex effect the value of weapon speed.",
		48	);
		49
		50	package CFClient::PodToPango;
		51
		52	use base Pod::POM::View::Text;
		53
		54	our $VERSION = 1; # bump if resultant formatting changes
		55
		56	our $indent = 0;
		57
		58	*view_seq_code =
		59	*view_seq_bold = sub { "<b>$_[1]</b>" };
		60	*view_seq_italic = sub { "<i>$_[1]</i>" };
		61	*view_seq_space =
		62	*view_seq_link =
		63	*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) };
		64
		65	sub view_seq_text {
		66	my $text = $_[1];
		67	$text =~ s/\s+/ /g;
		68	CFClient::UI::Label::escape ($text)
		69	}
		70
		71	sub view_item {
		72	("\t" x ($indent / 4))
		73	. $_[1]->title->present ($_[0])
		74	. "\n\n"
		75	. $_[1]->content->present ($_[0])
		76	}
		77
		78	sub view_verbatim {
		79	(join "",
		80	map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
		81	split /\n/, CFClient::UI::Label::escape ($_[1]))
		82	. "\n"
		83	}
		84
		85	sub view_textblock {
		86	("\t" x ($indent / 2)) . "$_[1]\n\n"
		87	}
		88
		89	sub view_head1 {
		90	"\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
		91	. $_[1]->content->present ($_[0])
		92	};
		93
		94	sub view_head2 {
		95	"\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
		96	. $_[1]->content->present ($_[0])
		97	};
		98
		99	sub view_head3 {
		100	"\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
		101	. $_[1]->content->present ($_[0])
		102	};
		103
		104	sub view_over {
		105	local $indent = $indent + $_[1]->indent;
		106	$_[1]->content->present ($_[0])
		107	}
		108
		109	package CFClient::Database;
		110
		111	our @ISA = BerkeleyDB::Btree::;
		112
		113	sub get($$) {
		114	my $data;
		115
		116	$_[0]->db_get ($_[1], $data) == 0
		117	? $data
		118	: ()
		119	}
		120
		121	my %DB_SYNC;
		122
		123	sub put($$$) {
		124	my ($db, $key, $data) = @_;
		125
		126	$DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
		127
		128	$db->db_put ($key => $data)
		129	}
		130
		131	package CFClient;
30		132
31	sub find_rcfile($) {	133	sub find_rcfile($) {
32	my $path;	134	my $path;
33		135
34	for (grep !ref, @INC) {	136	for (grep !ref, @INC) {
…		…
67	$::CFG->{VERSION} = $::VERSION;	169	$::CFG->{VERSION} = $::VERSION;
68	print CFG Data::Dumper->Dump ([$::CFG], [qw/CFG/]);	170	print CFG Data::Dumper->Dump ([$::CFG], [qw/CFG/]);
69	}	171	}
70		172
71	close CFG;	173	close CFG;
72	}
73
74	my %POD_CACHE;
75
76	sub load_pod($) {
77	$POD_CACHE{$_[0]} \|\|= do {
78	my $pod = do {
79	local $/;
80	open my $pod, "<:utf8", $_[0]
81	or die "$_[0]: $!";
82	<$pod>
83	};
84
85	Pod::POM->new->parse_text ($pod)
86	}
87	}	174	}
88		175
89	our $DB_ENV;	176	our $DB_ENV;
90		177
91	{	178	{
…		…
120	-Property => DB_CHKSUM,	207	-Property => DB_CHKSUM,
121	-Flags => DB_CREATE \| DB_UPGRADE,	208	-Flags => DB_CREATE \| DB_UPGRADE,
122	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"	209	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
123	}	210	}
124		211
		212	my $pod_cache = db_table "pod_cache";
		213
		214	sub load_pod($$$$) {
		215	my ($path, $filtertype, $filterversion, $filtercb) = @_;
		216
		217	stat $path
		218	or die "$path: $!";
		219
		220	my $phash = join ",", $filterversion, $CFClient::PodToPango::VERSION, (stat _)[7,9];
		221
		222	my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } };
		223
		224	return $pom if $chash eq $phash;
		225
		226	my $pod = do {
		227	local $/;
		228	open my $pod, "<:utf8", $_[0]
		229	or die "$_[0]: $!";
		230	<$pod>
		231	};
		232
		233	#utf8::downgrade $pod;
		234
		235	$pom = $filtercb-> (Pod::POM->new->parse_text ($pod));
		236
		237	$pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]);
		238
		239	$pom
		240	}
		241
125	sub pod_to_pango($) {	242	sub pod_to_pango($) {
126	my ($pom) = @_;	243	my ($pom) = @_;
127		244
128	$pom->present ("CFClient::PodToPango")	245	$pom->present ("CFClient::PodToPango")
129	}	246	}
…		…
135	map s/^(\s)// && [40 length $1, length $_ ? $_ : " "],	252	map s/^(\s)// && [40 length $1, length $_ ? $_ : " "],
136	split /\n/, $pom->present ("CFClient::PodToPango")	253	split /\n/, $pom->present ("CFClient::PodToPango")
137	]	254	]
138	}	255	}
139		256
140	package CFClient::PodToPango;	257	package CFClient::Layout;
141		258
142	use base Pod::POM::View::Text;	259	$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub {
143		260	reset_glyph_cache;
144	our $indent = 0;
145
146	*view_seq_code =
147	*view_seq_bold = sub { "<b>$_[1]</b>" };
148	*view_seq_italic = sub { "<i>$_[1]</i>" };
149	*view_seq_space =
150	*view_seq_link =
151	*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) };
152
153	sub view_seq_text {
154	my $text = $_[1];
155	$text =~ s/\s+/ /g;
156	CFClient::UI::Label::escape ($text)
157	}
158
159	sub view_item {
160	("\t" x ($indent / 4))
161	. $_[1]->title->present ($_[0])
162	. "\n"
163	. $_[1]->content->present ($_[0])
164	}
165
166	sub view_verbatim {
167	(join "",
168	map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
169	split /\n/, CFClient::UI::Label::escape ($_[1]))
170	. "\n"
171	}
172
173	sub view_textblock {
174	("\t" x ($indent / 2)) . "$_[1]\n\n"
175	}
176
177	sub view_head1 {
178	"\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
179	. $_[1]->content->present ($_[0])
180	};	261	};
181
182	sub view_head2 {
183	"\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
184	. $_[1]->content->present ($_[0])
185	};
186
187	sub view_head3 {
188	"\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
189	. $_[1]->content->present ($_[0])
190	};
191
192	sub view_over {
193	local $indent = $indent + $_[1]->indent;
194	$_[1]->content->present ($_[0])
195	}
196
197	package CFClient::Database;
198
199	our @ISA = BerkeleyDB::Btree::;
200
201	sub get($$) {
202	my $data;
203
204	$_[0]->db_get ($_[1], $data) == 0
205	? $data
206	: ()
207	}
208
209	my %DB_SYNC;
210
211	sub put($$$) {
212	my ($db, $key, $data) = @_;
213
214	$DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
215
216	$db->db_put ($key => $data)
217	}
218		262
219	package CFClient::Item;	263	package CFClient::Item;
220		264
221	use strict;	265	use strict;
222	use Crossfire::Protocol::Constants;	266	use Crossfire::Protocol::Constants;
…		…
258	}	302	}
259		303
260	sub do_n_dialog {	304	sub do_n_dialog {
261	my ($cb) = @_;	305	my ($cb) = @_;
262		306
263	my $w = new CFClient::UI::FancyFrame;	307	my $w = new CFClient::UI::FancyFrame
		308	on_delete => sub { $_[0]->destroy; 1 },
		309	has_close_button => 1,
		310	;
		311
264	$w->add (my $vb = new CFClient::UI::VBox x => "center", y => "center");	312	$w->add (my $vb = new CFClient::UI::VBox x => "center", y => "center");
265	$vb->add (new CFClient::UI::Label text => "Enter item count:");	313	$vb->add (new CFClient::UI::Label text => "Enter item count:");
266	$vb->add (my $entry = new CFClient::UI::Entry	314	$vb->add (my $entry = new CFClient::UI::Entry
267	text => $last_enter_count,	315	text => $last_enter_count,
268	on_activate => sub {	316	on_activate => sub {
269	my ($entry) = @_;	317	my ($entry) = @_;
270	$last_enter_count = $entry->get_text;	318	$last_enter_count = $entry->get_text;
271	$cb->($last_enter_count);	319	$cb->($last_enter_count);
272	$w->hide;	320	$w->hide;
273	$w = undef;	321	$w->destroy;
		322
		323	0
274	}	324	},
		325	on_escape => sub { $w->destroy; 1 },
275	);	326	);
276	$entry->focus_in;	327	$entry->grab_focus;
277	$w->show;	328	$w->show;
278
279	}	329	}
280		330
281	sub update_widgets {	331	sub update_widgets {
282	my ($self) = @_;	332	my ($self) = @_;
		333
		334	# necessary to avoid cyclic references
		335	Scalar::Util::weaken $self;
283		336
284	my $button_cb = sub {	337	my $button_cb = sub {
285	my (undef, $ev, $x, $y) = @_;	338	my (undef, $ev, $x, $y) = @_;
286		339
287	my $targ = $::CONN->{player}{tag};	340	my $targ = $::CONN->{player}{tag};
…		…
300	} elsif ($ev->{button} == 1) {	353	} elsif ($ev->{button} == 1) {
301	$::CONN->send ("examine $self->{tag}");	354	$::CONN->send ("examine $self->{tag}");
302	} elsif ($ev->{button} == 2) {	355	} elsif ($ev->{button} == 2) {
303	$::CONN->send ("apply $self->{tag}");	356	$::CONN->send ("apply $self->{tag}");
304	} elsif ($ev->{button} == 3) {	357	} elsif ($ev->{button} == 3) {
		358	my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop';
		359	if ($self->{container} == $::CONN->{open_container}) {
		360	$move_prefix = "take";
		361	}
		362
305	my @menu_items = (	363	my @menu_items = (
306	["examine", sub { $::CONN->send ("examine $self->{tag}") }],	364	["examine", sub { $::CONN->send ("examine $self->{tag}") }],
307	["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],	365	["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
		366	["ignite/thaw", # first try of an easier use of flint&steel
		367	sub {
		368	$::CONN->send ("mark ". pack "N", $self->{tag});
		369	$::CONN->send ("command apply flint and steel");
		370	}
		371	],
308	["apply", sub { $::CONN->send ("apply $self->{tag}") }],	372	["apply", sub { $::CONN->send ("apply $self->{tag}") }],
309	(	373	(
310	$self->{flags} & F_LOCKED	374	$self->{flags} & F_LOCKED
311	? (	375	? (
312	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],	376	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
313	)	377	)
314	: (	378	: (
315	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],	379	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
316	["drop", sub { $::CONN->send ("move $::CONN->{open_container} $self->{tag} 0") }],	380	["$move_prefix all", sub { $::CONN->send ("move $targ $self->{tag} 0") }],
317	["move n",	381	["$move_prefix n",
318	sub {	382	sub {
319	do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })	383	do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
320	}	384	}
321	]	385	]
322	)	386	)
…		…
380	. ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")	444	. ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
381	. "\n\n$tooltip_std"	445	. "\n\n$tooltip_std"
382	);	446	);
383	}	447	}
384		448
385	package CFClient::Binder;
386
387	my @ALLOWED_MODIFIER_KEYS = (
388	CFClient::SDLK_LSHIFT,
389	CFClient::SDLK_LCTRL ,
390	CFClient::SDLK_LALT ,
391	CFClient::SDLK_LMETA ,
392
393	CFClient::SDLK_RSHIFT,
394	CFClient::SDLK_RCTRL ,
395	CFClient::SDLK_RALT ,
396	CFClient::SDLK_RMETA ,
397	);
398
399	my %ALLOWED_MODIFIERS = (
400	CFClient::KMOD_LSHIFT => "LSHIFT",
401	CFClient::KMOD_LCTRL => "LCTRL",
402	CFClient::KMOD_LALT => "LALT",
403	CFClient::KMOD_LMETA => "LMETA",
404
405	CFClient::KMOD_RSHIFT => "RSHIFT",
406	CFClient::KMOD_RCTRL => "RCTRL",
407	CFClient::KMOD_RALT => "RALT",
408	CFClient::KMOD_RMETA => "RMETA",
409	);
410
411	my %DIRECT_BIND_CHARS = map { $_ => 1 } qw/0 1 2 3 4 5 6 7 8 9/;
412	my @DIRECT_BIND_KEYS = (
413	CFClient::SDLK_F1,
414	CFClient::SDLK_F2,
415	CFClient::SDLK_F3,
416	CFClient::SDLK_F4,
417	CFClient::SDLK_F5,
418	CFClient::SDLK_F6,
419	CFClient::SDLK_F7,
420	CFClient::SDLK_F8,
421	CFClient::SDLK_F9,
422	CFClient::SDLK_F10,
423	CFClient::SDLK_F11,
424	CFClient::SDLK_F12,
425	CFClient::SDLK_F13,
426	CFClient::SDLK_F14,
427	CFClient::SDLK_F15,
428	);
429
430	# this binding dialog asks for a key-combo to be pressed
431	# and if successful it calls the $cb with $mod and $sym as args.
432	sub open_binding_dialog {
433	my ($cb) = @_;
434
435	my $w = new CFClient::UI::FancyFrame
436	title => "Bind Action",
437	x => "center",
438	y => "center";
439
440	$w->add (my $vb = new CFClient::UI::VBox);
441	$vb->add (new CFClient::UI::Label
442	text => "Press a modifier (CTRL, ALT and/or SHIFT) and a key."
443	."You can only bind 0-9 and F1-F15 without modifiers."
444	);
445	$vb->add (my $entry = new CFClient::UI::Entry
446	text => "",
447	on_key_down => sub {
448	my ($entry, $ev) = @_;
449
450	my $mod = $ev->{mod};
451	my $sym = $ev->{sym};
452
453	# XXX: This seems a little bit hackisch to me, but i have to ignore them
454	if (grep { $_ == $sym } @ALLOWED_MODIFIER_KEYS) {
455	return;
456	}
457
458	if ($mod == CFClient::KMOD_NONE
459	and not $DIRECT_BIND_CHARS{chr ($ev->{unicode})}
460	and not grep { $sym == $_ } @DIRECT_BIND_KEYS)
461	{
462	$::STATUSBOX->add (
463	"Can't bind key ".CFClient::SDL_GetKeyName ($sym)
464	." directly without modifier! It would damage the completer handling."
465	);
466	return;
467	}
468
469	$entry->focus_out;
470
471	$cb->($mod, $sym);
472
473	$w->destroy
474	});
475
476	$entry->focus_in;
477	$w->show;
478	}
479
480	sub keycombo_to_name {
481	my ($mod, $sym) = @_;
482
483	my $mods = join '+',
484	map { $ALLOWED_MODIFIERS{$_} }
485	grep { ($_ + 0) & ($mod + 0) }
486	keys %ALLOWED_MODIFIERS;
487	$mods .= "+" if $mods ne '';
488
489	return $mods . CFClient::SDL_GetKeyName ($sym);
490	}
491
492	package CFClient::Pickup;
493	# some pickup constants
494	sub PU_NOTHING { 0x00000000 }
495
496	sub PU_DEBUG { 0x10000000 }
497	sub PU_INHIBIT { 0x20000000 }
498	sub PU_STOP { 0x40000000 }
499	sub PU_NEWMODE { 0x80000000 }
500
501	sub PU_RATIO { 0x0000000F }
502
503	sub PU_FOOD { 0x00000010 }
504	sub PU_DRINK { 0x00000020 }
505	sub PU_VALUABLES { 0x00000040 }
506	sub PU_BOW { 0x00000080 }
507
508	sub PU_ARROW { 0x00000100 }
509	sub PU_HELMET { 0x00000200 }
510	sub PU_SHIELD { 0x00000400 }
511	sub PU_ARMOUR { 0x00000800 }
512
513	sub PU_BOOTS { 0x00001000 }
514	sub PU_GLOVES { 0x00002000 }
515	sub PU_CLOAK { 0x00004000 }
516	sub PU_KEY { 0x00008000 }
517
518	sub PU_MISSILEWEAPON { 0x00010000 }
519	sub PU_ALLWEAPON { 0x00020000 }
520	sub PU_MAGICAL { 0x00040000 }
521	sub PU_POTION { 0x00080000 }
522
523	sub PU_SPELLBOOK { 0x00100000 }
524	sub PU_SKILLSCROLL { 0x00200000 }
525	sub PU_READABLES { 0x00400000 }
526	sub PU_MAGIC_DEVICE { 0x00800000 }
527
528	sub PU_NOT_CURSED { 0x01000000 }
529
530	sub PU_JEWELS { 0x02000000 }
531
532
533	1;	449	1;
534		450
535	=back	451	=back
536		452
537	=head1 AUTHOR	453	=head1 AUTHOR

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC.pm (file contents): Revision 1.88 by root, Mon Jun 5 05:31:13 2006 UTC vs. Revision 1.102 by root, Sat Jul 22 13:20:33 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.88 by root, Mon Jun 5 05:31:13 2006 UTC vs.
Revision 1.102 by root, Sat Jul 22 13:20:33 2006 UTC