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 YAML ();
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 parse_yaml {
   my $text = shift;

   utf8::decode $text;

   YAML::Load $text
}

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

   open my $fh, $file
      or return;

   local $/;
   my $CFG = <$fh>;

   if ($CFG =~ /^---/) {
      $::CFG = parse_yaml $CFG;
   } else {
      $::CFG = eval $CFG;
   }
}

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

   $::CFG->{VERSION} = $::VERSION;

   open my $fh, ">:utf8", $file
      or return;
   print $fh YAML::Dump $::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.107
Committed:	Mon Jul 24 08:23:27 2006 UTC (17 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.106:	+20 -17 lines
Log Message:	use yaml for config, many misc fixes
#	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.107	use YAML ();
32	root	1.89	use Storable (); # finally
33
34	root	1.102	our %STAT_TOOLTIP = (
35			Str => "<b>Physical Strength</b>, determines damage dealt with weapons, how much you can carry, and how often you can attack",
36			Dex => "<b>Dexterity</b>, your physical agility. Determines chance of being hit and affects armor class and speed",
37			Con => "<b>Constitution</b>, physical health and toughness. Determines how many healthpoints you can have",
38			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",
39			Wis => "<b>Wisdom</b>, the ability to learn and use divine magic (prayers). Determines how many grace points you can have",
40			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",
41			Cha => "<b>Charisma</b>, how well you are received by NPCs. Affects buying and selling prices in shops.",
42
43			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.",
44			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.",
45			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.",
46			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.",
47			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.",
48			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.",
49			);
50
51	root	1.103	=item guard { BLOCK }
52
53			Returns an object that executes the given block as soon as it is destroyed.
54
55			=cut
56
57			sub guard(&) {
58			bless \(my $cb = $_[0]), "CFClient::Guard"
59			}
60
61			sub CFClient::Guard::DESTROY {
62			${$_[0]}->()
63			}
64
65	root	1.105	sub asxml($) {
66			local $_ = $_[0];
67	root	1.89
68	root	1.105	s/&/&/g;
69			s/>/>/g;
70			s/</</g;
71	root	1.89
72	root	1.105	$_
73	root	1.89	}
74
75			package CFClient::Database;
76
77			our @ISA = BerkeleyDB::Btree::;
78
79			sub get($$) {
80			my $data;
81
82			$_[0]->db_get ($_[1], $data) == 0
83			? $data
84			: ()
85			}
86
87			my %DB_SYNC;
88
89			sub put($$$) {
90			my ($db, $key, $data) = @_;
91
92			$DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
93
94			$db->db_put ($key => $data)
95			}
96
97			package CFClient;
98	root	1.52
99	root	1.5	sub find_rcfile($) {
100			my $path;
101
102	root	1.46	for (grep !ref, @INC) {
103	root	1.22	$path = "$_/CFClient/resources/$_[0]";
104	root	1.5	return $path if -r $path;
105			}
106
107			die "FATAL: can't find required file $_[0]\n";
108			}
109
110	root	1.107	sub parse_yaml {
111			my $text = shift;
112
113			utf8::decode $text;
114
115			YAML::Load $text
116			}
117
118	root	1.5	sub read_cfg {
119			my ($file) = @_;
120
121	root	1.107	open my $fh, $file
122	root	1.5	or return;
123
124			local $/;
125	root	1.107	my $CFG = <$fh>;
126	root	1.5
127	root	1.107	if ($CFG =~ /^---/) {
128			$::CFG = parse_yaml $CFG;
129			} else {
130			$::CFG = eval $CFG;
131			}
132	root	1.5	}
133
134			sub write_cfg {
135			my ($file) = @_;
136
137	root	1.107	$::CFG->{VERSION} = $::VERSION;
138
139			open my $fh, ">:utf8", $file
140	root	1.5	or return;
141	root	1.107	print $fh YAML::Dump $::CFG;
142	root	1.5	}
143
144	root	1.77	our $DB_ENV;
145
146	root	1.76	{
147			use strict;
148
149	root	1.87	mkdir "$Crossfire::VARDIR/cfplus", 0777;
150	root	1.77	my $recover = $BerkeleyDB::db_version >= 4.4
151			? eval "DB_REGISTER \| DB_RECOVER"
152			: 0;
153
154			$DB_ENV = new BerkeleyDB::Env
155	root	1.76	-Home => "$Crossfire::VARDIR/cfplus",
156			-Cachesize => 1_000_000,
157			-ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
158	root	1.39	# -ErrPrefix => "DATABASE",
159	root	1.76	-Verbose => 1,
160	root	1.77	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN \| $recover,
161	root	1.78	-SetFlags => DB_AUTO_COMMIT \| DB_LOG_AUTOREMOVE,
162	root	1.76	or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
163			}
164	root	1.34
165			sub db_table($) {
166	root	1.38	my ($table) = @_;
167
168			$table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
169	root	1.76
170	root	1.34	new CFClient::Database
171			-Env => $DB_ENV,
172	root	1.38	-Filename => $table,
173			# -Filename => "database",
174			# -Subname => $table,
175	root	1.51	-Property => DB_CHKSUM,
176	root	1.34	-Flags => DB_CREATE \| DB_UPGRADE,
177	root	1.76	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
178	root	1.34	}
179
180	root	1.97	package CFClient::Layout;
181
182			$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub {
183	root	1.98	reset_glyph_cache;
184	root	1.97	};
185
186	root	1.62	package CFClient::Item;
187
188	root	1.71	use strict;
189			use Crossfire::Protocol::Constants;
190
191	elmex	1.84	my $last_enter_count = 1;
192
193	root	1.62	sub desc_string {
194			my ($self) = @_;
195
196			my $desc =
197			$self->{nrof} < 2
198			? $self->{name}
199			: "$self->{nrof} × $self->{name_pl}";
200
201	root	1.71	$self->{flags} & F_OPEN
202	root	1.62	and $desc .= " (open)";
203	root	1.71	$self->{flags} & F_APPLIED
204	root	1.62	and $desc .= " (applied)";
205	root	1.71	$self->{flags} & F_UNPAID
206	root	1.62	and $desc .= " (unpaid)";
207	root	1.71	$self->{flags} & F_MAGIC
208	root	1.62	and $desc .= " (magic)";
209	root	1.71	$self->{flags} & F_CURSED
210	root	1.62	and $desc .= " (cursed)";
211	root	1.71	$self->{flags} & F_DAMNED
212	root	1.62	and $desc .= " (damned)";
213	root	1.71	$self->{flags} & F_LOCKED
214	root	1.62	and $desc .= " *";
215
216			$desc
217			}
218
219			sub weight_string {
220			my ($self) = @_;
221
222			my $weight = ($self->{nrof} \|\| 1) * $self->{weight};
223
224			$weight < 0 ? "?" : $weight * 0.001
225			}
226
227	elmex	1.84	sub do_n_dialog {
228			my ($cb) = @_;
229
230	root	1.100	my $w = new CFClient::UI::FancyFrame
231			on_delete => sub { $_[0]->destroy; 1 },
232			has_close_button => 1,
233			;
234
235	elmex	1.84	$w->add (my $vb = new CFClient::UI::VBox x => "center", y => "center");
236			$vb->add (new CFClient::UI::Label text => "Enter item count:");
237			$vb->add (my $entry = new CFClient::UI::Entry
238			text => $last_enter_count,
239			on_activate => sub {
240			my ($entry) = @_;
241			$last_enter_count = $entry->get_text;
242			$cb->($last_enter_count);
243			$w->hide;
244	root	1.100	$w->destroy;
245
246			0
247			},
248			on_escape => sub { $w->destroy; 1 },
249	elmex	1.84	);
250	root	1.93	$entry->grab_focus;
251	elmex	1.84	$w->show;
252			}
253
254	root	1.62	sub update_widgets {
255			my ($self) = @_;
256
257	root	1.92	# necessary to avoid cyclic references
258			Scalar::Util::weaken $self;
259
260	root	1.63	my $button_cb = sub {
261			my (undef, $ev, $x, $y) = @_;
262
263	elmex	1.84	my $targ = $::CONN->{player}{tag};
264	root	1.63
265	elmex	1.84	if ($self->{container} == $::CONN->{player}{tag}) {
266			$targ = $::CONN->{open_container};
267			}
268	root	1.63
269	elmex	1.84	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
270	root	1.79	$::CONN->send ("move $targ $self->{tag} 0")
271			if $targ \|\| !($self->{flags} & F_LOCKED);
272	elmex	1.86	} elsif (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 2) {
273			$self->{flags} & F_LOCKED
274			? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
275			: $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
276	root	1.63	} elsif ($ev->{button} == 1) {
277			$::CONN->send ("examine $self->{tag}");
278			} elsif ($ev->{button} == 2) {
279			$::CONN->send ("apply $self->{tag}");
280			} elsif ($ev->{button} == 3) {
281	elmex	1.101	my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop';
282			if ($self->{container} == $::CONN->{open_container}) {
283			$move_prefix = "take";
284			}
285
286	root	1.63	my @menu_items = (
287			["examine", sub { $::CONN->send ("examine $self->{tag}") }],
288			["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
289	elmex	1.99	["ignite/thaw", # first try of an easier use of flint&steel
290			sub {
291			$::CONN->send ("mark ". pack "N", $self->{tag});
292			$::CONN->send ("command apply flint and steel");
293			}
294			],
295	root	1.63	["apply", sub { $::CONN->send ("apply $self->{tag}") }],
296			(
297	root	1.71	$self->{flags} & F_LOCKED
298	root	1.63	? (
299			["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
300			)
301			: (
302			["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
303	elmex	1.101	["$move_prefix all", sub { $::CONN->send ("move $targ $self->{tag} 0") }],
304	root	1.104	["$move_prefix <n>",
305	elmex	1.84	sub {
306			do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
307			}
308			]
309	root	1.63	)
310			),
311			);
312
313			CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
314			}
315
316			1
317			};
318
319	root	1.62	my $tooltip_std = "<small>"
320			. "Left click - examine item\n"
321			. "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
322			. "Middle click - apply\n"
323	elmex	1.86	. "Shift-Middle click - lock/unlock\n"
324	root	1.62	. "Right click - further options"
325			. "</small>\n";
326
327	root	1.106	my $bg = $self->{flags} & F_CURSED ? [1 , 0 , 0, 0.5]
328			: $self->{flags} & F_MAGIC ? [0.2, 0.2, 1, 0.5]
329			: undef;
330
331	root	1.63	$self->{face_widget} \|\|= new CFClient::UI::Face
332			can_events => 1,
333			can_hover => 1,
334	root	1.67	anim => $self->{anim},
335	root	1.66	animspeed => $self->{animspeed}, # TODO# must be set at creation time
336	root	1.72	on_button_down => $button_cb,
337	root	1.63	;
338	root	1.106	$self->{face_widget}{bg} = $bg;
339	root	1.62	$self->{face_widget}{face} = $self->{face};
340			$self->{face_widget}{anim} = $self->{anim};
341	root	1.65	$self->{face_widget}{animspeed} = $self->{animspeed};
342	root	1.62	$self->{face_widget}->set_tooltip (
343			"<b>Face/Animation.</b>\n"
344			. "Item uses face #$self->{face}. "
345			. ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ")
346			. "\n\n$tooltip_std"
347			);
348
349	root	1.63	$self->{desc_widget} \|\|= new CFClient::UI::Label
350			can_events => 1,
351			can_hover => 1,
352			ellipsise => 2,
353	root	1.68	align => -1,
354	root	1.72	on_button_down => $button_cb,
355	root	1.63	;
356			my $desc = CFClient::Item::desc_string $self;
357	root	1.106	$self->{desc_widget}{bg} = $bg;
358	root	1.63	$self->{desc_widget}->set_text ($desc);
359			$self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
360
361			$self->{weight_widget} \|\|= new CFClient::UI::Label
362			can_events => 1,
363			can_hover => 1,
364			ellipsise => 0,
365	root	1.68	align => 0,
366	root	1.72	on_button_down => $button_cb,
367	root	1.63	;
368	root	1.106	$self->{weight_widget}{bg} = $bg;
369	root	1.62	$self->{weight_widget}->set_text (CFClient::Item::weight_string $self);
370			$self->{weight_widget}->set_tooltip (
371			"<b>Weight</b>.\n"
372			. ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ")
373			. ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
374			. "\n\n$tooltip_std"
375			);
376			}
377
378	root	1.1	1;
379
380			=back
381
382			=head1 AUTHOR
383
384			Marc Lehmann <schmorp@schmorp.de>
385			http://home.schmorp.de/
386
387			=cut
388