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

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.69 by root, Thu May 25 23:06:05 2006 UTC vs.
Revision 1.75 by root, Mon May 29 21:10:47 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
30	use CFClient::OpenGL;
31
32	our %GL_EXT;
33	our $GL_VERSION;
34
35	our $GL_NPOT;
36	our $GL_DEBUG = 1;
37
38	sub gl_init {
39	$GL_VERSION = gl_version * 1;
40	%GL_EXT = map +($_ => 1), split /\s+/, gl_extensions;
41
42	$GL_NPOT = $GL_EXT{GL_ARB_texture_non_power_of_two} \|\| $GL_VERSION >= 2;
43	$GL_NPOT = 0 if gl_vendor =~ /ATI Technologies/; # ATI doesn't get it right...
44
45	glDisable GL_COLOR_MATERIAL;
46	glShadeModel GL_FLAT;
47	glDisable GL_DITHER;
48	glDisable GL_DEPTH_TEST;
49	glDepthMask 0;
50	glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_FASTEST;
51
52	CFClient::Texture::restore_state ();
53	}
54
55	sub gl_check {
56	return unless $GL_DEBUG;
57
58	if (my $error = glGetError) {
59	my ($format, @args) = @_;
60	Carp::cluck sprintf "opengl error %x while $format", $error, @args;
61	}
62	}
63		29
64	sub find_rcfile($) {	30	sub find_rcfile($) {
65	my $path;	31	my $path;
66		32
67	for (grep !ref, @INC) {	33	for (grep !ref, @INC) {
…		…
102	}	68	}
103		69
104	close CFG;	70	close CFG;
105	}	71	}
106		72
107	mkdir "$Crossfire::VARDIR/pclient", 0777;	73	mkdir "$Crossfire::VARDIR/cfplus", 0777;
108		74
109	our $DB_ENV = new BerkeleyDB::Env	75	our $DB_ENV = new BerkeleyDB::Env
110	-Home => "$Crossfire::VARDIR/pclient",	76	-Home => "$Crossfire::VARDIR/cfplus",
111	-Cachesize => 1_000_000,	77	-Cachesize => 1_000_000,
112	-ErrFile => "$Crossfire::VARDIR/pclient/errorlog.txt",	78	-ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
113	# -ErrPrefix => "DATABASE",	79	# -ErrPrefix => "DATABASE",
114	-Verbose => 1,	80	-Verbose => 1,
115	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN,	81	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN,
116	or die "unable to create/open database home $Crossfire::VARDIR/pclient: $BerkeleyDB::Error";	82	or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
117		83
118	sub db_table($) {	84	sub db_table($) {
119	my ($table) = @_;	85	my ($table) = @_;
120		86
121	$table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;	87	$table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
…		…
224	$db->db_put ($key => $data)	190	$db->db_put ($key => $data)
225	}	191	}
226		192
227	package CFClient::Item;	193	package CFClient::Item;
228		194
		195	use strict;
		196	use Crossfire::Protocol::Constants;
		197
229	sub desc_string {	198	sub desc_string {
230	my ($self) = @_;	199	my ($self) = @_;
231		200
232	my $desc =	201	my $desc =
233	$self->{nrof} < 2	202	$self->{nrof} < 2
234	? $self->{name}	203	? $self->{name}
235	: "$self->{nrof} × $self->{name_pl}";	204	: "$self->{nrof} × $self->{name_pl}";
236		205
237	$self->{flags} & Crossfire::Protocol::F_OPEN	206	$self->{flags} & F_OPEN
238	and $desc .= " (open)";	207	and $desc .= " (open)";
239	$self->{flags} & Crossfire::Protocol::F_APPLIED	208	$self->{flags} & F_APPLIED
240	and $desc .= " (applied)";	209	and $desc .= " (applied)";
241	$self->{flags} & Crossfire::Protocol::F_UNPAID	210	$self->{flags} & F_UNPAID
242	and $desc .= " (unpaid)";	211	and $desc .= " (unpaid)";
243	$self->{flags} & Crossfire::Protocol::F_MAGIC	212	$self->{flags} & F_MAGIC
244	and $desc .= " (magic)";	213	and $desc .= " (magic)";
245	$self->{flags} & Crossfire::Protocol::F_CURSED	214	$self->{flags} & F_CURSED
246	and $desc .= " (cursed)";	215	and $desc .= " (cursed)";
247	$self->{flags} & Crossfire::Protocol::F_DAMNED	216	$self->{flags} & F_DAMNED
248	and $desc .= " (damned)";	217	and $desc .= " (damned)";
249	$self->{flags} & Crossfire::Protocol::F_LOCKED	218	$self->{flags} & F_LOCKED
250	and $desc .= " *";	219	and $desc .= " *";
251		220
252	$desc	221	$desc
253	}	222	}
254		223
…		…
282	my @menu_items = (	251	my @menu_items = (
283	["examine", sub { $::CONN->send ("examine $self->{tag}") }],	252	["examine", sub { $::CONN->send ("examine $self->{tag}") }],
284	["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],	253	["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
285	["apply", sub { $::CONN->send ("apply $self->{tag}") }],	254	["apply", sub { $::CONN->send ("apply $self->{tag}") }],
286	(	255	(
287	$self->{flags} & Crossfire::Protocol::F_LOCKED	256	$self->{flags} & F_LOCKED
288	? (	257	? (
289	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],	258	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
290	)	259	)
291	: (	260	: (
292	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],	261	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
…		…
311	$self->{face_widget} \|\|= new CFClient::UI::Face	280	$self->{face_widget} \|\|= new CFClient::UI::Face
312	can_events => 1,	281	can_events => 1,
313	can_hover => 1,	282	can_hover => 1,
314	anim => $self->{anim},	283	anim => $self->{anim},
315	animspeed => $self->{animspeed}, # TODO# must be set at creation time	284	animspeed => $self->{animspeed}, # TODO# must be set at creation time
316	connect_button_down => $button_cb,	285	on_button_down => $button_cb,
317	;	286	;
318	$self->{face_widget}{face} = $self->{face};	287	$self->{face_widget}{face} = $self->{face};
319	$self->{face_widget}{anim} = $self->{anim};	288	$self->{face_widget}{anim} = $self->{anim};
320	$self->{face_widget}{animspeed} = $self->{animspeed};	289	$self->{face_widget}{animspeed} = $self->{animspeed};
321	$self->{face_widget}->set_tooltip (	290	$self->{face_widget}->set_tooltip (
…		…
328	$self->{desc_widget} \|\|= new CFClient::UI::Label	297	$self->{desc_widget} \|\|= new CFClient::UI::Label
329	can_events => 1,	298	can_events => 1,
330	can_hover => 1,	299	can_hover => 1,
331	ellipsise => 2,	300	ellipsise => 2,
332	align => -1,	301	align => -1,
333	connect_button_down => $button_cb,	302	on_button_down => $button_cb,
334	;	303	;
335	my $desc = CFClient::Item::desc_string $self;	304	my $desc = CFClient::Item::desc_string $self;
336	$self->{desc_widget}->set_text ($desc);	305	$self->{desc_widget}->set_text ($desc);
337	$self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");	306	$self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
338		307
339	$self->{weight_widget} \|\|= new CFClient::UI::Label	308	$self->{weight_widget} \|\|= new CFClient::UI::Label
340	can_events => 1,	309	can_events => 1,
341	can_hover => 1,	310	can_hover => 1,
342	ellipsise => 0,	311	ellipsise => 0,
343	align => 0,	312	align => 0,
344	connect_button_down => $button_cb,	313	on_button_down => $button_cb,
345	;	314	;
346	$self->{weight_widget}->set_text (CFClient::Item::weight_string $self);	315	$self->{weight_widget}->set_text (CFClient::Item::weight_string $self);
347		316
348	$self->{weight_widget}->set_tooltip (	317	$self->{weight_widget}->set_tooltip (
349	"<b>Weight</b>.\n"	318	"<b>Weight</b>.\n"
…		…
351	. ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")	320	. ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
352	. "\n\n$tooltip_std"	321	. "\n\n$tooltip_std"
353	);	322	);
354	}	323	}
355		324
356	package CFClient::Texture;	325	package CFClient::Recorder;
357		326
358	use strict;	327	our $RECORD_WINDOW;
359		328
360	use Scalar::Util;	329	my $CMDBOX;
		330	my $CURRENT_CMDS;
		331	my $REC_BTN;
361		332
362	use CFClient::OpenGL;	333	my @ALLOWED_MODIFIER_KEYS = (
		334	(CFClient::SDLK_LSHIFT) => "LSHIFT",
		335	(CFClient::SDLK_LCTRL ) => "LCTRL",
		336	(CFClient::SDLK_LALT ) => "LALT",
		337	(CFClient::SDLK_LMETA ) => "LMETA",
363		338
364	my %TEXTURES;	339	(CFClient::SDLK_RSHIFT) => "RSHIFT",
		340	(CFClient::SDLK_RCTRL ) => "RCTRL",
		341	(CFClient::SDLK_RALT ) => "RALT",
		342	(CFClient::SDLK_RMETA ) => "RMETA",
		343	);
365		344
366	sub new {	345	my %ALLOWED_MODIFIERS = (
		346	(CFClient::KMOD_LSHIFT) => "LSHIFT",
		347	(CFClient::KMOD_LCTRL ) => "LCTRL",
		348	(CFClient::KMOD_LALT ) => "LALT",
		349	(CFClient::KMOD_LMETA ) => "LMETA",
		350
		351	(CFClient::KMOD_RSHIFT) => "RSHIFT",
		352	(CFClient::KMOD_RCTRL ) => "RCTRL",
		353	(CFClient::KMOD_RALT ) => "RALT",
		354	(CFClient::KMOD_RMETA ) => "RMETA",
		355	);
		356
		357	my %DIRECT_BIND_CHARS = map { $_ => 1 } qw/0 1 2 3 4 5 6 7 8 9/;
		358	my @DIRECT_BIND_KEYS = (
		359	CFClient::SDLK_F1,
		360	CFClient::SDLK_F2,
		361	CFClient::SDLK_F3,
		362	CFClient::SDLK_F4,
		363	CFClient::SDLK_F5,
		364	CFClient::SDLK_F6,
		365	CFClient::SDLK_F7,
		366	CFClient::SDLK_F8,
		367	CFClient::SDLK_F9,
		368	CFClient::SDLK_F10,
		369	CFClient::SDLK_F11,
		370	CFClient::SDLK_F12,
		371	CFClient::SDLK_F13,
		372	CFClient::SDLK_F14,
		373	CFClient::SDLK_F15,
		374	);
		375
		376	# this binding dialog asks for a key-combo to be pressed
		377	# and if successful it binds the modifier+symbol to the
		378	# supplied actions in $cmd.
		379	# (Bindings are stored in $::CFG->{bindings}->{$mod}->{$sym})
		380	sub open_binding_dialog {
367	my ($class, %data) = @_;	381	my ($cmd) = @_;
368		382
369	my $self = bless {	383	my $w = new CFClient::UI::FancyFrame
370	internalformat => GL_RGBA,	384	title => "Bind Action";
371	format => GL_RGBA,
372	type => GL_UNSIGNED_BYTE,
373	%data,
374	}, $class;
375		385
376	Scalar::Util::weaken ($TEXTURES{$self+0} = $self);	386	$w->add (my $vb = new CFClient::UI::VBox);
377		387	$vb->add (new CFClient::UI::Label
378	$self->upload;	388	text => "Press a modifier (CTRL, ALT and/or SHIFT) and a key."
379		389	."You can only bind 0-9 and F1-F15 without modifiers."
380	$self
381	}
382
383	sub new_from_image {
384	my ($class, $image, %arg) = @_;
385
386	$class->new (image => $image, %arg)
387	}
388
389	sub new_from_file {
390	my ($class, $path, %arg) = @_;
391
392	open my $fh, "<:raw", $path
393	or die "$path: $!";
394
395	local $/;
396	$class->new_from_image (<$fh>, %arg)
397	}
398
399	#sub new_from_surface {
400	# my ($class, $surface) = @_;
401	#
402	# $surface->rgba;
403	#
404	# $class->new (
405	# data => $surface->pixels,
406	# w => $surface->width,
407	# h => $surface->height,
408	# )
409	#}
410
411	sub new_from_layout {
412	my ($class, $layout, %arg) = @_;
413
414	my ($w, $h, $data, $format, $internalformat) = $layout->render;
415
416	$class->new (
417	w => $w,
418	h => $h,
419	data => $data,
420	format => $format,
421	internalformat => $format,
422	type => GL_UNSIGNED_BYTE,
423	%arg,
424	)	390	);
425	}	391	$vb->add (my $entry = new CFClient::UI::Entry
		392	text => "",
		393	on_key_down => sub {
		394	my ($entry, $ev) = @_;
426		395
427	sub new_from_opengl {	396	my $mod = $ev->{mod};
428	my ($class, $w, $h, $cb) = @_;	397	my $sym = $ev->{sym};
429		398
430	$class->new (w => $w \|\| 1, h => $h \|\| 1, render_cb => $cb)	399	# XXX: This seems a little bit hackisch to me, but i have to ignore them
431	}	400	if (grep { $_ == $sym } @ALLOWED_MODIFIER_KEYS) {
		401	return;
		402	}
432		403
433	sub topot {	404	if ($mod == CFClient::KMOD_NONE
434	(grep $_ >= $_[0], 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384, 32768)[0]	405	and not $DIRECT_BIND_CHARS{chr ($ev->{unicode})}
435	}	406	and not grep { $sym == $_ } @DIRECT_BIND_KEYS)
		407	{
		408	$::STATUSBOX->add (
		409	"Can't bind key ".CFClient::SDL_GetKeyName ($sym)
		410	." directly without modifier! It would damage the completer handling."
		411	);
		412	return;
		413	}
436		414
437	sub upload {	415	$entry->focus_out;
		416
		417	$::CFG->{bindings}->{$mod}->{$sym} = $cmd;
		418	$::STATUSBOX->add ("Bound actions to '".keycombo_to_name ($mod, $sym)."'. Don't forget 'Save Config'!");
		419
		420	$w->destroy
		421	});
		422
		423	$entry->focus_in;
		424	$w->center;
		425	$w->show;
		426	}
		427
		428	sub keycombo_to_name {
		429	my ($mod, $sym) = @_;
		430
		431	my $mods = join '+',
		432	map { $ALLOWED_MODIFIERS{$_} }
		433	grep { $_ & $mod }
		434	keys %ALLOWED_MODIFIERS;
		435	$mods .= "+" if $mods ne '';
		436
		437	return $mods . CFClient::SDL_GetKeyName ($sym);
		438	}
		439
		440	sub clear_command_list {
		441	$CMDBOX->clear () if $CMDBOX;
		442	}
		443
		444	sub set_command_list {
438	my ($self) = @_;	445	my ($list) = @_;
439		446
440	return unless $GL_VERSION;	447	return unless $CMDBOX;
441		448
442	my $data;	449	$CMDBOX->clear ();
		450	$CURRENT_CMDS = $list;
443		451
444	if (exists $self->{data}) {	452	my $idx = 0;
445	$data = $self->{data};
446		453
447	} elsif (exists $self->{render_cb}) {	454	for (@$list) {
448	glViewport 0, 0, $self->{w}, $self->{h};	455	$CMDBOX->add (my $hb = new CFClient::UI::HBox);
449	glMatrixMode GL_PROJECTION;
450	glLoadIdentity;
451	glOrtho 0, $self->{w}, 0, $self->{h}, -10000, 10000;
452	glMatrixMode GL_MODELVIEW;
453	glLoadIdentity;
454	$self->{render_cb}->($self, $self->{w}, $self->{h});
455		456
456	} else {	457	my $i = $idx;
457	($self->{w}, $self->{h}, $data, $self->{internalformat}, $self->{format}, $self->{type})	458	$hb->add (new CFClient::UI::Button
458	= CFClient::load_image_inline $self->{image};	459	text => "delete",
		460	tooltip => "Deletes the action from the record",
		461	on_activate => sub {
		462	$CMDBOX->remove ($hb);
		463	$list->[$i] = undef;
		464	});
		465
		466	$hb->add (new CFClient::UI::Label text => $_);
		467
		468	$idx++
459	}	469	}
		470	}
460		471
461	my ($tw, $th) = @$self{qw(w h)};	472	# if $show is 1 the recorder will be shown
		473	sub start {
		474	my ($show) = @_;
462		475
463	unless ($tw > 0 && $th > 0) {	476	$RECORD_WINDOW->show if $show;
464	$tw = $th = 1;	477
465	$data = "\x00" x 64;	478	$REC_BTN->set_text ("stop recording");
		479	$REC_BTN->{recording} = 1;
		480	clear_command_list;
		481	$::CONN->start_record;
		482	}
		483
		484	# if $autobind is 1 the recorder will be automatically
		485	# jump into the binding query and hide the recorder window
		486	sub stop {
		487	my ($autobind) = @_;
		488
		489	$REC_BTN->set_text ("start recording");
		490	$REC_BTN->{recording} = 0;
		491
		492	my $rec = $::CONN->stop_record;
		493	return unless ref $rec eq 'ARRAY';
		494	set_command_list ($rec);
		495
		496	if ($autobind) {
		497	open_binding_dialog ([ grep { defined $_ } @$CURRENT_CMDS ]);
		498	$RECORD_WINDOW->hide;
466	}	499	}
		500	}
467		501
468	$self->{minified} = [CFClient::average $tw, $th, $data]	502	sub make_window {
469	if $self->{minify};	503	$RECORD_WINDOW = new CFClient::UI::FancyFrame
		504	req_y => 1,
		505	req_x => -1,
		506	title => "Action Recorder";
470		507
471	unless ($GL_NPOT) {	508	$RECORD_WINDOW->add (my $vb = new CFClient::UI::VBox);
472	# TODO: does not work for zero-sized textures	509	$vb->add ($REC_BTN = new CFClient::UI::Button
473	$tw = topot $tw;	510	text => "start recording",
474	$th = topot $th;	511	tooltip => "Start/Stops recording of actions."
		512	."(CTRL+Insert Starts the recorder, Insert Stops recorder and binds automatically)"
		513	."All subsequent actions after the recording started will be captured."
		514	."The actions are displayed after the record was stopped."
		515	."To bind the action you have to click on the 'Bind' button",
		516	on_activate => sub {
		517	my ($btn) = @_;
475		518
476	if (($tw != $self->{w} \|\| $th != $self->{h}) && defined $data) {	519	unless ($btn->{recording}) {
477	my $bpp = (length $data) / ($self->{w} * $self->{h});	520	start;
478	$data = pack "(a" . ($tw * $bpp) . ")*",	521	} else {
479	unpack "(a" . ($self->{w} * $bpp) . ")*", $data;	522	stop;
480	$data .= ("\x00" x ($tw * $bpp)) x ($th - $self->{h});	523	}
481	}	524	});
482	}	525	$vb->add ($CMDBOX = new CFClient::UI::VBox);
		526	$vb->add (new CFClient::UI::Button
		527	text => "bind",
		528	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		529	on_activate => sub {
		530	open_binding_dialog ([ grep { defined $_ } @$CURRENT_CMDS ]);
		531	});
483		532
484	$self->{s} = $self->{w} / $tw;	533	$RECORD_WINDOW
485	$self->{t} = $self->{h} / $th;
486
487	$self->{name} \|\|= glGenTexture;
488
489	glBindTexture GL_TEXTURE_2D, $self->{name};
490
491	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP;
492	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP;
493
494	if ($::FAST) {
495	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST;
496	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST;
497	} elsif ($self->{mipmap} && $GL_VERSION >= 1.4) {
498	# alternatively check for 0x8191
499	glTexParameter GL_TEXTURE_2D, GL_GENERATE_MIPMAP, 1;
500	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
501	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR;
502	} else {
503	glTexParameter GL_TEXTURE_2D, GL_GENERATE_MIPMAP, $self->{mipmap};
504	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
505	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR;
506	}
507
508	glGetError;
509
510	if (defined $data) {
511	glTexImage2D GL_TEXTURE_2D, 0,
512	$self->{internalformat},
513	$tw, $th,
514	0,
515	$self->{format},
516	$self->{type},
517	$data;
518	CFClient::gl_check "uploading texture %dx%d if=%x f=%x t=%x",
519	$tw, $th, $self->{internalformat}, $self->{format}, $self->{type};
520	} else {
521	glCopyTexImage2D GL_TEXTURE_2D, 0,
522	$self->{internalformat},
523	0, 0,
524	$tw, $th,
525	0;
526	CFClient::gl_check "copying to texture %dx%d if=%x",
527	$tw, $th, $self->{internalformat};
528	}
529
530	glBindTexture GL_TEXTURE_2D, 0; # just to be on the safe side
531	}
532
533	sub DESTROY {
534	my ($self) = @_;
535
536	delete $TEXTURES{$self+0};
537
538	glDeleteTexture delete $self->{name}
539	if $self->{name};
540	}
541
542	sub restore_state {
543	$_->upload
544	for values %TEXTURES;
545	}	534	}
546		535
547	1;	536	1;
548		537
549	=back	538	=back

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC.pm (file contents): Revision 1.69 by root, Thu May 25 23:06:05 2006 UTC vs. Revision 1.75 by root, Mon May 29 21:10:47 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.69 by root, Thu May 25 23:06:05 2006 UTC vs.
Revision 1.75 by root, Mon May 29 21:10:47 2006 UTC