| 1 |
#! perl # depends=widget mandatory |
| 2 |
|
| 3 |
# this module implements a rather fancy worldmap |
| 4 |
|
| 5 |
our $WORLDMAP_UPDATE_INTERVAL = $cf::CFG{worldmap_update_interval} || 10; |
| 6 |
|
| 7 |
our $GENCOUNT = 0; |
| 8 |
our %PLAYERINFO; |
| 9 |
|
| 10 |
sub update_worldmap { |
| 11 |
my ($ws) = @_; |
| 12 |
|
| 13 |
my $labels = delete $ws->{labels}; |
| 14 |
|
| 15 |
while (my ($k, $v) = each %PLAYERINFO) { |
| 16 |
if (my $old = $labels->{$k}) { |
| 17 |
$ws->{labels}{$k} = $old; |
| 18 |
} else { |
| 19 |
$ws->{labels}{$k} = $ws->new (Label => |
| 20 |
text => $k, |
| 21 |
fontsize => 0.2, |
| 22 |
c_rel => 1, |
| 23 |
c_halign => -.5, |
| 24 |
c_valign => -1, |
| 25 |
); |
| 26 |
$ws->{canvas}->add ($ws->{labels}{$k}); |
| 27 |
} |
| 28 |
$ws->{labels}{$k}->set (c_x => $v->[0], c_y => $v->[1]); |
| 29 |
} |
| 30 |
} |
| 31 |
|
| 32 |
sub create_widgets { |
| 33 |
my ($ns) = @_; |
| 34 |
|
| 35 |
my $ws = $ns->new_widgetset; |
| 36 |
|
| 37 |
$ws->{toplevel} = my $w = $ws->new (Toplevel => |
| 38 |
title => "Worldmap", |
| 39 |
name => "server_item_worldmap", |
| 40 |
force_w => 400, |
| 41 |
force_h => 400, |
| 42 |
x => "center", |
| 43 |
y => "center", |
| 44 |
has_close_button => 1, |
| 45 |
on_delete => sub { shift->hide }, |
| 46 |
on_visibility_change => sub { |
| 47 |
$_[0]{visibility} = $_[1]; |
| 48 |
update_worldmap $_[0]{ws} if $_[1]; |
| 49 |
}, |
| 50 |
); |
| 51 |
|
| 52 |
my $face = cf::face::find "res/worldmap.jpg"; |
| 53 |
$ns->send_face ($face); |
| 54 |
$ns->flush_fx; |
| 55 |
|
| 56 |
$w->add (my $sw = $ws->new (ScrolledWindow => scroll_x => 1, scroll_y => 1)); |
| 57 |
$sw->add (my $canvas = $ws->{canvas} = $ws->new (Canvas => expand => 1)); |
| 58 |
|
| 59 |
$ws->{mapface} = $ws->new (Face => |
| 60 |
expand => 1, |
| 61 |
size_w => undef, |
| 62 |
size_h => undef, |
| 63 |
face => $face, |
| 64 |
); |
| 65 |
|
| 66 |
$ws->{canvas}->add ($ws->{mapface}); |
| 67 |
|
| 68 |
$ws |
| 69 |
} |
| 70 |
|
| 71 |
cf::object::attachment item_worldmap => |
| 72 |
on_apply => sub { |
| 73 |
my ($self, $who) = @_; |
| 74 |
|
| 75 |
my $ns = $who->contr->ns; |
| 76 |
|
| 77 |
if ($ns->{can_widget}) { |
| 78 |
my $ws = $ns->{ws_worldmap} ||= create_widgets $ns; |
| 79 |
$ws->{toplevel}->toggle_visibility; |
| 80 |
} else { |
| 81 |
$ns->send_msg ("log", "Your client doesn't support the (required) widget extension. Try CFPlus at http://crossfire.schmorp.de/.", cf::NDI_RED); |
| 82 |
} |
| 83 |
|
| 84 |
cf::override 1; |
| 85 |
}, |
| 86 |
; |
| 87 |
|
| 88 |
cf::async_ext { |
| 89 |
my $schedule_interval = Coro::Event->timer (after => 1); |
| 90 |
|
| 91 |
while () { |
| 92 |
$schedule_interval->interval ($WORLDMAP_UPDATE_INTERVAL); |
| 93 |
$schedule_interval->next; |
| 94 |
|
| 95 |
cf::get_slot 0.05; |
| 96 |
|
| 97 |
++$GENCOUNT; |
| 98 |
|
| 99 |
# recalculate player info |
| 100 |
my %new; |
| 101 |
for (values %cf::PLAYER) { |
| 102 |
my $map = $_->ob->map |
| 103 |
or next; |
| 104 |
$map =~ /^\/world\/world_(\d\d\d)_(\d\d\d)/ |
| 105 |
or next; |
| 106 |
|
| 107 |
my $ob = $_->ob; |
| 108 |
my $x = ($1 - 100) * 50 + $ob->x; |
| 109 |
my $y = ($2 - 100) * 50 + $ob->y; |
| 110 |
|
| 111 |
0 <= $x && 0 <= $y && $x < 1500 && $y < 1500 |
| 112 |
or next; |
| 113 |
|
| 114 |
# rounding saves network bandwidth... |
| 115 |
$x = sprintf "%.3f", $x / 1500; |
| 116 |
$y = sprintf "%.3f", $y / 1500; |
| 117 |
|
| 118 |
my $name = $ob->name; |
| 119 |
|
| 120 |
if (my $pi = delete $PLAYERINFO{$name}) { |
| 121 |
if ($pi->[0] == $x && $pi->[1] == $y) { |
| 122 |
$new{$name} = $pi; |
| 123 |
next; |
| 124 |
} |
| 125 |
} |
| 126 |
|
| 127 |
$new{$name} = [$x, $y]; |
| 128 |
} |
| 129 |
|
| 130 |
for (values %cf::PLAYER) { |
| 131 |
my $ns = $_->ns |
| 132 |
or next; |
| 133 |
|
| 134 |
update_worldmap $ns->{ws_worldmap} |
| 135 |
if $ns->{ws_worldmap} && $ns->{ws_worldmap}{toplevel}{visibility}; |
| 136 |
} |
| 137 |
} |
| 138 |
}; |
| 139 |
|
