| 1 |
root |
1.5 |
#! perl # mandatory |
| 2 |
root |
1.1 |
|
| 3 |
|
|
use Scalar::Util; |
| 4 |
|
|
|
| 5 |
|
|
# minesweeper extension. dumb. |
| 6 |
|
|
|
| 7 |
|
|
sub result { |
| 8 |
|
|
my ($ob, $status) = @_; |
| 9 |
|
|
|
| 10 |
|
|
if (my $teleport = $ob->{options}{"teleport_$status"}) { |
| 11 |
|
|
my ($x, $y, $damned) = split /,/, $teleport; |
| 12 |
root |
1.3 |
my $pl = cf::player::find_active $ob->{player}; |
| 13 |
root |
1.1 |
|
| 14 |
root |
1.6 |
my $path = $pl->ob->map->path; |
| 15 |
|
|
|
| 16 |
|
|
$pl->ob->goto ($path, $x, $y); |
| 17 |
|
|
$pl->savebed ($path, $x, $y) |
| 18 |
root |
1.1 |
if $ob->{options}{"set_savebed_$status"}; |
| 19 |
|
|
} |
| 20 |
|
|
} |
| 21 |
|
|
|
| 22 |
|
|
sub apply { |
| 23 |
|
|
my ($who) = @_; |
| 24 |
|
|
|
| 25 |
|
|
my $meta = $who->{meta} |
| 26 |
|
|
or return; |
| 27 |
|
|
|
| 28 |
|
|
my $map = $meta->{map}; |
| 29 |
|
|
|
| 30 |
|
|
my ($x, $y) = ($who->x - $meta->x, $who->y - $meta->y); |
| 31 |
|
|
|
| 32 |
|
|
$who->{visible} = 1; |
| 33 |
|
|
|
| 34 |
|
|
if ($who->{bomb}) { |
| 35 |
|
|
result $meta, "failure" |
| 36 |
|
|
if $meta->{todo}; |
| 37 |
|
|
} else { |
| 38 |
|
|
$meta->{todo}--; |
| 39 |
|
|
# if <= 0, finished |
| 40 |
|
|
|
| 41 |
|
|
my @neigh; |
| 42 |
|
|
|
| 43 |
|
|
for my $y ($y - 1 .. $y + 1) { |
| 44 |
|
|
next if $y < 0 || $y > $#{$map->[0]}; |
| 45 |
|
|
for my $x ($x - 1 .. $x + 1) { |
| 46 |
|
|
next if $x < 0 || $x > $#$map; |
| 47 |
|
|
push @neigh, $map->[$x][$y]; |
| 48 |
|
|
} |
| 49 |
|
|
} |
| 50 |
|
|
|
| 51 |
|
|
my $bombs = grep $_->{bomb}, @neigh; |
| 52 |
|
|
|
| 53 |
|
|
my $ob = $map->[$x][$y] = cf::object::new "minesweeper-$bombs"; |
| 54 |
|
|
|
| 55 |
|
|
$ob->insert_ob_in_map_at ($who->map, undef, cf::INS_ABOVE_FLOOR_ONLY, |
| 56 |
|
|
$who->x, $who->y); |
| 57 |
|
|
|
| 58 |
|
|
push @{ $meta->{queue} }, grep !$_->{visible}, @neigh |
| 59 |
|
|
unless $bombs; |
| 60 |
|
|
|
| 61 |
|
|
$who->destroy; |
| 62 |
|
|
} |
| 63 |
|
|
|
| 64 |
|
|
1 |
| 65 |
|
|
} |
| 66 |
|
|
|
| 67 |
root |
1.2 |
cf::object::attachment minesweeper => |
| 68 |
root |
1.1 |
on_tick => sub { |
| 69 |
|
|
my ($self) = @_; |
| 70 |
|
|
|
| 71 |
|
|
if (my $queue = $self->{queue}) { |
| 72 |
|
|
my $count = 4; |
| 73 |
|
|
|
| 74 |
|
|
while (@$queue) { |
| 75 |
|
|
my $i = int rand @$queue; |
| 76 |
|
|
my $ob = splice @$queue, $i, 1, (); |
| 77 |
|
|
|
| 78 |
|
|
next if $ob->{visible}; |
| 79 |
|
|
|
| 80 |
|
|
apply $ob |
| 81 |
|
|
or next; |
| 82 |
|
|
|
| 83 |
|
|
result $self, "success" |
| 84 |
|
|
unless $self->{todo}; |
| 85 |
|
|
|
| 86 |
|
|
$count-- |
| 87 |
|
|
or last; |
| 88 |
|
|
} |
| 89 |
|
|
} else { |
| 90 |
|
|
my %arg = %{ $self->{options} = delete $self->{minesweeper} }; |
| 91 |
|
|
$self->{queue} = []; |
| 92 |
|
|
|
| 93 |
|
|
my $map = $self->{map} = []; |
| 94 |
|
|
|
| 95 |
|
|
for my $x (0 .. $arg{width} - 1) { |
| 96 |
|
|
for my $y (0 .. $arg{height} - 1) { |
| 97 |
|
|
my $ob = $map->[$x][$y] = cf::object::new "minesweeper-unknown"; |
| 98 |
|
|
$ob->name ("apply to try your luck or intelligence"); |
| 99 |
|
|
Scalar::Util::weaken ($ob->{meta} = $self); |
| 100 |
|
|
|
| 101 |
|
|
$ob->attach ("minesweeper_field"); |
| 102 |
|
|
$ob->insert_ob_in_map_at ($self->map, undef, cf::INS_ABOVE_FLOOR_ONLY, |
| 103 |
|
|
$self->x + $x, $self->y + $y); |
| 104 |
|
|
} |
| 105 |
|
|
} |
| 106 |
|
|
|
| 107 |
|
|
# #tiles that need to be uncovered |
| 108 |
|
|
$self->{todo} = $arg{width} * $arg{height} - $arg{bombs}; |
| 109 |
|
|
|
| 110 |
|
|
for (1 .. $arg{bombs}) { |
| 111 |
root |
1.7 |
my $x = cf::rndm $arg{width}; |
| 112 |
|
|
my $y = cf::rndm $arg{height}; |
| 113 |
root |
1.1 |
|
| 114 |
|
|
redo if $map->[$x][$y]{bomb}; |
| 115 |
|
|
|
| 116 |
|
|
$map->[$x][$y]{bomb} = 1; |
| 117 |
|
|
} |
| 118 |
|
|
} |
| 119 |
|
|
|
| 120 |
|
|
cf::override; |
| 121 |
|
|
}, |
| 122 |
|
|
; |
| 123 |
|
|
|
| 124 |
root |
1.2 |
cf::object::attachment minesweeper_field => |
| 125 |
root |
1.1 |
on_apply => sub { |
| 126 |
|
|
my ($ob, $who) = @_; |
| 127 |
|
|
|
| 128 |
|
|
$ob->{meta}{player} = $who->name; |
| 129 |
|
|
push @{$ob->{meta}{queue}}, $ob; |
| 130 |
|
|
|
| 131 |
|
|
cf::override 1; |
| 132 |
|
|
}, |
| 133 |
|
|
; |
| 134 |
|
|
|
