server/ext/item-worldmap.ext

#! perl # depends=widget mandatory

# this module implements a rather fancy worldmap

our $WORLDMAP_UPDATE_INTERVAL = $cf::CFG{worldmap_update_interval} || 10;

our $GENCOUNT = 0;
our %PLAYERINFO;

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

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

   while (my ($k, $v) = each %PLAYERINFO) {
      if (my $old = $labels->{$k}) {
         $ws->{labels}{$k} = $old;
      } else {
         $ws->{labels}{$k} = $ws->new (Label =>
            text     => $k,
            fontsize => 0.2,
            c_rel    => 1,
            c_halign => -.5,
            c_valign => -1,
         );
         $ws->{canvas}->add ($ws->{labels}{$k});
      }
      $ws->{labels}{$k}->set (c_x => $v->[0], c_y => $v->[1]);
   }
}

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];
      },
   );

   my $face = cf::face::find "res/worldmap.jpg";
   $ns->send_face ($face);
   $ns->flush_fx;

   $w->add (my $sw = $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 =>
      expand => 1,
      size_w => undef,
      size_h => undef,
      face   => $face,
   );

   $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 CFPlus at http://crossfire.schmorp.de/.", cf::NDI_RED);
      }

      cf::override 1;
   },
;

cf::async_ext {
   my $schedule_interval = Coro::Event->timer (after => 1);

   while () {
      $schedule_interval->interval ($WORLDMAP_UPDATE_INTERVAL);
      $schedule_interval->next;

      cf::get_slot 0.05;

      ++$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;

         # rounding saves network bandwidth...
         $x = sprintf "%.3f", $x / 1500;
         $y = sprintf "%.3f", $y / 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];
      }

      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.6
Committed:	Mon Jul 23 16:53:15 2007 UTC (16 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.5:	+21 -2 lines
Log Message:	implement yet another et-cpu-time primitive, this time its called get_slot... might replace most uses of wait_for_tick
#	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.5	our $WORLDMAP_UPDATE_INTERVAL = $cf::CFG{worldmap_update_interval} \|\| 10;
6	root	1.4
7	root	1.6	our $GENCOUNT = 0;
8	root	1.5	our %PLAYERINFO;
9
10			sub update_worldmap {
11			my ($ws) = @_;
12
13			my $labels = delete $ws->{labels};
14	root	1.4
15	root	1.5	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	root	1.4	}
30	root	1.5	}
31	root	1.1
32			sub create_widgets {
33			my ($ns) = @_;
34
35	root	1.5	my $ws = $ns->new_widgetset;
36	root	1.1
37	root	1.5	$ws->{toplevel} = my $w = $ws->new (Toplevel =>
38	root	1.2	title => "Worldmap",
39			name => "server_item_worldmap",
40	root	1.1	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	root	1.5	on_visibility_change => sub {
47			$_[0]{visibility} = $_[1];
48			update_worldmap $_[0]{ws} if $_[1];
49			},
50	root	1.1	);
51
52			my $face = cf::face::find "res/worldmap.jpg";
53			$ns->send_face ($face);
54	root	1.3	$ns->flush_fx;
55	root	1.1
56			$w->add (my $sw = $ws->new (ScrolledWindow => scroll_x => 1, scroll_y => 1));
57	root	1.5	$sw->add (my $canvas = $ws->{canvas} = $ws->new (Canvas => expand => 1));
58	root	1.1
59	root	1.5	$ws->{mapface} = $ws->new (Face =>
60			expand => 1,
61			size_w => undef,
62			size_h => undef,
63			face => $face,
64			);
65	root	1.1
66	root	1.5	$ws->{canvas}->add ($ws->{mapface});
67	root	1.4
68	root	1.5	$ws
69	root	1.4	}
70	root	1.1
71			cf::object::attachment item_worldmap =>
72			on_apply => sub {
73			my ($self, $who) = @_;
74
75			my $ns = $who->contr->ns;
76
77	root	1.2	if ($ns->{can_widget}) {
78			my $ws = $ns->{ws_worldmap} \|\|= create_widgets $ns;
79	root	1.4	$ws->{toplevel}->toggle_visibility;
80	root	1.2	} 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	root	1.1
84			cf::override 1;
85			},
86			;
87
88	root	1.5	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	root	1.6	cf::get_slot 0.05;
96
97			++$GENCOUNT;
98
99	root	1.5	# recalculate player info
100	root	1.6	my %new;
101	root	1.5	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	root	1.6
107	root	1.5	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	root	1.6	$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	root	1.5	}
129
130			for (values %cf::PLAYER) {
131			my $ns = $_->ns
132			or next;
133	root	1.6
134	root	1.5	update_worldmap $ns->{ws_worldmap}
135			if $ns->{ws_worldmap} && $ns->{ws_worldmap}{toplevel}{visibility};
136			}
137			}
138			};
139