| 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} || 2; |
| 6 |
|
| 7 |
our $GENCOUNT = 0; |
| 8 |
our %PLAYERINFO; |
| 9 |
|
| 10 |
our ($MAPW, $MAPH) = (1024, 1024); # it's useful to know the map width/height in pixels |
| 11 |
|
| 12 |
sub update_worldmap { |
| 13 |
my ($ws) = @_; |
| 14 |
|
| 15 |
return if $GENCOUNT == $ws->{gencount}; |
| 16 |
$ws->{gencount} = $GENCOUNT; |
| 17 |
|
| 18 |
my $old = delete $ws->{labels}; |
| 19 |
my $new; |
| 20 |
|
| 21 |
my $name = $ws->{ns}->pl->ob->name; |
| 22 |
|
| 23 |
while (my ($k, $v) = each %PLAYERINFO) { |
| 24 |
my $label = (delete $old->{$k}) || do { |
| 25 |
my $label = $ws->new (Label => |
| 26 |
text => $k, |
| 27 |
fontsize => 0.2, |
| 28 |
); |
| 29 |
|
| 30 |
my $marker = $ws->new (Face => |
| 31 |
face => $ws->{ns}->need_face ("res/map-arrow"), |
| 32 |
); |
| 33 |
my $children = [$label, $marker]; |
| 34 |
|
| 35 |
$ws->{canvas}->add (my $vbox = $ws->new (VBox => |
| 36 |
children => $children, |
| 37 |
c_halign => -.5, |
| 38 |
c_valign => -1, |
| 39 |
)); |
| 40 |
$vbox->{children} = $children; |
| 41 |
|
| 42 |
$vbox |
| 43 |
}; |
| 44 |
|
| 45 |
$new->{$k} = $label; |
| 46 |
|
| 47 |
if ($v != $label->{prevpos}) { |
| 48 |
$label->set (c_x => $v->[0], c_y => $v->[1]); |
| 49 |
$label->{prevpos} = $v; |
| 50 |
$ws->{window}->make_visible ($v->[0], $v->[1], .2) |
| 51 |
if $k eq $name; |
| 52 |
} |
| 53 |
} |
| 54 |
|
| 55 |
$ws->{labels} = $new; |
| 56 |
} |
| 57 |
|
| 58 |
sub create_widgets { |
| 59 |
my ($ns) = @_; |
| 60 |
|
| 61 |
my $ws = $ns->new_widgetset; |
| 62 |
|
| 63 |
$ws->{toplevel} = my $w = $ws->new (Toplevel => |
| 64 |
title => "Worldmap", |
| 65 |
name => "server_item_worldmap", |
| 66 |
force_w => 400, |
| 67 |
force_h => 400, |
| 68 |
x => "center", |
| 69 |
y => "center", |
| 70 |
has_close_button => 1, |
| 71 |
on_delete => sub { shift->hide }, |
| 72 |
on_visibility_change => sub { |
| 73 |
$_[0]{visibility} = $_[1]; |
| 74 |
update_worldmap $_[0]{ws} if $_[1]; |
| 75 |
}, |
| 76 |
); |
| 77 |
|
| 78 |
$w->add (my $sw = $ws->{window} = $ws->new (ScrolledWindow => scroll_x => 1, scroll_y => 1)); |
| 79 |
$sw->add (my $canvas = $ws->{canvas} = $ws->new (Canvas => expand => 1)); |
| 80 |
|
| 81 |
$ws->{mapface} = $ws->new (Face => |
| 82 |
size_w => undef, |
| 83 |
size_h => undef, |
| 84 |
face => $ws->{ns}->need_face ("res/worldmap"), |
| 85 |
); |
| 86 |
|
| 87 |
$ws->{canvas}->add ($ws->{mapface}); |
| 88 |
|
| 89 |
$ws |
| 90 |
} |
| 91 |
|
| 92 |
cf::object::attachment item_worldmap => |
| 93 |
on_apply => sub { |
| 94 |
my ($self, $who) = @_; |
| 95 |
|
| 96 |
my $ns = $who->contr->ns; |
| 97 |
|
| 98 |
if ($ns->{can_widget}) { |
| 99 |
my $ws = $ns->{ws_worldmap} ||= create_widgets $ns; |
| 100 |
$ws->{toplevel}->toggle_visibility; |
| 101 |
} else { |
| 102 |
$ns->send_msg ("log", "Your client doesn't support the (required) widget extension. Try CFPlus at http://crossfire.schmorp.de/.", cf::NDI_RED); |
| 103 |
} |
| 104 |
|
| 105 |
cf::override 1; |
| 106 |
}, |
| 107 |
; |
| 108 |
|
| 109 |
cf::async_ext { |
| 110 |
$Coro::current->{desc} = "worldmap updater"; |
| 111 |
my $schedule_interval = Coro::Event->timer (after => 1); |
| 112 |
|
| 113 |
while () { |
| 114 |
$schedule_interval->interval ($WORLDMAP_UPDATE_INTERVAL); |
| 115 |
$schedule_interval->next; |
| 116 |
|
| 117 |
cf::get_slot 0.01, -50, "worldmap update"; |
| 118 |
|
| 119 |
++$GENCOUNT; |
| 120 |
|
| 121 |
# recalculate player info |
| 122 |
my %new; |
| 123 |
for (values %cf::PLAYER) { |
| 124 |
my $map = $_->ob->map |
| 125 |
or next; |
| 126 |
$map =~ /^\/world\/world_(\d\d\d)_(\d\d\d)/ |
| 127 |
or next; |
| 128 |
|
| 129 |
my $ob = $_->ob; |
| 130 |
my $x = ($1 - 100) * 50 + $ob->x; |
| 131 |
my $y = ($2 - 100) * 50 + $ob->y; |
| 132 |
|
| 133 |
0 <= $x && 0 <= $y && $x < 1500 && $y < 1500 |
| 134 |
or next; |
| 135 |
|
| 136 |
$x = int $x * $MAPW / 1500; |
| 137 |
$y = int $y * $MAPH / 1500; |
| 138 |
|
| 139 |
my $name = $ob->name; |
| 140 |
|
| 141 |
if (my $pi = delete $PLAYERINFO{$name}) { |
| 142 |
if ($pi->[0] == $x && $pi->[1] == $y) { |
| 143 |
$new{$name} = $pi; |
| 144 |
next; |
| 145 |
} |
| 146 |
} |
| 147 |
|
| 148 |
$new{$name} = [$x, $y]; |
| 149 |
} |
| 150 |
|
| 151 |
*PLAYERINFO = \%new; |
| 152 |
|
| 153 |
cf::get_slot 0.03, -50, "worldmap socket update"; |
| 154 |
for (values %cf::PLAYER) { |
| 155 |
my $ns = $_->ns |
| 156 |
or next; |
| 157 |
|
| 158 |
update_worldmap $ns->{ws_worldmap} |
| 159 |
if $ns->{ws_worldmap} && $ns->{ws_worldmap}{toplevel}{visibility}; |
| 160 |
} |
| 161 |
} |
| 162 |
}; |
| 163 |
|
