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 %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;

      # recalculate player info
      %PLAYERINFO = ();
      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...
         $PLAYERINFO{$ob->name} = [(sprintf "%.3f", $x / 1500), (sprintf "%.3f", $y / 1500)];
      }

      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.5
Committed:	Sun Jul 22 20:08:38 2007 UTC (16 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.4:	+72 -23 lines
Log Message:	preliminary worldmap hack + widget toolkit fixes
#	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.5	our %PLAYERINFO;
8
9			sub update_worldmap {
10			my ($ws) = @_;
11
12			my $labels = delete $ws->{labels};
13	root	1.4
14	root	1.5	while (my ($k, $v) = each %PLAYERINFO) {
15			if (my $old = $labels->{$k}) {
16			$ws->{labels}{$k} = $old;
17			} else {
18			$ws->{labels}{$k} = $ws->new (Label =>
19			text => $k,
20			fontsize => 0.2,
21			c_rel => 1,
22			c_halign => -.5,
23			c_valign => -1,
24			);
25			$ws->{canvas}->add ($ws->{labels}{$k});
26			}
27			$ws->{labels}{$k}->set (c_x => $v->[0], c_y => $v->[1]);
28	root	1.4	}
29	root	1.5	}
30	root	1.1
31			sub create_widgets {
32			my ($ns) = @_;
33
34	root	1.5	my $ws = $ns->new_widgetset;
35	root	1.1
36	root	1.5	$ws->{toplevel} = my $w = $ws->new (Toplevel =>
37	root	1.2	title => "Worldmap",
38			name => "server_item_worldmap",
39	root	1.1	force_w => 400,
40			force_h => 400,
41			x => "center",
42			y => "center",
43			has_close_button => 1,
44			on_delete => sub { shift->hide },
45	root	1.5	on_visibility_change => sub {
46			$_[0]{visibility} = $_[1];
47			update_worldmap $_[0]{ws} if $_[1];
48			},
49	root	1.1	);
50
51			my $face = cf::face::find "res/worldmap.jpg";
52			$ns->send_face ($face);
53	root	1.3	$ns->flush_fx;
54	root	1.1
55			$w->add (my $sw = $ws->new (ScrolledWindow => scroll_x => 1, scroll_y => 1));
56	root	1.5	$sw->add (my $canvas = $ws->{canvas} = $ws->new (Canvas => expand => 1));
57	root	1.1
58	root	1.5	$ws->{mapface} = $ws->new (Face =>
59			expand => 1,
60			size_w => undef,
61			size_h => undef,
62			face => $face,
63			);
64	root	1.1
65	root	1.5	$ws->{canvas}->add ($ws->{mapface});
66	root	1.4
67	root	1.5	$ws
68	root	1.4	}
69	root	1.1
70			cf::object::attachment item_worldmap =>
71			on_apply => sub {
72			my ($self, $who) = @_;
73
74			my $ns = $who->contr->ns;
75
76	root	1.2	if ($ns->{can_widget}) {
77			my $ws = $ns->{ws_worldmap} \|\|= create_widgets $ns;
78	root	1.4	$ws->{toplevel}->toggle_visibility;
79	root	1.2	} else {
80			$ns->send_msg ("log", "Your client doesn't support the (required) widget extension. Try CFPlus at http://crossfire.schmorp.de/.", cf::NDI_RED);
81			}
82	root	1.1
83			cf::override 1;
84			},
85			;
86
87	root	1.5	cf::async_ext {
88			my $schedule_interval = Coro::Event->timer (after => 1);
89
90			while () {
91			$schedule_interval->interval ($WORLDMAP_UPDATE_INTERVAL);
92			$schedule_interval->next;
93
94			# recalculate player info
95			%PLAYERINFO = ();
96			for (values %cf::PLAYER) {
97			my $map = $_->ob->map
98			or next;
99			$map =~ /^\/world\/world_(\d\d\d)_(\d\d\d)/
100			or next;
101			my $ob = $_->ob;
102			my $x = ($1 - 100) * 50 + $ob->x;
103			my $y = ($2 - 100) * 50 + $ob->y;
104
105			0 <= $x && 0 <= $y && $x < 1500 && $y < 1500
106			or next;
107
108			# rounding saves network bandwidth...
109			$PLAYERINFO{$ob->name} = [(sprintf "%.3f", $x / 1500), (sprintf "%.3f", $y / 1500)];
110			}
111
112			for (values %cf::PLAYER) {
113			my $ns = $_->ns
114			or next;
115			update_worldmap $ns->{ws_worldmap}
116			if $ns->{ws_worldmap} && $ns->{ws_worldmap}{toplevel}{visibility};
117			}
118			}
119			};
120