deliantra/Deliantra-Client/DC.pm

=head1 NAME

DC - undocumented utility garbage for our deliantra client

=head1 SYNOPSIS

 use DC;

=head1 DESCRIPTION

=over 4

=cut

package DC;

use Carp ();

our $VERSION;

BEGIN {
   $VERSION = '3.0';

   use XSLoader;
   XSLoader::load "Deliantra::Client", $VERSION;
}

use utf8;
use strict qw(vars subs);

use Socket ();
use AnyEvent ();
use AnyEvent::Util ();
use Pod::POM ();
use File::Path ();
use Storable (); # finally
use Fcntl ();
use JSON::XS qw(encode_json decode_json);
use Guard qw(guard);

# modules to support other DC::* packages
use List::Util ();
use IO::AIO ();
use Coro::AIO ();
use AnyEvent::AIO ();

use Deliantra::Protocol::Constants ();

=item shorten $string[, $maxlength]

=cut

sub shorten($;$) {
   my ($str, $len) = @_;
   substr $str, $len, (length $str), "..." if $len + 3 <= length $str;
   $str
}

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

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

   $_
}

sub background(&;&) {
   my ($bg, $cb) = @_;

   my ($fh_r, $fh_w) = AnyEvent::Util::portable_socketpair
     or die "unable to create background socketpair: $!";

   my $pid = fork;

   if (defined $pid && !$pid) {
      local $SIG{__DIE__};

      open STDOUT, ">&", $fh_w;
      open STDERR, ">&", $fh_w;
      close $fh_r;
      close $fh_w;

      $| = 1;

      eval { $bg->() };

      if ($@) {
         my $msg = $@;
         $msg =~ s/\n+/\n/;
         warn "FATAL: $msg";
         DC::_exit 1;
      }

      # win32 is fucked up, of course. exit will clean stuff up,
      # which destroys our database etc. _exit will exit ALL
      # forked processes, because of the dreaded fork emulation.
      DC::_exit 0;
   }

   close $fh_w;

   my $buffer;

   my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
      unless (sysread $fh_r, $buffer, 4096, length $buffer) {
         undef $w;
         $cb->();
         return;
      }

      while ($buffer =~ s/^(.*)\n//) {
         my $line = $1;
         $line =~ s/\s+$//;
         utf8::decode $line;
         if ($line =~ /^\x{e877}json_msg (.*)$/s) {
            $cb->(JSON::XS->new->allow_nonref->decode ($1));
         } else {
            ::message ({
               markup => "background($pid): " . DC::asxml $line,
            });
         }
      }
   });
}

sub background_msg {
   my ($msg) = @_;

   $msg = "\x{e877}json_msg " . JSON::XS->new->allow_nonref->encode ($msg);
   $msg =~ s/\n//g;
   utf8::encode $msg;
   print $msg, "\n";
}

package DC;

our $RC_THEME;
our %THEME;
our @RC_PATH;
our $RC_BASE;

for (grep !ref, @INC) {
   $RC_BASE = "$_/Deliantra/Client/private/resources";
   last if -d $RC_BASE;
}

sub find_rcfile($) {
   my $path;

   for (@RC_PATH, "") {
      $path = "$RC_BASE/$_/$_[0]";
      return $path if -e $path;
   }

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

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

   open my $fh, $file
      or return;

   local $/;
   eval { JSON::XS->new->utf8->relaxed->decode (<$fh>) }
}

sub set_theme($) {
   return if $RC_THEME eq $_[0];
   $RC_THEME = $_[0];

   # kind of hacky, find the main theme file, then load all theme files and merge them

   %THEME = ();
   @RC_PATH = "theme-$RC_THEME";

   my $theme = load_json find_rcfile "theme.json"
      or die "FATAL: theme resource file not found";

   @RC_PATH = @{ $theme->{path} } if $theme->{path};

   for (@RC_PATH, "") {
      my $theme = load_json "$RC_BASE/$_/theme.json"
         or next;

      %THEME = ( %$theme, %THEME );
   }
}

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

   $::CFG = (load_json $file) || (load_json "$file.bak");
}

sub write_cfg($) {
   my $file = "$Deliantra::VARDIR/client.cf";

   $::CFG->{VERSION} = $::VERSION;
   $::CFG->{layout}  = DC::UI::get_layout ();

   open my $fh, ">:utf8", "$file~"
      or return;
   print $fh JSON::XS->new->utf8->pretty->encode ($::CFG);
   close $fh;

   rename $file, "$file.bak";
   rename "$file~", $file;
}

sub load_cfg() {
   if (-e "$Deliantra::VARDIR/client.cf") {
      DC::read_cfg "$Deliantra::VARDIR/client.cf";
   } else {
      $::CFG = {};
   }
}

sub save_cfg() {
   write_cfg "$Deliantra::VARDIR/client.cf";
}

sub upgrade_cfg() {
   my %DEF_CFG = (
      config_autosave     => 1,
      sdl_mode            => undef,
      fullscreen          => 1,
      fast                => 0,
      force_opengl11      => undef,
      disable_alpha       => 0,
      smooth_movement     => 1,
      smooth_transitions  => 1,
      texture_compression => 1,
      map_scale           => 1,
      fow_enable          => 1,
      fow_intensity       => 0,
      fow_texture         => 0,
      map_smoothing       => 1,
      gui_fontsize        => 1,
      log_fontsize        => 0.7,
      gauge_fontsize      => 1,
      gauge_size          => 0.35,
      stat_fontsize       => 0.7,
      mapsize             => 100,
      audio_enable        => 1,
      audio_hw_channels   => 0,
      audio_hw_frequency  => 0,
      audio_hw_chunksize  => 0,
      audio_mix_channels  => 8,
      effects_enable      => 1,
      effects_volume      => 1,
      bgm_enable          => 1,
      bgm_volume          => 0.5,
      output_rate         => "",
      pickup              => Deliantra::Protocol::Constants::PICKUP_SPELLBOOK
                           | Deliantra::Protocol::Constants::PICKUP_SKILLSCROLL
                           | Deliantra::Protocol::Constants::PICKUP_VALUABLES,
      inv_sort            => "mtime",
      default             => "profile", # default profile
      show_tips           => 1,
      logview_max_par     => 1000,
      shift_fire_stop     => 0,
      uitheme             => "wood",
      map_shift_x         => -24, # arbitrary
      map_shift_y         => +24, # arbitrary
      #db_schema          => 0,
   );

   while (my ($k, $v) = each %DEF_CFG) {
      $::CFG->{$k} = $v unless exists $::CFG->{$k};
   }
}

sub http_proxy {
   my @proxy = win32_proxy_info;

   if (@proxy) {
      "http://" . (@proxy < 2 ? "" : @proxy < 3 ? "$proxy[1]\@" : "$proxy[1]:$proxy[2]\@") . $proxy[0]
   } elsif (exists $ENV{http_proxy}) {
      $ENV{http_proxy}
   } else {
     ()
   }
}

sub set_proxy {
   my $proxy = http_proxy
      or return;

   $ENV{http_proxy} = $proxy;
}

sub lwp_useragent {
   require LWP::UserAgent;
   
   DC::set_proxy;

   my $ua = LWP::UserAgent->new (
      agent      => "deliantra $VERSION",
      keep_alive => 1,
      env_proxy  => 1,
      timeout    => 30,
   );
}

sub lwp_check($) {
   my ($res) = @_;

   $res->is_error
      and die $res->status_line;

   $res
}

sub fh_nonblocking($$) {
   my ($fh, $nb) = @_;

   if ($^O eq "MSWin32") {
      $nb = (! ! $nb) + 0;
      ioctl $fh, 0x8004667e, \$nb; # FIONBIO
   } else {
      fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0;
   }
}

package DC::Layout;

$DC::OpenGL::INIT_HOOK{"DC::Layout"} = sub {
   glyph_cache_restore;
};

$DC::OpenGL::SHUTDOWN_HOOK{"DC::Layout"} = sub {
   glyph_cache_backup;
};

1;

=back

=head1 AUTHOR

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

=cut

Revision:	1.215
Committed:	Wed Jan 18 13:42:19 2012 UTC (12 years, 3 months ago) by root
Branch:	MAIN
Changes since 1.214:	+14 -2 lines
Log Message:	* empty log message *
#	Content
1	=head1 NAME
2
3	DC - undocumented utility garbage for our deliantra client
4
5	=head1 SYNOPSIS
6
7	use DC;
8
9	=head1 DESCRIPTION
10
11	=over 4
12
13	=cut
14
15	package DC;
16
17	use Carp ();
18
19	our $VERSION;
20
21	BEGIN {
22	$VERSION = '3.0';
23
24	use XSLoader;
25	XSLoader::load "Deliantra::Client", $VERSION;
26	}
27
28	use utf8;
29	use strict qw(vars subs);
30
31	use Socket ();
32	use AnyEvent ();
33	use AnyEvent::Util ();
34	use Pod::POM ();
35	use File::Path ();
36	use Storable (); # finally
37	use Fcntl ();
38	use JSON::XS qw(encode_json decode_json);
39	use Guard qw(guard);
40
41	# modules to support other DC::* packages
42	use List::Util ();
43	use IO::AIO ();
44	use Coro::AIO ();
45	use AnyEvent::AIO ();
46
47	use Deliantra::Protocol::Constants ();
48
49	=item shorten $string[, $maxlength]
50
51	=cut
52
53	sub shorten($;$) {
54	my ($str, $len) = @_;
55	substr $str, $len, (length $str), "..." if $len + 3 <= length $str;
56	$str
57	}
58
59	sub asxml($) {
60	local $_ = $_[0];
61
62	s/&/&/g;
63	s/>/>/g;
64	s/</</g;
65
66	$_
67	}
68
69	sub background(&;&) {
70	my ($bg, $cb) = @_;
71
72	my ($fh_r, $fh_w) = AnyEvent::Util::portable_socketpair
73	or die "unable to create background socketpair: $!";
74
75	my $pid = fork;
76
77	if (defined $pid && !$pid) {
78	local $SIG{__DIE__};
79
80	open STDOUT, ">&", $fh_w;
81	open STDERR, ">&", $fh_w;
82	close $fh_r;
83	close $fh_w;
84
85	$\| = 1;
86
87	eval { $bg->() };
88
89	if ($@) {
90	my $msg = $@;
91	$msg =~ s/\n+/\n/;
92	warn "FATAL: $msg";
93	DC::_exit 1;
94	}
95
96	# win32 is fucked up, of course. exit will clean stuff up,
97	# which destroys our database etc. _exit will exit ALL
98	# forked processes, because of the dreaded fork emulation.
99	DC::_exit 0;
100	}
101
102	close $fh_w;
103
104	my $buffer;
105
106	my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
107	unless (sysread $fh_r, $buffer, 4096, length $buffer) {
108	undef $w;
109	$cb->();
110	return;
111	}
112
113	while ($buffer =~ s/^(.*)\n//) {
114	my $line = $1;
115	$line =~ s/\s+$//;
116	utf8::decode $line;
117	if ($line =~ /^\x{e877}json_msg (.*)$/s) {
118	$cb->(JSON::XS->new->allow_nonref->decode ($1));
119	} else {
120	::message ({
121	markup => "background($pid): " . DC::asxml $line,
122	});
123	}
124	}
125	});
126	}
127
128	sub background_msg {
129	my ($msg) = @_;
130
131	$msg = "\x{e877}json_msg " . JSON::XS->new->allow_nonref->encode ($msg);
132	$msg =~ s/\n//g;
133	utf8::encode $msg;
134	print $msg, "\n";
135	}
136
137	package DC;
138
139	our $RC_THEME;
140	our %THEME;
141	our @RC_PATH;
142	our $RC_BASE;
143
144	for (grep !ref, @INC) {
145	$RC_BASE = "$_/Deliantra/Client/private/resources";
146	last if -d $RC_BASE;
147	}
148
149	sub find_rcfile($) {
150	my $path;
151
152	for (@RC_PATH, "") {
153	$path = "$RC_BASE/$_/$_[0]";
154	return $path if -e $path;
155	}
156
157	die "FATAL: can't find required file \"$_[0]\" in \"$RC_BASE\"\n";
158	}
159
160	sub load_json($) {
161	my ($file) = @_;
162
163	open my $fh, $file
164	or return;
165
166	local $/;
167	eval { JSON::XS->new->utf8->relaxed->decode (<$fh>) }
168	}
169
170	sub set_theme($) {
171	return if $RC_THEME eq $_[0];
172	$RC_THEME = $_[0];
173
174	# kind of hacky, find the main theme file, then load all theme files and merge them
175
176	%THEME = ();
177	@RC_PATH = "theme-$RC_THEME";
178
179	my $theme = load_json find_rcfile "theme.json"
180	or die "FATAL: theme resource file not found";
181
182	@RC_PATH = @{ $theme->{path} } if $theme->{path};
183
184	for (@RC_PATH, "") {
185	my $theme = load_json "$RC_BASE/$_/theme.json"
186	or next;
187
188	%THEME = ( %$theme, %THEME );
189	}
190	}
191
192	sub read_cfg($) {
193	my ($file) = @_;
194
195	$::CFG = (load_json $file) \|\| (load_json "$file.bak");
196	}
197
198	sub write_cfg($) {
199	my $file = "$Deliantra::VARDIR/client.cf";
200
201	$::CFG->{VERSION} = $::VERSION;
202	$::CFG->{layout} = DC::UI::get_layout ();
203
204	open my $fh, ">:utf8", "$file~"
205	or return;
206	print $fh JSON::XS->new->utf8->pretty->encode ($::CFG);
207	close $fh;
208
209	rename $file, "$file.bak";
210	rename "$file~", $file;
211	}
212
213	sub load_cfg() {
214	if (-e "$Deliantra::VARDIR/client.cf") {
215	DC::read_cfg "$Deliantra::VARDIR/client.cf";
216	} else {
217	$::CFG = {};
218	}
219	}
220
221	sub save_cfg() {
222	write_cfg "$Deliantra::VARDIR/client.cf";
223	}
224
225	sub upgrade_cfg() {
226	my %DEF_CFG = (
227	config_autosave => 1,
228	sdl_mode => undef,
229	fullscreen => 1,
230	fast => 0,
231	force_opengl11 => undef,
232	disable_alpha => 0,
233	smooth_movement => 1,
234	smooth_transitions => 1,
235	texture_compression => 1,
236	map_scale => 1,
237	fow_enable => 1,
238	fow_intensity => 0,
239	fow_texture => 0,
240	map_smoothing => 1,
241	gui_fontsize => 1,
242	log_fontsize => 0.7,
243	gauge_fontsize => 1,
244	gauge_size => 0.35,
245	stat_fontsize => 0.7,
246	mapsize => 100,
247	audio_enable => 1,
248	audio_hw_channels => 0,
249	audio_hw_frequency => 0,
250	audio_hw_chunksize => 0,
251	audio_mix_channels => 8,
252	effects_enable => 1,
253	effects_volume => 1,
254	bgm_enable => 1,
255	bgm_volume => 0.5,
256	output_rate => "",
257	pickup => Deliantra::Protocol::Constants::PICKUP_SPELLBOOK
258	\| Deliantra::Protocol::Constants::PICKUP_SKILLSCROLL
259	\| Deliantra::Protocol::Constants::PICKUP_VALUABLES,
260	inv_sort => "mtime",
261	default => "profile", # default profile
262	show_tips => 1,
263	logview_max_par => 1000,
264	shift_fire_stop => 0,
265	uitheme => "wood",
266	map_shift_x => -24, # arbitrary
267	map_shift_y => +24, # arbitrary
268	#db_schema => 0,
269	);
270
271	while (my ($k, $v) = each %DEF_CFG) {
272	$::CFG->{$k} = $v unless exists $::CFG->{$k};
273	}
274	}
275
276	sub http_proxy {
277	my @proxy = win32_proxy_info;
278
279	if (@proxy) {
280	"http://" . (@proxy < 2 ? "" : @proxy < 3 ? "$proxy[1]\@" : "$proxy[1]:$proxy[2]\@") . $proxy[0]
281	} elsif (exists $ENV{http_proxy}) {
282	$ENV{http_proxy}
283	} else {
284	()
285	}
286	}
287
288	sub set_proxy {
289	my $proxy = http_proxy
290	or return;
291
292	$ENV{http_proxy} = $proxy;
293	}
294
295	sub lwp_useragent {
296	require LWP::UserAgent;
297
298	DC::set_proxy;
299
300	my $ua = LWP::UserAgent->new (
301	agent => "deliantra $VERSION",
302	keep_alive => 1,
303	env_proxy => 1,
304	timeout => 30,
305	);
306	}
307
308	sub lwp_check($) {
309	my ($res) = @_;
310
311	$res->is_error
312	and die $res->status_line;
313
314	$res
315	}
316
317	sub fh_nonblocking($$) {
318	my ($fh, $nb) = @_;
319
320	if ($^O eq "MSWin32") {
321	$nb = (! ! $nb) + 0;
322	ioctl $fh, 0x8004667e, \$nb; # FIONBIO
323	} else {
324	fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0;
325	}
326	}
327
328	package DC::Layout;
329
330	$DC::OpenGL::INIT_HOOK{"DC::Layout"} = sub {
331	glyph_cache_restore;
332	};
333
334	$DC::OpenGL::SHUTDOWN_HOOK{"DC::Layout"} = sub {
335	glyph_cache_backup;
336	};
337
338	1;
339
340	=back
341
342	=head1 AUTHOR
343
344	Marc Lehmann <schmorp@schmorp.de>
345	http://home.schmorp.de/
346
347	=cut
348