deliantra/Deliantra-Client/DC.pm

=head1 NAME

CFPlus - undocumented utility garbage for our crossfire client

=head1 SYNOPSIS

 use CFPlus;

=head1 DESCRIPTION

=over 4

=cut

package CFPlus;

BEGIN {
   $VERSION = '0.1';

   use XSLoader;
   XSLoader::load "CFPlus", $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]), "CFPlus::Guard"
}

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

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

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

   $_
}

package CFPlus::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 CFPlus;

sub find_rcfile($) {
   my $path;

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

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

BEGIN {
   use Crossfire::Protocol::Base ();
   *to_json   = \&Crossfire::Protocol::Base::to_json;
   *from_json = \&Crossfire::Protocol::Base::from_json;
}

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

   open my $fh, $file
      or return;

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

   if ($CFG =~ /^---/) { ## TODO compatibility cruft, remove
      require YAML;
      utf8::decode $CFG;
      $::CFG = YAML::Load ($CFG);
   } elsif ($CFG =~ /^\{/) {
      $::CFG = from_json $CFG;
   } else {
      $::CFG = eval $CFG; ## todo comaptibility cruft
   }
}

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

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

   open my $fh, ">:utf8", $file
      or return;
   print $fh to_json $::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 CFPlus::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 CFPlus::Layout;

$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {
   reset_glyph_cache;
};

package CFPlus::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 CFPlus::UI::FancyFrame
      on_delete => sub { $_[0]->destroy; 1 },
      has_close_button => 1,
   ;

   $w->add (my $vb = new CFPlus::UI::VBox x => "center", y => "center");
   $vb->add (new CFPlus::UI::Label text => "Enter item count:");
   $vb->add (my $entry = new CFPlus::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} & CFPlus::KMOD_SHIFT) && $ev->{button} == 1) {
         $::CONN->send ("move $targ $self->{tag} 0")
            if $targ || !($self->{flags} & F_LOCKED);
      } elsif (($ev->{mod} & CFPlus::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");
               }
            ],
            ["inscribe",  # first try of an easier use of flint&steel
               sub {
                  &::open_string_query ("Text to inscribe", sub {
                     my ($entry, $txt) = @_;
                     $::CONN->send ("mark ". pack "N", $self->{tag});
                     $::CONN->send ("command use_skill inscription $txt");
                  });
               }
            ],
            ["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]") })
                     }
                  ]
               )
            ),
         );

         CFPlus::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 CFPlus::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 CFPlus::UI::Label
      can_events => 1,
      can_hover  => 1,
      ellipsise  => 2,
      align      => -1,
      on_button_down => $button_cb,
   ;
   my $desc = CFPlus::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 CFPlus::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 (CFPlus::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.110
Committed:	Sun Jul 30 17:43:26 2006 UTC (17 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.109:	+4 -9 lines
Log Message:	first phase of JSONification of extension protocol
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.108	CFPlus - undocumented utility garbage for our crossfire client
4	root	1.1
5			=head1 SYNOPSIS
6
7	root	1.108	use CFPlus;
8	root	1.1
9			=head1 DESCRIPTION
10
11			=over 4
12
13			=cut
14
15	root	1.108	package CFPlus;
16	root	1.1
17			BEGIN {
18			$VERSION = '0.1';
19
20	root	1.2	use XSLoader;
21	root	1.108	XSLoader::load "CFPlus", $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	root	1.108	bless \(my $cb = $_[0]), "CFPlus::Guard"
58	root	1.103	}
59
60	root	1.108	sub CFPlus::Guard::DESTROY {
61	root	1.103	${$_[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	root	1.108	package CFPlus::Database;
75	root	1.89
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	root	1.108	package CFPlus;
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.108	$path = "$_/CFPlus/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	root	1.110	BEGIN {
110			use Crossfire::Protocol::Base ();
111			*to_json = \&Crossfire::Protocol::Base::to_json;
112			*from_json = \&Crossfire::Protocol::Base::from_json;
113	root	1.107	}
114
115	root	1.5	sub read_cfg {
116			my ($file) = @_;
117
118	root	1.107	open my $fh, $file
119	root	1.5	or return;
120
121			local $/;
122	root	1.107	my $CFG = <$fh>;
123	root	1.5
124	root	1.108	if ($CFG =~ /^---/) { ## TODO compatibility cruft, remove
125			require YAML;
126			utf8::decode $CFG;
127			$::CFG = YAML::Load ($CFG);
128			} elsif ($CFG =~ /^\{/) {
129			$::CFG = from_json $CFG;
130	root	1.107	} else {
131	root	1.108	$::CFG = eval $CFG; ## todo comaptibility cruft
132	root	1.107	}
133	root	1.5	}
134
135			sub write_cfg {
136			my ($file) = @_;
137
138	root	1.107	$::CFG->{VERSION} = $::VERSION;
139
140			open my $fh, ">:utf8", $file
141	root	1.5	or return;
142	root	1.108	print $fh to_json $::CFG;
143	root	1.5	}
144
145	root	1.77	our $DB_ENV;
146
147	root	1.76	{
148			use strict;
149
150	root	1.87	mkdir "$Crossfire::VARDIR/cfplus", 0777;
151	root	1.77	my $recover = $BerkeleyDB::db_version >= 4.4
152			? eval "DB_REGISTER \| DB_RECOVER"
153			: 0;
154
155			$DB_ENV = new BerkeleyDB::Env
156	root	1.76	-Home => "$Crossfire::VARDIR/cfplus",
157			-Cachesize => 1_000_000,
158			-ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
159	root	1.39	# -ErrPrefix => "DATABASE",
160	root	1.76	-Verbose => 1,
161	root	1.77	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN \| $recover,
162	root	1.78	-SetFlags => DB_AUTO_COMMIT \| DB_LOG_AUTOREMOVE,
163	root	1.76	or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
164			}
165	root	1.34
166			sub db_table($) {
167	root	1.38	my ($table) = @_;
168
169			$table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
170	root	1.76
171	root	1.108	new CFPlus::Database
172	root	1.34	-Env => $DB_ENV,
173	root	1.38	-Filename => $table,
174			# -Filename => "database",
175			# -Subname => $table,
176	root	1.51	-Property => DB_CHKSUM,
177	root	1.34	-Flags => DB_CREATE \| DB_UPGRADE,
178	root	1.76	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
179	root	1.34	}
180
181	root	1.108	package CFPlus::Layout;
182	root	1.97
183	root	1.108	$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {
184	root	1.98	reset_glyph_cache;
185	root	1.97	};
186
187	root	1.108	package CFPlus::Item;
188	root	1.62
189	root	1.71	use strict;
190			use Crossfire::Protocol::Constants;
191
192	elmex	1.84	my $last_enter_count = 1;
193
194	root	1.62	sub desc_string {
195			my ($self) = @_;
196
197			my $desc =
198			$self->{nrof} < 2
199			? $self->{name}
200			: "$self->{nrof} × $self->{name_pl}";
201
202	root	1.71	$self->{flags} & F_OPEN
203	root	1.62	and $desc .= " (open)";
204	root	1.71	$self->{flags} & F_APPLIED
205	root	1.62	and $desc .= " (applied)";
206	root	1.71	$self->{flags} & F_UNPAID
207	root	1.62	and $desc .= " (unpaid)";
208	root	1.71	$self->{flags} & F_MAGIC
209	root	1.62	and $desc .= " (magic)";
210	root	1.71	$self->{flags} & F_CURSED
211	root	1.62	and $desc .= " (cursed)";
212	root	1.71	$self->{flags} & F_DAMNED
213	root	1.62	and $desc .= " (damned)";
214	root	1.71	$self->{flags} & F_LOCKED
215	root	1.62	and $desc .= " *";
216
217			$desc
218			}
219
220			sub weight_string {
221			my ($self) = @_;
222
223			my $weight = ($self->{nrof} \|\| 1) * $self->{weight};
224
225			$weight < 0 ? "?" : $weight * 0.001
226			}
227
228	elmex	1.84	sub do_n_dialog {
229			my ($cb) = @_;
230
231	root	1.108	my $w = new CFPlus::UI::FancyFrame
232	root	1.100	on_delete => sub { $_[0]->destroy; 1 },
233			has_close_button => 1,
234			;
235
236	root	1.108	$w->add (my $vb = new CFPlus::UI::VBox x => "center", y => "center");
237			$vb->add (new CFPlus::UI::Label text => "Enter item count:");
238			$vb->add (my $entry = new CFPlus::UI::Entry
239	elmex	1.84	text => $last_enter_count,
240			on_activate => sub {
241			my ($entry) = @_;
242			$last_enter_count = $entry->get_text;
243			$cb->($last_enter_count);
244			$w->hide;
245	root	1.100	$w->destroy;
246
247			0
248			},
249			on_escape => sub { $w->destroy; 1 },
250	elmex	1.84	);
251	root	1.93	$entry->grab_focus;
252	elmex	1.84	$w->show;
253			}
254
255	root	1.62	sub update_widgets {
256			my ($self) = @_;
257
258	root	1.92	# necessary to avoid cyclic references
259			Scalar::Util::weaken $self;
260
261	root	1.63	my $button_cb = sub {
262			my (undef, $ev, $x, $y) = @_;
263
264	elmex	1.84	my $targ = $::CONN->{player}{tag};
265	root	1.63
266	elmex	1.84	if ($self->{container} == $::CONN->{player}{tag}) {
267			$targ = $::CONN->{open_container};
268			}
269	root	1.63
270	root	1.108	if (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 1) {
271	root	1.79	$::CONN->send ("move $targ $self->{tag} 0")
272			if $targ \|\| !($self->{flags} & F_LOCKED);
273	root	1.108	} elsif (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 2) {
274	elmex	1.86	$self->{flags} & F_LOCKED
275			? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
276			: $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
277	root	1.63	} elsif ($ev->{button} == 1) {
278			$::CONN->send ("examine $self->{tag}");
279			} elsif ($ev->{button} == 2) {
280			$::CONN->send ("apply $self->{tag}");
281			} elsif ($ev->{button} == 3) {
282	elmex	1.101	my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop';
283			if ($self->{container} == $::CONN->{open_container}) {
284			$move_prefix = "take";
285			}
286
287	root	1.63	my @menu_items = (
288			["examine", sub { $::CONN->send ("examine $self->{tag}") }],
289			["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
290	elmex	1.99	["ignite/thaw", # first try of an easier use of flint&steel
291			sub {
292			$::CONN->send ("mark ". pack "N", $self->{tag});
293			$::CONN->send ("command apply flint and steel");
294			}
295			],
296	elmex	1.109	["inscribe", # first try of an easier use of flint&steel
297			sub {
298			&::open_string_query ("Text to inscribe", sub {
299			my ($entry, $txt) = @_;
300			$::CONN->send ("mark ". pack "N", $self->{tag});
301			$::CONN->send ("command use_skill inscription $txt");
302			});
303			}
304			],
305	root	1.63	["apply", sub { $::CONN->send ("apply $self->{tag}") }],
306			(
307	root	1.71	$self->{flags} & F_LOCKED
308	root	1.63	? (
309			["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }],
310			)
311			: (
312			["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }],
313	elmex	1.101	["$move_prefix all", sub { $::CONN->send ("move $targ $self->{tag} 0") }],
314	root	1.104	["$move_prefix <n>",
315	elmex	1.84	sub {
316			do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
317			}
318			]
319	root	1.63	)
320			),
321			);
322
323	root	1.108	CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
324	root	1.63	}
325
326			1
327			};
328
329	root	1.62	my $tooltip_std = "<small>"
330			. "Left click - examine item\n"
331			. "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
332			. "Middle click - apply\n"
333	elmex	1.86	. "Shift-Middle click - lock/unlock\n"
334	root	1.62	. "Right click - further options"
335			. "</small>\n";
336
337	root	1.106	my $bg = $self->{flags} & F_CURSED ? [1 , 0 , 0, 0.5]
338			: $self->{flags} & F_MAGIC ? [0.2, 0.2, 1, 0.5]
339			: undef;
340
341	root	1.108	$self->{face_widget} \|\|= new CFPlus::UI::Face
342	root	1.63	can_events => 1,
343			can_hover => 1,
344	root	1.67	anim => $self->{anim},
345	root	1.66	animspeed => $self->{animspeed}, # TODO# must be set at creation time
346	root	1.72	on_button_down => $button_cb,
347	root	1.63	;
348	root	1.106	$self->{face_widget}{bg} = $bg;
349	root	1.62	$self->{face_widget}{face} = $self->{face};
350			$self->{face_widget}{anim} = $self->{anim};
351	root	1.65	$self->{face_widget}{animspeed} = $self->{animspeed};
352	root	1.62	$self->{face_widget}->set_tooltip (
353			"<b>Face/Animation.</b>\n"
354			. "Item uses face #$self->{face}. "
355			. ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ")
356			. "\n\n$tooltip_std"
357			);
358
359	root	1.108	$self->{desc_widget} \|\|= new CFPlus::UI::Label
360	root	1.63	can_events => 1,
361			can_hover => 1,
362			ellipsise => 2,
363	root	1.68	align => -1,
364	root	1.72	on_button_down => $button_cb,
365	root	1.63	;
366	root	1.108	my $desc = CFPlus::Item::desc_string $self;
367	root	1.106	$self->{desc_widget}{bg} = $bg;
368	root	1.63	$self->{desc_widget}->set_text ($desc);
369			$self->{desc_widget}->set_tooltip ("<b>$desc</b>.\n$tooltip_std");
370
371	root	1.108	$self->{weight_widget} \|\|= new CFPlus::UI::Label
372	root	1.63	can_events => 1,
373			can_hover => 1,
374			ellipsise => 0,
375	root	1.68	align => 0,
376	root	1.72	on_button_down => $button_cb,
377	root	1.63	;
378	root	1.106	$self->{weight_widget}{bg} = $bg;
379	root	1.108	$self->{weight_widget}->set_text (CFPlus::Item::weight_string $self);
380	root	1.62	$self->{weight_widget}->set_tooltip (
381			"<b>Weight</b>.\n"
382			. ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ")
383			. ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ")
384			. "\n\n$tooltip_std"
385			);
386			}
387
388	root	1.1	1;
389
390			=back
391
392			=head1 AUTHOR
393
394			Marc Lehmann <schmorp@schmorp.de>
395			http://home.schmorp.de/
396
397			=cut
398