[ViewVC] Diff of: cvs/deliantra/Deliantra-Client/DC.pm

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.85 by root, Thu Jun 1 05:04:34 2006 UTC vs.
Revision 1.89 by root, Mon Jun 5 21:10:03 2006 UTC

…		…
24	use utf8;	24	use utf8;
25		25
26	use Carp ();	26	use Carp ();
27	use AnyEvent ();	27	use AnyEvent ();
28	use BerkeleyDB;	28	use BerkeleyDB;
		29	use Pod::POM ();
		30	use Storable (); # finally
		31
		32	package CFClient::PodToPango;
		33
		34	use base Pod::POM::View::Text;
		35
		36	our $VERSION = 1; # bump if resultant formatting changes
		37
		38	our $indent = 0;
		39
		40	*view_seq_code =
		41	*view_seq_bold = sub { "<b>$_[1]</b>" };
		42	*view_seq_italic = sub { "<i>$_[1]</i>" };
		43	*view_seq_space =
		44	*view_seq_link =
		45	*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) };
		46
		47	sub view_seq_text {
		48	my $text = $_[1];
		49	$text =~ s/\s+/ /g;
		50	CFClient::UI::Label::escape ($text)
		51	}
		52
		53	sub view_item {
		54	("\t" x ($indent / 4))
		55	. $_[1]->title->present ($_[0])
		56	. "\n"
		57	. $_[1]->content->present ($_[0])
		58	}
		59
		60	sub view_verbatim {
		61	(join "",
		62	map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
		63	split /\n/, CFClient::UI::Label::escape ($_[1]))
		64	. "\n"
		65	}
		66
		67	sub view_textblock {
		68	("\t" x ($indent / 2)) . "$_[1]\n\n"
		69	}
		70
		71	sub view_head1 {
		72	"\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
		73	. $_[1]->content->present ($_[0])
		74	};
		75
		76	sub view_head2 {
		77	"\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
		78	. $_[1]->content->present ($_[0])
		79	};
		80
		81	sub view_head3 {
		82	"\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
		83	. $_[1]->content->present ($_[0])
		84	};
		85
		86	sub view_over {
		87	local $indent = $indent + $_[1]->indent;
		88	$_[1]->content->present ($_[0])
		89	}
		90
		91	package CFClient::Database;
		92
		93	our @ISA = BerkeleyDB::Btree::;
		94
		95	sub get($$) {
		96	my $data;
		97
		98	$_[0]->db_get ($_[1], $data) == 0
		99	? $data
		100	: ()
		101	}
		102
		103	my %DB_SYNC;
		104
		105	sub put($$$) {
		106	my ($db, $key, $data) = @_;
		107
		108	$DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
		109
		110	$db->db_put ($key => $data)
		111	}
		112
		113	package CFClient;
29		114
30	sub find_rcfile($) {	115	sub find_rcfile($) {
31	my $path;	116	my $path;
32		117
33	for (grep !ref, @INC) {	118	for (grep !ref, @INC) {
…		…
68	}	153	}
69		154
70	close CFG;	155	close CFG;
71	}	156	}
72		157
73	mkdir "$Crossfire::VARDIR/cfplus", 0777;
74
75	our $DB_ENV;	158	our $DB_ENV;
76		159
77	{	160	{
78	use strict;	161	use strict;
79		162
		163	mkdir "$Crossfire::VARDIR/cfplus", 0777;
80	my $recover = $BerkeleyDB::db_version >= 4.4	164	my $recover = $BerkeleyDB::db_version >= 4.4
81	? eval "DB_REGISTER \| DB_RECOVER"	165	? eval "DB_REGISTER \| DB_RECOVER"
82	: 0;	166	: 0;
83		167
84	$DB_ENV = new BerkeleyDB::Env	168	$DB_ENV = new BerkeleyDB::Env
…		…
105	-Property => DB_CHKSUM,	189	-Property => DB_CHKSUM,
106	-Flags => DB_CREATE \| DB_UPGRADE,	190	-Flags => DB_CREATE \| DB_UPGRADE,
107	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"	191	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
108	}	192	}
109		193
		194	my $pod_cache = db_table "pod_cache";
		195
		196	sub load_pod($$$$) {
		197	my ($path, $filtertype, $filterversion, $filtercb) = @_;
		198
		199	stat $path
		200	or die "$path: $!";
		201
		202	my $phash = join ",", $filterversion, $CFClient::PodToPango::VERSION, (stat _)[7,9];
		203
		204	my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } };
		205
		206	return $pom if $chash eq $phash;
		207
		208	my $pod = do {
		209	local $/;
		210	open my $pod, "<:utf8", $_[0]
		211	or die "$_[0]: $!";
		212	<$pod>
		213	};
		214
		215	#utf8::downgrade $pod;
		216
		217	$pom = $filtercb-> (Pod::POM->new->parse_text ($pod));
		218
		219	$pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]);
		220
		221	$pom
		222	}
		223
110	sub pod_to_pango($) {	224	sub pod_to_pango($) {
111	my ($pom) = @_;	225	my ($pom) = @_;
112		226
113	$pom->present ("CFClient::PodToPango")	227	$pom->present ("CFClient::PodToPango")
114	}	228	}
…		…
118		232
119	[	233	[
120	map s/^(\s)// && [40 length $1, length $_ ? $_ : " "],	234	map s/^(\s)// && [40 length $1, length $_ ? $_ : " "],
121	split /\n/, $pom->present ("CFClient::PodToPango")	235	split /\n/, $pom->present ("CFClient::PodToPango")
122	]	236	]
123	}
124
125	package CFClient::PodToPango;
126
127	use base Pod::POM::View::Text;
128
129	our $indent = 0;
130
131	*view_seq_code =
132	*view_seq_bold = sub { "<b>$_[1]</b>" };
133	*view_seq_italic = sub { "<i>$_[1]</i>" };
134	*view_seq_space =
135	*view_seq_link =
136	*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) };
137
138	sub view_seq_text {
139	my $text = $_[1];
140	$text =~ s/\s+/ /g;
141	CFClient::UI::Label::escape ($text)
142	}
143
144	sub view_item {
145	("\t" x ($indent / 4))
146	. $_[1]->title->present ($_[0])
147	. "\n"
148	. $_[1]->content->present ($_[0])
149	}
150
151	sub view_verbatim {
152	(join "",
153	map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
154	split /\n/, CFClient::UI::Label::escape ($_[1]))
155	. "\n"
156	}
157
158	sub view_textblock {
159	("\t" x ($indent / 2)) . "$_[1]\n\n"
160	}
161
162	sub view_head1 {
163	"\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
164	. $_[1]->content->present ($_[0])
165	};
166
167	sub view_head2 {
168	"\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
169	. $_[1]->content->present ($_[0])
170	};
171
172	sub view_head3 {
173	"\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
174	. $_[1]->content->present ($_[0])
175	};
176
177	sub view_over {
178	local $indent = $indent + $_[1]->indent;
179	$_[1]->content->present ($_[0])
180	}
181
182	package CFClient::Database;
183
184	our @ISA = BerkeleyDB::Btree::;
185
186	sub get($$) {
187	my $data;
188
189	$_[0]->db_get ($_[1], $data) == 0
190	? $data
191	: ()
192	}
193
194	my %DB_SYNC;
195
196	sub put($$$) {
197	my ($db, $key, $data) = @_;
198
199	$DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
200
201	$db->db_put ($key => $data)
202	}	237	}
203		238
204	package CFClient::Item;	239	package CFClient::Item;
205		240
206	use strict;	241	use strict;
…		…
276	}	311	}
277		312
278	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {	313	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
279	$::CONN->send ("move $targ $self->{tag} 0")	314	$::CONN->send ("move $targ $self->{tag} 0")
280	if $targ \|\| !($self->{flags} & F_LOCKED);	315	if $targ \|\| !($self->{flags} & F_LOCKED);
		316	} elsif (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 2) {
		317	$self->{flags} & F_LOCKED
		318	? $::CONN->send ("lock " . pack "CN", 0, $self->{tag})
		319	: $::CONN->send ("lock " . pack "CN", 1, $self->{tag})
281	} elsif ($ev->{button} == 1) {	320	} elsif ($ev->{button} == 1) {
282	$::CONN->send ("examine $self->{tag}");	321	$::CONN->send ("examine $self->{tag}");
283	} elsif ($ev->{button} == 2) {	322	} elsif ($ev->{button} == 2) {
284	$::CONN->send ("apply $self->{tag}");	323	$::CONN->send ("apply $self->{tag}");
285	} elsif ($ev->{button} == 3) {	324	} elsif ($ev->{button} == 3) {
…		…
312		351
313	my $tooltip_std = "<small>"	352	my $tooltip_std = "<small>"
314	. "Left click - examine item\n"	353	. "Left click - examine item\n"
315	. "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"	354	. "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n"
316	. "Middle click - apply\n"	355	. "Middle click - apply\n"
		356	. "Shift-Middle click - lock/unlock\n"
317	. "Right click - further options"	357	. "Right click - further options"
318	. "</small>\n";	358	. "</small>\n";
319		359
320	$self->{face_widget} \|\|= new CFClient::UI::Face	360	$self->{face_widget} \|\|= new CFClient::UI::Face
321	can_events => 1,	361	can_events => 1,
…		…
467	$mods .= "+" if $mods ne '';	507	$mods .= "+" if $mods ne '';
468		508
469	return $mods . CFClient::SDL_GetKeyName ($sym);	509	return $mods . CFClient::SDL_GetKeyName ($sym);
470	}	510	}
471		511
		512	package CFClient::Pickup;
		513	# some pickup constants
		514	sub PU_NOTHING { 0x00000000 }
		515
		516	sub PU_DEBUG { 0x10000000 }
		517	sub PU_INHIBIT { 0x20000000 }
		518	sub PU_STOP { 0x40000000 }
		519	sub PU_NEWMODE { 0x80000000 }
		520
		521	sub PU_RATIO { 0x0000000F }
		522
		523	sub PU_FOOD { 0x00000010 }
		524	sub PU_DRINK { 0x00000020 }
		525	sub PU_VALUABLES { 0x00000040 }
		526	sub PU_BOW { 0x00000080 }
		527
		528	sub PU_ARROW { 0x00000100 }
		529	sub PU_HELMET { 0x00000200 }
		530	sub PU_SHIELD { 0x00000400 }
		531	sub PU_ARMOUR { 0x00000800 }
		532
		533	sub PU_BOOTS { 0x00001000 }
		534	sub PU_GLOVES { 0x00002000 }
		535	sub PU_CLOAK { 0x00004000 }
		536	sub PU_KEY { 0x00008000 }
		537
		538	sub PU_MISSILEWEAPON { 0x00010000 }
		539	sub PU_ALLWEAPON { 0x00020000 }
		540	sub PU_MAGICAL { 0x00040000 }
		541	sub PU_POTION { 0x00080000 }
		542
		543	sub PU_SPELLBOOK { 0x00100000 }
		544	sub PU_SKILLSCROLL { 0x00200000 }
		545	sub PU_READABLES { 0x00400000 }
		546	sub PU_MAGIC_DEVICE { 0x00800000 }
		547
		548	sub PU_NOT_CURSED { 0x01000000 }
		549
		550	sub PU_JEWELS { 0x02000000 }
		551
		552
472	1;	553	1;
473		554
474	=back	555	=back
475		556
476	=head1 AUTHOR	557	=head1 AUTHOR

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing deliantra/Deliantra-Client/DC.pm (file contents): Revision 1.85 by root, Thu Jun 1 05:04:34 2006 UTC vs. Revision 1.89 by root, Mon Jun 5 21:10:03 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.85 by root, Thu Jun 1 05:04:34 2006 UTC vs.
Revision 1.89 by root, Mon Jun 5 21:10:03 2006 UTC