package Unit; use strict; use warnings; use include; use Waypoint; use Obj; Obj->newclass("Unit" => # Meta Stages => ["-"], # Instance Data Map => undef, Y => undef, X => undef, Num => undef, Last => undef, Laster => undef, Goals => undef, StuckMem => undef, #Stucker => undef, # Class stuff Actions => ["go", "magnet", "deadmag"], Methods => ["symbol", "trapt", "anchord"], init => sub { my $self = shift; return unless $self->{Instance}; die "Instance lacks a Map!\n" unless $self->{Map}; $self->{Last} = [-1, -1]; $self->{Laster} = [-1, -1]; $self->{Goals} = []; $self->{StuckMem} = {}; #$self->{Stucker} = {}; my ($y, $x) = ($self->{Y}, $self->{X}); # Choose a random starting point. ($y, $x) = $self->{Map}->getpt(".") unless defined $y and defined $x; $self->go("-warp", $y, $x); } ); sub symbol { my $self = shift; my $symbol = $self->{Num}; $symbol = "@" if $symbol > 9; my $color = "cyan"; $color = "yellow" if $self->trapt; return ($symbol, $color); } sub trapt { # Misleadingly named... my $self = shift; return unless @{ $self->{Goals} }; # not really but visually... return if $self->{Goals}[-1][0]{Y} == $self->{Goals}[0][0]{Y} and $self->{Goals}[-1][0]{X} == $self->{Goals}[0][0]{X}; return 1; } sub go { my ($self, $act) = @_; my ($y, $x) = args $act; # CHECKS die "thats not a map" unless ref $self->{Map} eq "BDSM::Map"; die "go where?" unless defined $y and defined $x; die "bounds!" if $y < 0 or $y > $self->{Map}->height; die "bounds!" if $x < 0 or $x > $self->{Map}->width; die "cant go there!" if $self->{Map}{Map}[$y][$x]{_} ne "."; # DO IT # Leave old tile unless we just appeared $self->{Map}->mod($self->{Y}, $self->{X}, ".") unless $act->{warp}; # Enter the new tile $self->{Y} = $y; $self->{X} = $x; $self->{Map}->mod($y, $x, $self); } sub magnet { my $self = shift; my $noY = shift; my $noX = shift; my $magnet = $self->{Goals}[-1]; my ($toY, $toX) = offset($magnet); # Can this scenario even be finished? die "GROWL IMPOSSIBLE $self->{Num}" if $self->{Num} != 1 and $self->{Map}{Map}[$toY][$toX]{_} eq "#" and $self->{Goals}[0][0]->anchord; my @best; # Determine the best direction in which to move. foreach my $dir (1 .. 9) { # don't wait just cause thats our only option! last if $#best == -1 and $dir == 9; my $y = $self->{Y}; my $x = $self->{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 $self->{Num} != 1 and defined $noY and $noY == $y and $noX == $x; # Adjacent to a non-buddy? Move, then! if ($dir == 9) { # Anyone next to us? my $move = 0; foreach my $DIR (1 .. 8) { my $Y = $self->{Y}; my $X = $self->{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; my $block = $self->{Map}{Map}[$Y][$X]{_}; next unless ref $block; # Only move if of a lower rank. That way both dont move and cause that # thing where you both go left and right and never break the loop! # And lower numbers are higher ranks. Heh! $move++, last if $self->{Num} > $block->{Num}; } next if $move; } # Backtracking is ok. Moving into stuff is not (unless we're chillin') next if $dir != 9 and $self->{Map}{Map}[$y][$x]{_} ne "."; # If we can directly follow our buddy and go on the tile they were # literally just on, then by golly, do it! # But not if we're in movement mode. Cause then we wanna probably form a # shappe! unless ($noY) { if ($magnet->[0]{Laster} and @{ $magnet->[0]{Laster} } and $y == $magnet->[0]{Laster}[0] and $x == $magnet->[0]{Laster}[1]) { @best = (0, $y, $x, $dir); last; } } # Evaluate sum of the distances between the magnet. my $dist = euclid($y, $x, offset($magnet)); # Is this the way to go? @best = ($dist, $y, $x, $dir) if $#best == -1 or $dist <= $best[0]; } # If we're literally surrounded, just chill and pray people get moving. debug("$self->{Num} trapped!!!!!!!!"), return if $#best == -1; # So do we go now? return 42 if $best[1] == $self->{Y} and $best[2] == $self->{X}; # Chillin'. $self->go($best[1], $best[2]); $self->{Laster} = $self->{Last}; $self->{Last} = [$best[1], $best[2]]; return $best[3]; } sub deadmag { my $unit = shift; my $map = $unit->{Map}; my $REFID = $map->{Map}[$unit->{Y}][$unit->{X}]{Ref}; my ($Y, $X) = @{ $map->{Magnets}[$REFID]{At} }; # What if the current magnet is our goal now? Special case. my $still; $still = 1 if $Y == $unit->{Goals}[-1][0]{Y} and $X == $unit->{Goals}[-1][0]{X} and scalar @{ $unit->{Goals} } == 2; # Or what if we've TRIED going to that magnet before and it just dont work? debug("loopy"), $still = 2 if $unit->{StuckMem}{"$Y,$X"} and $unit->{StuckMem}{"$Y,$X"} > 2; if (scalar @{ $unit->{Goals} } == 2 and !$still) { # Go to the current region's magnet first. my $refid = $map->{Map}[$unit->{Y}][$unit->{X}]{Ref}; my ($y, $x) = @{ $map->{Magnets}[$refid]{At} }; # But after that, resume normality. So make the intermediate goal the # only subgoal! Or something. pop @{ $unit->{Goals} }; push @{ $unit->{Goals} }, [{ Y => $y, X => $x }, 0, 0]; debug "PANIC) $unit->{Num} now to $y, $x!"; $unit->{StuckMem}{"$Y,$X"}++; } elsif ($still or scalar @{ $unit->{Goals} } == 1) { pop @{ $unit->{Goals} } if $still and $still == 1; # Temporarily magnet to a waypoint both reachable from here and close # to our buddy. # First, what are the reachable waypoints? Those that preprock has # said are "adjacent" to our current region. *AND* our current # waypoint! my $refid = $map->{Map}[$unit->{Y}][$unit->{X}]{Ref}; my ($why, $eggs) = ($unit->{Goals}[0][0]{Y}, $unit->{Goals}[0][0]{X}); my $toid = $map->{Map}[$why][$eggs]{Ref}; my $curway = $map->{Magnets}[$refid]; # Now, choose the waypoint closest to our buddy. my $best = []; foreach my $attract (@{ $curway->{To} }, $refid) { debug("avoiding loopyness"), next if $still and $attract == $refid; my ($y, $x) = @{ $map->{Magnets}[$attract]{At} }; #debug("$unit->{Num} banned from that way"), next if $unit->{Stucker}{"$y,$x"} and $unit->{Stucker}{"$y,$x"} > 2; if ($toid == $attract) { debug "$unit->{Num} choosing buddys region."; @$best = (42, $y, $x); last; } # That'd be pointless! next if $unit->{Y} == $y and $unit->{X} == $x; my $dist = euclid($unit->{Goals}[0][0]{Y}, $unit->{Goals}[0][0]{X}, $y, $x); @$best = ($dist, $y, $x) if $#{$best} == -1 or $dist < $best->[0]; } push @{ $unit->{Goals} }, [{ Y => $best->[1], X => $best->[2] }, 0, 0]; debug "$unit->{Num} now to $best->[1], $best->[2]!"; #$unit->{Stucker}{"$best->[1],$best->[2]"}++; } else { debug "oh snap. $unit->{Num} has " . scalar @{ $unit->{Goals} } . " goals!"; } } # Are we directly next to our buddy, which is directly next to their buddy...? sub anchord { my $self = shift; while (ref $self->{Goals}[0][0]) { my ($y, $x) = offset($self->{Goals}[0]); return if $y != $self->{Y} or $x != $self->{X}; $self = $self->{Goals}[0][0]; } return 1; } 42;