ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.596 by root, Fri Nov 9 20:37:57 2012 UTC vs.
Revision 1.622 by root, Wed Nov 23 06:05:33 2016 UTC

… …
57use JSON::XS 2.01 (); 57use JSON::XS 2.01 ();
58use BDB (); 58use BDB ();
59use Data::Dumper; 59use Data::Dumper;
60use Fcntl; 60use Fcntl;
61use YAML::XS (); 61use YAML::XS ();
62use CBOR::XS ();
62use IO::AIO (); 63use IO::AIO ();
63use Time::HiRes;
64use Compress::LZF; 64use Compress::LZF;
65use Digest::MD5 (); 65use Digest::MD5 ();
66 66
67AnyEvent::detect; 67AnyEvent::detect;
68 68
… …
226=item $cf::RUNTIME 226=item $cf::RUNTIME
227 227
228The time this server has run, starts at 0 and is increased by $cf::TICK on 228The time this server has run, starts at 0 and is increased by $cf::TICK on
229every server tick. 229every server tick.
230 230
231=item $cf::CONFDIR $cf::DATADIR $cf::LIBDIR $cf::PODDIR 231=item $cf::CONFDIR $cf::DATADIR $cf::LIBDIR $cf::PODDIR
232$cf::MAPDIR $cf::LOCALDIR $cf::TMPDIR $cf::UNIQUEDIR 232$cf::MAPDIR $cf::LOCALDIR $cf::TMPDIR $cf::UNIQUEDIR
233$cf::PLAYERDIR $cf::RANDOMDIR $cf::BDBDIR 233$cf::PLAYERDIR $cf::RANDOMDIR $cf::BDBDIR
234 234
235Various directories - "/etc", read-only install directory, perl-library 235Various directories - "/etc", read-only install directory, perl-library
236directory, pod-directory, read-only maps directory, "/var", "/var/tmp", 236directory, pod-directory, read-only maps directory, "/var", "/var/tmp",
… …
252Configuration for the server, loaded from C</etc/deliantra-server/config>, or 252Configuration for the server, loaded from C</etc/deliantra-server/config>, or
253from wherever your confdir points to. 253from wherever your confdir points to.
254 254
255=item cf::wait_for_tick, cf::wait_for_tick_begin 255=item cf::wait_for_tick, cf::wait_for_tick_begin
256 256
257These are functions that inhibit the current coroutine one tick. cf::wait_for_tick_begin only 257These are functions that inhibit the current coroutine one tick.
258returns directly I<after> the tick processing (and consequently, can only wake one thread 258cf::wait_for_tick_begin only returns directly I<after> the tick
259processing (and consequently, can only wake one thread per tick), while
259per tick), while cf::wait_for_tick wakes up all waiters after tick processing. 260cf::wait_for_tick wakes up all waiters after tick processing.
260 261
261Note that cf::Wait_for_tick will immediately return when the server is not 262Note that cf::wait_for_tick will immediately return when the server is not
262ticking, making it suitable for small pauses in threads that need to run 263ticking, making it suitable for small pauses in threads that need to run
263when the server is paused. If that is not applicable (i.e. you I<really> 264when the server is paused. If that is not applicable (i.e. you I<really>
264want to wait, use C<$cf::WAIT_FOR_TICK>). 265want to wait, use C<$cf::WAIT_FOR_TICK>).
265 266
266=item $cf::WAIT_FOR_TICK 267=item $cf::WAIT_FOR_TICK
… …
464 465
465sub decode_yaml($) { 466sub decode_yaml($) {
466 fork_call { YAML::XS::Load $_[0] } @_ 467 fork_call { YAML::XS::Load $_[0] } @_
467} 468}
468 469
470=item $scalar = cf::decode_cbor $scalar
471
472Same as CBOR::XS::decode_cbor, but takes server ticks into account, so
473blocks. For small amounts of data, C<CBOR::XS::decode_cbor> is the better
474alternative.
475
476=cut
477
478sub decode_cbor($) {
479 # we assume 10mb/s minimum decoding speed (on a ~2ghz machine)
480 cf::get_slot +(length $_[0]) / 10_000_000, 0, "decode_cbor";
481 CBOR::XS::decode_cbor $_[0]
482}
483
469=item $scalar = cf::unlzf $scalar 484=item $scalar = cf::unlzf $scalar
470 485
471Same as Compress::LZF::compress, but takes server ticks into account, so 486Same as Compress::LZF::compress, but takes server ticks into account, so
472blocks. 487blocks.
473 488
… …
510 } 525 }
511} 526}
512 527
513=item cf::lock_wait $string 528=item cf::lock_wait $string
514 529
515Wait until the given lock is available. See cf::lock_acquire. 530Wait until the given lock is available. See cf::lock_acquire.
516 531
517=item my $lock = cf::lock_acquire $string 532=item my $lock = cf::lock_acquire $string
518 533
519Wait until the given lock is available and then acquires it and returns 534Wait until the given lock is available and then acquires it and returns
520a L<Guard> object. If the guard object gets destroyed (goes out of scope, 535a L<Guard> object. If the guard object gets destroyed (goes out of scope,
… …
573Allocate $time seconds of blocking CPU time at priority C<$priority> 588Allocate $time seconds of blocking CPU time at priority C<$priority>
574(default: 0): This call blocks and returns only when you have at least 589(default: 0): This call blocks and returns only when you have at least
575C<$time> seconds of cpu time till the next tick. The slot is only valid 590C<$time> seconds of cpu time till the next tick. The slot is only valid
576till the next cede. 591till the next cede.
577 592
578Background jobs should use a priority les than zero, interactive jobs 593Background jobs should use a priority less than zero, interactive jobs
579should use 100 or more. 594should use 100 or more.
580 595
581The optional C<$name> can be used to identify the job to run. It might be 596The optional C<$name> can be used to identify the job to run. It might be
582used for statistical purposes and should identify the same time-class. 597used for statistical purposes and should identify the same time-class.
583 598
… …
596 my $signal = new Coro::Signal; 611 my $signal = new Coro::Signal;
597 my $busy; 612 my $busy;
598 613
599 while () { 614 while () {
600 next_job: 615 next_job:
616
617 Coro::cede;
601 618
602 my $avail = cf::till_tick; 619 my $avail = cf::till_tick;
603 620
604 for (0 .. $#SLOT_QUEUE) { 621 for (0 .. $#SLOT_QUEUE) {
605 if ($SLOT_QUEUE[$_][0] <= $avail) { 622 if ($SLOT_QUEUE[$_][0] <= $avail) {
606 $busy = 0; 623 $busy = 0;
607 my $job = splice @SLOT_QUEUE, $_, 1, (); 624 my $job = splice @SLOT_QUEUE, $_, 1, ();
608 $job->[2]->send; 625 $job->[2]->send;
609 Coro::cede;
610 goto next_job; 626 goto next_job;
611 } else { 627 } else {
612 $SLOT_QUEUE[$_][0] *= $SLOT_DECAY; 628 $SLOT_QUEUE[$_][0] *= $SLOT_DECAY;
613 } 629 }
614 } 630 }
615 631
616 if (@SLOT_QUEUE) { 632 if (@SLOT_QUEUE) {
617 # we do not use wait_for_tick() as it returns immediately when tick is inactive 633 wait_for_tick;
618 $WAIT_FOR_TICK->wait;
619 } else { 634 } else {
620 $busy = 0; 635 $busy = 0;
621 Coro::schedule; 636 Coro::schedule;
622 } 637 }
623 } 638 }
… …
649BEGIN { *async = \&Coro::async_pool } 664BEGIN { *async = \&Coro::async_pool }
650 665
651=item cf::sync_job { BLOCK } 666=item cf::sync_job { BLOCK }
652 667
653The design of Deliantra requires that the main coroutine ($Coro::main) 668The design of Deliantra requires that the main coroutine ($Coro::main)
654is always able to handle events or runnable, as Deliantra is only 669is always able to handle events or is runnable, as Deliantra is only
655partly reentrant. Thus "blocking" it by e.g. waiting for I/O is not 670partly reentrant. Thus "blocking" it by e.g. waiting for I/O is not
656acceptable. 671acceptable.
657 672
658If it must be done, put the blocking parts into C<sync_job>. This will run 673If it must be done, put the blocking parts into C<sync_job>. This will run
659the given BLOCK in another coroutine while waiting for the result. The 674the given BLOCK in another coroutine while waiting for the result. The
… …
687 702
688 while ($busy) { 703 while ($busy) {
689 if (Coro::nready) { 704 if (Coro::nready) {
690 Coro::cede_notself; 705 Coro::cede_notself;
691 } else { 706 } else {
692 EV::loop EV::LOOP_ONESHOT; 707 EV::run EV::RUN_ONCE;
693 } 708 }
694 } 709 }
695 710
696 my $time = AE::time - $time; 711 my $time = AE::time - $time;
697 712
… …
738 reset_signals; 753 reset_signals;
739} 754}
740 755
741sub fork_call(&@) { 756sub fork_call(&@) {
742 my ($cb, @args) = @_; 757 my ($cb, @args) = @_;
743
744 # we seemingly have to make a local copy of the whole thing,
745 # otherwise perl prematurely frees the stuff :/
746 # TODO: investigate and fix (likely this will be rather laborious)
747 758
748 my @res = Coro::Util::fork_eval { 759 my @res = Coro::Util::fork_eval {
749 cf::post_fork; 760 cf::post_fork;
750 &$cb 761 &$cb
751 } @args; 762 } @args;
… …
901 912
902 return db_get cache => "$id/data"; 913 return db_get cache => "$id/data";
903 } 914 }
904 } 915 }
905 916
906 my $t1 = Time::HiRes::time; 917 my $t1 = EV::time;
907 my $data = $process->(\@data); 918 my $data = $process->(\@data);
908 my $t2 = Time::HiRes::time; 919 my $t2 = EV::time;
909 920
910 info "cache: '$id' processed in ", $t2 - $t1, "s\n"; 921 info "cache: '$id' processed in ", $t2 - $t1, "s\n";
911 922
912 db_put cache => "$id/data", $data; 923 db_put cache => "$id/data", $data;
913 db_put cache => "$id/md5" , $md5; 924 db_put cache => "$id/md5" , $md5;
… …
2388 2399
2389 $MAP_PREFETCHER ||= cf::async { 2400 $MAP_PREFETCHER ||= cf::async {
2390 $Coro::current->{desc} = "map prefetcher"; 2401 $Coro::current->{desc} = "map prefetcher";
2391 2402
2392 while (%MAP_PREFETCH) { 2403 while (%MAP_PREFETCH) {
2393 while (my ($k, $v) = each %MAP_PREFETCH) { 2404 for my $k (keys %MAP_PREFETCH) {
2394 if (my $map = find $k) { 2405 if (my $map = find $k) {
2395 $map->load if $v; 2406 $map->load if $MAP_PREFETCH{$k};
2396 } 2407 }
2397 2408
2398 delete $MAP_PREFETCH{$k}; 2409 delete $MAP_PREFETCH{$k};
2399 } 2410 }
2400 } 2411 }
… …
2654 2665
2655Creates and returns a persistent reference to an object that can be stored as a string. 2666Creates and returns a persistent reference to an object that can be stored as a string.
2656 2667
2657=item $ob = cf::object::deref ($refstring) 2668=item $ob = cf::object::deref ($refstring)
2658 2669
2659returns the objetc referenced by refstring. may return undef when it cnanot find the object, 2670returns the objetc referenced by refstring. may return undef when it cannot find the object,
2660even if the object actually exists. May block. 2671even if the object actually exists. May block.
2661 2672
2662=cut 2673=cut
2663 2674
2664sub deref { 2675sub deref {
… …
2746=item $player_object->may ("access") 2757=item $player_object->may ("access")
2747 2758
2748Returns wether the given player is authorized to access resource "access" 2759Returns wether the given player is authorized to access resource "access"
2749(e.g. "command_wizcast"). 2760(e.g. "command_wizcast").
2750 2761
2762This is implemented by checking a config setting of C<may_access> where
2763C<access> is replaced by the access string. The following alternatives are
2764possible (and are tested in order):
2765
2766=over 4
2767
2768=item * Player is DM
2769
2770The request will succeed.
2771
2772=item * may_access is an array reference
2773
2774If either the player nickname or UUID is in the array, the request will
2775succeed, otherwise it will fail.
2776
2777=item * may_access is a true value
2778
2779The request will succeed.
2780
2781=item * may_access is missing or false
2782
2783The request will fail.
2784
2785=back
2786
2751=cut 2787=cut
2752 2788
2753sub cf::object::player::may { 2789sub cf::object::player::may {
2754 my ($self, $access) = @_; 2790 my ($self, $access) = @_;
2755 2791
2756 $self->flag (cf::FLAG_WIZ) || 2792 $self->flag (cf::FLAG_WIZ) ||
2757 (ref $cf::CFG{"may_$access"} 2793 (ref $cf::CFG{"may_$access"}
2758 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 2794 ? scalar grep $self->name eq $_ || $self->uuid eq $_, @{$cf::CFG{"may_$access"}}
2759 : $cf::CFG{"may_$access"}) 2795 : $cf::CFG{"may_$access"})
2760} 2796}
2761 2797
2762=item $player_object->enter_link 2798=item $player_object->enter_link
2763 2799
… …
2766The player should be reasonably safe there for short amounts of time (e.g. 2802The player should be reasonably safe there for short amounts of time (e.g.
2767for loading a map). You I<MUST> call C<leave_link> as soon as possible, 2803for loading a map). You I<MUST> call C<leave_link> as soon as possible,
2768though, as the player cannot control the character while it is on the link 2804though, as the player cannot control the character while it is on the link
2769map. 2805map.
2770 2806
2771Will never block. 2807This method will never block, which is the whole reaosn for it's
2808existance: you can I<always> put a player onto the link map, which is the
2809only place to put objects that is guaranteed to exist.
2810
2811A typical usage pattern is to call C<enter_link> synchronously from the
2812server, then start a new thread, do your blocking stuff there and then
2813call C<leave_link> from that thread.
2772 2814
2773=item $player_object->leave_link ($map, $x, $y) 2815=item $player_object->leave_link ($map, $x, $y)
2774 2816
2775Moves the player out of the special C<{link}> map onto the specified 2817Moves the player out of the special C<{link}> map onto the specified
2776map. If the map is not valid (or omitted), the player will be moved back 2818map. If the map is not valid (or omitted), the player will be moved back
… …
3046 3088
3047=head3 cf::client 3089=head3 cf::client
3048 3090
3049=over 4 3091=over 4
3050 3092
3051=item $client->send_drawinfo ($text, $flags)
3052
3053Sends a drawinfo packet to the client. Circumvents output buffering so
3054should not be used under normal circumstances.
3055
3056=cut
3057
3058sub cf::client::send_drawinfo {
3059 my ($self, $text, $flags) = @_;
3060
3061 utf8::encode $text;
3062 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text);
3063}
3064
3065=item $client->send_big_packet ($pkt) 3093=item $client->send_big_packet ($pkt)
3066 3094
3067Like C<send_packet>, but tries to compress large packets, and fragments 3095Like C<send_packet>, but tries to compress large packets, and fragments
3068them as required. 3096them as required.
3069 3097
… …
3087 $self->send_packet ($pkt); 3115 $self->send_packet ($pkt);
3088} 3116}
3089 3117
3090=item $client->send_msg ($channel, $msg, $color, [extra...]) 3118=item $client->send_msg ($channel, $msg, $color, [extra...])
3091 3119
3092Send a drawinfo or msg packet to the client, formatting the msg for the 3120Send a msg packet to the client, formatting the msg for the client if
3093client if neccessary. C<$type> should be a string identifying the type of 3121necessary. C<$type> should be a string identifying the type of the
3094the message, with C<log> being the default. If C<$color> is negative, suppress 3122message, with C<log> being the default. If C<$color> is negative, suppress
3095the message unless the client supports the msg packet. 3123the message unless the client supports the msg packet.
3096 3124
3097=cut 3125=cut
3098 3126
3099# non-persistent channels (usually the info channel) 3127# non-persistent channels (usually the info channel)
… …
3204 id => "death", 3232 id => "death",
3205 title => "Death", 3233 title => "Death",
3206 reply => undef, 3234 reply => undef,
3207 tooltip => "Reason for and more info about your most recent death", 3235 tooltip => "Reason for and more info about your most recent death",
3208 }, 3236 },
3237 "c/fatal" => {
3238 id => "fatal",
3239 title => "Fatal Error",
3240 reply => undef,
3241 tooltip => "Reason for the server disconnect",
3242 },
3209 "c/say" => $SAY_CHANNEL, 3243 "c/say" => $SAY_CHANNEL,
3210 "c/chat" => $CHAT_CHANNEL, 3244 "c/chat" => $CHAT_CHANNEL,
3211); 3245);
3212 3246
3213sub cf::client::send_msg { 3247sub cf::client::send_msg {
… …
3286 3320
3287 $self->send_packet ($self->{query_queue}[0][0]) 3321 $self->send_packet ($self->{query_queue}[0][0])
3288 if @{ $self->{query_queue} } == 1; 3322 if @{ $self->{query_queue} } == 1;
3289 3323
3290 1 3324 1
3325}
3326
3327=item $client->update_command_faces
3328
3329=cut
3330
3331our %COMMAND_FACE;
3332
3333sub cf::client::update_command_faces {
3334 my ($self) = @_;
3335
3336 my @faces = grep $_,
3337 $COMMAND_FACE{preferred},
3338 $COMMAND_FACE{standard},
3339 $COMMAND_FACE{skill},
3340 $self->pl->ob->flag (cf::FLAG_WIZ) ? $COMMAND_FACE{dm} : (),
3341 $COMMAND_FACE{emote},
3342 ;
3343
3344 $self->send_face ($_)
3345 for @faces;
3346 $self->flush_fx;
3347
3348 $self->ext_msg (command_list => @faces);
3349}
3350
3351=item cf::client::set_command_face $type, $commands
3352
3353=cut
3354
3355sub cf::client::set_command_face {
3356 my ($type, $list) = @_;
3357
3358 my $idx = &cf::face::set ( #d# ugly forward reference
3359 "command_list/$type" => cf::FT_RSRC,
3360 JSON::XS->new->utf8->encode ([ sort @$list ])
3361 );
3362
3363 $COMMAND_FACE{$type} = $idx;
3291} 3364}
3292 3365
3293cf::client->attach ( 3366cf::client->attach (
3294 on_connect => sub { 3367 on_connect => sub {
3295 my ($ns) = @_; 3368 my ($ns) = @_;
… …
3519=cut 3592=cut
3520 3593
3521############################################################################# 3594#############################################################################
3522# the server's init and main functions 3595# the server's init and main functions
3523 3596
3524our %FACEHASH; # hash => idx, #d# HACK for http server 3597{
3598 package cf::face;
3525 3599
3600 our %HASH; # hash => idx
3601 our @DATA; # dynamically-created facedata, only faceste 0 used
3602 our @FOFS; # file offset, if > 0
3603 our @SIZE; # size of face, in octets
3604 our @META; # meta hash of face, if any
3605 our $DATAFH; # facedata filehandle
3606
3526# internal api, not fianlised 3607 # internal api, not finalised
3527sub set_face { 3608 sub set {
3528 my ($name, $type, $data) = @_; 3609 my ($name, $type, $data) = @_;
3529 3610
3530 my $idx = cf::face::find $name; 3611 my $idx = cf::face::find $name;
3531 3612
3532 if ($idx) { 3613 if ($idx) {
3533 delete $FACEHASH{cf::face::get_chksum $idx}; 3614 delete $HASH{cf::face::get_csum $idx};
3534 } else { 3615 } else {
3535 $idx = cf::face::alloc $name; 3616 $idx = cf::face::alloc $name;
3536 } 3617 }
3537 3618
3538 my $hash = cf::face::mangle_chksum Digest::MD5::md5 $data; 3619 my $hash = cf::face::mangle_csum Digest::MD5::md5 $data;
3539 3620
3540 cf::face::set_type $idx, $type; 3621 cf::face::set_type $idx, $type;
3541 cf::face::set_data $idx, 0, $data, $hash; 3622 cf::face::set_csum $idx, 0, $hash;
3542 cf::face::set_meta $idx, $type & 1 ? undef : undef; 3623
3624 # we need to destroy the SV itself, not just modify it, as a running ix
3625 # might hold a reference to it: "delete" achieves that.
3626 delete $FOFS[0][$idx];
3627 delete $DATA[0][$idx];
3628 $DATA[0][$idx] = $data;
3629 $SIZE[0][$idx] = length $data;
3630 delete $META[$idx];
3543 $FACEHASH{$hash} = $idx;#d# 3631 $HASH{$hash} = $idx;#d#
3544 3632
3545 $idx 3633 $idx
3634 }
3635
3636 sub _get_data($$$) {
3637 my ($idx, $set, $cb) = @_;
3638
3639 if (defined $DATA[$set][$idx]) {
3640 $cb->($DATA[$set][$idx]);
3641 } elsif (my $fofs = $FOFS[$set][$idx]) {
3642 my $size = $SIZE[$set][$idx];
3643 my $buf;
3644 IO::AIO::aio_read $DATAFH, $fofs, $size, $buf, 0, sub {
3645 if ($_[0] == $size) {
3646 #cf::debug "read face $idx, $size from $fofs as ", length $buf;#d#
3647 $cb->($buf);
3648 } else {
3649 cf::error "INTERNAL ERROR: unable to read facedata for face $idx#$set ($size, $fofs), ignoring request.";
3650 }
3651 };
3652 } else {
3653 cf::error "requested facedata for unknown face $idx#$set, ignoring.";
3654 }
3655 }
3656
3657 # rather ineffient
3658 sub cf::face::get_data($;$) {
3659 my ($idx, $set) = @_;
3660
3661 _get_data $idx, $set, Coro::rouse_cb;
3662 Coro::rouse_wait
3663 }
3664
3665 sub cf::face::ix {
3666 my ($ns, $set, $idx, $pri) = @_;
3667
3668 _get_data $idx, $set, sub {
3669 $ns->ix_send ($idx, $pri, $_[0]);
3670 };
3671 }
3546} 3672}
3547 3673
3548sub load_facedata($) { 3674sub load_facedata($) {
3549 my ($path) = @_; 3675 my ($path) = @_;
3550 3676
3551 # HACK to clear player env face cache, we need some signal framework
3552 # for this (global event?)
3553 %ext::player_env::MUSIC_FACE_CACHE = ();
3554
3555 my $enc = JSON::XS->new->utf8->canonical->relaxed; 3677 my $enc = JSON::XS->new->utf8->canonical->relaxed;
3556 3678
3557 trace "loading facedata from $path\n"; 3679 trace "loading facedata from $path\n";
3558 3680
3559 my $facedata = decode_storable load_file $path; 3681 my $facedata = decode_storable load_file "$path/faceinfo";
3560 3682
3561 $facedata->{version} == 2 3683 $facedata->{version} == 2
3562 or cf::cleanup "$path: version mismatch, cannot proceed."; 3684 or cf::cleanup "$path/faceinfo: version mismatch, cannot proceed.";
3563 3685
3564 cf::cede_to_tick; 3686 my $fh = aio_open "$DATADIR/facedata", IO::AIO::O_RDONLY, 0
3687 or cf::cleanup "$path/facedata: $!, cannot proceed.";
3688
3689 get_slot 1, -100, "load_facedata"; # make sure we get a very big slot
3690
3691 # BEGIN ATOMIC
3692 # from here on, everything must be atomic - no thread switch allowed
3693 my $t1 = EV::time;
3565 3694
3566 { 3695 {
3567 my $faces = $facedata->{faceinfo}; 3696 my $faces = $facedata->{faceinfo};
3568 3697
3569 for my $face (sort keys %$faces) { 3698 for my $face (sort keys %$faces) {
3570 my $info = $faces->{$face}; 3699 my $info = $faces->{$face};
3571 my $idx = (cf::face::find $face) || cf::face::alloc $face; 3700 my $idx = (cf::face::find $face) || cf::face::alloc $face;
3572 3701
3573 cf::face::set_visibility $idx, $info->{visibility}; 3702 cf::face::set_visibility $idx, $info->{visibility};
3574 cf::face::set_magicmap $idx, $info->{magicmap}; 3703 cf::face::set_magicmap $idx, $info->{magicmap};
3575 cf::face::set_data $idx, 0, $info->{data32}, $info->{hash32}; 3704 cf::face::set_csum $idx, 0, $info->{hash64}; $cf::face::SIZE[0][$idx] = $info->{size64}; $cf::face::FOFS[0][$idx] = $info->{fofs64};
3576 cf::face::set_data $idx, 1, $info->{data64}, $info->{hash64}; 3705 cf::face::set_csum $idx, 1, $info->{hash32}; $cf::face::SIZE[1][$idx] = $info->{size32}; $cf::face::FOFS[1][$idx] = $info->{fofs32};
3577 cf::face::set_data $idx, 2, $info->{glyph} , $info->{glyph} ; 3706 cf::face::set_csum $idx, 2, $info->{glyph}; $cf::face::DATA[2][$idx] = $info->{glyph};
3578 $FACEHASH{$info->{hash64}} = $idx;#d# 3707 $cf::face::HASH{$info->{hash64}} = $idx;
3579 3708 delete $cf::face::META[$idx];
3580 cf::cede_to_tick;
3581 } 3709 }
3582 3710
3583 while (my ($face, $info) = each %$faces) { 3711 while (my ($face, $info) = each %$faces) {
3584 next unless $info->{smooth}; 3712 next unless $info->{smooth};
3585 3713
… …
3590 cf::face::set_smooth $idx, $smooth; 3718 cf::face::set_smooth $idx, $smooth;
3591 cf::face::set_smoothlevel $idx, $info->{smoothlevel}; 3719 cf::face::set_smoothlevel $idx, $info->{smoothlevel};
3592 } else { 3720 } else {
3593 error "smooth face '$info->{smooth}' not found for face '$face'"; 3721 error "smooth face '$info->{smooth}' not found for face '$face'";
3594 } 3722 }
3595
3596 cf::cede_to_tick;
3597 } 3723 }
3598 } 3724 }
3599 3725
3600 { 3726 {
3601 my $anims = $facedata->{animinfo}; 3727 my $anims = $facedata->{animinfo};
3602 3728
3603 while (my ($anim, $info) = each %$anims) { 3729 while (my ($anim, $info) = each %$anims) {
3604 cf::anim::set $anim, $info->{frames}, $info->{facings}; 3730 cf::anim::set $anim, $info->{frames}, $info->{facings};
3605 cf::cede_to_tick;
3606 } 3731 }
3607 3732
3608 cf::anim::invalidate_all; # d'oh 3733 cf::anim::invalidate_all; # d'oh
3609 } 3734 }
3610 3735
… …
3615 if (defined (my $type = $info->{type})) { 3740 if (defined (my $type = $info->{type})) {
3616 # TODO: different hash - must free and use new index, or cache ixface data queue 3741 # TODO: different hash - must free and use new index, or cache ixface data queue
3617 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3742 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3618 3743
3619 cf::face::set_type $idx, $type; 3744 cf::face::set_type $idx, $type;
3620 cf::face::set_data $idx, 0, $info->{data}, $info->{hash}; 3745 cf::face::set_csum $idx, 0, $info->{hash};
3746 $cf::face::SIZE[0][$idx] = $info->{size};
3747 $cf::face::FOFS[0][$idx] = $info->{fofs};
3621 cf::face::set_meta $idx, $type & 1 ? undef : $info->{meta}; # preserve meta unless prepended already 3748 $cf::face::META[$idx] = $type & 1 ? undef : $info->{meta}; # preserve meta unless prepended already
3622 $FACEHASH{$info->{hash}} = $idx;#d# 3749 $cf::face::HASH{$info->{hash}} = $idx;
3623 } else { 3750 } else {
3624# $RESOURCE{$name} = $info; # unused 3751# $RESOURCE{$name} = $info; # unused
3625 } 3752 }
3626
3627 cf::cede_to_tick;
3628 } 3753 }
3629 } 3754 }
3755
3756 ($fh, $cf::face::DATAFH) = ($cf::face::DATAFH, $fh);
3757
3758 # HACK to clear player env face cache, we need some signal framework
3759 # for this (global event?)
3760 %ext::player_env::MUSIC_FACE_CACHE = ();
3761
3762 # END ATOMIC
3763
3764 cf::debug "facedata atomic update time ", EV::time - $t1;
3630 3765
3631 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE); 3766 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE);
3767
3768 aio_close $fh if $fh; # close old facedata
3632 3769
3633 1 3770 1
3634} 3771}
3635 3772
3636register_exticmd fx_want => sub { 3773register_exticmd fx_want => sub {
… …
3652} 3789}
3653 3790
3654sub reload_exp_table { 3791sub reload_exp_table {
3655 _reload_exp_table; 3792 _reload_exp_table;
3656 3793
3794 cf::face::set
3657 set_face "res/exp_table" => FT_RSRC, 3795 "res/exp_table" => FT_RSRC,
3658 JSON::XS->new->utf8->canonical->encode ( 3796 JSON::XS->new->utf8->canonical->encode (
3659 [map cf::level_to_min_exp $_, 1 .. cf::settings->max_level] 3797 [map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]
3660 ); 3798 );
3661} 3799}
3662 3800
3663sub reload_materials { 3801sub reload_materials {
3664 _reload_materials; 3802 _reload_materials;
3665} 3803}
… …
3677 if exists $_->{match}; 3815 if exists $_->{match};
3678 } 3816 }
3679} 3817}
3680 3818
3681sub reload_facedata { 3819sub reload_facedata {
3682 load_facedata "$DATADIR/facedata" 3820 load_facedata $DATADIR
3683 or die "unable to load facedata\n"; 3821 or die "unable to load facedata\n";
3684} 3822}
3685 3823
3686sub reload_archetypes { 3824sub reload_archetypes {
3687 load_resource_file "$DATADIR/archetypes" 3825 load_resource_file "$DATADIR/archetypes"
3688 or die "unable to load archetypes\n"; 3826 or die "unable to load archetypes\n";
3689 3827
3828 cf::face::set
3690 set_face "res/skill_info" => FT_RSRC, 3829 "res/skill_info" => FT_RSRC,
3691 JSON::XS->new->utf8->canonical->encode ( 3830 JSON::XS->new->utf8->canonical->encode (
3692 [map [cf::arch::skillvec ($_)->name], 0 .. cf::arch::skillvec_size - 1] 3831 [map [cf::arch::skillvec ($_)->name], 0 .. cf::arch::skillvec_size - 1]
3693 ); 3832 );
3833
3834 cf::face::set
3694 set_face "res/spell_paths" => FT_RSRC, 3835 "res/spell_paths" => FT_RSRC,
3695 JSON::XS->new->utf8->canonical->encode ( 3836 JSON::XS->new->utf8->canonical->encode (
3696 [map [cf::spellpathnames ($_)], 0 .. NRSPELLPATHS - 1] 3837 [map [cf::spellpathnames ($_)], 0 .. NRSPELLPATHS - 1]
3697 ); 3838 );
3839
3840 # command completion
3841 my @commands;
3842
3843 for (0..cf::arch::skillvec_size - 1) {
3844 my $skill = cf::arch::skillvec $_;
3845 my $name = $skill->name;
3846 my $flags = cf::skill_flags $skill->subtype;
3847
3848 push @commands, "ready_skill $name" if $flags & (SF_COMBAT | SF_RANGED | SF_GRACE);
3849 push @commands, "use_skill $name" if $flags & (SF_USE | SF_AUTARK | SF_GRACE);
3850 }
3851
3852 cf::client::set_command_face skill => \@commands;
3698} 3853}
3699 3854
3700sub reload_treasures { 3855sub reload_treasures {
3701 load_resource_file "$DATADIR/treasures" 3856 load_resource_file "$DATADIR/treasures"
3702 or die "unable to load treasurelists\n"; 3857 or die "unable to load treasurelists\n";
… …
3775 seek $fh, 0, 0; 3930 seek $fh, 0, 0;
3776 print $fh $$; 3931 print $fh $$;
3777} 3932}
3778 3933
3779sub main_loop { 3934sub main_loop {
3780 trace "EV::loop starting\n"; 3935 trace "EV::run starting\n";
3781 if (1) { 3936 if (1) {
3782 EV::loop; 3937 EV::run;
3783 } 3938 }
3784 trace "EV::loop returned\n"; 3939 trace "EV::run returned\n";
3785 goto &main_loop unless $REALLY_UNLOOP; 3940 goto &main_loop unless $REALLY_UNLOOP;
3786} 3941}
3787 3942
3788sub main { 3943sub main {
3789 cf::init_globals; # initialise logging 3944 cf::init_globals; # initialise logging
… …
3798 # we must not ever block the main coroutine 3953 # we must not ever block the main coroutine
3799 $Coro::idle = sub { 3954 $Coro::idle = sub {
3800 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 3955 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
3801 (async { 3956 (async {
3802 $Coro::current->{desc} = "IDLE BUG HANDLER"; 3957 $Coro::current->{desc} = "IDLE BUG HANDLER";
3803 EV::loop EV::LOOP_ONESHOT; 3958 EV::run EV::RUN_ONCE;
3804 })->prio (Coro::PRIO_MAX); 3959 })->prio (Coro::PRIO_MAX);
3805 }; 3960 };
3806 3961
3807 evthread_start IO::AIO::poll_fileno; 3962 evthread_start IO::AIO::poll_fileno;
3808 3963

Diff Legend

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