server/ext/item-worldmap.ext

#! perl # depends=widget mandatory

# this module implements a rather fancy worldmap

CONF WORLDMAP_UPDATE_INTERVAL = 2;

our $GENCOUNT = 0;
our %PLAYERINFO;

our ($MAPW, $MAPH) = (1024, 1024); # it's useful to know the map width/height in pixels

sub update_worldmap {
   my ($ws) = @_;

   return if $GENCOUNT == $ws->{gencount};
   $ws->{gencount} = $GENCOUNT;

   my $old = delete $ws->{labels};
   my $new;

   my $name = $ws->{ns}->pl->ob->name;

   while (my ($k, $v) = each %PLAYERINFO) {
      my $label = (delete $old->{$k}) || do {
         my $label = $ws->new (Label =>
            text     => $k,
            fontsize => 0.2,
         );

         my $marker = $ws->new (Face =>
            face => $ws->{ns}->need_face ("res/map-arrow"),
         );
         my $children = [$label, $marker];

         $ws->{canvas}->add (my $vbox = $ws->new (VBox =>
            children => $children,
            c_halign => -.5,
            c_valign => -1,
         ));
         $vbox->{children} = $children;

         $vbox
      };

      $new->{$k} = $label;

      if ($v != $label->{prevpos}) {
         $label->set (c_x => $v->[0], c_y => $v->[1]);
         $label->{prevpos} = $v;
         $ws->{window}->make_visible ($v->[0], $v->[1], .2)
            if $k eq $name;
      }
   }

   $ws->{labels} = $new;
}

sub create_widgets {
   my ($ns) = @_;

   my $ws = $ns->new_widgetset;

   $ws->{toplevel} = my $w = $ws->new (Toplevel =>
      title   => "Worldmap",
      name    => "server_item_worldmap",
      force_w => 400,
      force_h => 400,
      x       => "center",
      y       => "center",
      has_close_button => 1,
      on_delete => sub { shift->hide },
      on_visibility_change => sub {
         $_[0]{visibility} = $_[1];
         update_worldmap $_[0]{ws} if $_[1];
      },
   );

   $w->add (my $sw = $ws->{window} = $ws->new (ScrolledWindow => scroll_x => 1, scroll_y => 1));
   $sw->add (my $canvas = $ws->{canvas} = $ws->new (Canvas => expand => 1));

   $ws->{mapface} = $ws->new (Face =>
      size_w => undef,
      size_h => undef,
      face   => $ws->{ns}->need_face ("res/worldmap"),
   );

   $ws->{canvas}->add ($ws->{mapface});

   $ws
}

cf::object::attachment item_worldmap =>
   on_apply => sub {
      my ($self, $who) = @_;

      my $ns = $who->contr->ns;

      if ($ns->{can_widget}) {
         my $ws = $ns->{ws_worldmap} ||= create_widgets $ns;
         $ws->{toplevel}->toggle_visibility;
      } else {
         $ns->send_msg ("log", "Your client doesn't support the (required) widget extension. Try the deliantra client at http://www.deliantra.net/.", cf::NDI_RED);
      }

      cf::override 1;
   },
;

cf::post_init {
   our $UPDATER = cf::async_ext {
      $Coro::current->{desc} = "worldmap updater";

      while () {
         Coro::AnyEvent::sleep $WORLDMAP_UPDATE_INTERVAL;

         cf::get_slot 0.01, -50, "worldmap update";

         ++$GENCOUNT;

         # recalculate player info
         my %new;
         for (values %cf::PLAYER) {
            my $map = $_->ob->map
               or next;
            $map =~ /^\/world\/world_(\d\d\d)_(\d\d\d)/
               or next;

            my $ob = $_->ob;
            my $x = ($1 - 100) * 50 + $ob->x;
            my $y = ($2 - 100) * 50 + $ob->y;

            0 <= $x && 0 <= $y && $x < 1500 && $y < 1500
               or next;

            $x = int $x * $MAPW / 1500;
            $y = int $y * $MAPH / 1500;

            my $name = $ob->name;

            if (my $pi = delete $PLAYERINFO{$name}) {
               if ($pi->[0] == $x && $pi->[1] == $y) {
                  $new{$name} = $pi;
                  next;
               }
            }
                  
            $new{$name} = [$x, $y];
         }

         *PLAYERINFO = \%new;

         cf::get_slot 0.03, -50, "worldmap socket update";
         for (values %cf::PLAYER) {
            my $ns = $_->ns
               or next;

            update_worldmap $ns->{ws_worldmap}
               if $ns->{ws_worldmap} && $ns->{ws_worldmap}{toplevel}{visibility};
         }
      }
   };
};

Revision:	1.23
Committed:	Fri Feb 3 03:01:44 2012 UTC (14 years, 9 months ago) by root
Branch:	MAIN
CVS Tags:	rel-3_1, HEAD
Changes since 1.22:	+1 -1 lines
Log Message:	* empty log message *
#	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.23	CONF 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.8	my $label = (delete $old->{$k}) \|\| do {
25	root	1.7	my $label = $ws->new (Label =>
26	root	1.5	text => $k,
27			fontsize => 0.2,
28	root	1.9	);
29
30	root	1.10	my $marker = $ws->new (Face =>
31	root	1.14	face => $ws->{ns}->need_face ("res/map-arrow"),
32	root	1.9	);
33			my $children = [$label, $marker];
34
35			$ws->{canvas}->add (my $vbox = $ws->new (VBox =>
36			children => $children,
37	root	1.5	c_halign => -.5,
38			c_valign => -1,
39	root	1.9	));
40			$vbox->{children} = $children;
41
42			$vbox
43	root	1.7	};
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	root	1.5	}
53	root	1.4	}
54	root	1.7
55			$ws->{labels} = $new;
56	root	1.5	}
57	root	1.1
58			sub create_widgets {
59			my ($ns) = @_;
60
61	root	1.5	my $ws = $ns->new_widgetset;
62	root	1.1
63	root	1.5	$ws->{toplevel} = my $w = $ws->new (Toplevel =>
64	root	1.2	title => "Worldmap",
65			name => "server_item_worldmap",
66	root	1.1	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	root	1.5	on_visibility_change => sub {
73			$_[0]{visibility} = $_[1];
74			update_worldmap $_[0]{ws} if $_[1];
75			},
76	root	1.1	);
77
78	root	1.7	$w->add (my $sw = $ws->{window} = $ws->new (ScrolledWindow => scroll_x => 1, scroll_y => 1));
79	root	1.5	$sw->add (my $canvas = $ws->{canvas} = $ws->new (Canvas => expand => 1));
80	root	1.1
81	root	1.5	$ws->{mapface} = $ws->new (Face =>
82	root	1.12	size_w => undef,
83			size_h => undef,
84	root	1.14	face => $ws->{ns}->need_face ("res/worldmap"),
85	root	1.5	);
86	root	1.1
87	root	1.5	$ws->{canvas}->add ($ws->{mapface});
88	root	1.4
89	root	1.5	$ws
90	root	1.4	}
91	root	1.1
92			cf::object::attachment item_worldmap =>
93			on_apply => sub {
94			my ($self, $who) = @_;
95
96			my $ns = $who->contr->ns;
97
98	root	1.2	if ($ns->{can_widget}) {
99			my $ws = $ns->{ws_worldmap} \|\|= create_widgets $ns;
100	root	1.4	$ws->{toplevel}->toggle_visibility;
101	root	1.2	} else {
102	root	1.19	$ns->send_msg ("log", "Your client doesn't support the (required) widget extension. Try the deliantra client at http://www.deliantra.net/.", cf::NDI_RED);
103	root	1.2	}
104	root	1.1
105			cf::override 1;
106			},
107			;
108
109	root	1.20	cf::post_init {
110	root	1.21	our $UPDATER = cf::async_ext {
111	root	1.20	$Coro::current->{desc} = "worldmap updater";
112
113			while () {
114	root	1.22	Coro::AnyEvent::sleep $WORLDMAP_UPDATE_INTERVAL;
115	root	1.20
116			cf::get_slot 0.01, -50, "worldmap update";
117
118			++$GENCOUNT;
119
120			# recalculate player info
121			my %new;
122			for (values %cf::PLAYER) {
123			my $map = $_->ob->map
124			or next;
125			$map =~ /^\/world\/world_(\d\d\d)_(\d\d\d)/
126			or next;
127
128			my $ob = $_->ob;
129			my $x = ($1 - 100) * 50 + $ob->x;
130			my $y = ($2 - 100) * 50 + $ob->y;
131
132			0 <= $x && 0 <= $y && $x < 1500 && $y < 1500
133			or next;
134
135			$x = int $x * $MAPW / 1500;
136			$y = int $y * $MAPH / 1500;
137
138			my $name = $ob->name;
139
140			if (my $pi = delete $PLAYERINFO{$name}) {
141			if ($pi->[0] == $x && $pi->[1] == $y) {
142			$new{$name} = $pi;
143			next;
144			}
145	root	1.6	}
146	root	1.20
147			$new{$name} = [$x, $y];
148	root	1.6	}
149	root	1.5
150	root	1.20	*PLAYERINFO = \%new;
151	root	1.7
152	root	1.20	cf::get_slot 0.03, -50, "worldmap socket update";
153			for (values %cf::PLAYER) {
154			my $ns = $_->ns
155			or next;
156	root	1.6
157	root	1.20	update_worldmap $ns->{ws_worldmap}
158			if $ns->{ws_worldmap} && $ns->{ws_worldmap}{toplevel}{visibility};
159			}
160	root	1.5	}
161	root	1.20	};
162	root	1.5	};
163