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

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.77 by root, Mon May 29 21:54:15 2006 UTC vs.
Revision 1.105 by root, Sun Jul 23 16:11:12 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 ();
		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	=item guard { BLOCK }
		51
		52	Returns an object that executes the given block as soon as it is destroyed.
		53
		54	=cut
		55
		56	sub guard(&) {
		57	bless \(my $cb = $_[0]), "CFClient::Guard"
		58	}
		59
		60	sub CFClient::Guard::DESTROY {
		61	${$_[0]}->()
		62	}
		63
		64	sub asxml($) {
		65	local $_ = $_[0];
		66
		67	s/&/&/g;
		68	s/>/>/g;
		69	s/</</g;
		70
		71	$_
		72	}
		73
		74	package CFClient::Database;
		75
		76	our @ISA = BerkeleyDB::Btree::;
		77
		78	sub get($$) {
		79	my $data;
		80
		81	$_[0]->db_get ($_[1], $data) == 0
		82	? $data
		83	: ()
		84	}
		85
		86	my %DB_SYNC;
		87
		88	sub put($$$) {
		89	my ($db, $key, $data) = @_;
		90
		91	$DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
		92
		93	$db->db_put ($key => $data)
		94	}
		95
		96	package CFClient;
29		97
30	sub find_rcfile($) {	98	sub find_rcfile($) {
31	my $path;	99	my $path;
32		100
33	for (grep !ref, @INC) {	101	for (grep !ref, @INC) {
…		…
68	}	136	}
69		137
70	close CFG;	138	close CFG;
71	}	139	}
72		140
73	mkdir "$Crossfire::VARDIR/cfplus", 0777;
74
75	our $DB_ENV;	141	our $DB_ENV;
76		142
77	{	143	{
78	use strict;	144	use strict;
79		145
		146	mkdir "$Crossfire::VARDIR/cfplus", 0777;
80	my $recover = $BerkeleyDB::db_version >= 4.4	147	my $recover = $BerkeleyDB::db_version >= 4.4
81	? eval "DB_REGISTER \| DB_RECOVER"	148	? eval "DB_REGISTER \| DB_RECOVER"
82	: 0;	149	: 0;
83		150
84	$DB_ENV = new BerkeleyDB::Env	151	$DB_ENV = new BerkeleyDB::Env
…		…
86	-Cachesize => 1_000_000,	153	-Cachesize => 1_000_000,
87	-ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",	154	-ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
88	# -ErrPrefix => "DATABASE",	155	# -ErrPrefix => "DATABASE",
89	-Verbose => 1,	156	-Verbose => 1,
90	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN \| $recover,	157	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN \| $recover,
91	-SetFlags => DB_AUTO_COMMIT \| DB_LOG_AUTOREMOVE \| DB_TXN_WRITE_NOSYNC,	158	-SetFlags => DB_AUTO_COMMIT \| DB_LOG_AUTOREMOVE,
92	or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";	159	or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
93	}	160	}
94		161
95	sub db_table($) {	162	sub db_table($) {
96	my ($table) = @_;	163	my ($table) = @_;
…		…
105	-Property => DB_CHKSUM,	172	-Property => DB_CHKSUM,
106	-Flags => DB_CREATE \| DB_UPGRADE,	173	-Flags => DB_CREATE \| DB_UPGRADE,
107	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"	174	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
108	}	175	}
109		176
110	sub pod_to_pango($) {	177	package CFClient::Layout;
111	my ($pom) = @_;
112		178
113	$pom->present ("CFClient::PodToPango")	179	$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub {
114	}	180	reset_glyph_cache;
115
116	sub pod_to_pango_list($) {
117	my ($pom) = @_;
118
119	[
120	map s/^(\s)// && [40 length $1, length $_ ? $_ : " "],
121	split /\n/, $pom->present ("CFClient::PodToPango")
122	]
123	}
124
125	package CFClient::PodToPango;
126
127	use base Pod::POM::View::Text;
128
129	our $indent = 0;
130
131	*view_seq_code =
132	*view_seq_bold = sub { "<b>$_[1]</b>" };
133	*view_seq_italic = sub { "<i>$_[1]</i>" };
134	*view_seq_space =
135	*view_seq_link =
136	*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) };
137
138	sub view_seq_text {
139	my $text = $_[1];
140	$text =~ s/\s+/ /g;
141	CFClient::UI::Label::escape ($text)
142	}
143
144	sub view_item {
145	("\t" x ($indent / 4))
146	. $_[1]->title->present ($_[0])
147	. "\n"
148	. $_[1]->content->present ($_[0])
149	}
150
151	sub view_verbatim {
152	(join "",
153	map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
154	split /\n/, CFClient::UI::Label::escape ($_[1]))
155	. "\n"
156	}
157
158	sub view_textblock {
159	("\t" x ($indent / 2)) . "$_[1]\n\n"
160	}
161
162	sub view_head1 {
163	"\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
164	. $_[1]->content->present ($_[0])
165	};	181	};
166
167	sub view_head2 {
168	"\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
169	. $_[1]->content->present ($_[0])
170	};
171
172	sub view_head3 {
173	"\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
174	. $_[1]->content->present ($_[0])
175	};
176
177	sub view_over {
178	local $indent = $indent + $_[1]->indent;
179	$_[1]->content->present ($_[0])
180	}
181
182	package CFClient::Database;
183
184	our @ISA = BerkeleyDB::Btree::;
185
186	sub get($$) {
187	my $data;
188
189	$_[0]->db_get ($_[1], $data) == 0
190	? $data
191	: ()
192	}
193
194	my %DB_SYNC;
195
196	sub put($$$) {
197	my ($db, $key, $data) = @_;
198
199	$DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
200
201	$db->db_put ($key => $data)
202	}
203		182
204	package CFClient::Item;	183	package CFClient::Item;
205		184
206	use strict;	185	use strict;
207	use Crossfire::Protocol::Constants;	186	use Crossfire::Protocol::Constants;
		187
		188	my $last_enter_count = 1;
208		189
209	sub desc_string {	190	sub desc_string {
210	my ($self) = @_;	191	my ($self) = @_;
211		192
212	my $desc =	193	my $desc =
…		…
238	my $weight = ($self->{nrof} \|\| 1) * $self->{weight};	219	my $weight = ($self->{nrof} \|\| 1) * $self->{weight};
239		220
240	$weight < 0 ? "?" : $weight * 0.001	221	$weight < 0 ? "?" : $weight * 0.001
241	}	222	}
242		223
		224	sub do_n_dialog {
		225	my ($cb) = @_;
		226
		227	my $w = new CFClient::UI::FancyFrame
		228	on_delete => sub { $_[0]->destroy; 1 },
		229	has_close_button => 1,
		230	;
		231
		232	$w->add (my $vb = new CFClient::UI::VBox x => "center", y => "center");
		233	$vb->add (new CFClient::UI::Label text => "Enter item count:");
		234	$vb->add (my $entry = new CFClient::UI::Entry
		235	text => $last_enter_count,
		236	on_activate => sub {
		237	my ($entry) = @_;
		238	$last_enter_count = $entry->get_text;
		239	$cb->($last_enter_count);
		240	$w->hide;
		241	$w->destroy;
		242
		243	0
		244	},
		245	on_escape => sub { $w->destroy; 1 },
		246	);
		247	$entry->grab_focus;
		248	$w->show;
		249	}
		250
243	sub update_widgets {	251	sub update_widgets {
244	my ($self) = @_;	252	my ($self) = @_;
245		253
		254	# necessary to avoid cyclic references
		255	Scalar::Util::weaken $self;
		256
246	my $button_cb = sub {	257	my $button_cb = sub {
247	my (undef, $ev, $x, $y) = @_;	258	my (undef, $ev, $x, $y) = @_;
248		259
		260	my $targ = $::CONN->{player}{tag};
		261
		262	if ($self->{container} == $::CONN->{player}{tag}) {
		263	$targ = $::CONN->{open_container};
		264	}
		265
249	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {	266	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
250	my $targ = $::CONN->{player}{tag};
251
252	if ($self->{container} == $::CONN->{player}{tag}) {
253	$targ = $::CONN->{open_container};
254	}
255
256	$::CONN->send ("move $targ $self->{tag} 0");	267	$::CONN->send ("move $targ $self->{tag} 0")
		268	if $targ \|\| !($self->{flags} & F_LOCKED);
		269	} elsif (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 2) {
		270	$self->{flags} & F_LOCKED
		271	? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
		272	: $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
257	} elsif ($ev->{button} == 1) {	273	} elsif ($ev->{button} == 1) {
258	$::CONN->send ("examine $self->{tag}");	274	$::CONN->send ("examine $self->{tag}");
259	} elsif ($ev->{button} == 2) {	275	} elsif ($ev->{button} == 2) {
260	$::CONN->send ("apply $self->{tag}");	276	$::CONN->send ("apply $self->{tag}");
261	} elsif ($ev->{button} == 3) {	277	} elsif ($ev->{button} == 3) {
		278	my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop';
		279	if ($self->{container} == $::CONN->{open_container}) {
		280	$move_prefix = "take";
		281	}
		282
262	my @menu_items = (	283	my @menu_items = (
263	["examine", sub { $::CONN->send ("examine $self->{tag}") }],	284	["examine", sub { $::CONN->send ("examine $self->{tag}") }],
264	["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],	285	["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
		286	["ignite/thaw", # first try of an easier use of flint&steel
		287	sub {
		288	$::CONN->send ("mark ". pack "N", $self->{tag});
		289	$::CONN->send ("command apply flint and steel");
		290	}
		291	],
265	["apply", sub { $::CONN->send ("apply $self->{tag}") }],	292	["apply", sub { $::CONN->send ("apply $self->{tag}") }],
266	(	293	(
267	$self->{flags} & F_LOCKED	294	$self->{flags} & F_LOCKED
268	? (	295	? (
269	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],	296	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
270	)	297	)
271	: (	298	: (
272	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],	299	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
273	["drop", sub { $::CONN->send ("move $::CONN->{open_container} $self->{tag} 0") }],	300	["$move_prefix all", sub { $::CONN->send ("move $targ $self->{tag} 0") }],
		301	["$move_prefix <n>",
		302	sub {
		303	do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
		304	}
		305	]
274	)	306	)
275	),	307	),
276	);	308	);
277		309
278	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);	310	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
…		…
283		315
284	my $tooltip_std = "<small>"	316	my $tooltip_std = "<small>"
285	. "Left click - examine item\n"	317	. "Left click - examine item\n"
286	. "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"	318	. "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
287	. "Middle click - apply\n"	319	. "Middle click - apply\n"
		320	. "Shift-Middle click - lock/unlock\n"
288	. "Right click - further options"	321	. "Right click - further options"
289	. "</small>\n";	322	. "</small>\n";
290		323
291	$self->{face_widget} \|\|= new CFClient::UI::Face	324	$self->{face_widget} \|\|= new CFClient::UI::Face
292	can_events => 1,	325	can_events => 1,
…		…
331	. ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")	364	. ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
332	. "\n\n$tooltip_std"	365	. "\n\n$tooltip_std"
333	);	366	);
334	}	367	}
335		368
336	package CFClient::Recorder;
337
338	our $RECORD_WINDOW;
339
340	my $CMDBOX;
341	my $CURRENT_CMDS;
342	my $REC_BTN;
343
344	my @ALLOWED_MODIFIER_KEYS = (
345	(CFClient::SDLK_LSHIFT) => "LSHIFT",
346	(CFClient::SDLK_LCTRL ) => "LCTRL",
347	(CFClient::SDLK_LALT ) => "LALT",
348	(CFClient::SDLK_LMETA ) => "LMETA",
349
350	(CFClient::SDLK_RSHIFT) => "RSHIFT",
351	(CFClient::SDLK_RCTRL ) => "RCTRL",
352	(CFClient::SDLK_RALT ) => "RALT",
353	(CFClient::SDLK_RMETA ) => "RMETA",
354	);
355
356	my %ALLOWED_MODIFIERS = (
357	(CFClient::KMOD_LSHIFT) => "LSHIFT",
358	(CFClient::KMOD_LCTRL ) => "LCTRL",
359	(CFClient::KMOD_LALT ) => "LALT",
360	(CFClient::KMOD_LMETA ) => "LMETA",
361
362	(CFClient::KMOD_RSHIFT) => "RSHIFT",
363	(CFClient::KMOD_RCTRL ) => "RCTRL",
364	(CFClient::KMOD_RALT ) => "RALT",
365	(CFClient::KMOD_RMETA ) => "RMETA",
366	);
367
368	my %DIRECT_BIND_CHARS = map { $_ => 1 } qw/0 1 2 3 4 5 6 7 8 9/;
369	my @DIRECT_BIND_KEYS = (
370	CFClient::SDLK_F1,
371	CFClient::SDLK_F2,
372	CFClient::SDLK_F3,
373	CFClient::SDLK_F4,
374	CFClient::SDLK_F5,
375	CFClient::SDLK_F6,
376	CFClient::SDLK_F7,
377	CFClient::SDLK_F8,
378	CFClient::SDLK_F9,
379	CFClient::SDLK_F10,
380	CFClient::SDLK_F11,
381	CFClient::SDLK_F12,
382	CFClient::SDLK_F13,
383	CFClient::SDLK_F14,
384	CFClient::SDLK_F15,
385	);
386
387	# this binding dialog asks for a key-combo to be pressed
388	# and if successful it binds the modifier+symbol to the
389	# supplied actions in $cmd.
390	# (Bindings are stored in $::CFG->{bindings}->{$mod}->{$sym})
391	sub open_binding_dialog {
392	my ($cmd) = @_;
393
394	my $w = new CFClient::UI::FancyFrame
395	title => "Bind Action";
396
397	$w->add (my $vb = new CFClient::UI::VBox);
398	$vb->add (new CFClient::UI::Label
399	text => "Press a modifier (CTRL, ALT and/or SHIFT) and a key."
400	."You can only bind 0-9 and F1-F15 without modifiers."
401	);
402	$vb->add (my $entry = new CFClient::UI::Entry
403	text => "",
404	on_key_down => sub {
405	my ($entry, $ev) = @_;
406
407	my $mod = $ev->{mod};
408	my $sym = $ev->{sym};
409
410	# XXX: This seems a little bit hackisch to me, but i have to ignore them
411	if (grep { $_ == $sym } @ALLOWED_MODIFIER_KEYS) {
412	return;
413	}
414
415	if ($mod == CFClient::KMOD_NONE
416	and not $DIRECT_BIND_CHARS{chr ($ev->{unicode})}
417	and not grep { $sym == $_ } @DIRECT_BIND_KEYS)
418	{
419	$::STATUSBOX->add (
420	"Can't bind key ".CFClient::SDL_GetKeyName ($sym)
421	." directly without modifier! It would damage the completer handling."
422	);
423	return;
424	}
425
426	$entry->focus_out;
427
428	$::CFG->{bindings}->{$mod}->{$sym} = $cmd;
429	$::STATUSBOX->add ("Bound actions to '".keycombo_to_name ($mod, $sym)."'. Don't forget 'Save Config'!");
430
431	$w->destroy
432	});
433
434	$entry->focus_in;
435	$w->center;
436	$w->show;
437	}
438
439	sub keycombo_to_name {
440	my ($mod, $sym) = @_;
441
442	my $mods = join '+',
443	map { $ALLOWED_MODIFIERS{$_} }
444	grep { $_ & $mod }
445	keys %ALLOWED_MODIFIERS;
446	$mods .= "+" if $mods ne '';
447
448	return $mods . CFClient::SDL_GetKeyName ($sym);
449	}
450
451	sub clear_command_list {
452	$CMDBOX->clear () if $CMDBOX;
453	}
454
455	sub set_command_list {
456	my ($list) = @_;
457
458	return unless $CMDBOX;
459
460	$CMDBOX->clear ();
461	$CURRENT_CMDS = $list;
462
463	my $idx = 0;
464
465	for (@$list) {
466	$CMDBOX->add (my $hb = new CFClient::UI::HBox);
467
468	my $i = $idx;
469	$hb->add (new CFClient::UI::Button
470	text => "delete",
471	tooltip => "Deletes the action from the record",
472	on_activate => sub {
473	$CMDBOX->remove ($hb);
474	$list->[$i] = undef;
475	});
476
477	$hb->add (new CFClient::UI::Label text => $_);
478
479	$idx++
480	}
481	}
482
483	# if $show is 1 the recorder will be shown
484	sub start {
485	my ($show) = @_;
486
487	$RECORD_WINDOW->show if $show;
488
489	$REC_BTN->set_text ("stop recording");
490	$REC_BTN->{recording} = 1;
491	clear_command_list;
492	$::CONN->start_record;
493	}
494
495	# if $autobind is 1 the recorder will be automatically
496	# jump into the binding query and hide the recorder window
497	sub stop {
498	my ($autobind) = @_;
499
500	$REC_BTN->set_text ("start recording");
501	$REC_BTN->{recording} = 0;
502
503	my $rec = $::CONN->stop_record;
504	return unless ref $rec eq 'ARRAY';
505	set_command_list ($rec);
506
507	if ($autobind) {
508	open_binding_dialog ([ grep { defined $_ } @$CURRENT_CMDS ]);
509	$RECORD_WINDOW->hide;
510	}
511	}
512
513	sub make_window {
514	$RECORD_WINDOW = new CFClient::UI::FancyFrame
515	req_y => 1,
516	req_x => -1,
517	title => "Action Recorder";
518
519	$RECORD_WINDOW->add (my $vb = new CFClient::UI::VBox);
520	$vb->add ($REC_BTN = new CFClient::UI::Button
521	text => "start recording",
522	tooltip => "Start/Stops recording of actions."
523	."(CTRL+Insert Starts the recorder, Insert Stops recorder and binds automatically)"
524	."All subsequent actions after the recording started will be captured."
525	."The actions are displayed after the record was stopped."
526	."To bind the action you have to click on the 'Bind' button",
527	on_activate => sub {
528	my ($btn) = @_;
529
530	unless ($btn->{recording}) {
531	start;
532	} else {
533	stop;
534	}
535	});
536	$vb->add ($CMDBOX = new CFClient::UI::VBox);
537	$vb->add (new CFClient::UI::Button
538	text => "bind",
539	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
540	on_activate => sub {
541	open_binding_dialog ([ grep { defined $_ } @$CURRENT_CMDS ]);
542	});
543
544	$RECORD_WINDOW
545	}
546
547	1;	369	1;
548		370
549	=back	371	=back
550		372
551	=head1 AUTHOR	373	=head1 AUTHOR

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC.pm (file contents): Revision 1.77 by root, Mon May 29 21:54:15 2006 UTC vs. Revision 1.105 by root, Sun Jul 23 16:11:12 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.77 by root, Mon May 29 21:54:15 2006 UTC vs.
Revision 1.105 by root, Sun Jul 23 16:11:12 2006 UTC