--- deliantra/Deliantra-Client/DC.pm 2006/04/11 17:02:35 1.23 +++ deliantra/Deliantra-Client/DC.pm 2007/12/05 10:51:53 1.159 @@ -1,10 +1,10 @@ =head1 NAME -CFClient - undocumented utility garbage for our crossfire client +CFPlus - undocumented utility garbage for our crossfire client =head1 SYNOPSIS - use CFClient; + use CFPlus; =head1 DESCRIPTION @@ -12,240 +12,234 @@ =cut -package CFClient; +package CFPlus; + +use Carp (); BEGIN { - $VERSION = '0.1'; + $VERSION = '0.9956'; use XSLoader; - XSLoader::load "CFClient", $VERSION; + XSLoader::load "CFPlus", $VERSION; } -our %GL_EXT; -our $GL_VERSION; - -our $GL_NPOT; +use utf8; -sub gl_init { - $GL_VERSION = gl_version * 1; - %GL_EXT = map +($_ => 1), split /\s+/, gl_extensions; +use AnyEvent (); +use Pod::POM (); +use File::Path (); +use Storable (); # finally +use Fcntl (); +use JSON::XS qw(encode_json decode_json); - $GL_NPOT = $GL_EXT{GL_ARB_texture_non_power_of_two} || $GL_VERSION >= 2; +=item guard { BLOCK } - CFClient::Texture::restore_state (); -} +Returns an object that executes the given block as soon as it is destroyed. -sub find_rcfile($) { - my $path; +=cut - for (@INC) { - $path = "$_/CFClient/resources/$_[0]"; - return $path if -r $path; - } +sub guard(&) { + bless \(my $cb = $_[0]), "CFPlus::Guard" +} - die "FATAL: can't find required file $_[0]\n"; +sub CFPlus::Guard::DESTROY { + ${$_[0]}->() } -sub read_cfg { - my ($file) = @_; +=item shorten $string[, $maxlength] - open CFG, $file - or return; +=cut - my $CFG; +sub shorten($;$) { + my ($str, $len) = @_; + substr $str, $len, (length $str), "..." if $len + 3 <= length $str; + $str +} - local $/; - $CFG = eval ; +sub asxml($) { + local $_ = $_[0]; - $::CFG = $CFG; + s/&/&/g; + s/>/>/g; + s/$file" - or return; + ($fh1, $fh2) +} - { - require Data::Dumper; - local $Data::Dumper::Purity = 1; - $::CFG->{VERSION} = $::VERSION; - print CFG Data::Dumper->Dump ([$::CFG], [qw/CFG/]); - } +sub background(&;&) { + my ($bg, $cb) = @_; - close CFG; -} + my ($fh_r, $fh_w) = CFPlus::socketpipe; -package CFClient::Texture; + my $pid = fork; -use Scalar::Util; + if (defined $pid && !$pid) { + local $SIG{__DIE__}; -use SDL::OpenGL; + open STDOUT, ">&", $fh_w; + open STDERR, ">&", $fh_w; + close $fh_r; + close $fh_w; -my @textures; + $| = 1; -sub new { - my ($class, %data) = @_; + eval { $bg->() }; - my $self = bless { - internalformat => GL_RGBA, - format => GL_RGBA, - %data, - }, $class; + if ($@) { + my $msg = $@; + $msg =~ s/\n+/\n/; + warn "FATAL: $msg"; + CFPlus::_exit 1; + } - push @textures, $self; - Scalar::Util::weaken $textures[-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. + CFPlus::_exit 0; + } - $self->upload; + close $fh_w; - $self -} + my $buffer; -sub new_from_image { - my ($class, $image) = @_; + my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub { + unless (sysread $fh_r, $buffer, 4096, length $buffer) { + undef $w; + $cb->(); + return; + } - $class->new (image => $image) + 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): " . CFPlus::asxml $line, + }); + } + } + }); } -sub new_from_file { - my ($class, $path) = @_; - - open my $fh, "<:raw", $path - or die "$path: $!"; +sub background_msg { + my ($msg) = @_; - local $/; - $class->new_from_image (<$fh>) + $msg = "\x{e877}json_msg " . JSON::XS->new->allow_nonref->encode ($msg); + $msg =~ s/\n//g; + utf8::encode $msg; + print $msg, "\n"; } -#sub new_from_surface { -# my ($class, $surface) = @_; -# -# $surface->rgba; -# -# $class->new ( -# data => $surface->pixels, -# width => $surface->width, -# height => $surface->height, -# ) -#} +package CFPlus; -sub new_from_layout { - my ($class, $layout) = @_; +sub find_rcfile($) { + my $path; - my ($w, $h, $data) = $layout->render; + for (grep !ref, @INC) { + $path = "$_/CFPlus/resources/$_[0]"; + return $path if -r $path; + } - $class->new ( - width => $w, - height => $h, - data => $data, - internalformat => GL_ALPHA4, - format => GL_ALPHA, - ) + die "FATAL: can't find required file $_[0]\n"; } -sub new_from_opengl { - my ($class, $w, $h, $cb) = @_; +sub read_cfg { + my ($file) = @_; - $class->new (width => $w, height => $h, rendercb => $cb) -} + open my $fh, $file + or return; -sub topot { - (grep $_ >= $_[0], 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384, 32768)[0] + local $/; + my $CFG = <$fh>; + + if ($CFG =~ /^---/) { ## TODO compatibility cruft, remove + require YAML; + utf8::decode $CFG; + $::CFG = YAML::Load ($CFG); + } elsif ($CFG =~ /^\{/) { + $::CFG = decode_json $CFG; + } else { + $::CFG = eval $CFG; ## todo comaptibility cruft + } } -sub upload { - my ($self) = @_; +sub write_cfg { + my ($file) = @_; - return unless $SDL::App::USING_OPENGL; + $::CFG->{VERSION} = $::VERSION; - my $data; + open my $fh, ">:utf8", $file + or return; + print $fh encode_json $::CFG; +} - if (exists $self->{data}) { - $data = $self->{data}; - } elsif (exists $self->{rendercb}) { - glViewport 0, 0, $self->{width}, $self->{height}; - glMatrixMode GL_PROJECTION; - glLoadIdentity; - glOrtho 0, $self->{width}, 0, $self->{height}, -10000, 10000; - glMatrixMode GL_MODELVIEW; - glPushmatrix; - glLoadIdentity; - glClear GL_COLOR_BUFFER_BIT; +sub http_proxy { + my @proxy = win32_proxy_info; - $self->{rendercb}->($self, $self->{width}, $self->{height}); + if (@proxy) { + "http://" . (@proxy < 2 ? "" : @proxy < 3 ? "$proxy[1]\@" : "$proxy[1]:$proxy[2]\@") . $proxy[0] + } elsif (exists $ENV{http_proxy}) { + $ENV{http_proxy} } else { - my $pb = new Gtk2::Gdk::PixbufLoader; - $pb->write ($self->{image}); - $pb->close; + () + } +} - $pb = $pb->get_pixbuf; - $pb = $pb->add_alpha (0, 0, 0, 0); +sub set_proxy { + my $proxy = http_proxy + or return; - $self->{width} = $pb->get_width; - $self->{height} = $pb->get_height; + $ENV{http_proxy} = $proxy; +} - $data = $pb->get_pixels; - } +sub lwp_useragent { + require LWP::UserAgent; + + CFPlus::set_proxy; - my ($tw, $th) = @$self{qw(width height)}; + my $ua = LWP::UserAgent->new ( + agent => "cfplus $VERSION", + keep_alive => 1, + env_proxy => 1, + timeout => 30, + ); +} - unless ($GL_NPOT && $tw && $th) { - $tw = topot $tw; - $th = topot $th; - - if (defined $data) { - my $bpp = (length $data) / ($self->{width} * $self->{height}); - $data = pack "(a" . ($tw * $bpp) . ")*", - unpack "(a" . ($self->{width} * $bpp) . ")*", $data; - $data .= ("\x00" x ($tw * $bpp)) x ($th - $self->{height}); - } - } +sub lwp_check($) { + my ($res) = @_; - $self->{s} = $self->{width} / $tw; - $self->{t} = $self->{height} / $th; + $res->is_error + and die $res->status_line; - $self->{name} ||= (glGenTextures 1)->[0]; + $res +} - glBindTexture GL_TEXTURE_2D, $self->{name}; +sub fh_nonblocking($$) { + my ($fh, $nb) = @_; - glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR; - glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR;#_MIPMAP_LINEAR; - glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP; - glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP; - - glGetError; - if (defined $data) { - glTexImage2D GL_TEXTURE_2D, 0, - $self->{internalformat}, - $tw, $th, # need to pad texture first - 0, - $self->{format}, - GL_UNSIGNED_BYTE, - $data; - glGetError and die; + if ($^O eq "MSWin32") { + $nb = (! ! $nb) + 0; + ioctl $fh, 0x8004667e, \$nb; # FIONBIO } else { - glCopyTexImage2D GL_TEXTURE_2D, 0, - $self->{internalformat}, - 0, 0, - $tw, $th, - 0; - glPopmatrix; + fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0; } -} -sub DESTROY { - my ($self) = @_; - - return unless exists $self->{name}; - - glDeleteTextures delete $self->{name}; } -sub restore_state{ - $_->upload - for grep $_, @textures; +package CFPlus::Layout; + +$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub { + reset_glyph_cache; }; 1;