# MagneticRepulsion.pl generated from MagneticRepulsion.awk # written by Ysa in TSNET Script Communication No. 7 # by a2p and modified by jscripter # 2009-12-25 # remove the first part of a2p code ## use Audio::Beep instead of a simple beep if you have it #use Audio::Beep; $[ = 1; # set array base to 1 $, = ' '; # set output field separator $\ = "\n"; # set output record separator $MAXSIZE = 10; printf "\nSize (4-%d) ?>", $MAXSIZE; do { $max = ''; $max = &Getline1(); } while ($max < 4 && $MAXSIZE < $max); &initialize(); do { &disp(0); &which(); } while ($bomb > 0 && $missile > 0); &disp(1); # Add beep print chr(7); ## use Audio::Beep instead of a simple beep #my $beeper = Audio::Beep->new(); #my $music = "g' f bes' c8 f d4 c8 f d4 bes c g f2"; #$beeper->play( $music ); if ($sc > 0) { $sc += $missile * 5 + $probe; } if ($bomb == 0) { $s1 = 'MISSION COMPLETE'; $s2 = 'CONGRATULATIONS !!'; } else { $s1 = 'GAME OVER'; $s2 = '...YOU LOSE'; } printf "\n\n****** %s ******\n\n", $s1; printf " %s (SCORE:%05d0)\n", $s2, $sc; sub rnd { local($N) = @_; int($N * rand(1)); } sub initialize { $dx{0} = 0; $dx{1} = 1; $dx{2} = 0; $dx{3} = -1; $dx{4} = 1; $dx{5} = 1; $dx{6} = -1; $dx{7} = -1; $dy{0} = -1; $dy{1} = 0; $dy{2} = 1; $dy{3} = 0; $dy{4} = -1; $dy{5} = 1; $dy{6} = 1; $dy{7} = -1; $left{0} = 7; $left{1} = 4; $left{2} = 5; $left{3} = 6; $right{0} = 4; $right{1} = 5; $right{2} = 6; $right{3} = 7; @NtoA = split(/,/, 'A,B,C,D,E,F,G,H,I,J', -1); $M{0} = ' '; for ($i = 1; $i <= $max * 4; ++$i) { $M{$i} = ''; } for ($i = 1; $i <= $max; ++$i) { $n = $i; $testX{$n} = $i; $testY{$n} = 1; $testD{$n} = 2; $q{($M{$n} = 'U' . $NtoA[$i])} = $i; $n = $i + $max * 2; $testX{$n} = $i; $testY{$n} = $max; $testD{$n} = 0; $q{($M{$n} = 'D' . $NtoA[$i])} = $n; $n = $i + $max; $testX{$n} = $max; $testY{$n} = $i; $testD{$n} = 3; $q{($M{$n} = 'R' . ($i % 10))} = $n; $n = $i + $max * 3; $testX{$n} = 1; $testY{$n} = $i; $testD{$n} = 1; $q{($M{$n} = 'L' . ($i % 10))} = $n; } for ($X = 0; $X <= $max + 1; ++$X) { for ($Y = 0; $Y <= $max + 1; ++$Y) { $b{$X, $Y} = 0; } } srand();# remove "$_"; $bomb = int($max / 2 + 0.5) + &rnd(int($max / 2 + 0.5)); for ($n = 1; $n <= $bomb; ++$n) { do { $X = 2 + &rnd($max - 2); $Y = 2 + &rnd($max - 2); } while ($b{$X, $Y} != 0); $b{$X, $Y} = -1; } $missile = int($bomb * 3 / 2); $probe = ($max - 2) * ($max - 2); if ($probe > $bomb * 4) { $probe = $bomb * 4; } if (($max - 2) * ($max - 2) <= $missile + int($probe / 5)) { --$missile; } $sc = 0; } sub search { local($n) = @_; $pos{0} = $testX{$n}; $pos{1} = $testY{$n}; $pos{2} = $testD{$n}; do { &try(); } while ($pos{2} >= 0 && 0 < $pos{0} && $pos{0} < $max + 1 && 0 < $pos{1} && $pos{1} < $max + 1); $b{$pos{0}, $pos{1}} = $n; } sub try { local($f, $r, $l, $Stat) = @_; $f = &getKind($pos{0}, $pos{1}, $pos{2}); if ($f == -1) { $pos{2} += 2; if ($pos{2} >= 4) { $pos{2} -= 4; } if (&getKind($pos{0}, $pos{1}, $pos{2}) == -1) { $pos{2} = -1; } return; } $r = &getKind($pos{0}, $pos{1}, $right{$pos{2}}); $l = &getKind($pos{0}, $pos{1}, $left{$pos{2}}); $Stat = 0; if ($r == -1 && $l != -1) { --$pos{2}; if ($pos{2} < 0) { $pos{2} += 4; } $Stat = 1; } if ($r != -1 && $l == -1) { ++$pos{2}; if ($pos{2} >= 4) { $pos{2} -= 4; } $Stat = 2; } if ($Stat != 0) { if (&getKind($pos{0}, $pos{1}, $pos{2}) == -1) { return; } $r = &getKind($pos{0}, $pos{1}, $right{$pos{2}}); $l = &getKind($pos{0}, $pos{1}, $left{$pos{2}}); if ($r == -1 && $l != -1 && $Stat == 2 || $r != -1 && $l == -1 && $Stat == 1) { $pos{2} = -1; } return; } $pos{0} += $dx{$pos{2}}; $pos{1} += $dy{$pos{2}}; } sub getKind { local($X, $Y, $d, $t) = @_; $t = $b{($X + $dx{$d}), ($Y + $dy{$d})}; (($t < 0) ? (-1) : ($t)); } sub toPos { local($str, $r, $c, $S) = @_; $r = substr($str, 2, 1) + 0; if (1 <= $r && $r <= $max) { $S = &toupper(substr($str, 1, 1)); for ($c = 1; $c <= $max; ++$c) { if ($S eq $NtoA[$c]) { return $r * 100 + $c; } } } -1; } # added sub sub toupper { local($str) = @_; $str =~ tr/a-z/A-Z/; return $str; } sub which { local($p, $tmp, $X, $Y) = @_; do { printf (("\nCOMMAND?>")); do { $tmp = ''; $tmp = &Getline1(); } while ($tmp eq ''); if ($probe > 0 && (defined $q{&toupper($tmp)})) { if (--$probe < 0) { $probe = 0; } &search($q{&toupper($tmp)}); return; } $p = &toPos($tmp); if ($p < 0) { $p = &toPos(substr($tmp, 2, 1) . substr($tmp, 1, 1)); } } while ($p < 0); if (--$missile < 0) { $missile = 0; } $X = $p % 100; $Y = int($p / 100); if ($b{$X, $Y} == -1) { --$bomb; $sc += 100; print " <<< SUCCESSFUL ATTACK ! >>>\n"; $b{$X, $Y} = -2; } elsif ($b{$X, $Y} != -2) { $b{$X, $Y} = 99; } if ($bomb > $missile && $probe >= 5) { $probe -= 5; ++$missile; } } sub disp { local($sw, $Y) = @_; print ''; $Y = 0; &line01($Y); &line02(); &line03(0); for ($Y = 1; $Y <= $max; ++$Y) { &line04($sw, $Y); if ($Y < $max) { &line05($Y); } } $Y = $max + 1; &line03(2); &line02(); &line01($Y); printf "\n### BOMB:%02d ### ENERGY:%03d0 [PROBE:%02d / MISSILE:%02d]\n", $bomb, $missile * 5 + $probe, $probe, $missile; } sub line01 { local($Y, $X) = @_; printf ((' ')); for ($X = 1; $X <= $max; ++$X) { printf ' %s ', $M{$b{$X, $Y}}; if ($X < $max) { printf ((' ')); } } printf ((" \n")); } sub line02 { local($X) = @_; printf ((' |')); for ($X = 1; $X <= $max; ++$X) { printf ((' ')); if ($X < $max) { printf (('|')); } } printf (("| \n")); } sub line03 { local($n, $X) = @_; printf ((' ----+')); for ($X = 1; $X <= $max; ++$X) { printf '<%s>', $M{$X + $n * $max}; if ($X < $max) { printf (('+')); } } printf (("+---- \n")); } sub line04 { local($sw, $Y, $X, $S) = @_; printf '%s <%s>', $M{$b{0, $Y}}, $M{$Y + $max * 3}; for ($X = 1; $X <= $max; ++$X) { $S = ' '; if ($sw == 1 && $b{$X, $Y} == -1) { $S = '@@'; } elsif ($b{$X, $Y} == -2) { $S = '><'; } elsif ($b{$X, $Y} == 99) { $S = '??'; } elsif ($b{$X, $Y} > 0) { $S = $M{$b{$X, $Y}}; } printf ' %s ', $S; if ($X < $max) { printf '%s', (2 <= $Y && $Y < $max && ($X == 1 || $X == $max - 1)) ? ('#') : ('|'); } } printf "<%s> %s\n", $M{$Y + $max}, $M{$b{$max + 1, $Y}}; } sub line05 { local($Y, $X) = @_; printf ((' ----')); for ($X = 1; $X <= $max; ++$X) { printf '%s', (2 <= $X && $X < $max && ($Y == 1 || $Y == $max - 1)) ? ('+====') : ('+----'); } printf (("+---- \n")); } sub Getline1 { local($_); if ($getline_ok = (($_ = <>) ne '')) { chomp; # strip record separator } $_; }