ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC.pm
(Generate patch)

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.4 by root, Fri Apr 7 18:49:52 2006 UTC vs.
Revision 1.155 by root, Sun Oct 14 23:19:13 2007 UTC

1=head1 NAME 1=head1 NAME
2 2
3Crossfire::Client - undocumented utility garbage for our crossfire client 3CFPlus - undocumented utility garbage for our crossfire client
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use Crossfire::Client; 7 use CFPlus;
8 8
9=head1 DESCRIPTION 9=head1 DESCRIPTION
10 10
11=over 4 11=over 4
12 12
13=cut 13=cut
14 14
15package Crossfire::Client; 15package CFPlus;
16
17use Carp ();
16 18
17BEGIN { 19BEGIN {
18 $VERSION = '0.1'; 20 $VERSION = '0.994';
19 21
20 use XSLoader; 22 use XSLoader;
21 XSLoader::load "Crossfire::Client", $VERSION; 23 XSLoader::load "CFPlus", $VERSION;
22} 24}
23 25
24package Crossfire::Client::Texture; 26use utf8;
25 27
26use Scalar::Util; 28use AnyEvent ();
29use Pod::POM ();
30use File::Path ();
31use Storable (); # finally
32use Fcntl ();
33use JSON::XS qw(to_json from_json);
27 34
28use SDL::OpenGL; 35=item guard { BLOCK }
29 36
30my @textures; 37Returns an object that executes the given block as soon as it is destroyed.
31 38
32sub _new { 39=cut
33 my ($class, %data) = @_;
34 40
35 my $self = bless \%data, $class; 41sub guard(&) {
36 42 bless \(my $cb = $_[0]), "CFPlus::Guard"
37 push @textures, $self;
38 Scalar::Util::weaken $textures[-1];
39
40 $self->upload;
41
42 $self
43} 43}
44 44
45sub new_from_image { 45sub CFPlus::Guard::DESTROY {
46 my ($class, $image) = @_; 46 ${$_[0]}->()
47
48 $class->_new (image => $image)
49} 47}
50 48
51sub new_from_file { 49=item shorten $string[, $maxlength]
52 my ($class, $path) = @_;
53 50
54 open my $fh, "<:raw", $path 51=cut
55 or die "$path: $!"; 52
53sub shorten($;$) {
54 my ($str, $len) = @_;
55 substr $str, $len, (length $str), "..." if $len + 3 <= length $str;
56 $str
57}
58
59sub asxml($) {
60 local $_ = $_[0];
61
62 s/&/&amp;/g;
63 s/>/&gt;/g;
64 s/</&lt;/g;
65
66 $_
67}
68
69sub socketpipe() {
70 socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC
71 or die "cannot establish bidirectional pipe: $!\n";
72
73 ($fh1, $fh2)
74}
75
76sub background(&;&) {
77 my ($bg, $cb) = @_;
78
79 my ($fh_r, $fh_w) = CFPlus::socketpipe;
80
81 my $pid = fork;
82
83 if (defined $pid && !$pid) {
84 local $SIG{__DIE__};
85
86 open STDOUT, ">&", $fh_w;
87 open STDERR, ">&", $fh_w;
88 close $fh_r;
89 close $fh_w;
90
91 $| = 1;
92
93 eval { $bg->() };
94
95 if ($@) {
96 my $msg = $@;
97 $msg =~ s/\n+/\n/;
98 warn "FATAL: $msg";
99 CFPlus::_exit 1;
100 }
101
102 # win32 is fucked up, of course. exit will clean stuff up,
103 # which destroys our database etc. _exit will exit ALL
104 # forked processes, because of the dreaded fork emulation.
105 CFPlus::_exit 0;
106 }
107
108 close $fh_w;
109
110 my $buffer;
111
112 my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
113 unless (sysread $fh_r, $buffer, 4096, length $buffer) {
114 undef $w;
115 $cb->();
116 return;
117 }
118
119 while ($buffer =~ s/^(.*)\n//) {
120 my $line = $1;
121 $line =~ s/\s+$//;
122 utf8::decode $line;
123 if ($line =~ /^\x{e877}json_msg (.*)$/s) {
124 $cb->(JSON::XS->new->allow_nonref->decode ($1));
125 } else {
126 ::message ({
127 markup => "background($pid): " . CFPlus::asxml $line,
128 });
129 }
130 }
131 });
132}
133
134sub background_msg {
135 my ($msg) = @_;
136
137 $msg = "\x{e877}json_msg " . JSON::XS->new->allow_nonref->encode ($msg);
138 $msg =~ s/\n//g;
139 utf8::encode $msg;
140 print $msg, "\n";
141}
142
143package CFPlus;
144
145sub find_rcfile($) {
146 my $path;
147
148 for (grep !ref, @INC) {
149 $path = "$_/CFPlus/resources/$_[0]";
150 return $path if -r $path;
151 }
152
153 die "FATAL: can't find required file $_[0]\n";
154}
155
156sub read_cfg {
157 my ($file) = @_;
158
159 open my $fh, $file
160 or return;
56 161
57 local $/; 162 local $/;
58 $class->new_from_image (<$fh>) 163 my $CFG = <$fh>;
59}
60 164
61sub new_from_surface { 165 if ($CFG =~ /^---/) { ## TODO compatibility cruft, remove
62 my ($class, $surface) = @_; 166 require YAML;
63 167 utf8::decode $CFG;
64 $surface->rgba; 168 $::CFG = YAML::Load ($CFG);
65 169 } elsif ($CFG =~ /^\{/) {
66 $class->_new ( 170 $::CFG = from_json $CFG;
67 data => $surface->pixels,
68 width => $surface->width,
69 height => $surface->height,
70 )
71}
72
73sub upload {
74 my ($self) = @_;
75
76 return unless $SDL::App::USING_OPENGL;
77
78 my ($data, $width, $height);
79
80 if (exists $self->{data}) {
81 ($data, $width, $height) = ($self->{data}, $self->{width}, $self->{height});
82 } else { 171 } else {
83 my $pb = new Gtk2::Gdk::PixbufLoader; 172 $::CFG = eval $CFG; ## todo comaptibility cruft
84 $pb->write ($self->{image});
85 $pb->close;
86
87 $pb = $pb->get_pixbuf;
88 $pb = $pb->add_alpha (0, 0, 0, 0);
89
90 ($data, $width, $height) = ($pb->get_pixels, $pb->get_width, $pb->get_height);
91 } 173 }
174}
92 175
93 ($self->{name}) = @{glGenTextures 1}; 176sub write_cfg {
177 my ($file) = @_;
94 178
95 glBindTexture GL_TEXTURE_2D, $self->{name}; 179 $::CFG->{VERSION} = $::VERSION;
96 180
97 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR; 181 open my $fh, ">:utf8", $file
98 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR;#_MIPMAP_LINEAR; 182 or return;
99 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP; 183 print $fh to_json $::CFG;
100 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP; 184}
185
186sub http_proxy {
187 my @proxy = win32_proxy_info;
188
189 if (@proxy) {
190 "http://" . (@proxy < 2 ? "" : @proxy < 3 ? "$proxy[1]\@" : "$proxy[1]:$proxy[2]\@") . $proxy[0]
191 } elsif (exists $ENV{http_proxy}) {
192 $ENV{http_proxy}
193 } else {
194 ()
195 }
196}
197
198sub set_proxy {
199 my $proxy = http_proxy
200 or return;
201
202 $ENV{http_proxy} = $proxy;
203}
204
205sub lwp_useragent {
206 require LWP::UserAgent;
101 207
102 glTexImage2D GL_TEXTURE_2D, 0, 208 CFPlus::set_proxy;
103 GL_RGBA8,
104 $width, $height,
105 0,
106 GL_RGBA,
107 GL_UNSIGNED_BYTE,
108 $data;
109}
110 209
111sub DESTROY { 210 my $ua = LWP::UserAgent->new (
211 agent => "cfplus $VERSION",
212 keep_alive => 1,
213 env_proxy => 1,
214 timeout => 30,
215 );
216}
217
218sub lwp_check($) {
112 my ($self) = @_; 219 my ($res) = @_;
113 220
114 return unless exists $self->{name}; 221 $res->is_error
222 and die $res->status_line;
115 223
116 glDeleteTextures delete $self->{name}; 224 $res
117} 225}
118 226
119push @::GLINIT, sub { 227sub fh_nonblocking($$) {
120 $_->upload 228 my ($fh, $nb) = @_;
121 for grep $_, @textures; 229
230 if ($^O eq "MSWin32") {
231 $nb = (! ! $nb) + 0;
232 ioctl $fh, 0x8004667e, \$nb; # FIONBIO
233 } else {
234 fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0;
235 }
236
237}
238
239package CFPlus::Layout;
240
241$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {
242 reset_glyph_cache;
122}; 243};
123 244
1241; 2451;
125 246
126=back 247=back

Diff Legend

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