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

package CFClient::PodToPango;

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

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

our $indent = 0;

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

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

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

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

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

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

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

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

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

package CFClient::Database;

our @ISA = BerkeleyDB::Btree::;

sub get($$) {
   my $data;

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

my %DB_SYNC;

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

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

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

package CFClient;

sub find_rcfile($) {
   my $path;

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

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

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

   open CFG, $file
      or return;

   my $CFG;

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

   $::CFG = $CFG;

   close CFG;
}

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

   open CFG, ">$file"
      or return;

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

   close CFG;
}

our $DB_ENV;

{
   use strict;

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

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

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

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

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

my $pod_cache = db_table "pod_cache";

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

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

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

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

   return $pom if $chash eq $phash;

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

   #utf8::downgrade $pod;

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

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

   $pom
}

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

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

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

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

package CFClient::Layout;

$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub {
   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 n", 
                     sub {
                        do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
                     }
                  ]
               )
            ),
         );

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

      1
   };

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

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

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

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

1;

=back

=head1 AUTHOR

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

=cut

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