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 JSON::Syck ();
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";
}

$JSON::Syck::ImplicitUnicode = 1;

sub from_json {
   JSON::Syck::Load $_[0]
}

sub to_json {
   JSON::Syck::Dump $_[0]
}

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