package Unit; use strict; use warnings; use include; use Highway; use Obj; Obj->newclass("Unit" => # Meta Stages => ["-"], # Instance Data Map => undef, Y => undef, X => undef, Num => undef, Magnet => undef, Group => undef, Last => undef, Laster => undef, Wander => undef, # Class stuff Actions => ["go", "gethi", "magnet"], Methods => ["symbol", "lost", "offset", "ondope", "grouphug", "stranded", "anchord", "assemble"], init => sub { my $self = shift; return unless $self->{Instance}; die "Instance lacks a Map!\n" unless $self->{Map}; $self->{Last} = [0, 0]; $self->{Laster} = [0, 0]; my ($y, $x) = ($self->{Y}, $self->{X}); ($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->lost; $color = "Green" if $self->{Num} == 1; return ($symbol, $color); } # Are we adjacent to our buddy, or exactly where we need to be, or lost? sub lost { my $self = shift; my $strict = shift; return unless $self->{Magnet}{Buddy} and $self->{Magnet}{Dir}; return if $self->{Num} == 1; my $buddy = $self->{Magnet}{Buddy}; my $lost = 0; $lost++ if abs($self->{Y} - $buddy->{Y}) > 1 or abs($self->{X} - $buddy->{X}) > 1; my ($y, $x) = $self->offset; $lost++ if $y != $self->{Y} or $x != $self->{X}; if ($strict) { # Who cares if we're adjacent. We wanna be RIGHT THERE. return if $y == $self->{Y} and $x == $self->{X}; return 1; } return 1 if $lost == 2; return; } sub go { my ($self, $act) = @_; my ($y, $x) = args $act; # CHECKS die "thats not a map" unless ref $self->{Map} eq "BDSM::Map"; unless (defined $y and defined $x) { debug caller; die "go where?"; } #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; if ($self->{Map}{Map}[$y][$x]{_} ne ".") { return if $self->{Num} == 1; die "cant go there $self->{Num}!"; } # 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); # Possibly lay a pheromene if ($act->{scent}) { my $tile = $self->{Map}{Map}[$y][$x]; $tile->{Scents} ||= {}; $tile->{Scents}{ $self->{Num} }++; } } sub offset { my $self = shift; my $magnet = $self->{Magnet}; my $buddy = $magnet->{Buddy}; return ($buddy->{Y} + $magnet->{Dir}[0], $buddy->{X} + $magnet->{Dir}[1]); } # Locate the highway. sub gethi { my $self = shift; GAME->{UI}{Main}->draw; my %dirs = ( h => [0, -1], l => [0, +1], j => [+1, 0], k => [-1, 0], n => [+1, +1], b => [+1, -1], u => [-1, +1], y => [-1, -1] ); # First, get on the highway. Anywhere adjacent to or on any part of the # highway. my $needto; $needto++ unless $self->ondope; $needto++ if $self->{Num} == 1 and !$self->{Map}{Map}[$self->{Y}][$self->{X}]{HIway}; unless ($needto) { if ($self->{Num} != 1 or $self->{Clear}) { return 42; } # Move until we have enough space for everyone else to line up. my $crowded = 0; $crowded++ if $self->{X} + GAME->{UnitSize} - 1 > $self->{Map}->width; foreach my $x ($self->{X} .. $self->{X} + GAME->{UnitSize} - 1) { $crowded++, last if $self->{Map}{Map}[$self->{Y}][$x]{_} eq "#"; } $self->{Clear} = 1 unless $crowded; return if $self->{Clear}; debug "clear? $crowded"; } GAME->{AssCnt}++; $self->{Wander} ||= CONFIG->chooserand(qw(h j k l y u b n)); while (1) { my @dir = @{ $dirs{ $self->{Wander} } }; my $y = $self->{Y} + $dir[0]; my $x = $self->{X} + $dir[1]; if ($y < 0 or $x < 0 or $y > $self->{Map}->height or $x > $self->{Map}->width or $self->{Map}{Map}[$y][$x]{_} ne ".") { # new direction my $dir = $self->{Wander}; $dir = CONFIG->chooserand(qw(h j k l y u b n)) until $dir ne $self->{Wander}; $self->{Wander} = $dir; next; } $self->go($y, $x); last; } return; } # Are we right on the highway? sub ondope { my $self = shift; my ($y, $x) = ($self->{Y}, $self->{X}); ($y, $x) = @_ if @_; my $tile = $self->{Map}{Map}[$y][$x]; return 1 if $tile->{Hiway} or $tile->{HIway}; return; } # Once everyone's on the highway, find our buddy. sub assemble { my $self = shift; my $force = shift; return 42 if $self->{Num} == 1 and !$force; # Our buddy needs to be on the highway first. Is he? Or in place at least. if ($self->{Num} == 1) { # Just kidding for leader. We use assemble to get to our destination! } elsif ($self->{Magnet}{Buddy}{Num} == 1) { return 0 unless $self->{Magnet}{Buddy}->ondope; } else { return 0 unless $self->{Magnet}{Buddy}->anchord or $self->{Magnet}{Buddy}->ondope; } my ($ny, $nx) = $self->offset; return 42 if $self->{Y} == $ny and $self->{X} == $nx; GAME->{AssCnt}++; # Can this scenario even be finished? die "GROWL IMPOSSIBLE" if $self->{Num} != 1 and $self->{Map}{Map}[$ny][$nx]{_} eq "#" and $self->{Magnet}{Buddy}->anchord; my $offroad = 1 if $self->grouphug or $self->stranded; GAME->{UI}{Main}->draw; # Now, we need to find our buddy and tag up with them. Don't leave the # highway necessarily till we find em. my (@best, @bakup); # Determine the best direction in which to move. foreach my $dir (1 .. 8) { my ($y, $x) = ($self->{Y}, $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; # Moving into stuff is bad (unless we're chillin') next if $self->{Map}{Map}[$y][$x]{_} ne "."; # If we're LITERALLY right behind our buddy and they just stepped there, # follow them directly. if ($self->{Magnet}{Buddy}{Laster}[0] == $y and $self->{Magnet}{Buddy}{Laster}[1] == $x) { @best = (0, $y, $x, $dir); last; } # Don't ASAP backtrack! unless its only option @bakup = (0, $y, $x, $dir), next if $y == $self->{Laster}[0] and $x == $self->{Laster}[1]; # Evaluate the distance between the magnet. And going where we've been is # bad. my $dist = euclid($y, $x, $self->offset); $self->{Map}{Map}[$y][$x]{Scents}{ $self->{Num} } ||= 1; $dist += $self->{Map}{Map}[$y][$x]{Scents}{ $self->{Num} }; # Is this the way to go? # Don't leave the highway, though. Unless we're almost there. next if (!$offroad and !$self->ondope($y, $x)); # Prefer directly on the highway to off it, though. $dist *= 2 if (!$offroad and !$self->{Map}{Map}[$y][$x]{HIway}); @best = ($dist, $y, $x, $dir) if $#best == -1 or $dist <= $best[0]; } # If we're literally surrounded, just chill and pray people get moving. # But if we can backtrack to escape the lock, then do it @best = @bakup if @bakup and $#best == -1; return 0 if $#best == -1; $self->go("-scent", @best[1..2]); $self->{Laster} = $self->{Last}; $self->{Last} = [$self->{Y}, $self->{X}]; return $best[3]; } # Are we adjacent to a unit of higher rank? (thats already moved!) sub grouphug { my $self = shift; my ($Y, $X) = ($self->{Y}, $self->{X}); 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; my $tile = $self->{Map}{Map}[$y][$x]{_}; # Who cares if we're next to some slum? they better have already moved! return 1 if ref $tile and $tile->{Num} < $self->{Num}; } return; } # Are we off the highway? This is kinda like extended ondope. sub stranded { my $self = shift; # If we went off the highway for some reason and get stuck... we still wanna # magnet normally! my ($Y, $X) = ($self->{Y}, $self->{X}); 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; my $tile = $self->{Map}{Map}[$y][$x]; return if $tile->{HIway}; # only real highway. just cause. } return 1; } # Are we directly next to our buddy, which is directly next to their buddy...? sub anchord { my $self = shift; while (ref $self->{Magnet}{Buddy}) { return if $self->lost(1); $self = $self->{Magnet}{Buddy}; } return 1; } # Maintain formation and follow our buddy. sub magnet { my ($self, $banY, $banX) = @_; my ($ny, $nx) = $self->offset; return 42 if $self->{Y} == $ny and $self->{X} == $nx; my @best; # Determine the best direction in which to move. my $dir; foreach $dir (1 .. 8) { my ($y, $x) = ($self->{Y}, $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; # dont block the leader no matter WHAT next if $self->{Num} != 1 and $y == $banY and $x == $banX; # Moving into stuff is bad next if $self->{Map}{Map}[$y][$x]{_} ne "."; # Evaluate the distance between the magnet. my $dist = euclid($y, $x, $self->offset); # Is this the way to go? @best = ($dist, $y, $x) if $#best == -1 or $dist <= $best[0]; } # If we're literally surrounded, just chill and pray people get moving. return if $#best == -1; $self->go(@best[1..2]); $self->{Laster} = $self->{Last}; $self->{Last} = [$self->{Y}, $self->{X}]; return $dir; } 42;