ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/item-worldmap.ext
Revision: 1.7
Committed: Mon Jul 23 17:53:54 2007 UTC (16 years, 10 months ago) by root
Branch: MAIN
Changes since 1.6: +32 -14 lines
Log Message:
much better, still label duplication

File Contents

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