--- deliantra/Deliantra-Client/bin/pclient 2006/04/28 05:17:24 1.191 +++ deliantra/Deliantra-Client/bin/pclient 2006/05/22 02:23:10 1.235 @@ -3,6 +3,7 @@ use strict; use utf8; +# do things only needed for single-binary version (par) BEGIN { if (%PAR::LibCache) { @INC = grep ref, @INC; # weed out all paths except pars loader refs @@ -15,18 +16,18 @@ } } - unshift @INC, $ENV{PAR_TEMP}; + # TODO: pango-rc file, anybody? - if ($^O eq "MSWin32") { - $ENV{GTK_RC_FILES} = "$ENV{PAR_TEMP}/share/themes/MS-Windows/gtk-2.0/gtkrc"; - } + unshift @INC, $ENV{PAR_TEMP}; } } # need to do it again because that pile of garbage called PAR nukes it before main -unshift @INC, $ENV{PAR_TEMP}; +unshift @INC, $ENV{PAR_TEMP} + if %PAR::LibCache; use Time::HiRes 'time'; +use Pod::POM; use Event; use Crossfire; @@ -39,6 +40,7 @@ use CFClient::MapWidget; $Event::DIED = sub { + # TODO: display dialog box or so CFClient::error $_[1]; }; @@ -62,6 +64,9 @@ our $CONN; our $FAST; # fast, low-quality mode, possibly useful for software-rendering +our $WANT_REFRESH; +our $CAN_REFRESH; + our @SDL_MODES; our $WIDTH; our $HEIGHT; @@ -78,6 +83,7 @@ our $LOGVIEW; our $CONSOLE; our $METASERVER; +our $LOGIN_BUTTON; our $FLOORBOX; our $GAUGES; @@ -91,20 +97,23 @@ our %AUDIO_CHUNKS; # audio files our $ALT_ENTER_MESSAGE; -our $STATUS_LINE; +our $STATUSBOX; our $DEBUG_STATUS; our $INVWIN; our $INV; +our $INVR; +our $INVR_LBL; +our $OPENCONT; sub status { - $STATUS_LINE->set_text ($_[0]); - $STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h}); + $STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 20, fg => [1, 1, 0, 1]); } sub debug { $DEBUG_STATUS->set_text ($_[0]); - $DEBUG_STATUS->move ($WIDTH - $DEBUG_STATUS->{w}, 0, $DEBUG_STATUS->{w}, $DEBUG_STATUS->{h}); + my ($w, $h) = $DEBUG_STATUS->size_request; + $DEBUG_STATUS->move ($WIDTH - $w, 0); } sub start_game { @@ -113,27 +122,49 @@ 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, - ; + $CONN = eval { + new conn + host => $host, + port => $port || 13327, + user => $CFG->{user}, + pass => $CFG->{password}, + mapw => $mapsize, + maph => $mapsize, + ; + }; + + if ($CONN) { + CFClient::lowdelay fileno $CONN->{fh}; + + $LOGIN_BUTTON->set_text ("Logout"); + status "login successful"; - status "login successful"; + $BUTTONBAR->{children}[1]->emit ("activate") + if $BUTTONBAR->{children}[1]->{state}; - CFClient::lowdelay fileno $CONN->{fh}; + } else { + status "unable to connect"; + stop_game(); + } } sub stop_game { - undef $CONN; + return unless $CONN; + + status "connection closed"; + $LOGIN_BUTTON->set_text ("Login"); + $CONN->destroy; + $CONN = 0; # false, does not autovivify + + $BUTTONBAR->{children}[1]->emit ("activate") + unless $BUTTONBAR->{children}[1]->{state}; + + undef $MAPCACHE; + undef $MAP; } sub client_setup { @@ -145,7 +176,7 @@ $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_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 1, 1]); $hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999"); $mode_slider->connect (changed => sub { @@ -180,11 +211,11 @@ $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], + range => [$CFG->{map_scale}, 0.25, 2, 0.05, 0.05], tooltip => "Enlarge or shrink the displayed map", connect_changed => sub { my ($self, $value) = @_; - $CFG->{map_scale} = 0.05 * int $value / 0.05; + $CFG->{map_scale} = $value; } ); @@ -221,30 +252,25 @@ $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], + range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1, 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}; - } + connect_changed => sub { $CFG->{gui_fontsize} = $_[1] }, ); $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], + range => [$CFG->{log_fontsize}, 0.5, 2, 0.1, 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); - } + connect_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) }, ); $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], + range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1, 0.1], tooltip => "The font size used by the statistics window only", connect_changed => sub { - $CFG->{stat_fontsize} = 0.1 * int $_[1] * 10; + $CFG->{stat_fontsize} = $_[1]; &set_stats_window_fontsize; } ); @@ -255,18 +281,16 @@ 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); + $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size}); } ); $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], + range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1, 0.1], tooltip => "Adjusts the fontsize of the gauges at the bottom right", connect_changed => sub { - $CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10; + $CFG->{gauge_fontsize} = $_[1]; &set_gauge_window_fontsize; } ); @@ -350,16 +374,21 @@ } sub make_gauge_window { - my $gh = int ($HEIGHT * $CFG->{gauge_size}); -# my $gw = int ($WIDTH * $CFG->{gauge_w_size}); + my $gh = int $HEIGHT * $CFG->{gauge_size}; my $win = new CFClient::UI::Frame ( - y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh + req_y => -1, + 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), + (new CFClient::UI::VBox children => [ + (new CFClient::UI::Empty expand => 1), + (new CFClient::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFClient::UI::VBox)), + ]), (my $vbox = new CFClient::UI::VBox), ], ); @@ -439,24 +468,24 @@ my $col = 0; my %resist_names = ( - slow => "Slow (slows you down when you are hit by the spell. Monsters will have an opportunity to come near you faster and hit you more often.)", - holyw => "Holy Word (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)", - conf => "Confusion (If you are hit by confusion you will move into random directions, and likely into monsters.)", - fire => "Fire (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)", - depl => "Depletion (some monsters and other effects can cause stats depletion)", - magic => "Magic (resistance to magic spells like magic missile or similar)", - drain => "Draining (some monsters (e.g. vampires) and other effects can steal experience)", - acid => "Acid (resistance to acid, acid hurts pretty much and also corrodes your weapons)", - pois => "Poison (resistance to getting poisoned)", - para => "Paralysation (this resistance affects the chance you get paralysed)", - deat => "Death (resistance against death spells)", - phys => "Physical (this is the resistance against physical attacks, like when a monster hit you in melee combat)", - blind => "Blind (blind resistance affects the chance of a successful blinding attack)", - fear => "Fear (this attack will drive you away from monsters who cast this and hit you successfully, being resistant to this helps a lot when fighting those monsters)", - tund => "Turn undead", - elec => "Electricity (resistance againt electricity, spells like large lightning, small lightning, ...)", - cold => "Cold (this is your resistance against cold spells like icestorm, snowstorm, ...)", - ghit => "Ghost hit (special attack used by ghosts and ghost-like beings)", + slow => "Slow (slows you down when you are hit by the spell. Monsters will have an opportunity to come near you faster and hit you more often.)", + holyw => "Holy Word (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)", + conf => "Confusion (If you are hit by confusion you will move into random directions, and likely into monsters.)", + fire => "Fire (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)", + depl => "Depletion (some monsters and other effects can cause stats depletion)", + magic => "Magic (resistance to magic spells like magic missile or similar)", + drain => "Draining (some monsters (e.g. vampires) and other effects can steal experience)", + acid => "Acid (resistance to acid, acid hurts pretty much and also corrodes your weapons)", + pois => "Poison (resistance to getting poisoned)", + para => "Paralysation (this resistance affects the chance you get paralysed)", + deat => "Death (resistance against death spells)", + phys => "Physical (this is the resistance against physical attacks, like when a monster hit you in melee combat)", + blind => "Blind (blind resistance affects the chance of a successful blinding attack)", + fear => "Fear (this attack will drive you away from monsters who cast this and hit you successfully, being resistant to this helps a lot when fighting those monsters)", + tund => "Turn undead (affects your resistancy to various forms of 'turn undead' spells. Only relevant when you are, in fact, undead...", + elec => "Electricity (resistance against electricity, spells like large lightning, small lightning, ...)", + cold => "Cold (this is your resistance against cold spells like icestorm, snowstorm, ...)", + ghit => "Ghost hit (special attack used by ghosts and ghost-like beings)", ); for (qw/slow holyw conf fire depl magic drain acid pois para deat phys @@ -567,7 +596,7 @@ sub metaserver_dialog { my $dialog = new CFClient::UI::FancyFrame - title => "Metaserver", + title => "Server List", child => (my $vbox = new CFClient::UI::VBox); $vbox->add ($dialog->{table} = new CFClient::UI::Table); @@ -646,7 +675,8 @@ (new CFClient::UI::Empty expand => 1), ]); - $table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => 0.8) + $table->add ($_ + 1, $y, new CFClient::UI::Label + ellipsise => 0, align => $align[$_], text => $m->[$_], fontsize => 0.8) for 0 .. $#$m; } } @@ -679,9 +709,9 @@ $vbox->add (new CFClient::UI::Flopper expand => 1, - text => "Metaserver", + text => "Server List", other => $METASERVER, - tooltip => "Show a list of avaible crossfire servers", + tooltip => "Show a list of available crossfire servers", connect_open => sub { update_metaserver $HOST; } @@ -712,7 +742,7 @@ $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], + range => [$CFG->{mapsize}, 10, 100 + 1, 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 { @@ -722,9 +752,29 @@ }, ); - $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub { - start_game; - }); + $table->add (0, 8, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count"); + $table->add (1, 8, new CFClient::UI::Entry + text => $CFG->{output_count}, + tooltip => "Should be set to 1 unless you know what you are doing", + connect_changed => sub { $CFG->{output_count} = $_[1] }, + ); + + $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync"); + $table->add (1, 9, new CFClient::UI::Entry + text => $CFG->{output_sync}, + tooltip => "Should be set to 1 unless you know what you are doing", + connect_changed => sub { $CFG->{output_sync} = $_[1] }, + ); + + $table->add (1, 10, $LOGIN_BUTTON = new CFClient::UI::Button + expand => 1, + align => 0, + text => "Login", + connect_activate => sub { + $CONN ? stop_game + : start_game; + }, + ); $dialog } @@ -738,11 +788,7 @@ 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 ($LOGVIEW); $vbox->add (my $input = new CFClient::UI::Entry connect_focus_in => sub { @@ -784,11 +830,21 @@ } sub make_inventory_window { - my $invwin = new CFClient::UI::FancyFrame user_w => 300, user_h => 300, title => "Inventory"; - $invwin->add (my $hb = new CFClient::UI::HBox); - $hb->add ($INV = new CFClient::UI::Inventory expand => 1); - $hb->add (my $rng = new CFClient::UI::Slider vertical => 1); - $INV->set_range ($rng); + my $invwin = new CFClient::UI::FancyFrame + user_w => $WIDTH * (4/5), user_h => $HEIGHT * (4/5), title => "Inventory"; + + $invwin->add (my $hb = new CFClient::UI::HBox expand => 1); + + $hb->add (my $vb1 = new CFClient::UI::VBox expand => 1); + $vb1->add (my $lbl = new CFClient::UI::Label); + $lbl->set_text ("Player"); + $vb1->add ($INV = new CFClient::UI::Inventory expand => 1); + + $hb->add (my $vb2 = new CFClient::UI::VBox expand => 1); + $vb2->add ($INVR_LBL = new CFClient::UI::Label); + $INVR_LBL->set_text ("Floor"); + $vb2->add ($INVR = new CFClient::UI::Inventory expand => 1); + $invwin } @@ -800,90 +856,112 @@ sub video_init { sdl_init; + $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES; + ($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"; + or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n"; $SDL_ACTIVE = 1; - $LAST_REFRESH = time - 0.01; CFClient::gl_init; $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize}; - ############################################################################# + $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d# - $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 Alt-Enter to toggle fullscreen mode"; - $ALT_ENTER_MESSAGE->show; - $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h}); - - CFClient::UI::FancyFrame->new ( - border_bg => [1, 1, 1, 192/255], - bg => [1, 1, 1, 0], - child => ($MAPMAP = new CFClient::MapWidget::MapMap), - )->show; - - $MAPWIDGET = new CFClient::MapWidget; - $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); - } - } - }); - $MAPWIDGET->show; - $MAPWIDGET->focus_in; - - $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::Flopper text => "Inventory", other => make_inventory_window); - - $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub { - CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; - status "Configuration Saved"; - }); + unless ($DEBUG_STATUS) { + # create the widgets - $BUTTONBAR->show; + $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, req_x => -1; + $DEBUG_STATUS->show; + + $STATUSBOX = new CFClient::UI::Statusbox; + $STATUSBOX->add ("Use Alt-Enter to toggle fullscreen mode", pri => -100, color => [1, 1, 1, 0.8]); + + (new CFClient::UI::Frame + bg => [0, 0, 0, 0.4], + req_y => -1, + child => $STATUSBOX, + )->show; + + CFClient::UI::FancyFrame->new ( + border_bg => [1, 1, 1, 192/255], + bg => [1, 1, 1, 0], + child => ($MAPMAP = new CFClient::MapWidget::MapMap), + )->show; + + $MAPWIDGET = new CFClient::MapWidget; + $MAPWIDGET->connect (activate_console => sub { + my ($mapwidget, $preset) = @_; + + if ($CONSOLE) { + $CONSOLE->{input}->{auto_activated} = 1; + $CONSOLE->{input}->focus_in; - $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup + if ($preset && $CONSOLE->{input}->get_text eq '') { + $CONSOLE->{input}->set_text ($preset); + } + } + }); + $MAPWIDGET->show; + $MAPWIDGET->focus_in; + + $LOGVIEW = new CFClient::UI::TextView + expand => 1, + font => $FONT_FIXED, + fontsize => $::CFG->{log_fontsize}, + ; + + $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); + + make_gauge_window->show; # 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::Flopper text => "Inventory", other => make_inventory_window); + + $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub { + CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; + status "Configuration Saved"; + }); + + $BUTTONBAR->show; + + $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]); + + # delay till geometry is constant + $CFClient::UI::ROOT->on_post_alloc (startup => sub { + $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup + my $widget = $GAUGES->{win}; + $widget->move (0, $HEIGHT - $widget->{h});#d# to in toplevel + }); + force_refresh (); + } } 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_channel_finished { + my ($channel) = @_; + + #warn "channel $channel finished\n";#d# +} + sub audio_music_finished { return unless $CFG->{bgm_enable}; @@ -896,7 +974,7 @@ sub audio_init { if ($CFG->{audio_enable}) { - if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") { + if (open my $fh, "<", CFClient::find_rcfile "sounds/config") { $SDL_MIXER = !CFClient::Mix_OpenAudio; CFClient::Mix_AllocateChannels 8; CFClient::MixMusic::volume $CFG->{bgm_volume} * 128; @@ -933,23 +1011,75 @@ my %animate_object; my $animate_timer; -my $want_refresh; -my $can_refresh; - my $fps = 9; +my %demo;#d# + sub force_refresh { - $fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05; + $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05; debug sprintf "%3.2f", $fps; - $want_refresh = 0; - $can_refresh = 0; - $CFClient::UI::ROOT->draw; - CFClient::SDL_GL_SwapBuffers; - + $WANT_REFRESH = 0; + $CAN_REFRESH = 0; $LAST_REFRESH = $NOW; + +0 && do { + # some weird model-drawing code, just a joke right now + use CFClient::OpenGL; + + $demo{t}{eye_auv} ||= new_from_file CFClient::Texture "eye2.png" or die; + $demo{t}{body_auv} ||= new_from_file CFClient::Texture "body_auv3.png" or die; + $demo{r} ||= do { + my $mod = Compress::LZF::sthaw do { local $/; open my $fh, "<:raw:perlio", "dread.lz3"; <$fh> }; + $mod->{v} = pack "f*", @{$mod->{v}}; + $_ = [scalar @$_, pack "S!*", @$_] + for values %{$mod->{g}}; + $mod + }; + + my $r = $demo{r} or die; + + glDepthMask 1; + glClear GL_DEPTH_BUFFER_BIT; + glEnable GL_TEXTURE_2D; + glEnable GL_DEPTH_TEST; + glEnable GL_CULL_FACE; + glShadeModel $::FAST ? GL_FLAT : GL_SMOOTH; + + glMatrixMode GL_PROJECTION; + glLoadIdentity; + glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000; + #glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000; + glMatrixMode GL_MODELVIEW; + glLoadIdentity; + + glPushMatrix; + glTranslate 0, 0, -800; + glScale 1, -1, 1; + glRotate $NOW * 1000 % 36000 / 5, 0, 1, 0; + glRotate $NOW * 1000 % 36000 / 6, 1, 0, 0; + glRotate $NOW * 1000 % 36000 / 7, 0, 0, 1; + glScale 50, 50, 50; + + glInterleavedArrays GL_T2F_N3F_V3F, 0, $r->{v}; + while (my ($k, $v) = each %{$r->{g}}) { + glBindTexture GL_TEXTURE_2D, ($demo{t}{$k}{name} or die); + glDrawElements GL_TRIANGLES, $v->[0], GL_UNSIGNED_SHORT, $v->[1]; + } + + glPopMatrix; + + glShadeModel GL_FLAT; + glDisable GL_DEPTH_TEST; + glDisable GL_TEXTURE_2D; + glDepthMask 0; + + $WANT_REFRESH++; +}; + + CFClient::SDL_GL_SwapBuffers; } my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub { @@ -960,20 +1090,16 @@ if (%animate_object) { $_->animate ($LAST_REFRESH - $NOW) for values %animate_object; - $want_refresh++; + $WANT_REFRESH++; } - if ($want_refresh) { + if ($WANT_REFRESH) { force_refresh; } else { - $can_refresh = 1; + $CAN_REFRESH = 1; } }); -sub refresh { - $want_refresh++; -} - sub animation_start { my ($widget) = @_; $animate_object{$widget} = $widget; @@ -986,9 +1112,46 @@ @conn::ISA = Crossfire::Protocol::; +sub conn::new { + my $class = shift; + + my $self = $class->Crossfire::Protocol::new (@_); + + $MAPWIDGET->clr_commands; + + my $parser = new Pod::POM; + my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod"); + + for my $head2 ($pod->head2) { + $head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x + or next; + + my $cmd = $1; + my @args = split /\|/, $2; + @args = (".*") unless @args; + + my $text = CFClient::pod_to_pango $head2->content; + + for my $arg (@args) { + $arg = $arg eq ".*" ? "" : " $arg"; + + $MAPWIDGET->add_command ("$cmd$arg", $text); + } + } + + $self +} + sub conn::stats_update { my ($self, $stats) = @_; + if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) { + my $diff = $exp - $self->{prev_exp}; + $STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5) + if exists $self->{prev_exp} && $diff; + $self->{prev_exp} = $exp; + } + update_stats_window ($stats); } @@ -1052,13 +1215,46 @@ } } +# hardcode /world/world_xxx_xxx map names, the savings are enourmous, +# (server resource,s latency, bandwidth), so this hack is warranted. +# the right fix is to make real tiled maps with an overview file +sub conn::send_mapinfo { + my ($self, $data, $cb) = @_; + + if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) { + my ($wx, $wy) = ($1, $2); + + if ($data =~ /^spatial ([1-4]+)$/) { + my @dx = (0, 0, 1, 0, -1); + my @dy = (0, -1, 0, 1, 0); + my ($dx, $dy); + + for (split //, $1) { + $dx += $dx[$_]; + $dy += $dy[$_]; + } + + $cb->(spatial => 15, + $self->{map_info}[1] - $MAP->ox + $dx * 50, + $self->{map_info}[2] - $MAP->oy + $dy * 50, + 50, 50, + sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy + ); + + return; + } + } + + $self->SUPER::send_mapinfo ($data, $cb); +} + # 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) = @_; + my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_; # the server does not allow map paths > 6 return if 7 <= length $path; @@ -1066,12 +1262,15 @@ my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}}; for ( - [1, 0, -1], - [2, 1, 0], - [3, 0, 1], - [4, -1, 0], + [1, 3, 0, -1], + [2, 4, 1, 0], + [3, 1, 0, 1], + [4, 2, -1, 0], ) { - my ($tile, $dx, $dy) = @$_; + my ($tile, $tile2, $dx, $dy) = @$_; + + next if $block & (1 << $tile); + my $block = $block | (1 << $tile2); my $gx = $gx + $dx; my $gy = $gy + $dy; @@ -1083,7 +1282,7 @@ if (my $info = $neigh->[$tile]) { my ($flags, $x, $y, $w, $h, $hash) = @$info; - $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags) + $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags) if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1; } else { @@ -1094,13 +1293,13 @@ $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) + $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags) if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1; }); } @@ -1123,18 +1322,17 @@ ]; 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/; + (my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/; $STATWIDS->{map}->set_text ("Map: " . $map); $self->load_map ($hash, $x, $y); + $self->flood_fill (0, 0, 0, "", $hash, $flags); } sub conn::face_find { @@ -1294,7 +1492,27 @@ [0.74, 0.65, 0.41], ); - $LOGVIEW->add_paragraph ($color[$color], $text); + my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0]; + + $text = CFClient::UI::Label::escape $text; + $text =~ s/\[b\](.*?)\[\/b\]/\1<\/b>/g; + $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/\2<\/span>/g; + + $LOGVIEW->add_paragraph ($color[$color], + join "\n", map "$time $_", split /\n/, $text); + + $STATUSBOX->add ($text, + group => $text, + fg => $color[$color], + timeout => 60, + tooltip_font => $::FONT_FIXED, + ); +} + +sub conn::drawextinfo { + my ($self, $color, $type, $subtype, $message) = @_; + + $self->drawinfo ($color, $message); } sub conn::spell_add { @@ -1302,8 +1520,8 @@ # 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}); + $MAPWIDGET->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message}); + $MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message}); } sub conn::spell_delete { @@ -1313,91 +1531,95 @@ sub conn::addme_success { my ($self) = @_; + $self->send ("command output-sync $CFG->{output_sync}"); + $self->send ("command output-count $CFG->{output_count}"); + + my $parser = new Pod::POM; + my $pod = $parser->parse_file (CFClient::find_rcfile "pod/skill_help.pod"); + + my %skill_tooltip; + + for my $head2 ($pod->head2) { + $skill_tooltip{$head2->title} = CFClient::pod_to_pango $head2->content; + } + 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'"); + $MAPWIDGET->add_command ("ready_skill $skill", + (CFClient::UI::Label::escape "Ready the skill '$skill'\n\n") + . $skill_tooltip{$skill}); + $MAPWIDGET->add_command ("use_skill $skill", + (CFClient::UI::Label::escape "Immediately use the skill '$skill'\n\n") + . $skill_tooltip{$skill}); } } +sub conn::eof { + $MAPWIDGET->clr_commands; + + stop_game; +} + sub update_floorbox { $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub { + return unless $CONN; + $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) - . "\nleftclick - pick up\nmiddle click - apply\nrightclick - menu"), - 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) { - CFClient::UI::Menu->new ( - items => [ - ["examine", sub { $CONN->send ("examine $item->{tag}") }], - [ - $item->{flags} & Crossfire::Protocol::F_LOCKED ? "lock" : "unlock", - sub { $CONN->send ("lock $item->{tag}") }, - ], - ["mark", sub { $CONN->send ("mark $item->{tag}") }], - ["apply", sub { $CONN->send ("apply $item->{tag}") }], - ], - )->popup ($ev); - } - - 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, - ); + my $count = 4; + for (@{ $CONN->{container}{0} }) { + if (--$count) { + $FLOORBOX->add (new CFClient::UI::InventoryItem item => $_); + } else { + $FLOORBOX->add (new CFClient::UI::Label text => "More..."); + last; + } } }); - refresh; + + $WANT_REFRESH++; } sub conn::container_add { - my ($self, $id, $items) = @_; + my ($self, $tag, $items) = @_; - update_floorbox if $id == 0; - if ($self->{player}{tag} == $id) { - $INV->set_items ($self->{container}{$self->{player}{tag}}); + #d# print "container_add: container $tag ($self->{player}{tag})\n"; + + if ($tag == 0) { + update_floorbox; + $OPENCONT = 0; + $INVR_LBL->set_text ("Floor"); + $INVR->set_items ($self->{container}{0}); + } elsif ($tag == $self->{player}{tag}) { + $INVR_LBL->set_text ("Player"); + $INV->set_items ($self->{container}{$self->{player}{tag}}) + } else { + $OPENCONT = $tag; + $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT})); + $INVR->set_items ($self->{container}{$tag}); } + # $self-<{player}{tag} => player inv #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}}; } sub conn::container_clear { - my ($self, $id) = @_; + my ($self, $tag) = @_; - update_floorbox if $id == 0; - if ($self->{player}{tag} == $id) { - $INV->set_items ($self->{container}{$id}); + #d# print "container_clear: container $tag ($self->{player}{tag})\n"; + + if ($tag == 0) { + update_floorbox; + $OPENCONT = 0; + $INVR_LBL->set_text ("Floor"); + $INVR->set_items ($self->{container}{0}); + } elsif ($tag == $self->{player}{tag}) { + $INVR_LBL->set_text ("Player"); + $INV->set_items ($self->{container}{$tag}) + } else { + $OPENCONT = $tag; + $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT})); + $INVR->set_items ($self->{container}{$tag}); } # use PApp::Util; warn PApp::Util::dumpval $self->{container}{0}; @@ -1407,9 +1629,20 @@ my ($self, @items) = @_; for (@items) { - update_floorbox if $_->{container} == 0; - if ($self->{player}{tag} == $_->{container}) { - $INV->set_items ($self->{container}{$_->{container}}); + #d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n"; + + if ($_->{container} == 0) { + update_floorbox; + $OPENCONT = 0; + $INVR_LBL->set_text ("Floor"); + $INVR->set_items ($self->{container}{0}); + } elsif ($_->{container} == $self->{player}{tag}) { + $INVR_LBL->set_text ("Player"); + $INV->set_items ($self->{container}{$self->{player}{tag}}) + } else { + $OPENCONT = $_->{container}; + $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT})); + $INVR->set_items ($self->{container}{$_->{container}}); } } } @@ -1417,9 +1650,24 @@ sub conn::item_update { my ($self, $item) = @_; - update_floorbox if $item->{container} == 0; - if ($self->{player}{tag} == $item->{container}) { - $INV->set_items ($self->{container}{$item->{container}}); + #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n"; + + if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) { + $OPENCONT = 0; + $INVR_LBL->set_text ("Floor"); + $INVR->set_items ($self->{container}{0}); + + $item->{widget}->update_item + if $item->{widget}; + } else { + if ($item->{container} == 0) { + update_floorbox; + $OPENCONT = 0; + $INVR_LBL->set_text ("Floor"); + $INVR->set_items ($self->{container}{0}); + } elsif ($item->{container} == $self->{player}{tag}) { + $INV->set_items ($self->{container}{$item->{container}}) + } } } @@ -1429,7 +1677,9 @@ }, CFClient::SDL_VIDEORESIZE => sub { }, - CFClient::SDL_VIDEOEXPOSE => \&refresh, + CFClient::SDL_VIDEOEXPOSE => sub { + $WANT_REFRESH++; + }, CFClient::SDL_ACTIVEEVENT => sub { # printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d# }, @@ -1443,81 +1693,108 @@ 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_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, + CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event, + CFClient::SDL_USEREVENT => sub { + if ($_[0]{code} == 1) { + audio_channel_finished $_[0]{data1}; + } elsif ($_[0]{code} == 0) { + audio_music_finished; + } + }, ); ############################################################################# $SIG{INT} = $SIG{TERM} = sub { exit }; -$TILECACHE = CFClient::db_table "tilecache"; -$FACEMAP = CFClient::db_table "facemap"; +{ + local $SIG{__DIE__} = sub { CFClient::fatal $_[0] }; -CFClient::read_cfg "$Crossfire::VARDIR/pclientrc"; + 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, -); + $TILECACHE = CFClient::db_table "tilecache"; + $FACEMAP = CFClient::db_table "facemap"; -while (my ($k, $v) = each %DEF_CFG) { - $CFG->{$k} = $v unless exists $CFG->{$k}; -} + my %DEF_CFG = ( + sdl_mode => 0, + width => 640, + height => 480, + fullscreen => 0, + fast => 0, + map_scale => 1, + 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, + output_sync => 1, + output_count => 1, + ); -sdl_init; + while (my ($k, $v) = each %DEF_CFG) { + $CFG->{$k} = $v unless exists $CFG->{$k}; + } -@SDL_MODES = reverse - grep $_->[0] >= 640 && $_->[1] >= 480, - CFClient::SDL_ListModes; + sdl_init; -@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)"; + @SDL_MODES = reverse + grep $_->[0] >= 640 && $_->[1] >= 480, + CFClient::SDL_ListModes; -$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES; + @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)"; -{ - 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 - ); + $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES; - CFClient::add_font $_ for @fonts; - - $FONT_PROP = new_from_file CFClient::Font $fonts[0]; - $FONT_FIXED = new_from_file CFClient::Font $fonts[1]; + { + 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 + ); - $FONT_PROP->make_default; -} + CFClient::add_font $_ for @fonts; + + CFClient::pango_init; -video_init; -audio_init; + $FONT_PROP = new_from_file CFClient::Font $fonts[0]; + $FONT_FIXED = new_from_file CFClient::Font $fonts[1]; + + $FONT_PROP->make_default; + } + +# compare mono (ft) vs. rgba (cairo) +# ft - 1.8s, cairo 3s, even in alpha-only mode +# for my $rgba (0..1) { +# my $t1 = Time::HiRes::time; +# for (1..1000) { +# my $layout = CFClient::Layout->new ($rgba); +# $layout->set_text ("hallo" x 100); +# $layout->render; +# } +# my $t2 = Time::HiRes::time; +# warn $t2-$t1; +# } + + video_init; + audio_init; +} Event::loop; @@ -1578,10 +1855,14 @@ name, such as I and I. You can abbreviate commands by typing only the first character of every -word. For example, typing I will likely select I, while I will select I. Likewise, I -will likely select I and I will give you -I. +word (or even characters within the word - the client will try to make +a good guess, as long as the characters are in order). For example, +typing I will likely select I, while I +will select I. Likewise, I will likely select +I and I will give you I. + +You can enter space and other text as arguemnt to the command. For +example, C will expand to C. =head2 The map overview