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} || 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,
            c_halign => -.5,
            c_valign => -1,
         );
         $ws->{canvas}->add ($label);
         $label
      };

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

   #$_->destroy for values %$old;#d#
}

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->{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 =>
      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.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.8
Committed:	Mon Jul 23 21:02:50 2007 UTC (16 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.7:	+3 -1 lines
Log Message:	- new extcmd version, much streamlined - new npc dialogue protocol - older cfplus clients are supported, without cfplus_support (no dialogue), for some time. - improved worldmap support.
#	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.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			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.8
47			#$_->destroy for values %$old;#d#
48	root	1.5	}
49	root	1.1
50			sub create_widgets {
51			my ($ns) = @_;
52
53	root	1.5	my $ws = $ns->new_widgetset;
54	root	1.1
55	root	1.5	$ws->{toplevel} = my $w = $ws->new (Toplevel =>
56	root	1.2	title => "Worldmap",
57			name => "server_item_worldmap",
58	root	1.1	force_w => 400,
59			force_h => 400,
60			x => "center",
61			y => "center",
62			has_close_button => 1,
63			on_delete => sub { shift->hide },
64	root	1.5	on_visibility_change => sub {
65			$_[0]{visibility} = $_[1];
66			update_worldmap $_[0]{ws} if $_[1];
67			},
68	root	1.1	);
69
70			my $face = cf::face::find "res/worldmap.jpg";
71			$ns->send_face ($face);
72	root	1.3	$ns->flush_fx;
73	root	1.1
74	root	1.7	$w->add (my $sw = $ws->{window} = $ws->new (ScrolledWindow => scroll_x => 1, scroll_y => 1));
75	root	1.5	$sw->add (my $canvas = $ws->{canvas} = $ws->new (Canvas => expand => 1));
76	root	1.1
77	root	1.5	$ws->{mapface} = $ws->new (Face =>
78			expand => 1,
79			size_w => undef,
80			size_h => undef,
81			face => $face,
82			);
83	root	1.1
84	root	1.5	$ws->{canvas}->add ($ws->{mapface});
85	root	1.4
86	root	1.5	$ws
87	root	1.4	}
88	root	1.1
89			cf::object::attachment item_worldmap =>
90			on_apply => sub {
91			my ($self, $who) = @_;
92
93			my $ns = $who->contr->ns;
94
95	root	1.2	if ($ns->{can_widget}) {
96			my $ws = $ns->{ws_worldmap} \|\|= create_widgets $ns;
97	root	1.4	$ws->{toplevel}->toggle_visibility;
98	root	1.2	} else {
99			$ns->send_msg ("log", "Your client doesn't support the (required) widget extension. Try CFPlus at http://crossfire.schmorp.de/.", cf::NDI_RED);
100			}
101	root	1.1
102			cf::override 1;
103			},
104			;
105
106	root	1.5	cf::async_ext {
107			my $schedule_interval = Coro::Event->timer (after => 1);
108
109			while () {
110			$schedule_interval->interval ($WORLDMAP_UPDATE_INTERVAL);
111			$schedule_interval->next;
112
113	root	1.7	cf::get_slot 0.01, -50, "worldmap update";
114	root	1.6
115			++$GENCOUNT;
116
117	root	1.5	# recalculate player info
118	root	1.6	my %new;
119	root	1.5	for (values %cf::PLAYER) {
120			my $map = $_->ob->map
121			or next;
122			$map =~ /^\/world\/world_(\d\d\d)_(\d\d\d)/
123			or next;
124	root	1.6
125	root	1.5	my $ob = $_->ob;
126			my $x = ($1 - 100) * 50 + $ob->x;
127			my $y = ($2 - 100) * 50 + $ob->y;
128
129			0 <= $x && 0 <= $y && $x < 1500 && $y < 1500
130			or next;
131
132	root	1.7	$x = int $x * $MAPW / 1500;
133			$y = int $y * $MAPH / 1500;
134	root	1.6
135			my $name = $ob->name;
136
137			if (my $pi = delete $PLAYERINFO{$name}) {
138			if ($pi->[0] == $x && $pi->[1] == $y) {
139			$new{$name} = $pi;
140			next;
141			}
142			}
143
144			$new{$name} = [$x, $y];
145	root	1.5	}
146
147	root	1.7	*PLAYERINFO = \%new;
148
149			cf::get_slot 0.03, -50, "worldmap socket update";
150	root	1.5	for (values %cf::PLAYER) {
151			my $ns = $_->ns
152			or next;
153	root	1.6
154	root	1.5	update_worldmap $ns->{ws_worldmap}
155			if $ns->{ws_worldmap} && $ns->{ws_worldmap}{toplevel}{visibility};
156			}
157			}
158			};
159