ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/item-worldmap.ext
(Generate patch)

Comparing deliantra/server/ext/item-worldmap.ext (file contents):
Revision 1.3 by root, Sun Jul 22 14:17:58 2007 UTC vs.
Revision 1.6 by root, Mon Jul 23 16:53:15 2007 UTC

1#! perl # depends=widget 1#! perl # depends=widget mandatory
2#! perl 2
3# this module implements a rather fancy worldmap
4
5our $WORLDMAP_UPDATE_INTERVAL = $cf::CFG{worldmap_update_interval} || 10;
6
7our $GENCOUNT = 0;
8our %PLAYERINFO;
9
10sub 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}
3 31
4sub create_widgets { 32sub create_widgets {
5 my ($ns) = @_; 33 my ($ns) = @_;
6 34
7 my $info = { }; 35 my $ws = $ns->new_widgetset;
8 36
9 $info->{ws} = my $ws = $ns->new_widgetset;
10
11 $info->{toplevel} = my $w = $ws->new (Toplevel => 37 $ws->{toplevel} = my $w = $ws->new (Toplevel =>
12 title => "Worldmap", 38 title => "Worldmap",
13 name => "server_item_worldmap", 39 name => "server_item_worldmap",
14 force_w => 400, 40 force_w => 400,
15 force_h => 400, 41 force_h => 400,
16 x => "center", 42 x => "center",
17 y => "center", 43 y => "center",
18 has_close_button => 1, 44 has_close_button => 1,
19 on_delete => sub { shift->hide }, 45 on_delete => sub { shift->hide },
46 on_visibility_change => sub {
47 $_[0]{visibility} = $_[1];
48 update_worldmap $_[0]{ws} if $_[1];
49 },
20 ); 50 );
21 51
22 my $face = cf::face::find "res/worldmap.jpg"; 52 my $face = cf::face::find "res/worldmap.jpg";
23 $ns->send_face ($face); 53 $ns->send_face ($face);
24 $ns->flush_fx; 54 $ns->flush_fx;
25 55
26 $w->add (my $sw = $ws->new (ScrolledWindow => scroll_x => 1, scroll_y => 1)); 56 $w->add (my $sw = $ws->new (ScrolledWindow => scroll_x => 1, scroll_y => 1));
27 $sw->add (my $canvas = $ws->new (Canvas => expand => 1)); 57 $sw->add (my $canvas = $ws->{canvas} = $ws->new (Canvas => expand => 1));
28 $canvas->add_fixed ($ws->new (Face => expand => 1, size_w => undef, size_h => undef, face => $face), abs => 0, 0, rel => 1, 1);
29 $canvas->add_fixed ($ws->new (Label => text => "lb1"), abs => 10, 10, rel => 1, 1);
30 58
31 $info 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
32} 69}
33
34# this module implements a rather fancy worldmap
35 70
36cf::object::attachment item_worldmap => 71cf::object::attachment item_worldmap =>
37 on_apply => sub { 72 on_apply => sub {
38 my ($self, $who) = @_; 73 my ($self, $who) = @_;
39 74
40 my $ns = $who->contr->ns; 75 my $ns = $who->contr->ns;
41 76
42 if ($ns->{can_widget}) { 77 if ($ns->{can_widget}) {
43 my $ws = $ns->{ws_worldmap} ||= create_widgets $ns; 78 my $ws = $ns->{ws_worldmap} ||= create_widgets $ns;
44 $ws->{toplevel}->show; 79 $ws->{toplevel}->toggle_visibility;
45 } else { 80 } else {
46 $ns->send_msg ("log", "Your client doesn't support the (required) widget extension. Try CFPlus at http://crossfire.schmorp.de/.", cf::NDI_RED); 81 $ns->send_msg ("log", "Your client doesn't support the (required) widget extension. Try CFPlus at http://crossfire.schmorp.de/.", cf::NDI_RED);
47 } 82 }
48 83
49 cf::override 1; 84 cf::override 1;
50 }, 85 },
51; 86;
52 87
88cf::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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines