[ViewVC] Contents of: cvs/deliantra/Deliantra-Client/bin/pclient

#!/opt/bin/perl

use strict;
use utf8;

BEGIN {
   if (%PAR::LibCache) {
      @INC = grep ref, @INC; # weed out all paths except pars loader refs

      while (my ($filename, $zip) = each %PAR::LibCache) {
         for ($zip->memberNames) {
            next unless /^\/root\/(.*)/;
            $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")
               unless -e "$ENV{PAR_TEMP}/$1";
         }
      }

      unshift @INC, $ENV{PAR_TEMP};

      if ($^O eq "MSWin32") {
         $ENV{GTK_RC_FILES} = "$ENV{PAR_TEMP}/share/themes/MS-Windows/gtk-2.0/gtkrc";
      }
   }
}

# need to do it again because that pile of garbage called PAR nukes it before main
unshift @INC, $ENV{PAR_TEMP};

use Time::HiRes 'time';
use Event;

use Crossfire;
use Crossfire::Protocol;

use Compress::LZF;

use CFClient;
use CFClient::UI;
use CFClient::MapWidget;

$Event::DIED = sub {
   CFClient::error $_[1];
};

#$SIG{__WARN__} = sub { Carp::cluck  $_[0] };#d#

our $VERSION = '0.1';

my $MAX_FPS = 60;
my $MIN_FPS =  5; # unused as of yet

our $META_SERVER = "crossfire.real-time.com:13326";

our $FACEMAP;
our $TILECACHE;
our $MAPCACHE;

our $LAST_REFRESH;
our $NOW;

our $CFG;
our $CONN;
our $FAST; # fast, low-quality mode, possibly useful for software-rendering

our @SDL_MODES;
our $WIDTH;
our $HEIGHT;
our $FULLSCREEN;
our $FONTSIZE;

our $FONT_PROP;
our $FONT_FIXED;

our $MAP;
our $MAPWIDGET;
our $BUTTONBAR;
our $LOGVIEW;
our $CONSOLE;
our $METASERVER;

our $FLOORBOX;
our $GAUGES;
our $STATWIDS;

our $SDL_ACTIVE;
our %SDL_CB;

our $SDL_MIXER;
our @SOUNDS;       # event => file mapping
our %AUDIO_CHUNKS; # audio files

our $ALT_ENTER_MESSAGE;
our $STATUS_LINE;
our $DEBUG_STATUS;

sub status {
   $STATUS_LINE->set_text ($_[0]);
   $STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h});
}

sub debug {
   $DEBUG_STATUS->set_text ($_[0]);
   $DEBUG_STATUS->move ($WIDTH - $DEBUG_STATUS->{w}, 0, $DEBUG_STATUS->{w}, $DEBUG_STATUS->{h});
}

sub start_game {
   status "logging in...";

   my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;

   $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";

   $MAP = new CFClient::Map $mapsize, $mapsize;

   my ($host, $port) = split /:/, $CFG->{host};
   
   $CONN = new conn
      host => $host,
      port => $port || 13327,
      user => $CFG->{user},
      pass => $CFG->{password},
      mapw => $mapsize,
      maph => $mapsize,
   ;

   status "login successful";

   CFClient::lowdelay fileno $CONN->{fh};
}

sub stop_game {
   undef $CONN;
}

sub client_setup {
   my $dialog = new CFClient::UI::FancyFrame
      title => "Client Setup",
      child => (my $vbox = new CFClient::UI::VBox);
   $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);

   $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
   $table->add (1, 0, my $hbox = new CFClient::UI::HBox);

   $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);
   $hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");

   $mode_slider->connect (changed => sub {
      my ($self, $value) = @_;

      $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
      $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
   });
   $mode_slider->emit (changed => $mode_slider->{range}[0]);

   my $row = 1;

   $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
   $table->add (1, $row++, new CFClient::UI::CheckBox
      state => $CFG->{fullscreen},
      tooltip => "Bring the client into fullscreen mode",
      connect_changed => sub {
         my ($self, $value) = @_;
         $CFG->{fullscreen} = $value;
      }
   );

   $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
   $table->add (1, $row++, new CFClient::UI::CheckBox
      state => $CFG->{fast},
      tooltip => "Lower the visual quality considerably to speed up rendering.",
      connect_changed => sub {
         my ($self, $value) = @_;
         $CFG->{fast} = $value;
      }
   );

   $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
   $table->add (1, $row++, new CFClient::UI::Slider
      range => [$CFG->{map_scale}, 0.25, 2, 0.05],
      tooltip => "Enlarge or shrink the displayed map",
      connect_changed => sub {
         my ($self, $value) = @_;
         $CFG->{map_scale} = 0.05 * int $value / 0.05;
      }
   );

   $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
   $table->add (1, $row++, new CFClient::UI::CheckBox
      state => $CFG->{fow_enable},
      tooltip => "Fog-of-War marks areas that cannot be seen by the player",
      connect_changed => sub {
         my ($self, $value) = @_;
         $CFG->{fow_enable} = $value;
      }
   );

   $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
   $table->add (1, $row++, new CFClient::UI::Slider
      range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001],
      tooltip => "The higher the intensity, the lighter the Fog-of-War color",
      connect_changed => sub {
         my ($self, $value) = @_;
         $CFG->{fow_intensity} = $value;
      }
   );

   $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
   $table->add (1, $row++, new CFClient::UI::CheckBox
      state => $CFG->{fow_smooth},
      tooltip => "Smooth the Fog-of-War a bit to make it more realistic",
      connect_changed => sub {
         my ($self, $value) = @_;
         $CFG->{fow_smooth} = $value;
         status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;
      }
   );

   $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
   $table->add (1, $row++, new CFClient::UI::Slider
      range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1],
      tooltip => "The font size used by most GUI elements",
      connect_changed => sub {
         $CFG->{gui_fontsize} = 0.1 * int $_[1] * 10;
#      $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
      }
   );

   $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize");
   $table->add (1, $row++, new CFClient::UI::Slider
      range => [$CFG->{log_fontsize}, 0.5, 2, 0.1],
      tooltip => "The font size used by the server log window only",
      connect_changed => sub {
         $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10);
      }
   );

   $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");

   $table->add (1, $row++, new CFClient::UI::Slider
      range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1],
      tooltip => "The font size used by the statistics window only",
      connect_changed => sub {
         $CFG->{stat_fontsize} = 0.1 * int $_[1] * 10;
         &set_stats_window_fontsize;
      }
   );

   $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
   $table->add (1, $row++, new CFClient::UI::Slider
      range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],
      tooltip => "Adjust the size of the stats gauges at the bottom right",
      connect_changed => sub {
         $CFG->{gauge_size} = $_[1];
         my $h = int $HEIGHT * $CFG->{gauge_size};
         $GAUGES->{win}->set_size ($WIDTH, $h);
         $GAUGES->{win}->move (0, $HEIGHT - $h);
      }
   );

   $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
   $table->add (1, $row++, new CFClient::UI::Slider
      range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1],
      tooltip => "Adjusts the fontsize of the gauges at the bottom right",
      connect_changed => sub {
         $CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10;
         &set_gauge_window_fontsize;
      }
   );

   $table->add (1, $row++, new CFClient::UI::Button
      expand => 1, align => 0, text => "Apply",
      tooltip => "Apply the video settings",
      connect_activate => sub {
         video_shutdown ();
         video_init ();
      }
   );

   $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
   $table->add (1, $row++, new CFClient::UI::CheckBox
      state => $CFG->{audio_enable},
      tooltip => "If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
      connect_changed => sub {
         $CFG->{audio_enable} = $_[1];
      }
   );
#   $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
#   $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub {
#      $CFG->{effects_volume} = $_[1];
#   });
   $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
   $table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
   $hbox->add (new CFClient::UI::CheckBox
      expand => 1, state => $CFG->{bgm_enable},
      tooltip => "Enable background music playing",
      connect_changed => sub {
         $CFG->{bgm_enable} = $_[1];
      }
   );
   $hbox->add (new CFClient::UI::Slider
      expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1],
      tooltip => "The volume of the background music",
      connect_changed => sub {
         $CFG->{bgm_volume} = $_[1];
         CFClient::MixMusic::volume $_[1] * 128;
      }
   );

   $table->add (1, $row++, new CFClient::UI::Button
      expand => 1, align => 0, text => "Apply",
      tooltip => "Apply the audio settings",
      connect_activate => sub {
         audio_shutdown ();
         audio_init ();
      }
   );

   $dialog
}

sub set_stats_window_fontsize {
   for (values %{$STATWIDS}) {
      $_->set_fontsize ($::CFG->{stat_fontsize});
   }
}

sub set_gauge_window_fontsize {
   for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
      $_->set_fontsize ($::CFG->{gauge_fontsize});
   }

#   local $GAUGES->{win}{parent};#d#
#   use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D;
}

sub make_gauge_window {
   my $gh = int ($HEIGHT * $CFG->{gauge_size});
#   my $gw = int ($WIDTH * $CFG->{gauge_w_size});

   my $win = new CFClient::UI::Frame (
      y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh
   );
   $win->add (my $hbox = new CFClient::UI::HBox
      children => [
         (new CFClient::UI::HBox expand => 1),
         ($FLOORBOX = new CFClient::UI::VBox),
         (my $vbox = new CFClient::UI::VBox),
      ],
   );

   $vbox->add (new CFClient::UI::HBox
      expand => 1,
      children => [
         (new CFClient::UI::Empty expand => 1),
         (my $hb = new CFClient::UI::HBox),
      ],
   );

   $hb->add (my $hg = new CFClient::UI::Gauge type => 'hp',
      tooltip => "Health points - depletes when you get wounded, refills when you heal or idle");
   $hb->add (my $mg = new CFClient::UI::Gauge type => 'mana',
      tooltip => "Spell points - deplete when you cast wizard spells, refills when you idle");
   $hb->add (my $gg = new CFClient::UI::Gauge type => 'grace',
      tooltip => "Grace points - deplete when you cast priest spells, refills when you pray");
   $hb->add (my $fg = new CFClient::UI::Gauge type => 'food',
      tooltip => "Food - depletes with time, faster when you heal or build mana, refills when you eat healthy food");

   $vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
      tooltip => "Experience points and level - increases when you kill monsters or successfully use skills");
   $vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
      tooltip => "Ranged attack - how you attack when you press shift-cursor (spell, skill, weapon etc.)");

   $GAUGES = {
      exp => $exp, win => $win, range => $rng,
      food => $fg, mana => $mg, hp => $hg, grace => $gg
   };

   &set_gauge_window_fontsize;

   $win
}

sub make_stats_window {
   my $tgw = new CFClient::UI::FancyFrame (x => $WIDTH * 2/5, y => 0, title => "Stats");

   $tgw->add (my $vb = new CFClient::UI::VBox);
   $vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);
   $vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1);

   $vb->add (my $hb = new CFClient::UI::HBox expand => 1);

   $hb->add (my $tbl = new CFClient::UI::Table expand => 1);

   my $black = [0, 0, 0];

   $tbl->add (0, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
   $tbl->add (0, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
   $tbl->add (0, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
   $tbl->add (0, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
   $tbl->add (0, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
   $tbl->add (0, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
   $tbl->add (0, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => +1, template => "30");

   $tbl->add (1, 0, $STATWIDS->{st_str_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Str");
   $tbl->add (1, 1, $STATWIDS->{st_dex_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Dex");
   $tbl->add (1, 2, $STATWIDS->{st_con_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Con");
   $tbl->add (1, 3, $STATWIDS->{st_int_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Int");
   $tbl->add (1, 4, $STATWIDS->{st_wis_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Wis");
   $tbl->add (1, 5, $STATWIDS->{st_pow_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Pow");
   $tbl->add (1, 6, $STATWIDS->{st_cha_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Cha");

   $tbl->add (2, 0, $STATWIDS->{st_wc}   = new CFClient::UI::Label valign => 0, align => +1, template => "-120");
   $tbl->add (2, 1, $STATWIDS->{st_ac}   = new CFClient::UI::Label valign => 0, align => +1, template => "-120");
   $tbl->add (2, 2, $STATWIDS->{st_dam}  = new CFClient::UI::Label valign => 0, align => +1, template => "120");
   $tbl->add (2, 3, $STATWIDS->{st_arm}  = new CFClient::UI::Label valign => 0, align => +1, template => "120");
   $tbl->add (2, 4, $STATWIDS->{st_spd}  = new CFClient::UI::Label valign => 0, align => +1, template => "10.54");
   $tbl->add (2, 5, $STATWIDS->{st_wspd} = new CFClient::UI::Label valign => 0, align => +1, template => "9");

   $tbl->add (3, 0, $STATWIDS->{st_wc_lbl}   = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Wc");
   $tbl->add (3, 1, $STATWIDS->{st_ac_lbl}   = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Ac");
   $tbl->add (3, 2, $STATWIDS->{st_dam_lbl}  = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Dam");
   $tbl->add (3, 3, $STATWIDS->{st_arm_lbl}  = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Arm");
   $tbl->add (3, 4, $STATWIDS->{st_spd_lbl}  = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Sp");
   $tbl->add (3, 5, $STATWIDS->{st_wspd_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "WSp");

   $hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);

   my $row = 0;
   my $col = 0;

   my %resist_names = (
      slow  => "Slow",
      holyw => "Holy Word",
      conf  => "Confusion",
      fire  => "Fire",
      depl  => "Depletion",
      magic => "Magic",
      drain => "Draining",
      acid  => "Acid",
      pois  => "Poison",
      para  => "Paralysation",
      deat  => "Death",
      phys  => "Physical",
      blind => "Blind",
      fear  => "Fear",
      tund  => "Turn undead",
      elec  => "Electricity",
      cold  => "Cold",
      ghit  => "Ghost hit",
   );
   for (qw/slow holyw conf fire depl magic
           drain acid pois para deat phys
           blind fear tund elec cold ghit/)
   {
      $tbl2->add ($col, $row,
         $STATWIDS->{"res_$_"} =
            new CFClient::UI::Label
               template => "-100%",
               align => +1,
               valign => 0,
               tooltip => $resist_names{$_}
      );
      $tbl2->add ($col + 1, $row, new CFClient::UI::Image
         can_hover => 1,
         can_events => 1,
         image => "ui/resist/resist_$_.png",
         tooltip => $resist_names{$_}
      );

      $row++;
      if ($row % 6 == 0) {
         $col += 2;
         $row = 0;
      }
   }

   &set_stats_window_fontsize;
   update_stats_window ({});

   $tgw
}

sub formsep {
   reverse join ",", grep length, split /(...)/, reverse $_[0] * 1
}

sub update_stats_window {
   my ($stats) = @_;

   # i love text protocols!!!
   my $hp   = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;
   my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;
   my $sp   = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;
   my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;
   my $fo   = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;
   my $fo_m = 999;
   my $gr   = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;
   my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;

   $GAUGES->{hp}      ->set_value ($hp, $hp_m);
   $GAUGES->{mana}    ->set_value ($sp, $sp_m);
   $GAUGES->{food}    ->set_value ($fo, $fo_m);
   $GAUGES->{grace}   ->set_value ($gr, $gr_m);
   $GAUGES->{exp}     ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})
                                  . " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");
   my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};
   $rng =~ s/^Range: //;    # thank you so much dear server
   $GAUGES->{range}   ->set_text ("Rng: "  . $rng);
   my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};
   $title =~ s/^Player: //;
   $STATWIDS->{title} ->set_text ("Title: " . $title);

   $STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});
   $STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});
   $STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});
   $STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});
   $STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});
   $STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});
   $STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});
   $STATWIDS->{st_wc}  ->set_text (sprintf "%d", $stats->{13});
   $STATWIDS->{st_ac}  ->set_text (sprintf "%d", $stats->{14});
   $STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});
   $STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});
   $STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});
   $STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP});

   my %tbl = (
      phys  => 100,
      magic => 101,
      fire  => 102,
      elec  => 103,
      cold  => 104,
      conf  => 105,
      acid  => 106,
      drain => 107,
      ghit  => 108,
      pois  => 109,
      slow  => 110,
      para  => 111,
      tund  => 112,
      fear  => 113,
      depl  => 113,
      deat  => 115,
      holyw => 116,
      blind => 117
   );

   for (keys %tbl) {
      $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});
   }

}

sub metaserver_dialog {
   my $dialog = new CFClient::UI::FancyFrame
      title => "Metaserver",
      child => (my $vbox = new CFClient::UI::VBox);

   $vbox->add ($dialog->{table} = new CFClient::UI::Table);

   $dialog
}

sub update_metaserver {
   my ($HOST) = @_;

   my $table = $METASERVER->{table};
   $table->clear;
   $table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching metaserver list...");

   my $buf;

   my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;

   unless ($fh) {
      $label->set_text ("unable to contact metaserver: $!");
      return;
   }

   Event->io (fd => $fh, poll => 'r', cb => sub {
      my $res = sysread $fh, $buf, 8192, length $buf;

      if (!defined $res) {
         $_[0]->w->cancel;
         $label->set_text ("error while retrieving server list: $!");
      } elsif ($res == 0) {
         $_[0]->w->cancel;
         status "server list retrieved";

         utf8::decode $buf if utf8::valid $buf;

         $table->clear;

         my @col = qw(Use #Users Host Uptime Version Description);
         $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
            for 0 .. $#col;

         my @align = qw(1 0 1 1 -1);

         my $y = 0;
         for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
            my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;

            for ($desc) {
               s/<br>/\n/gi;
               s/<li>/\n· /gi;
               s/<.*?>//sgi;
               s/&/&amp;/g;
               s/</&lt;/g;
               s/>/&gt;/g;
            }

            $uptime = sprintf "%dd %02d:%02d:%02d",
               (int $m->[8] / 86400),
               (int $m->[8] / 3600) % 24,
               (int $m->[8] / 60) % 60,
               $m->[8] % 60;

            $m = [$users, $host, $uptime, $version, $desc];

            $y++;

            $table->add (0, $y, new CFClient::UI::VBox children => [
               (new CFClient::UI::Button text => "Use", connect_activate => sub {
                  $HOST->set_text ($CFG->{host} = $host);
               }),
               (new CFClient::UI::Empty expand => 1),
            ]);
            
            $table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => 0.8)
               for 0 .. $#$m;
         }
      }
   });
}

sub server_setup {
   my $dialog = new CFClient::UI::FancyFrame
      title => "Server Setup",
      child => (my $vbox = new CFClient::UI::VBox);
   
   $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
   $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");

   {
      $table->add (1, 2, my $vbox = new CFClient::UI::VBox);

      $vbox->add (
         my $HOST = new CFClient::UI::Entry
            expand => 1,
            text => $CFG->{host},
            tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
            connect_changed => sub {
               my ($self, $value) = @_;
               $CFG->{host} = $value;
            }
      );

      $METASERVER = metaserver_dialog;

      $vbox->add (new CFClient::UI::Flopper
         expand => 1,
         text => "Metaserver",
         other => $METASERVER,
         tooltip => "Show a list of avaible crossfire servers",
         connect_open => sub {
            update_metaserver $HOST;
         }
      );
   }

   $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
   $table->add (1, 4, new CFClient::UI::Entry
      text => $CFG->{user},
      tooltip => "The name of your character on the server",
      connect_changed => sub {
         my ($self, $value) = @_;
         $CFG->{user} = $value;
      }
   );

   $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
   $table->add (1, 5, new CFClient::UI::Entry
      text => $CFG->{password},
      hidden => 1,
      tooltip => "The password for your character",
      connect_changed => sub {
         my ($self, $value) = @_;
         $CFG->{password} = $value;
      }
   );

   $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");
   $table->add (1, 6, my $saycmd = new CFClient::UI::Entry
      text => $CFG->{say_command},
      tooltip => "This is the command that will be used if you write a line in the message window entry. "
                 ."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
                 ."But you could also set it to 'tell &lt;playername&gt;' to only chat with that user.",
      connect_changed => sub {
         my ($self, $value) = @_;
         $CFG->{say_command} = $value;
      }
   );

   $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
   $table->add (1, 7, new CFClient::UI::Slider
      req_w => 100,
      range => [$CFG->{mapsize}, 10, 100 + 1, 1],
      tooltip => "This is the size of the portion of the map update the server sends you. "
                ."If you set this to a high value you will be able to see further for example.",
      connect_changed => sub {
         my ($self, $value) = @_;

         $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
      },
   );

   $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub {
      start_game;
   });

   $dialog
}

sub message_window {
   my $window = new CFClient::UI::FancyFrame
      title     => "Messages",
      border_bg => [1, 1, 1, 0.5],
      bg        => [0.3, 0.3, 0.3, 0.8],
      user_w    => int $::WIDTH  / 3,
      user_h    => int $::HEIGHT / 5,
      child     => (my $vbox = new CFClient::UI::VBox);

   $vbox->add ($LOGVIEW = new CFClient::UI::TextView
      expand   => 1,
      font     => $FONT_FIXED,
      fontsize => $::CFG->{log_fontsize},
   );

   $vbox->add (my $input = new CFClient::UI::Entry
      connect_focus_in => sub {
         my ($input, $prev_focus) = @_;

         delete $input->{refocus_map};

         if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
            $input->{refocus_map} = 1;
         }
         delete $input->{auto_activated};
      },
      connect_activate => sub {
         my ($input, $text) = @_;
         $input->set_text ('');

         if ($text =~ /^\/(.*)/) {
            $::CONN->user_send ($1);
         } else {
            my $say_cmd = $::CFG->{say_command} || 'say';
            $::CONN->user_send ("$say_cmd $text");
         }
         if ($input->{refocus_map}) {
            delete $input->{refocus_map};
            $MAPWIDGET->focus_in
         }
      },
      connect_escape => sub {
         $MAPWIDGET->focus_in
      },
   );

   $CONSOLE = {
      window => $window,
      input => $input
   };

   $window
}

sub sdl_init {
   CFClient::SDL_Init
      and die "SDL::Init failed!\n";
}

sub video_init {
   sdl_init;

   ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
   $FULLSCREEN = $CFG->{fullscreen};
   $FAST       = $CFG->{fast};

   CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
      or die "SDL_SetVideoMode failed!\n";

   $SDL_ACTIVE = 1;

   $LAST_REFRESH = time - 0.01;

   CFClient::gl_init;

   $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};

   #############################################################################

   $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100;
   $DEBUG_STATUS->show;
   
   $STATUS_LINE = new CFClient::UI::Label
                     padding => 0,
                     y => $HEIGHT - $FONTSIZE * 1.8;
   $STATUS_LINE->show;

   $ALT_ENTER_MESSAGE = new CFClient::UI::Label
                           padding  => 0,
                           fontsize => 0.8,
                           markup   => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
   $ALT_ENTER_MESSAGE->show;
   $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});

   $CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::MapWidget);
   $MAPWIDGET->focus_in;
   $MAPWIDGET->connect (activate_console => sub {
      my ($mapwidget, $preset) = @_;

      if ($CONSOLE) {
         $CONSOLE->{input}->{auto_activated} = 1;
         $CONSOLE->{input}->focus_in;

         if ($preset && $CONSOLE->{input}->get_text eq '') {
            $CONSOLE->{input}->set_text ($preset);
         }
      }
   });

   $CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox);

   $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup",   other => client_setup);
   $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup",   other => server_setup);
   $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);

   $CFClient::UI::ROOT->add (make_gauge_window); # XXX: this has to be set before make_stats_window as make_stats_window calls update_stats_window which updated the gauges also X-D
   $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);

   $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
      CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
      status "Configuration Saved";
   });

   $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
}

sub video_shutdown {
   $CFClient::UI::ROOT->{children} = [];
   undef $CFClient::UI::GRAB;
   undef $CFClient::UI::HOVER;
   undef $SDL_ACTIVE;
}

my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
my $bgmusic;#TODO#hack#d#

sub audio_music_finished {
   return unless $CFG->{bgm_enable};

   # TODO: hack, do play loop and mood music
   $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
   $bgmusic->play (0);

   push @bgmusic, shift @bgmusic;
}

sub audio_init {
   if ($CFG->{audio_enable}) {
      if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") {
         $SDL_MIXER = !CFClient::Mix_OpenAudio;
         CFClient::Mix_AllocateChannels 8;
         CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;

         audio_music_finished;

         while (<$fh>) {
            next if /^\s*#/;
            next if /^\s*$/;

            my ($file, $volume, $event) = split /\s+/, $_, 3;

            push @SOUNDS, "$volume,$file";

            $AUDIO_CHUNKS{"$volume,$file"} ||= do {
               my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
               $chunk->volume ($volume * 128 / 100);
               $chunk
            };
         }
      } else {
         status "unable to open sound config: $!";
      }
   }
}

sub audio_shutdown {
   CFClient::Mix_CloseAudio if $SDL_MIXER;
   undef $SDL_MIXER;
   @SOUNDS = ();
   %AUDIO_CHUNKS = ();
}

my %animate_object;
my $animate_timer;

my $want_refresh;
my $can_refresh;

my $fps = 9;

sub force_refresh {
   $fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05;
   debug sprintf "%3.2f", $fps;

   $want_refresh = 0;
   $can_refresh = 0;

   $CFClient::UI::ROOT->draw;

   CFClient::SDL_GL_SwapBuffers;

   $LAST_REFRESH = $NOW;
}

my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
   $NOW = time;

   ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
      for CFClient::SDL_PollEvent;

   if (%animate_object) {
      $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
      $want_refresh++;
   }

   if ($want_refresh) {
      force_refresh;
   } else {
      $can_refresh = 1;
   }
});

sub refresh {
   $want_refresh++;
}

sub animation_start {
   my ($widget) = @_;
   $animate_object{$widget} = $widget;
}

sub animation_stop {
   my ($widget) = @_;
   delete $animate_object{$widget};
}

@conn::ISA = Crossfire::Protocol::;

sub conn::stats_update {
   my ($self, $stats) = @_;

   update_stats_window ($stats);
}

sub conn::user_send {
   my ($self, $command) = @_;

   $self->send_command ($command);
   status $command;
}

sub conn::map_scroll {
   my ($self, $dx, $dy) = @_;

   $MAP->scroll ($dx, $dy);
}

sub conn::feed_map1a {
   my ($self, $data) = @_;

#   $self->Crossfire::Protocol::feed_map1a ($data);

   $MAP->map1a_update ($data);
   $MAPWIDGET->update;
}

sub conn::flush_map {
   my ($self) = @_;

   my $map_info = delete $self->{map_info}
      or return;

   my ($hash, $x, $y, $w, $h) = @$map_info;

   my $data = $MAP->get_rect ($x, $y, $w, $h);
   $MAPCACHE->put ($hash => Compress::LZF::compress $data);
   #warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
}

sub conn::map_clear {
   my ($self) = @_;

   $self->flush_map;
   delete $self->{neigh_map};

   $MAP->clear;
}


sub conn::load_map($$$) {
   my ($self, $hash, $x, $y) = @_;

   if (defined (my $data = $MAPCACHE->get ($hash))) {
      $data = Compress::LZF::decompress $data;
      #warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
      for my $id ($MAP->set_rect ($x, $y, $data)) {
         my $data = $TILECACHE->get ($id)
            or next;

         $self->set_texture ($id => $data);
      }
   }
}

# this method does a "flood fill" into every tile direction
# it assumes that tiles are arranged in a rectangular grid,
# i.e. a map is the same as the left of the right map etc.
# failure to comply are harmless and result in display errors
# at worst.
sub conn::flood_fill {
   my ($self, $gx, $gy, $path, $hash, $flags) = @_;

   # the server does not allow map paths > 6
   return if 6 <= length $path;

   my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};

   for (
      [1,  0, -1],
      [2,  1,  0],
      [3,  0,  1],
      [4, -1,  0],
   ) {
      my ($tile, $dx, $dy) = @$_;

      my $gx = $gx + $dx;
      my $gy = $gy + $dy;

      next unless $flags & (1 << ($tile - 1));
      next if $self->{neigh_grid}{$gx, $gy}++;

      my $neigh = $self->{neigh_map}{$hash} ||= [];
      if (my $info = $neigh->[$tile]) {
         my ($flags, $x, $y, $w, $h, $hash) = @$info;

         $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
            if $x >= $x0 && $x + $w < $x1 && $y >= $y0  && $y + $h < $y1;

      } else {
         $self->send_mapinfo ("spatial $path$tile", sub {
            my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;

            return if $mode ne "spatial";

            $x += $MAP->ox;
            $y += $MAP->oy;
            
            $self->load_map ($hash, $x, $y)
               unless $self->{neigh_map}{$hash}[5]++;#d#

            $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];

            $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
               if $x >= $x0 && $x + $w < $x1 && $y >= $y0  && $y + $h < $y1;
         });
      }
   }
}

sub conn::map_change {
   my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;

   $self->flush_map;

   my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);

   my $mapmapw = 250;
   my $mapmaph = 250;

   $self->{neigh_rect} = [
      $ox - $mapmapw * 0.5,      $oy - $mapmapw * 0.5,
      $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
   ];
   
   delete $self->{neigh_grid};
   $self->flood_fill (0, 0, "", $hash, $flags);

   $x += $ox;
   $y += $oy;

   $self->{map_info} = [$hash, $x, $y, $w, $h];

   my $map = $self->{map_info}[0];
   $map =~ s/^.*?\/([^\/]+)$/\1/;
   $STATWIDS->{map}->set_text ("Map: " . $map);

   $self->load_map ($hash, $x, $y);
}

sub conn::face_find {
   my ($self, $facenum, $face) = @_;

   my $hash = "$face->{chksum},$face->{name}";

   my $id = $FACEMAP->get ($hash);

   unless ($id) {
      # create new id for face
      # i love transactions
      for (1..100) {
         my $txn = $CFClient::DB_ENV->txn_begin;
         my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
         if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
            $id++;
            if ($FACEMAP->put (id => $id) == 0
                && $FACEMAP->put ($hash => $id) == 0) {
               $txn->txn_commit;

               goto gotid;
            }
         }
         $txn->abort;
      }

      CFClient::fatal "maximum number of transaction retries reached - database problems?";
   }

gotid:
   $face->{id} = $id;
   $MAP->set_face ($facenum => $id);
   $self->{faceid}[$facenum] = $id;#d#
   $TILECACHE->get ($id)
}

sub conn::face_update {
   my ($self, $facenum, $face) = @_;

   $TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes

   $self->set_texture ($face->{id} => delete $face->{image});
}

sub conn::set_texture {
   my ($self, $id, $data) = @_;

   $self->{texture}[$id] ||= do {
      my $tex =
         new_from_image CFClient::Texture
            $data, minify => 1, mipmap => 1;

      $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
      $MAPWIDGET->update;

      $tex
   };
}

sub conn::sound_play {
   my ($self, $x, $y, $soundnum, $type) = @_;

   $SDL_MIXER
      or return;

   my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
      or return;

   $chunk->play;
#   warn "sound $x,$y,$soundnum,$type\n";#d#
}

my $LAST_QUERY; # server is stupid, stupid, stupid

sub conn::query {
   my ($self, $flags, $prompt) = @_;

   $prompt = $LAST_QUERY unless length $prompt;
   $LAST_QUERY = $prompt;

   my $dialog = new CFClient::UI::FancyFrame
      title => "Query",
      child => my $vbox = new CFClient::UI::VBox;

   $vbox->add (new CFClient::UI::Label
      max_w => $::WIDTH * 0.4,
      text => $prompt);

   if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
      $vbox->add (my $hbox = new CFClient::HBox);
      $hbox->add (new CFClient::Button
         text => "No",
         connect_activate => sub {
            $self->send ("reply n");
            $dialog->destroy;
            $MAPWIDGET->focus_in;
         }
      );
      $hbox->add (new CFClient::Button
         text => "Yes",
         connect_activate => sub {
            $self->send ("reply y");
            $dialog->destroy;
            $MAPWIDGET->focus_in;
         },
      );

      $dialog->focus_in;

   } elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
      $dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
      $vbox->add (my $entry = new CFClient::UI::Entry
         connect_changed => sub {
            $self->send ("reply $_[1]");
            $dialog->destroy;
            $MAPWIDGET->focus_in;
         },
      );

      $entry->focus_in;

   } else {
      $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";

      $vbox->add (my $entry = new CFClient::UI::Entry
         $flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
         connect_activate => sub {
            $self->send ("reply $_[1]");
            $dialog->destroy;
            $MAPWIDGET->focus_in;
         },
      );

      $entry->focus_in;
   }

   $dialog->show;
}

sub conn::drawinfo {
   my ($self, $color, $text) = @_;

   my @color = (
      [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
      [1.00, 1.00, 1.00],
      [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
      [1.00, 0.00, 0.00],
      [1.00, 0.54, 0.00],
      [0.11, 0.56, 1.00],
      [0.93, 0.46, 0.00],
      [0.18, 0.54, 0.34],
      [0.56, 0.73, 0.56],
      [0.80, 0.80, 0.80],
      [0.55, 0.41, 0.13],
      [0.99, 0.77, 0.26],
      [0.74, 0.65, 0.41],
   );

   $LOGVIEW->add_paragraph ($color[$color], $text);
}

sub conn::spell_add {
   my ($self, $spell) = @_;

   # TODO
   # create a widget dynamically, using spell face (CF::Protocol downloads them)
   $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message});
   $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message});
}

sub conn::spell_delete {
   my ($self, $spell) = @_;
}

sub conn::addme_success {
   my ($self) = @_;

   for my $skill (values %{$self->{skill_info}}) {
      $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");
      $MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");
   }
}

sub update_floorbox {
   $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
      $FLOORBOX->clear;
      $FLOORBOX->add (new CFClient::UI::Empty expand => 1);

      my @items = values %{ $CONN->{container}{0} };

      # we basically have to use the same sorting as everybody else
      @items = sort { $a->{type} <=> $b->{type} } @items;

      for my $item (reverse @items) {
         my $desc = $item->{nrof} < 2
            ? $item->{name}
            : "$item->{nrof} $item->{name_pl}";
         # todo: animation widget, face widget, weight(?) etc.
         $FLOORBOX->add (my $hbox = new CFClient::UI::HBox
            tooltip => (CFClient::UI::Label->escape ($desc)
                        . "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
            can_hover  => 1,
            can_events => 1,
            connect_button_down => sub {
               my ($self, $ev, $x, $y) = @_;

               # todo: maybe put examine on 1? but should just be a tooltip :(
               if ($ev->{button} == 1) {
                  $CONN->send ("move $CONN->{player}{tag} $item->{tag} 0");
               } elsif ($ev->{button} == 2) {
                  $CONN->send ("apply $item->{tag}");
               } elsif ($ev->{button} == 3) {
                  # examine, lock, mark, maybe other things
                  warn "MENU not implemented yet\n";
               }

               1
            },
         );

         $hbox->add (new CFClient::UI::Face
            can_events => 0,
            face       => $item->{face},
            anim       => $item->{anim},
            animspeed  => $item->{animspeed},
         );
         
         $hbox->add (new CFClient::UI::Label
            can_events => 0,
            text       => $desc,
         );
      }
   });
   refresh;
}

sub conn::container_add {
   my ($self, $id, $items) = @_;

   update_floorbox if $id == 0;
   # $self-<{player}{tag} => player inv
   #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
}

sub conn::container_clear {
   my ($self, $id) = @_;

   update_floorbox if $id == 0;
#   use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
}

sub conn::item_delete {
   my ($self, @items) = @_;

   for (@items) {
      update_floorbox if $_->{container} == 0;
   }
}

sub conn::item_update {
   my ($self, $item) = @_;

   update_floorbox if $item->{container} == 0;
}

%SDL_CB = (
   CFClient::SDL_QUIT => sub {
      Event::unloop -1;
   },
   CFClient::SDL_VIDEORESIZE => sub {
   },
   CFClient::SDL_VIDEOEXPOSE => \&refresh,
   CFClient::SDL_ACTIVEEVENT => sub {
#      printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
   },
   CFClient::SDL_KEYDOWN => sub {
      if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
         # alt-enter
         video_shutdown;
         $CFG->{fullscreen} = !$CFG->{fullscreen};
         video_init;
      } else {
         CFClient::UI::feed_sdl_key_down_event ($_[0]);
      }
   },
   CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
   CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
   CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
   CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
   CFClient::SDL_USEREVENT => \&audio_music_finished,
);

#############################################################################

$SIG{INT} = $SIG{TERM} = sub { exit };

$TILECACHE = CFClient::db_table "tilecache";
$FACEMAP   = CFClient::db_table "facemap";

CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";

my %DEF_CFG = (
   sdl_mode      => 0,
   width         => 640,
   height        => 480,
   fullscreen    => 0,
   fast          => 0,
   map_scale     => 0.5,
   fow_enable    => 1,
   fow_intensity => 0.45,
   fow_smooth    => 0,
   gui_fontsize  => 1,
   log_fontsize  => 1,
   gauge_fontsize => 1,
   gauge_size     => 0.35,
   stat_fontsize => 1,
   mapsize       => 100,
   host          => "crossfire.schmorp.de",
   say_command   => 'say',
   audio_enable  => 1,
   bgm_enable    => 1,
   bgm_volume    => 0.25,
);

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

sdl_init;

@SDL_MODES = reverse
                grep $_->[0] >= 640 && $_->[1] >= 480,
                   CFClient::SDL_ListModes;

@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";

$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;

{
   my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
      DejaVuSans.ttf
      DejaVuSansMono.ttf
      DejaVuSans-Bold.ttf
      DejaVuSansMono-Bold.ttf
      DejaVuSans-Oblique.ttf
      DejaVuSansMono-Oblique.ttf
      DejaVuSans-BoldOblique.ttf
      DejaVuSansMono-BoldOblique.ttf
   );

   CFClient::add_font $_ for @fonts;
   
   $FONT_PROP  = new_from_file CFClient::Font $fonts[0];
   $FONT_FIXED = new_from_file CFClient::Font $fonts[1];

   $FONT_PROP->make_default;
}

video_init;
audio_init;

Event::loop;

END { CFClient::SDL_Quit }

=head1 pclient - Crossfire+ and Crossfire game client

Pclient is a Crossfire+ and Crossfire game client.

=head2 Features

=over 4

=item Fullscreen Map

PClient can uses a fullscreen map, which greatly enhances how much of the
game world you can see.

=item Persistent Map Cache (Crossfire+ only)

PClient can persistently cache all map data it received from the
server. This not only allows it to display an overview map, but also
ensures that once-explored areas will be available the next time you want
to explore more.

=item Hardware acceleration

Unlike most Crossfire clients, PClient take advantage of OpenGL hardware
acceleration. Most modern graphics cards have difficulties with 2D
acceleration, while 3D graphics is accelerated well.

=item No arbitrary limits

Unlike other Crossfire clients, pclient does not suffer from arbitrary
limits (like a fixed amount of face numbers). There are still limits, but
they are not arbitrarily low :)

=back

=head1 FAQ

=over 4

=item The client is very sluggish and slow, what can I do about this?

Most likely, you don't have accelerated OpenGL support. Try to find a
newer driver, or a driver from your hardware vendor, that features OpenGL
support.

If this is not an option, the following Setup options reduce the load and
will likely make the client playable with sofwtare rendering (it will
still be slow, though):

=over 4

=item B<Video Mode> should be set as low as possible (e.g. 640x480)

=item Enable B<Fast & Ugly> mode

=item Disable B<Fog of War>

=item Increase B<Map Scale>

=back

=back

=head1 AUTHOR

Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>


Revision:	1.178
Committed:	Tue Apr 25 08:39:18 2006 UTC (18 years, 1 month ago) by root
Branch:	MAIN
Changes since 1.177:	+80 -4 lines
Log Message:	manpage added, metaserver improved