deliantra/Deliantra-Client/DC.pm

=head1 NAME

CFClient - undocumented utility garbage for our crossfire client

=head1 SYNOPSIS

 use CFClient;

=head1 DESCRIPTION

=over 4

=cut

package CFClient;

BEGIN {
   $VERSION = '0.1';

   use XSLoader;
   XSLoader::load "CFClient", $VERSION;
}

use utf8;

use Carp ();
use AnyEvent ();
use BerkeleyDB;
use Pod::POM ();
use Scalar::Util ();
use Storable (); # finally

package CFClient::PodToPango;

use base Pod::POM::View::Text;

our $VERSION = 1; # bump if resultant formatting changes

our $indent = 0;

*view_seq_code   =
*view_seq_bold   = sub { "<b>$_[1]</b>" };
*view_seq_italic = sub { "<i>$_[1]</i>" };
*view_seq_space  =
*view_seq_link   =
*view_seq_index  = sub { CFClient::UI::Label::escape ($_[1]) };

sub view_seq_text {
   my $text = $_[1];
   $text =~ s/\s+/ /g;
   CFClient::UI::Label::escape ($text)
}

sub view_item {
   ("\t" x ($indent / 4))
   . $_[1]->title->present ($_[0])
   . "\n\n"
   . $_[1]->content->present ($_[0])
}

sub view_verbatim {
   (join "",
       map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
          split /\n/, CFClient::UI::Label::escape ($_[1]))
   . "\n"
}

sub view_textblock {
   ("\t" x ($indent / 2)) . "$_[1]\n\n"
}

sub view_head1 {
   "\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
   . $_[1]->content->present ($_[0])
};

sub view_head2 {
   "\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
   . $_[1]->content->present ($_[0])
};

sub view_head3 {
   "\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
   . $_[1]->content->present ($_[0])
};

sub view_over {
   local $indent = $indent + $_[1]->indent;
   $_[1]->content->present ($_[0])
}

package CFClient::Database;

our @ISA = BerkeleyDB::Btree::;

sub get($$) {
   my $data;

   $_[0]->db_get ($_[1], $data) == 0
      ? $data
      : ()
}

my %DB_SYNC;

sub put($$$) {
   my ($db, $key, $data) = @_;

   $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });

   $db->db_put ($key => $data)
}

package CFClient;

sub find_rcfile($) {
   my $path;

   for (grep !ref, @INC) {
      $path = "$_/CFClient/resources/$_[0]";
      return $path if -r $path;
   }

   die "FATAL: can't find required file $_[0]\n";
}

sub read_cfg {
   my ($file) = @_;

   open CFG, $file
      or return;

   my $CFG;

   local $/;
   $CFG = eval <CFG>;

   $::CFG = $CFG;

   close CFG;
}

sub write_cfg {
   my ($file) = @_;

   open CFG, ">$file"
      or return;

   {
      require Data::Dumper;
      local $Data::Dumper::Purity = 1;
      $::CFG->{VERSION} = $::VERSION;
      print CFG Data::Dumper->Dump ([$::CFG], [qw/CFG/]);
   }

   close CFG;
}

our $DB_ENV;

{
   use strict;

   mkdir "$Crossfire::VARDIR/cfplus", 0777;
   my $recover = $BerkeleyDB::db_version >= 4.4 
                 ? eval "DB_REGISTER | DB_RECOVER"
                 : 0;

   $DB_ENV = new BerkeleyDB::Env
                    -Home => "$Crossfire::VARDIR/cfplus",
                    -Cachesize => 1_000_000,
                    -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
#                 -ErrPrefix => "DATABASE",
                    -Verbose => 1,
                    -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover,
                    -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
                       or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
}

sub db_table($) {
   my ($table) = @_;

   $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;

   new CFClient::Database
      -Env      => $DB_ENV,
      -Filename => $table,
#      -Filename => "database",
#      -Subname  => $table,
      -Property => DB_CHKSUM,
      -Flags    => DB_CREATE | DB_UPGRADE,
         or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
}

my $pod_cache = db_table "pod_cache";

sub load_pod($$$$) {
   my ($path, $filtertype, $filterversion, $filtercb) = @_;

   stat $path
      or die "$path: $!";

   my $phash = join ",", $filterversion, $CFClient::PodToPango::VERSION, (stat _)[7,9];

   my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } };

   return $pom if $chash eq $phash;

   my $pod = do {
      local $/;
      open my $pod, "<:utf8", $_[0]
         or die "$_[0]: $!";
      <$pod>
   };

   #utf8::downgrade $pod;

   $pom = $filtercb-> (Pod::POM->new->parse_text ($pod));

   $pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]);

   $pom
}

sub pod_to_pango($) {
   my ($pom) = @_;

   $pom->present ("CFClient::PodToPango")
}

sub pod_to_pango_list($) {
   my ($pom) = @_;

   [
      map s/^(\s*)// && [40 * length $1, length $_ ? $_ : " "],
         split /\n/, $pom->present ("CFClient::PodToPango")
   ]
}

package CFClient::Layout;

$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub {
   clear_font_cache;
};

package CFClient::Item;

use strict;
use Crossfire::Protocol::Constants;

my $last_enter_count = 1;

sub desc_string {
   my ($self) = @_;

   my $desc =
      $self->{nrof} < 2
         ? $self->{name}
         : "$self->{nrof} × $self->{name_pl}";

   $self->{flags} & F_OPEN
      and $desc .= " (open)";
   $self->{flags} & F_APPLIED
      and $desc .= " (applied)";
   $self->{flags} & F_UNPAID
      and $desc .= " (unpaid)";
   $self->{flags} & F_MAGIC
      and $desc .= " (magic)";
   $self->{flags} & F_CURSED
      and $desc .= " (cursed)";
   $self->{flags} & F_DAMNED
      and $desc .= " (damned)";
   $self->{flags} & F_LOCKED
      and $desc .= " *";

   $desc
}

sub weight_string {
   my ($self) = @_;

   my $weight = ($self->{nrof} || 1) * $self->{weight};

   $weight < 0 ? "?" : $weight * 0.001
}

sub do_n_dialog {
   my ($cb) = @_;

   my $w = new CFClient::UI::FancyFrame;
   $w->add (my $vb = new CFClient::UI::VBox x => "center", y => "center");
   $vb->add (new CFClient::UI::Label text => "Enter item count:");
   $vb->add (my $entry = new CFClient::UI::Entry
      text => $last_enter_count,
      on_activate => sub {
         my ($entry) = @_;
         $last_enter_count = $entry->get_text;
         $cb->($last_enter_count);
         $w->hide;
         $w = undef;
      }
   );
   $entry->grab_focus;
   $w->show;

}

sub update_widgets {
   my ($self) = @_;

   # necessary to avoid cyclic references
   Scalar::Util::weaken $self;

   my $button_cb = sub {
      my (undef, $ev, $x, $y) = @_;

      my $targ = $::CONN->{player}{tag};

      if ($self->{container} == $::CONN->{player}{tag}) {
         $targ = $::CONN->{open_container};
      }

      if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
         $::CONN->send ("move $targ $self->{tag} 0")
            if $targ || !($self->{flags} & F_LOCKED);
      } elsif (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 2) {
         $self->{flags} & F_LOCKED
            ? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
            : $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
      } elsif ($ev->{button} == 1) {
         $::CONN->send ("examine $self->{tag}");
      } elsif ($ev->{button} == 2) {
         $::CONN->send ("apply $self->{tag}");
      } elsif ($ev->{button} == 3) {
         my @menu_items = (
            ["examine", sub { $::CONN->send ("examine $self->{tag}") }],
            ["mark",    sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
            ["apply",   sub { $::CONN->send ("apply $self->{tag}") }],
            (
               $self->{flags} & F_LOCKED
               ? (
                  ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
                 )
               : (
                  ["lock",   sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
                  ["drop",   sub { $::CONN->send ("move $::CONN->{open_container} $self->{tag} 0") }],
                  ["move n", 
                     sub {
                        do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
                     }
                  ]
               )
            ),
         );

         CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
      }

      1
   };

   my $tooltip_std = "<small>"
                   . "Left click - examine item\n"
                   . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
                   . "Middle click - apply\n"
                   . "Shift-Middle click - lock/unlock\n"
                   . "Right click - further options"
                   . "</small>\n";

   $self->{face_widget} ||= new CFClient::UI::Face 
      can_events => 1,
      can_hover  => 1,
      anim       => $self->{anim},
      animspeed  => $self->{animspeed}, # TODO# must be set at creation time
      on_button_down => $button_cb,
   ;
   $self->{face_widget}{face}      = $self->{face};
   $self->{face_widget}{anim}      = $self->{anim};
   $self->{face_widget}{animspeed} = $self->{animspeed};
   $self->{face_widget}->set_tooltip (
      "<b>Face/Animation.</b>\n"
    . "Item uses face #$self->{face}. "
    . ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ")
    . "\n\n$tooltip_std"
   );
   
   $self->{desc_widget} ||= new CFClient::UI::Label
      can_events => 1,
      can_hover  => 1,
      ellipsise  => 2,
      align      => -1,
      on_button_down => $button_cb,
   ;
   my $desc = CFClient::Item::desc_string $self;
   $self->{desc_widget}->set_text ($desc);
   $self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");

   $self->{weight_widget} ||= new CFClient::UI::Label
      can_events => 1,
      can_hover  => 1,
      ellipsise  => 0,
      align      => 0,
      on_button_down => $button_cb,
   ;
   $self->{weight_widget}->set_text (CFClient::Item::weight_string $self);

   $self->{weight_widget}->set_tooltip (
      "<b>Weight</b>.\n"
    . ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ")
    . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
    . "\n\n$tooltip_std"
   );
}

1;

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.97
Committed:	Tue Jul 4 23:23:31 2006 UTC (17 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.96:	+6 -0 lines
Log Message:	Get rid of cairo completely (yay!) and of ft2 factually (still need the library as it included pangofc), by introducing a custom pango opengl renderer. Text rendering now no longer requires the distinction between rgba and grayscale modes, requires much less texture space and memory, and is faster on accelerated hardware (and possibly with software rendering, too). All at the cost of only 1200 lines or so.
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.22	CFClient - undocumented utility garbage for our crossfire client
4	root	1.1
5			=head1 SYNOPSIS
6
7	root	1.22	use CFClient;
8	root	1.1
9			=head1 DESCRIPTION
10
11			=over 4
12
13			=cut
14
15	root	1.22	package CFClient;
16	root	1.1
17			BEGIN {
18			$VERSION = '0.1';
19
20	root	1.2	use XSLoader;
21	root	1.22	XSLoader::load "CFClient", $VERSION;
22	root	1.1	}
23
24	root	1.62	use utf8;
25
26	root	1.43	use Carp ();
27	root	1.52	use AnyEvent ();
28	root	1.34	use BerkeleyDB;
29	root	1.89	use Pod::POM ();
30	root	1.92	use Scalar::Util ();
31	root	1.89	use Storable (); # finally
32
33			package CFClient::PodToPango;
34
35			use base Pod::POM::View::Text;
36
37			our $VERSION = 1; # bump if resultant formatting changes
38
39			our $indent = 0;
40
41			*view_seq_code =
42			*view_seq_bold = sub { "<b>$_[1]</b>" };
43			*view_seq_italic = sub { "<i>$_[1]</i>" };
44			*view_seq_space =
45			*view_seq_link =
46			*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) };
47
48			sub view_seq_text {
49			my $text = $_[1];
50			$text =~ s/\s+/ /g;
51			CFClient::UI::Label::escape ($text)
52			}
53
54			sub view_item {
55			("\t" x ($indent / 4))
56			. $_[1]->title->present ($_[0])
57	root	1.91	. "\n\n"
58	root	1.89	. $_[1]->content->present ($_[0])
59			}
60
61			sub view_verbatim {
62			(join "",
63			map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
64			split /\n/, CFClient::UI::Label::escape ($_[1]))
65			. "\n"
66			}
67
68			sub view_textblock {
69			("\t" x ($indent / 2)) . "$_[1]\n\n"
70			}
71
72			sub view_head1 {
73			"\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
74			. $_[1]->content->present ($_[0])
75			};
76
77			sub view_head2 {
78			"\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
79			. $_[1]->content->present ($_[0])
80			};
81
82			sub view_head3 {
83			"\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
84			. $_[1]->content->present ($_[0])
85			};
86
87			sub view_over {
88			local $indent = $indent + $_[1]->indent;
89			$_[1]->content->present ($_[0])
90			}
91
92			package CFClient::Database;
93
94			our @ISA = BerkeleyDB::Btree::;
95
96			sub get($$) {
97			my $data;
98
99			$_[0]->db_get ($_[1], $data) == 0
100			? $data
101			: ()
102			}
103
104			my %DB_SYNC;
105
106			sub put($$$) {
107			my ($db, $key, $data) = @_;
108
109			$DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
110
111			$db->db_put ($key => $data)
112			}
113
114			package CFClient;
115	root	1.52
116	root	1.5	sub find_rcfile($) {
117			my $path;
118
119	root	1.46	for (grep !ref, @INC) {
120	root	1.22	$path = "$_/CFClient/resources/$_[0]";
121	root	1.5	return $path if -r $path;
122			}
123
124			die "FATAL: can't find required file $_[0]\n";
125			}
126
127			sub read_cfg {
128			my ($file) = @_;
129
130			open CFG, $file
131			or return;
132
133			my $CFG;
134
135			local $/;
136			$CFG = eval <CFG>;
137
138			$::CFG = $CFG;
139
140			close CFG;
141			}
142
143			sub write_cfg {
144			my ($file) = @_;
145
146			open CFG, ">$file"
147			or return;
148
149			{
150	elmex	1.9	require Data::Dumper;
151	root	1.5	local $Data::Dumper::Purity = 1;
152			$::CFG->{VERSION} = $::VERSION;
153			print CFG Data::Dumper->Dump ([$::CFG], [qw/CFG/]);
154			}
155
156			close CFG;
157			}
158
159	root	1.77	our $DB_ENV;
160
161	root	1.76	{
162			use strict;
163
164	root	1.87	mkdir "$Crossfire::VARDIR/cfplus", 0777;
165	root	1.77	my $recover = $BerkeleyDB::db_version >= 4.4
166			? eval "DB_REGISTER \| DB_RECOVER"
167			: 0;
168
169			$DB_ENV = new BerkeleyDB::Env
170	root	1.76	-Home => "$Crossfire::VARDIR/cfplus",
171			-Cachesize => 1_000_000,
172			-ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
173	root	1.39	# -ErrPrefix => "DATABASE",
174	root	1.76	-Verbose => 1,
175	root	1.77	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN \| $recover,
176	root	1.78	-SetFlags => DB_AUTO_COMMIT \| DB_LOG_AUTOREMOVE,
177	root	1.76	or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
178			}
179	root	1.34
180			sub db_table($) {
181	root	1.38	my ($table) = @_;
182
183			$table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
184	root	1.76
185	root	1.34	new CFClient::Database
186			-Env => $DB_ENV,
187	root	1.38	-Filename => $table,
188			# -Filename => "database",
189			# -Subname => $table,
190	root	1.51	-Property => DB_CHKSUM,
191	root	1.34	-Flags => DB_CREATE \| DB_UPGRADE,
192	root	1.76	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
193	root	1.34	}
194
195	root	1.89	my $pod_cache = db_table "pod_cache";
196	root	1.52
197	root	1.89	sub load_pod($$$$) {
198			my ($path, $filtertype, $filterversion, $filtercb) = @_;
199	root	1.52
200	root	1.89	stat $path
201			or die "$path: $!";
202	root	1.60
203	root	1.89	my $phash = join ",", $filterversion, $CFClient::PodToPango::VERSION, (stat _)[7,9];
204	root	1.60
205	root	1.89	my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } };
206	root	1.52
207	root	1.89	return $pom if $chash eq $phash;
208	root	1.52
209	root	1.89	my $pod = do {
210			local $/;
211			open my $pod, "<:utf8", $_[0]
212			or die "$_[0]: $!";
213			<$pod>
214			};
215	root	1.52
216	root	1.89	#utf8::downgrade $pod;
217	root	1.52
218	root	1.89	$pom = $filtercb-> (Pod::POM->new->parse_text ($pod));
219	root	1.52
220	root	1.89	$pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]);
221	root	1.52
222	root	1.89	$pom
223	root	1.53	}
224
225	root	1.89	sub pod_to_pango($) {
226			my ($pom) = @_;
227	root	1.52
228	root	1.89	$pom->present ("CFClient::PodToPango")
229	root	1.52	}
230
231	root	1.89	sub pod_to_pango_list($) {
232			my ($pom) = @_;
233	root	1.34
234	root	1.89	[
235			map s/^(\s)// && [40 length $1, length $_ ? $_ : " "],
236			split /\n/, $pom->present ("CFClient::PodToPango")
237			]
238	root	1.34	}
239
240	root	1.97	package CFClient::Layout;
241
242			$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub {
243			clear_font_cache;
244			};
245
246	root	1.62	package CFClient::Item;
247
248	root	1.71	use strict;
249			use Crossfire::Protocol::Constants;
250
251	elmex	1.84	my $last_enter_count = 1;
252
253	root	1.62	sub desc_string {
254			my ($self) = @_;
255
256			my $desc =
257			$self->{nrof} < 2
258			? $self->{name}
259			: "$self->{nrof} × $self->{name_pl}";
260
261	root	1.71	$self->{flags} & F_OPEN
262	root	1.62	and $desc .= " (open)";
263	root	1.71	$self->{flags} & F_APPLIED
264	root	1.62	and $desc .= " (applied)";
265	root	1.71	$self->{flags} & F_UNPAID
266	root	1.62	and $desc .= " (unpaid)";
267	root	1.71	$self->{flags} & F_MAGIC
268	root	1.62	and $desc .= " (magic)";
269	root	1.71	$self->{flags} & F_CURSED
270	root	1.62	and $desc .= " (cursed)";
271	root	1.71	$self->{flags} & F_DAMNED
272	root	1.62	and $desc .= " (damned)";
273	root	1.71	$self->{flags} & F_LOCKED
274	root	1.62	and $desc .= " *";
275
276			$desc
277			}
278
279			sub weight_string {
280			my ($self) = @_;
281
282			my $weight = ($self->{nrof} \|\| 1) * $self->{weight};
283
284			$weight < 0 ? "?" : $weight * 0.001
285			}
286
287	elmex	1.84	sub do_n_dialog {
288			my ($cb) = @_;
289
290			my $w = new CFClient::UI::FancyFrame;
291			$w->add (my $vb = new CFClient::UI::VBox x => "center", y => "center");
292			$vb->add (new CFClient::UI::Label text => "Enter item count:");
293			$vb->add (my $entry = new CFClient::UI::Entry
294			text => $last_enter_count,
295			on_activate => sub {
296			my ($entry) = @_;
297			$last_enter_count = $entry->get_text;
298			$cb->($last_enter_count);
299			$w->hide;
300			$w = undef;
301			}
302			);
303	root	1.93	$entry->grab_focus;
304	elmex	1.84	$w->show;
305
306			}
307
308	root	1.62	sub update_widgets {
309			my ($self) = @_;
310
311	root	1.92	# necessary to avoid cyclic references
312			Scalar::Util::weaken $self;
313
314	root	1.63	my $button_cb = sub {
315			my (undef, $ev, $x, $y) = @_;
316
317	elmex	1.84	my $targ = $::CONN->{player}{tag};
318	root	1.63
319	elmex	1.84	if ($self->{container} == $::CONN->{player}{tag}) {
320			$targ = $::CONN->{open_container};
321			}
322	root	1.63
323	elmex	1.84	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
324	root	1.79	$::CONN->send ("move $targ $self->{tag} 0")
325			if $targ \|\| !($self->{flags} & F_LOCKED);
326	elmex	1.86	} elsif (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 2) {
327			$self->{flags} & F_LOCKED
328			? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
329			: $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
330	root	1.63	} elsif ($ev->{button} == 1) {
331			$::CONN->send ("examine $self->{tag}");
332			} elsif ($ev->{button} == 2) {
333			$::CONN->send ("apply $self->{tag}");
334			} elsif ($ev->{button} == 3) {
335			my @menu_items = (
336			["examine", sub { $::CONN->send ("examine $self->{tag}") }],
337			["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
338			["apply", sub { $::CONN->send ("apply $self->{tag}") }],
339			(
340	root	1.71	$self->{flags} & F_LOCKED
341	root	1.63	? (
342			["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
343			)
344			: (
345			["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
346	elmex	1.64	["drop", sub { $::CONN->send ("move $::CONN->{open_container} $self->{tag} 0") }],
347	elmex	1.84	["move n",
348			sub {
349			do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
350			}
351			]
352	root	1.63	)
353			),
354			);
355
356			CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
357			}
358
359			1
360			};
361
362	root	1.62	my $tooltip_std = "<small>"
363			. "Left click - examine item\n"
364			. "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
365			. "Middle click - apply\n"
366	elmex	1.86	. "Shift-Middle click - lock/unlock\n"
367	root	1.62	. "Right click - further options"
368			. "</small>\n";
369
370	root	1.63	$self->{face_widget} \|\|= new CFClient::UI::Face
371			can_events => 1,
372			can_hover => 1,
373	root	1.67	anim => $self->{anim},
374	root	1.66	animspeed => $self->{animspeed}, # TODO# must be set at creation time
375	root	1.72	on_button_down => $button_cb,
376	root	1.63	;
377	root	1.62	$self->{face_widget}{face} = $self->{face};
378			$self->{face_widget}{anim} = $self->{anim};
379	root	1.65	$self->{face_widget}{animspeed} = $self->{animspeed};
380	root	1.62	$self->{face_widget}->set_tooltip (
381			"<b>Face/Animation.</b>\n"
382			. "Item uses face #$self->{face}. "
383			. ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ")
384			. "\n\n$tooltip_std"
385			);
386
387	root	1.63	$self->{desc_widget} \|\|= new CFClient::UI::Label
388			can_events => 1,
389			can_hover => 1,
390			ellipsise => 2,
391	root	1.68	align => -1,
392	root	1.72	on_button_down => $button_cb,
393	root	1.63	;
394			my $desc = CFClient::Item::desc_string $self;
395			$self->{desc_widget}->set_text ($desc);
396			$self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
397
398			$self->{weight_widget} \|\|= new CFClient::UI::Label
399			can_events => 1,
400			can_hover => 1,
401			ellipsise => 0,
402	root	1.68	align => 0,
403	root	1.72	on_button_down => $button_cb,
404	root	1.63	;
405	root	1.62	$self->{weight_widget}->set_text (CFClient::Item::weight_string $self);
406
407			$self->{weight_widget}->set_tooltip (
408			"<b>Weight</b>.\n"
409			. ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ")
410			. ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
411			. "\n\n$tooltip_std"
412			);
413			}
414
415	root	1.1	1;
416
417			=back
418
419			=head1 AUTHOR
420
421			Marc Lehmann <schmorp@schmorp.de>
422			http://home.schmorp.de/
423
424			=cut
425