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

our %STAT_TOOLTIP = (
   Str => "<b>Physical Strength</b>, determines damage dealt with weapons, how much you can carry, and how often you can attack",
   Dex => "<b>Dexterity</b>, your physical agility. Determines chance of being hit and affects armor class and speed",
   Con => "<b>Constitution</b>, physical health and toughness. Determines how many healthpoints you can have",
   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",
   Wis => "<b>Wisdom</b>, the ability to learn and use divine magic (prayers). Determines how many grace points you can have",
   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",
   Cha => "<b>Charisma</b>, how well you are received by NPCs. Affects buying and selling prices in shops.",

   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.",
   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.",
   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.",
   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.",
   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.",
   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.",
);

=item guard { BLOCK }

Returns an object that executes the given block as soon as it is destroyed.

=cut

sub guard(&) {
   bless \(my $cb = $_[0]), "CFClient::Guard"
}

sub CFClient::Guard::DESTROY {
   ${$_[0]}->()
}

sub asxml($) {
   local $_ = $_[0];

   s/&/&amp;/g;
   s/>/&gt;/g;
   s/</&lt;/g;

   $_
}

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"
}

package CFClient::Layout;

$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub {
   reset_glyph_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
      on_delete => sub { $_[0]->destroy; 1 },
      has_close_button => 1,
   ;

   $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->destroy;

         0
      },
      on_escape => sub { $w->destroy; 1 },
   );
   $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 $move_prefix = $::CONN->{open_container} ? 'put' : 'drop';
         if ($self->{container} == $::CONN->{open_container}) {
            $move_prefix = "take";
         }

         my @menu_items = (
            ["examine", sub { $::CONN->send ("examine $self->{tag}") }],
            ["mark",    sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
            ["ignite/thaw",  # first try of an easier use of flint&steel
               sub {
                  $::CONN->send ("mark ". pack "N", $self->{tag});
                  $::CONN->send ("command apply flint and steel");
               }
            ],
            ["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}) }],
                  ["$move_prefix all",   sub { $::CONN->send ("move $targ $self->{tag} 0") }],
                  ["$move_prefix &lt;n&gt;", 
                     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";

   my $bg = $self->{flags} & F_CURSED ? [1  , 0  , 0, 0.5]
          : $self->{flags} & F_MAGIC  ? [0.2, 0.2, 1, 0.5]
          : undef;

   $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}{bg}        = $bg;
   $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}{bg} = $bg;
   $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}{bg} = $bg;
   $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.106
Committed:	Mon Jul 24 04:24:42 2006 UTC (17 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.105:	+7 -1 lines
Log Message:	many improvements/cleanups, reduced todo quite a bit
#	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	root	1.102	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	root	1.103	=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	root	1.105	sub asxml($) {
65			local $_ = $_[0];
66	root	1.89
67	root	1.105	s/&/&/g;
68			s/>/>/g;
69			s/</</g;
70	root	1.89
71	root	1.105	$_
72	root	1.89	}
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;
97	root	1.52
98	root	1.5	sub find_rcfile($) {
99			my $path;
100
101	root	1.46	for (grep !ref, @INC) {
102	root	1.22	$path = "$_/CFClient/resources/$_[0]";
103	root	1.5	return $path if -r $path;
104			}
105
106			die "FATAL: can't find required file $_[0]\n";
107			}
108
109			sub read_cfg {
110			my ($file) = @_;
111
112			open CFG, $file
113			or return;
114
115			my $CFG;
116
117			local $/;
118			$CFG = eval <CFG>;
119
120			$::CFG = $CFG;
121
122			close CFG;
123			}
124
125			sub write_cfg {
126			my ($file) = @_;
127
128			open CFG, ">$file"
129			or return;
130
131			{
132	elmex	1.9	require Data::Dumper;
133	root	1.5	local $Data::Dumper::Purity = 1;
134			$::CFG->{VERSION} = $::VERSION;
135			print CFG Data::Dumper->Dump ([$::CFG], [qw/CFG/]);
136			}
137
138			close CFG;
139			}
140
141	root	1.77	our $DB_ENV;
142
143	root	1.76	{
144			use strict;
145
146	root	1.87	mkdir "$Crossfire::VARDIR/cfplus", 0777;
147	root	1.77	my $recover = $BerkeleyDB::db_version >= 4.4
148			? eval "DB_REGISTER \| DB_RECOVER"
149			: 0;
150
151			$DB_ENV = new BerkeleyDB::Env
152	root	1.76	-Home => "$Crossfire::VARDIR/cfplus",
153			-Cachesize => 1_000_000,
154			-ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
155	root	1.39	# -ErrPrefix => "DATABASE",
156	root	1.76	-Verbose => 1,
157	root	1.77	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN \| $recover,
158	root	1.78	-SetFlags => DB_AUTO_COMMIT \| DB_LOG_AUTOREMOVE,
159	root	1.76	or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
160			}
161	root	1.34
162			sub db_table($) {
163	root	1.38	my ($table) = @_;
164
165			$table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
166	root	1.76
167	root	1.34	new CFClient::Database
168			-Env => $DB_ENV,
169	root	1.38	-Filename => $table,
170			# -Filename => "database",
171			# -Subname => $table,
172	root	1.51	-Property => DB_CHKSUM,
173	root	1.34	-Flags => DB_CREATE \| DB_UPGRADE,
174	root	1.76	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
175	root	1.34	}
176
177	root	1.97	package CFClient::Layout;
178
179			$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub {
180	root	1.98	reset_glyph_cache;
181	root	1.97	};
182
183	root	1.62	package CFClient::Item;
184
185	root	1.71	use strict;
186			use Crossfire::Protocol::Constants;
187
188	elmex	1.84	my $last_enter_count = 1;
189
190	root	1.62	sub desc_string {
191			my ($self) = @_;
192
193			my $desc =
194			$self->{nrof} < 2
195			? $self->{name}
196			: "$self->{nrof} × $self->{name_pl}";
197
198	root	1.71	$self->{flags} & F_OPEN
199	root	1.62	and $desc .= " (open)";
200	root	1.71	$self->{flags} & F_APPLIED
201	root	1.62	and $desc .= " (applied)";
202	root	1.71	$self->{flags} & F_UNPAID
203	root	1.62	and $desc .= " (unpaid)";
204	root	1.71	$self->{flags} & F_MAGIC
205	root	1.62	and $desc .= " (magic)";
206	root	1.71	$self->{flags} & F_CURSED
207	root	1.62	and $desc .= " (cursed)";
208	root	1.71	$self->{flags} & F_DAMNED
209	root	1.62	and $desc .= " (damned)";
210	root	1.71	$self->{flags} & F_LOCKED
211	root	1.62	and $desc .= " *";
212
213			$desc
214			}
215
216			sub weight_string {
217			my ($self) = @_;
218
219			my $weight = ($self->{nrof} \|\| 1) * $self->{weight};
220
221			$weight < 0 ? "?" : $weight * 0.001
222			}
223
224	elmex	1.84	sub do_n_dialog {
225			my ($cb) = @_;
226
227	root	1.100	my $w = new CFClient::UI::FancyFrame
228			on_delete => sub { $_[0]->destroy; 1 },
229			has_close_button => 1,
230			;
231
232	elmex	1.84	$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	root	1.100	$w->destroy;
242
243			0
244			},
245			on_escape => sub { $w->destroy; 1 },
246	elmex	1.84	);
247	root	1.93	$entry->grab_focus;
248	elmex	1.84	$w->show;
249			}
250
251	root	1.62	sub update_widgets {
252			my ($self) = @_;
253
254	root	1.92	# necessary to avoid cyclic references
255			Scalar::Util::weaken $self;
256
257	root	1.63	my $button_cb = sub {
258			my (undef, $ev, $x, $y) = @_;
259
260	elmex	1.84	my $targ = $::CONN->{player}{tag};
261	root	1.63
262	elmex	1.84	if ($self->{container} == $::CONN->{player}{tag}) {
263			$targ = $::CONN->{open_container};
264			}
265	root	1.63
266	elmex	1.84	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
267	root	1.79	$::CONN->send ("move $targ $self->{tag} 0")
268			if $targ \|\| !($self->{flags} & F_LOCKED);
269	elmex	1.86	} 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})
273	root	1.63	} elsif ($ev->{button} == 1) {
274			$::CONN->send ("examine $self->{tag}");
275			} elsif ($ev->{button} == 2) {
276			$::CONN->send ("apply $self->{tag}");
277			} elsif ($ev->{button} == 3) {
278	elmex	1.101	my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop';
279			if ($self->{container} == $::CONN->{open_container}) {
280			$move_prefix = "take";
281			}
282
283	root	1.63	my @menu_items = (
284			["examine", sub { $::CONN->send ("examine $self->{tag}") }],
285			["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
286	elmex	1.99	["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			],
292	root	1.63	["apply", sub { $::CONN->send ("apply $self->{tag}") }],
293			(
294	root	1.71	$self->{flags} & F_LOCKED
295	root	1.63	? (
296			["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
297			)
298			: (
299			["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
300	elmex	1.101	["$move_prefix all", sub { $::CONN->send ("move $targ $self->{tag} 0") }],
301	root	1.104	["$move_prefix <n>",
302	elmex	1.84	sub {
303			do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
304			}
305			]
306	root	1.63	)
307			),
308			);
309
310			CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
311			}
312
313			1
314			};
315
316	root	1.62	my $tooltip_std = "<small>"
317			. "Left click - examine item\n"
318			. "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
319			. "Middle click - apply\n"
320	elmex	1.86	. "Shift-Middle click - lock/unlock\n"
321	root	1.62	. "Right click - further options"
322			. "</small>\n";
323
324	root	1.106	my $bg = $self->{flags} & F_CURSED ? [1 , 0 , 0, 0.5]
325			: $self->{flags} & F_MAGIC ? [0.2, 0.2, 1, 0.5]
326			: undef;
327
328	root	1.63	$self->{face_widget} \|\|= new CFClient::UI::Face
329			can_events => 1,
330			can_hover => 1,
331	root	1.67	anim => $self->{anim},
332	root	1.66	animspeed => $self->{animspeed}, # TODO# must be set at creation time
333	root	1.72	on_button_down => $button_cb,
334	root	1.63	;
335	root	1.106	$self->{face_widget}{bg} = $bg;
336	root	1.62	$self->{face_widget}{face} = $self->{face};
337			$self->{face_widget}{anim} = $self->{anim};
338	root	1.65	$self->{face_widget}{animspeed} = $self->{animspeed};
339	root	1.62	$self->{face_widget}->set_tooltip (
340			"<b>Face/Animation.</b>\n"
341			. "Item uses face #$self->{face}. "
342			. ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ")
343			. "\n\n$tooltip_std"
344			);
345
346	root	1.63	$self->{desc_widget} \|\|= new CFClient::UI::Label
347			can_events => 1,
348			can_hover => 1,
349			ellipsise => 2,
350	root	1.68	align => -1,
351	root	1.72	on_button_down => $button_cb,
352	root	1.63	;
353			my $desc = CFClient::Item::desc_string $self;
354	root	1.106	$self->{desc_widget}{bg} = $bg;
355	root	1.63	$self->{desc_widget}->set_text ($desc);
356			$self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
357
358			$self->{weight_widget} \|\|= new CFClient::UI::Label
359			can_events => 1,
360			can_hover => 1,
361			ellipsise => 0,
362	root	1.68	align => 0,
363	root	1.72	on_button_down => $button_cb,
364	root	1.63	;
365	root	1.106	$self->{weight_widget}{bg} = $bg;
366	root	1.62	$self->{weight_widget}->set_text (CFClient::Item::weight_string $self);
367			$self->{weight_widget}->set_tooltip (
368			"<b>Weight</b>.\n"
369			. ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ")
370			. ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
371			. "\n\n$tooltip_std"
372			);
373			}
374
375	root	1.1	1;
376
377			=back
378
379			=head1 AUTHOR
380
381			Marc Lehmann <schmorp@schmorp.de>
382			http://home.schmorp.de/
383
384			=cut
385