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

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.70 by root, Fri May 26 18:28:23 2006 UTC vs.
Revision 1.76 by root, Mon May 29 21:20:15 2006 UTC

…		…
68	}	68	}
69		69
70	close CFG;	70	close CFG;
71	}	71	}
72		72
73	mkdir "$Crossfire::VARDIR/pclient", 0777;	73	mkdir "$Crossfire::VARDIR/cfplus", 0777;
74		74
		75	{
		76	use strict;
		77
75	our $DB_ENV = new BerkeleyDB::Env	78	our $DB_ENV = new BerkeleyDB::Env
76	-Home => "$Crossfire::VARDIR/pclient",	79	-Home => "$Crossfire::VARDIR/cfplus",
77	-Cachesize => 1_000_000,	80	-Cachesize => 1_000_000,
78	-ErrFile => "$Crossfire::VARDIR/pclient/errorlog.txt",	81	-ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
79	# -ErrPrefix => "DATABASE",	82	# -ErrPrefix => "DATABASE",
80	-Verbose => 1,	83	-Verbose => 1,
81	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN,	84	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN,
		85	-SetFlags => DB_AUTO_COMMIT \| DB_LOG_AUTOREMOVE \| DB_TXN_WRITE_NOSYNC,
82	or die "unable to create/open database home $Crossfire::VARDIR/pclient: $BerkeleyDB::Error";	86	or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
		87	}
83		88
84	sub db_table($) {	89	sub db_table($) {
85	my ($table) = @_;	90	my ($table) = @_;
86		91
87	$table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;	92	$table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
88		93
89	new CFClient::Database	94	new CFClient::Database
90	-Env => $DB_ENV,	95	-Env => $DB_ENV,
91	-Filename => $table,	96	-Filename => $table,
92	# -Filename => "database",	97	# -Filename => "database",
93	# -Subname => $table,	98	# -Subname => $table,
94	-Property => DB_CHKSUM,	99	-Property => DB_CHKSUM,
95	-Flags => DB_CREATE \| DB_UPGRADE,	100	-Flags => DB_CREATE \| DB_UPGRADE,
96	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error";	101	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
97	}	102	}
98		103
99	sub pod_to_pango($) {	104	sub pod_to_pango($) {
100	my ($pom) = @_;	105	my ($pom) = @_;
101		106
…		…
190	$db->db_put ($key => $data)	195	$db->db_put ($key => $data)
191	}	196	}
192		197
193	package CFClient::Item;	198	package CFClient::Item;
194		199
		200	use strict;
		201	use Crossfire::Protocol::Constants;
		202
195	sub desc_string {	203	sub desc_string {
196	my ($self) = @_;	204	my ($self) = @_;
197		205
198	my $desc =	206	my $desc =
199	$self->{nrof} < 2	207	$self->{nrof} < 2
200	? $self->{name}	208	? $self->{name}
201	: "$self->{nrof} × $self->{name_pl}";	209	: "$self->{nrof} × $self->{name_pl}";
202		210
203	$self->{flags} & Crossfire::Protocol::F_OPEN	211	$self->{flags} & F_OPEN
204	and $desc .= " (open)";	212	and $desc .= " (open)";
205	$self->{flags} & Crossfire::Protocol::F_APPLIED	213	$self->{flags} & F_APPLIED
206	and $desc .= " (applied)";	214	and $desc .= " (applied)";
207	$self->{flags} & Crossfire::Protocol::F_UNPAID	215	$self->{flags} & F_UNPAID
208	and $desc .= " (unpaid)";	216	and $desc .= " (unpaid)";
209	$self->{flags} & Crossfire::Protocol::F_MAGIC	217	$self->{flags} & F_MAGIC
210	and $desc .= " (magic)";	218	and $desc .= " (magic)";
211	$self->{flags} & Crossfire::Protocol::F_CURSED	219	$self->{flags} & F_CURSED
212	and $desc .= " (cursed)";	220	and $desc .= " (cursed)";
213	$self->{flags} & Crossfire::Protocol::F_DAMNED	221	$self->{flags} & F_DAMNED
214	and $desc .= " (damned)";	222	and $desc .= " (damned)";
215	$self->{flags} & Crossfire::Protocol::F_LOCKED	223	$self->{flags} & F_LOCKED
216	and $desc .= " *";	224	and $desc .= " *";
217		225
218	$desc	226	$desc
219	}	227	}
220		228
…		…
248	my @menu_items = (	256	my @menu_items = (
249	["examine", sub { $::CONN->send ("examine $self->{tag}") }],	257	["examine", sub { $::CONN->send ("examine $self->{tag}") }],
250	["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],	258	["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
251	["apply", sub { $::CONN->send ("apply $self->{tag}") }],	259	["apply", sub { $::CONN->send ("apply $self->{tag}") }],
252	(	260	(
253	$self->{flags} & Crossfire::Protocol::F_LOCKED	261	$self->{flags} & F_LOCKED
254	? (	262	? (
255	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],	263	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
256	)	264	)
257	: (	265	: (
258	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],	266	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
…		…
277	$self->{face_widget} \|\|= new CFClient::UI::Face	285	$self->{face_widget} \|\|= new CFClient::UI::Face
278	can_events => 1,	286	can_events => 1,
279	can_hover => 1,	287	can_hover => 1,
280	anim => $self->{anim},	288	anim => $self->{anim},
281	animspeed => $self->{animspeed}, # TODO# must be set at creation time	289	animspeed => $self->{animspeed}, # TODO# must be set at creation time
282	connect_button_down => $button_cb,	290	on_button_down => $button_cb,
283	;	291	;
284	$self->{face_widget}{face} = $self->{face};	292	$self->{face_widget}{face} = $self->{face};
285	$self->{face_widget}{anim} = $self->{anim};	293	$self->{face_widget}{anim} = $self->{anim};
286	$self->{face_widget}{animspeed} = $self->{animspeed};	294	$self->{face_widget}{animspeed} = $self->{animspeed};
287	$self->{face_widget}->set_tooltip (	295	$self->{face_widget}->set_tooltip (
…		…
294	$self->{desc_widget} \|\|= new CFClient::UI::Label	302	$self->{desc_widget} \|\|= new CFClient::UI::Label
295	can_events => 1,	303	can_events => 1,
296	can_hover => 1,	304	can_hover => 1,
297	ellipsise => 2,	305	ellipsise => 2,
298	align => -1,	306	align => -1,
299	connect_button_down => $button_cb,	307	on_button_down => $button_cb,
300	;	308	;
301	my $desc = CFClient::Item::desc_string $self;	309	my $desc = CFClient::Item::desc_string $self;
302	$self->{desc_widget}->set_text ($desc);	310	$self->{desc_widget}->set_text ($desc);
303	$self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");	311	$self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
304		312
305	$self->{weight_widget} \|\|= new CFClient::UI::Label	313	$self->{weight_widget} \|\|= new CFClient::UI::Label
306	can_events => 1,	314	can_events => 1,
307	can_hover => 1,	315	can_hover => 1,
308	ellipsise => 0,	316	ellipsise => 0,
309	align => 0,	317	align => 0,
310	connect_button_down => $button_cb,	318	on_button_down => $button_cb,
311	;	319	;
312	$self->{weight_widget}->set_text (CFClient::Item::weight_string $self);	320	$self->{weight_widget}->set_text (CFClient::Item::weight_string $self);
313		321
314	$self->{weight_widget}->set_tooltip (	322	$self->{weight_widget}->set_tooltip (
315	"<b>Weight</b>.\n"	323	"<b>Weight</b>.\n"
…		…
317	. ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")	325	. ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
318	. "\n\n$tooltip_std"	326	. "\n\n$tooltip_std"
319	);	327	);
320	}	328	}
321		329
		330	package CFClient::Recorder;
		331
		332	our $RECORD_WINDOW;
		333
		334	my $CMDBOX;
		335	my $CURRENT_CMDS;
		336	my $REC_BTN;
		337
		338	my @ALLOWED_MODIFIER_KEYS = (
		339	(CFClient::SDLK_LSHIFT) => "LSHIFT",
		340	(CFClient::SDLK_LCTRL ) => "LCTRL",
		341	(CFClient::SDLK_LALT ) => "LALT",
		342	(CFClient::SDLK_LMETA ) => "LMETA",
		343
		344	(CFClient::SDLK_RSHIFT) => "RSHIFT",
		345	(CFClient::SDLK_RCTRL ) => "RCTRL",
		346	(CFClient::SDLK_RALT ) => "RALT",
		347	(CFClient::SDLK_RMETA ) => "RMETA",
		348	);
		349
		350	my %ALLOWED_MODIFIERS = (
		351	(CFClient::KMOD_LSHIFT) => "LSHIFT",
		352	(CFClient::KMOD_LCTRL ) => "LCTRL",
		353	(CFClient::KMOD_LALT ) => "LALT",
		354	(CFClient::KMOD_LMETA ) => "LMETA",
		355
		356	(CFClient::KMOD_RSHIFT) => "RSHIFT",
		357	(CFClient::KMOD_RCTRL ) => "RCTRL",
		358	(CFClient::KMOD_RALT ) => "RALT",
		359	(CFClient::KMOD_RMETA ) => "RMETA",
		360	);
		361
		362	my %DIRECT_BIND_CHARS = map { $_ => 1 } qw/0 1 2 3 4 5 6 7 8 9/;
		363	my @DIRECT_BIND_KEYS = (
		364	CFClient::SDLK_F1,
		365	CFClient::SDLK_F2,
		366	CFClient::SDLK_F3,
		367	CFClient::SDLK_F4,
		368	CFClient::SDLK_F5,
		369	CFClient::SDLK_F6,
		370	CFClient::SDLK_F7,
		371	CFClient::SDLK_F8,
		372	CFClient::SDLK_F9,
		373	CFClient::SDLK_F10,
		374	CFClient::SDLK_F11,
		375	CFClient::SDLK_F12,
		376	CFClient::SDLK_F13,
		377	CFClient::SDLK_F14,
		378	CFClient::SDLK_F15,
		379	);
		380
		381	# this binding dialog asks for a key-combo to be pressed
		382	# and if successful it binds the modifier+symbol to the
		383	# supplied actions in $cmd.
		384	# (Bindings are stored in $::CFG->{bindings}->{$mod}->{$sym})
		385	sub open_binding_dialog {
		386	my ($cmd) = @_;
		387
		388	my $w = new CFClient::UI::FancyFrame
		389	title => "Bind Action";
		390
		391	$w->add (my $vb = new CFClient::UI::VBox);
		392	$vb->add (new CFClient::UI::Label
		393	text => "Press a modifier (CTRL, ALT and/or SHIFT) and a key."
		394	."You can only bind 0-9 and F1-F15 without modifiers."
		395	);
		396	$vb->add (my $entry = new CFClient::UI::Entry
		397	text => "",
		398	on_key_down => sub {
		399	my ($entry, $ev) = @_;
		400
		401	my $mod = $ev->{mod};
		402	my $sym = $ev->{sym};
		403
		404	# XXX: This seems a little bit hackisch to me, but i have to ignore them
		405	if (grep { $_ == $sym } @ALLOWED_MODIFIER_KEYS) {
		406	return;
		407	}
		408
		409	if ($mod == CFClient::KMOD_NONE
		410	and not $DIRECT_BIND_CHARS{chr ($ev->{unicode})}
		411	and not grep { $sym == $_ } @DIRECT_BIND_KEYS)
		412	{
		413	$::STATUSBOX->add (
		414	"Can't bind key ".CFClient::SDL_GetKeyName ($sym)
		415	." directly without modifier! It would damage the completer handling."
		416	);
		417	return;
		418	}
		419
		420	$entry->focus_out;
		421
		422	$::CFG->{bindings}->{$mod}->{$sym} = $cmd;
		423	$::STATUSBOX->add ("Bound actions to '".keycombo_to_name ($mod, $sym)."'. Don't forget 'Save Config'!");
		424
		425	$w->destroy
		426	});
		427
		428	$entry->focus_in;
		429	$w->center;
		430	$w->show;
		431	}
		432
		433	sub keycombo_to_name {
		434	my ($mod, $sym) = @_;
		435
		436	my $mods = join '+',
		437	map { $ALLOWED_MODIFIERS{$_} }
		438	grep { $_ & $mod }
		439	keys %ALLOWED_MODIFIERS;
		440	$mods .= "+" if $mods ne '';
		441
		442	return $mods . CFClient::SDL_GetKeyName ($sym);
		443	}
		444
		445	sub clear_command_list {
		446	$CMDBOX->clear () if $CMDBOX;
		447	}
		448
		449	sub set_command_list {
		450	my ($list) = @_;
		451
		452	return unless $CMDBOX;
		453
		454	$CMDBOX->clear ();
		455	$CURRENT_CMDS = $list;
		456
		457	my $idx = 0;
		458
		459	for (@$list) {
		460	$CMDBOX->add (my $hb = new CFClient::UI::HBox);
		461
		462	my $i = $idx;
		463	$hb->add (new CFClient::UI::Button
		464	text => "delete",
		465	tooltip => "Deletes the action from the record",
		466	on_activate => sub {
		467	$CMDBOX->remove ($hb);
		468	$list->[$i] = undef;
		469	});
		470
		471	$hb->add (new CFClient::UI::Label text => $_);
		472
		473	$idx++
		474	}
		475	}
		476
		477	# if $show is 1 the recorder will be shown
		478	sub start {
		479	my ($show) = @_;
		480
		481	$RECORD_WINDOW->show if $show;
		482
		483	$REC_BTN->set_text ("stop recording");
		484	$REC_BTN->{recording} = 1;
		485	clear_command_list;
		486	$::CONN->start_record;
		487	}
		488
		489	# if $autobind is 1 the recorder will be automatically
		490	# jump into the binding query and hide the recorder window
		491	sub stop {
		492	my ($autobind) = @_;
		493
		494	$REC_BTN->set_text ("start recording");
		495	$REC_BTN->{recording} = 0;
		496
		497	my $rec = $::CONN->stop_record;
		498	return unless ref $rec eq 'ARRAY';
		499	set_command_list ($rec);
		500
		501	if ($autobind) {
		502	open_binding_dialog ([ grep { defined $_ } @$CURRENT_CMDS ]);
		503	$RECORD_WINDOW->hide;
		504	}
		505	}
		506
		507	sub make_window {
		508	$RECORD_WINDOW = new CFClient::UI::FancyFrame
		509	req_y => 1,
		510	req_x => -1,
		511	title => "Action Recorder";
		512
		513	$RECORD_WINDOW->add (my $vb = new CFClient::UI::VBox);
		514	$vb->add ($REC_BTN = new CFClient::UI::Button
		515	text => "start recording",
		516	tooltip => "Start/Stops recording of actions."
		517	."(CTRL+Insert Starts the recorder, Insert Stops recorder and binds automatically)"
		518	."All subsequent actions after the recording started will be captured."
		519	."The actions are displayed after the record was stopped."
		520	."To bind the action you have to click on the 'Bind' button",
		521	on_activate => sub {
		522	my ($btn) = @_;
		523
		524	unless ($btn->{recording}) {
		525	start;
		526	} else {
		527	stop;
		528	}
		529	});
		530	$vb->add ($CMDBOX = new CFClient::UI::VBox);
		531	$vb->add (new CFClient::UI::Button
		532	text => "bind",
		533	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		534	on_activate => sub {
		535	open_binding_dialog ([ grep { defined $_ } @$CURRENT_CMDS ]);
		536	});
		537
		538	$RECORD_WINDOW
		539	}
		540
322	1;	541	1;
323		542
324	=back	543	=back
325		544
326	=head1 AUTHOR	545	=head1 AUTHOR

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC.pm (file contents): Revision 1.70 by root, Fri May 26 18:28:23 2006 UTC vs. Revision 1.76 by root, Mon May 29 21:20:15 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.70 by root, Fri May 26 18:28:23 2006 UTC vs.
Revision 1.76 by root, Mon May 29 21:20:15 2006 UTC