[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.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 ();
		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;
29		132
30	sub find_rcfile($) {	133	sub find_rcfile($) {
31	my $path;	134	my $path;
32		135
33	for (grep !ref, @INC) {	136	for (grep !ref, @INC) {
…		…
68	}	171	}
69		172
70	close CFG;	173	close CFG;
71	}	174	}
72		175
73	mkdir "$Crossfire::VARDIR/cfplus", 0777;
74
75	our $DB_ENV;	176	our $DB_ENV;
76		177
77	{	178	{
78	use strict;	179	use strict;
79		180
		181	mkdir "$Crossfire::VARDIR/cfplus", 0777;
80	my $recover = $BerkeleyDB::db_version >= 4.4	182	my $recover = $BerkeleyDB::db_version >= 4.4
81	? eval "DB_REGISTER \| DB_RECOVER"	183	? eval "DB_REGISTER \| DB_RECOVER"
82	: 0;	184	: 0;
83		185
84	$DB_ENV = new BerkeleyDB::Env	186	$DB_ENV = new BerkeleyDB::Env
…		…
86	-Cachesize => 1_000_000,	188	-Cachesize => 1_000_000,
87	-ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",	189	-ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
88	# -ErrPrefix => "DATABASE",	190	# -ErrPrefix => "DATABASE",
89	-Verbose => 1,	191	-Verbose => 1,
90	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN \| $recover,	192	-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,	193	-SetFlags => DB_AUTO_COMMIT \| DB_LOG_AUTOREMOVE,
92	or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";	194	or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
93	}	195	}
94		196
95	sub db_table($) {	197	sub db_table($) {
96	my ($table) = @_;	198	my ($table) = @_;
…		…
105	-Property => DB_CHKSUM,	207	-Property => DB_CHKSUM,
106	-Flags => DB_CREATE \| DB_UPGRADE,	208	-Flags => DB_CREATE \| DB_UPGRADE,
107	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"	209	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
108	}	210	}
109		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
110	sub pod_to_pango($) {	242	sub pod_to_pango($) {
111	my ($pom) = @_;	243	my ($pom) = @_;
112		244
113	$pom->present ("CFClient::PodToPango")	245	$pom->present ("CFClient::PodToPango")
114	}	246	}
…		…
120	map s/^(\s)// && [40 length $1, length $_ ? $_ : " "],	252	map s/^(\s)// && [40 length $1, length $_ ? $_ : " "],
121	split /\n/, $pom->present ("CFClient::PodToPango")	253	split /\n/, $pom->present ("CFClient::PodToPango")
122	]	254	]
123	}	255	}
124		256
125	package CFClient::PodToPango;	257	package CFClient::Layout;
126		258
127	use base Pod::POM::View::Text;	259	$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub {
128		260	reset_glyph_cache;
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	};	261	};
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		262
204	package CFClient::Item;	263	package CFClient::Item;
205		264
206	use strict;	265	use strict;
207	use Crossfire::Protocol::Constants;	266	use Crossfire::Protocol::Constants;
		267
		268	my $last_enter_count = 1;
208		269
209	sub desc_string {	270	sub desc_string {
210	my ($self) = @_;	271	my ($self) = @_;
211		272
212	my $desc =	273	my $desc =
…		…
238	my $weight = ($self->{nrof} \|\| 1) * $self->{weight};	299	my $weight = ($self->{nrof} \|\| 1) * $self->{weight};
239		300
240	$weight < 0 ? "?" : $weight * 0.001	301	$weight < 0 ? "?" : $weight * 0.001
241	}	302	}
242		303
		304	sub do_n_dialog {
		305	my ($cb) = @_;
		306
		307	my $w = new CFClient::UI::FancyFrame
		308	on_delete => sub { $_[0]->destroy; 1 },
		309	has_close_button => 1,
		310	;
		311
		312	$w->add (my $vb = new CFClient::UI::VBox x => "center", y => "center");
		313	$vb->add (new CFClient::UI::Label text => "Enter item count:");
		314	$vb->add (my $entry = new CFClient::UI::Entry
		315	text => $last_enter_count,
		316	on_activate => sub {
		317	my ($entry) = @_;
		318	$last_enter_count = $entry->get_text;
		319	$cb->($last_enter_count);
		320	$w->hide;
		321	$w->destroy;
		322
		323	0
		324	},
		325	on_escape => sub { $w->destroy; 1 },
		326	);
		327	$entry->grab_focus;
		328	$w->show;
		329	}
		330
243	sub update_widgets {	331	sub update_widgets {
244	my ($self) = @_;	332	my ($self) = @_;
245		333
		334	# necessary to avoid cyclic references
		335	Scalar::Util::weaken $self;
		336
246	my $button_cb = sub {	337	my $button_cb = sub {
247	my (undef, $ev, $x, $y) = @_;	338	my (undef, $ev, $x, $y) = @_;
248		339
		340	my $targ = $::CONN->{player}{tag};
		341
		342	if ($self->{container} == $::CONN->{player}{tag}) {
		343	$targ = $::CONN->{open_container};
		344	}
		345
249	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {	346	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");	347	$::CONN->send ("move $targ $self->{tag} 0")
		348	if $targ \|\| !($self->{flags} & F_LOCKED);
		349	} elsif (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 2) {
		350	$self->{flags} & F_LOCKED
		351	? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
		352	: $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
257	} elsif ($ev->{button} == 1) {	353	} elsif ($ev->{button} == 1) {
258	$::CONN->send ("examine $self->{tag}");	354	$::CONN->send ("examine $self->{tag}");
259	} elsif ($ev->{button} == 2) {	355	} elsif ($ev->{button} == 2) {
260	$::CONN->send ("apply $self->{tag}");	356	$::CONN->send ("apply $self->{tag}");
261	} 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
262	my @menu_items = (	363	my @menu_items = (
263	["examine", sub { $::CONN->send ("examine $self->{tag}") }],	364	["examine", sub { $::CONN->send ("examine $self->{tag}") }],
264	["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	],
265	["apply", sub { $::CONN->send ("apply $self->{tag}") }],	372	["apply", sub { $::CONN->send ("apply $self->{tag}") }],
266	(	373	(
267	$self->{flags} & F_LOCKED	374	$self->{flags} & F_LOCKED
268	? (	375	? (
269	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],	376	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
270	)	377	)
271	: (	378	: (
272	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],	379	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
273	["drop", sub { $::CONN->send ("move $::CONN->{open_container} $self->{tag} 0") }],	380	["$move_prefix all", sub { $::CONN->send ("move $targ $self->{tag} 0") }],
		381	["$move_prefix n",
		382	sub {
		383	do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
		384	}
		385	]
274	)	386	)
275	),	387	),
276	);	388	);
277		389
278	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);	390	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
…		…
283		395
284	my $tooltip_std = "<small>"	396	my $tooltip_std = "<small>"
285	. "Left click - examine item\n"	397	. "Left click - examine item\n"
286	. "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"	398	. "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
287	. "Middle click - apply\n"	399	. "Middle click - apply\n"
		400	. "Shift-Middle click - lock/unlock\n"
288	. "Right click - further options"	401	. "Right click - further options"
289	. "</small>\n";	402	. "</small>\n";
290		403
291	$self->{face_widget} \|\|= new CFClient::UI::Face	404	$self->{face_widget} \|\|= new CFClient::UI::Face
292	can_events => 1,	405	can_events => 1,
…		…
331	. ($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. ")
332	. "\n\n$tooltip_std"	445	. "\n\n$tooltip_std"
333	);	446	);
334	}	447	}
335		448
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;	449	1;
548		450
549	=back	451	=back
550		452
551	=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.77 by root, Mon May 29 21:54:15 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.77 by root, Mon May 29 21:54:15 2006 UTC vs.
Revision 1.102 by root, Sat Jul 22 13:20:33 2006 UTC