maps/perl/minesweeper.ext

#! perl
#CONVERSION: NONE

use Scalar::Util;

# minesweeper extension. dumb.

sub result {
   my ($ob, $status) = @_;

   if (my $teleport = $ob->{options}{"teleport_$status"}) {
      my ($x, $y, $damned) = split /,/, $teleport;
      my $pl = cf::player::find $ob->{player};

      $pl->ob->transfer ($x, $y);
      $pl->set_savebed ($pl->ob->map->path, $x, $y)
         if $ob->{options}{"set_savebed_$status"};
   }
}

sub apply {
   my ($who) = @_;

   my $meta = $who->{meta}
      or return;

   my $map = $meta->{map};

   my ($x, $y) = ($who->x - $meta->x, $who->y - $meta->y);

   $who->{visible} = 1;

   if ($who->{bomb}) {
      result $meta, "failure"
         if $meta->{todo};
   } else {
      $meta->{todo}--;
      # if <= 0, finished

      my @neigh;

      for my $y ($y - 1 .. $y + 1) {
         next if $y < 0 || $y > $#{$map->[0]};
         for my $x ($x - 1 .. $x + 1) {
            next if $x < 0 || $x > $#$map;
            push @neigh, $map->[$x][$y];
         }
      }

      my $bombs = grep $_->{bomb}, @neigh;

      my $ob = $map->[$x][$y] = cf::object::new "minesweeper-$bombs";

      $ob->insert_ob_in_map_at ($who->map, undef, cf::INS_ABOVE_FLOOR_ONLY,
                                $who->x, $who->y);

      push @{ $meta->{queue} }, grep !$_->{visible}, @neigh
         unless $bombs;

      $who->remove;
      $who->free;
   }

   1
}

sub on_time {
   my ($event, $who) = @_;

   if (my $queue = $who->{queue}) {
      my $count = 4;

      while (@$queue) {
         my $i = int rand @$queue;
         my $ob = splice @$queue, $i, 1, ();

         next if $ob->{visible};

         apply $ob
            or next;

         result $who, "success"
            unless $who->{todo};

         $count--
            or last;
      }
   } else {
      # generate minesweeper field
      my %arg = split /(?:\s+|=)/, $event->options;

      $who->{options} = \%arg;
      $who->{queue} = [];

      my $map = $who->{map} = [];

      for my $x (0 .. $arg{width} - 1) {
         for my $y (0 .. $arg{height} - 1) {
            my $ob = $map->[$x][$y] = cf::object::new "minesweeper-unknown";
            $ob->set_name ("apply to try your luck or intelligence");
            Scalar::Util::weaken ($ob->{meta} = $who);

            my $ev = cf::object::new "event_apply";
            $ev->set_title ("perl");
            $ev->set_slaying ("minesweeper");
            $ev->insert_in_ob ($ob);
            
            $ob->insert_ob_in_map_at ($who->map, undef, cf::INS_ABOVE_FLOOR_ONLY,
                                      $who->x + $x, $who->y + $y);
         }
      }

      # #tiles that need to be uncovered
      $who->{todo} = $arg{width} * $arg{height} - $arg{bombs};

      for (1 .. $arg{bombs}) {
         my $x = int rand $arg{width};
         my $y = int rand $arg{height};

         redo if $map->[$x][$y]{bomb};

         $map->[$x][$y]{bomb} = 1;
      }
   }
}

sub on_apply {
   my ($event, $ob, $who) = @_;

   $ob->{meta}{player} = $who->name;
   push @{$ob->{meta}{queue}}, $ob;

   1
}


Revision:	1.10
Committed:	Fri Aug 25 15:07:43 2006 UTC (17 years, 8 months ago) by root
Branch:	MAIN
Changes since 1.9:	+1 -0 lines
Log Message:	Convert remainin scripts to new event system, noted conversion status of all plugins in second line, to aid in further event conversions.
#	User	Rev	Content
1	root	1.1	#! perl
2	root	1.10	#CONVERSION: NONE
3	root	1.1
4			use Scalar::Util;
5
6			# minesweeper extension. dumb.
7
8	root	1.3	sub result {
9			my ($ob, $status) = @_;
10
11			if (my $teleport = $ob->{options}{"teleport_$status"}) {
12	root	1.9	my ($x, $y, $damned) = split /,/, $teleport;
13			my $pl = cf::player::find $ob->{player};
14	root	1.3
15	root	1.9	$pl->ob->transfer ($x, $y);
16			$pl->set_savebed ($pl->ob->map->path, $x, $y)
17			if $ob->{options}{"set_savebed_$status"};
18	root	1.3	}
19			}
20
21	root	1.2	sub apply {
22			my ($who) = @_;
23
24			my $meta = $who->{meta}
25			or return;
26
27			my $map = $meta->{map};
28
29			my ($x, $y) = ($who->x - $meta->x, $who->y - $meta->y);
30
31			$who->{visible} = 1;
32
33			if ($who->{bomb}) {
34	root	1.8	result $meta, "failure"
35			if $meta->{todo};
36	root	1.2	} else {
37			$meta->{todo}--;
38	root	1.8	# if <= 0, finished
39	root	1.2
40			my @neigh;
41
42			for my $y ($y - 1 .. $y + 1) {
43			next if $y < 0 \|\| $y > $#{$map->[0]};
44			for my $x ($x - 1 .. $x + 1) {
45			next if $x < 0 \|\| $x > $#$map;
46			push @neigh, $map->[$x][$y];
47			}
48			}
49
50			my $bombs = grep $_->{bomb}, @neigh;
51
52			my $ob = $map->[$x][$y] = cf::object::new "minesweeper-$bombs";
53
54			$ob->insert_ob_in_map_at ($who->map, undef, cf::INS_ABOVE_FLOOR_ONLY,
55			$who->x, $who->y);
56
57			push @{ $meta->{queue} }, grep !$_->{visible}, @neigh
58			unless $bombs;
59
60			$who->remove;
61			$who->free;
62			}
63	root	1.6
64			1
65	root	1.2	}
66
67	root	1.1	sub on_time {
68	root	1.7	my ($event, $who) = @_;
69	root	1.1
70	root	1.2	if (my $queue = $who->{queue}) {
71	root	1.3	my $count = 4;
72
73	root	1.2	while (@$queue) {
74			my $i = int rand @$queue;
75			my $ob = splice @$queue, $i, 1, ();
76
77			next if $ob->{visible};
78
79			apply $ob
80			or next;
81
82	root	1.3	result $who, "success"
83			unless $who->{todo};
84
85			$count--
86			or last;
87	root	1.2	}
88			} else {
89			# generate minesweeper field
90	root	1.7	my %arg = split /(?:\s+\|=)/, $event->options;
91	root	1.1
92	root	1.3	$who->{options} = \%arg;
93	root	1.2	$who->{queue} = [];
94	root	1.1
95			my $map = $who->{map} = [];
96
97	root	1.2	for my $x (0 .. $arg{width} - 1) {
98			for my $y (0 .. $arg{height} - 1) {
99	root	1.1	my $ob = $map->[$x][$y] = cf::object::new "minesweeper-unknown";
100	root	1.2	$ob->set_name ("apply to try your luck or intelligence");
101	root	1.1	Scalar::Util::weaken ($ob->{meta} = $who);
102
103			my $ev = cf::object::new "event_apply";
104			$ev->set_title ("perl");
105			$ev->set_slaying ("minesweeper");
106			$ev->insert_in_ob ($ob);
107
108	root	1.2	$ob->insert_ob_in_map_at ($who->map, undef, cf::INS_ABOVE_FLOOR_ONLY,
109			$who->x + $x, $who->y + $y);
110	root	1.1	}
111			}
112
113	root	1.2	# #tiles that need to be uncovered
114			$who->{todo} = $arg{width} * $arg{height} - $arg{bombs};
115
116			for (1 .. $arg{bombs}) {
117			my $x = int rand $arg{width};
118			my $y = int rand $arg{height};
119
120			redo if $map->[$x][$y]{bomb};
121	root	1.1
122	root	1.2	$map->[$x][$y]{bomb} = 1;
123			}
124			}
125	root	1.1	}
126
127			sub on_apply {
128	root	1.7	my ($event, $ob, $who) = @_;
129	root	1.1
130	root	1.7	$ob->{meta}{player} = $who->name;
131			push @{$ob->{meta}{queue}}, $ob;
132	root	1.5
133			1
134	root	1.1	}
135
136