package Highway; use strict; use warnings; use include; use Exporter; our @ISA = ("Exporter"); our @EXPORT = ("preprock", "euclid"); sub preprock { my $map = shift; auraize($map, srcify($map)); # TODO: in component form, cleanup excess tile data! } sub euclid { my ($y1, $x1, $y2, $x2) = @_; return sqrt((($y1 - $y2) ** 2) + (($x1 - $x2) ** 2)); } sub auraize { my ($map, @sources) = @_; my @colors = ("red", "green", "Blue", "Red", "Green", "yellow", "purple", "cyan", "blue", "Cyan"); # Build an aura around the @sources. while (1) { my $id = 0; my $cnt = 0; foreach my $hippie (@sources) { @$hippie = expand($map, $colors[$id++], @$hippie); $cnt++ if @$hippie; GAME->{UI}{Main}->draw; } last unless $cnt; } # To make unit's ondope() tester a bit (A LOT!!!) quicker... precompute # adjacent tiles and mark them foreach my $Y (1 .. $map->height) { foreach my $X (1 .. $map->width) { next unless $map->{Map}[$Y][$X]{HIway}; # mark as Hiway. notice caps. foreach my $dir (1 .. 8) { my ($y, $x) = ($Y, $X); $y-- if $dir == 1 or $dir == 5 or $dir == 6; $y++ if $dir == 2 or $dir == 7 or $dir == 8; $x-- if $dir == 3 or $dir == 5 or $dir == 7; $x++ if $dir == 4 or $dir == 6 or $dir == 8; next if $y < 0 or $x < 0 or $y > $map->height or $x > $map->width; my $tile = $map->{Map}[$y][$x]; next unless $tile->{_} eq "."; next if $tile->{HIway}; $tile->{Hiway} = 1; } } } } sub expand { my ($map, $color, @walls) = @_; my @aura; foreach my $node (@walls) { my ($why, $ex) = @$node; next if $map->{Map}[$why][$ex]{HIway}; # another aura has overlapt us foreach my $dir (1 .. 8) { my ($y, $x) = @$node; $y-- if $dir == 1 or $dir == 5 or $dir == 6; $y++ if $dir == 2 or $dir == 7 or $dir == 8; $x-- if $dir == 3 or $dir == 5 or $dir == 7; $x++ if $dir == 4 or $dir == 6 or $dir == 8; next if $y < 0 or $x < 0 or $y > $map->height or $x > $map->width; my $tile = $map->{Map}[$y][$x]; next unless $tile->{_} eq "."; if ($tile->{Aura}) { next if $tile->{Aura} eq "DEAD"; next if $tile->{Aura} eq $color; # Two auras have collided. Here's a piece of our path!!! $map->mod($y, $x, { color => "Green", Aura => "DEAD", HIway => 1 }); next; } push @aura, [$y, $x]; $map->mod($y, $x, { color => $color, Aura => $color }); #$map->mod($y, $x, { Aura => $color }); } } return @aura; } sub srcify { my $map = shift; my @srcs; # Floodfill from each untouched wall. foreach my $y (0 .. $map->height) { foreach my $x (0 .. $map->width) { next if $map->{Map}[$y][$x]{_} ne "#" or $map->{Map}[$y][$x]{Flood}; push @srcs, flood($map, $y, $x); } } return @srcs; } sub flood { my ($map, $s_y, $s_x) = @_; my @nodes = ([$s_y, $s_x]); while (1) { my $cnt = 0; foreach my $node (@nodes) { my ($Y, $X) = @$node; next if $map->{Map}[$Y][$X]{Flood} and $map->{Map}[$Y][$X]{Flood} == 2; # already considered $cnt++; $map->{Map}[$Y][$X]{Flood} = 2; foreach my $dir (1 .. 8) { my ($y, $x) = ($Y, $X); $y-- if $dir == 1 or $dir == 5 or $dir == 6; $y++ if $dir == 2 or $dir == 7 or $dir == 8; $x-- if $dir == 3 or $dir == 5 or $dir == 7; $x++ if $dir == 4 or $dir == 6 or $dir == 8; next if $y < 0 or $x < 0 or $y > $map->height or $x > $map->width; my $tile = $map->{Map}[$y][$x]; next unless $tile->{_} eq "#"; next if $tile->{Flood}; $tile->{Flood} = 1; # in our list push @nodes, [$y, $x]; } } last unless $cnt; } return \@nodes; } 42;