-
Notifications
You must be signed in to change notification settings - Fork 2
PerlMapScriptExamples35ex12
#!perl
#!/usr/bin/perl
@row0 = (
{ s => 6, qs => 'nw' }, { s => 6, qs => 'ne' },
{ s => 5, qs => 'nw' }, { s => 5, qs => 'ne' },
{ s => 4, qs => 'nw' }, { s => 4, qs => 'ne' },
{ s => 3, qs => 'nw' }, { s => 3, qs => 'ne' },
{ s => 2, qs => 'nw' }, { s => 2, qs => 'ne' },
{ s => 1, qs => 'nw' }, { s => 1, qs => 'ne' }
);
@row1 = (
{ s => 6, qs => 'sw' }, { s => 6, qs => 'se' },
{ s => 5, qs => 'sw' }, { s => 5, qs => 'se' },
{ s => 4, qs => 'sw' }, { s => 4, qs => 'se' },
{ s => 3, qs => 'sw' }, { s => 3, qs => 'se' },
{ s => 2, qs => 'sw' }, { s => 2, qs => 'se' },
{ s => 1, qs => 'sw' }, { s => 1, qs => 'se' }
);
@row2 = (
{ s => 7, qs => 'nw' }, { s => 7, qs => 'ne' },
{ s => 8, qs => 'nw' }, { s => 8, qs => 'ne' },
{ s => 9, qs => 'nw' }, { s => 9, qs => 'ne' },
{ s => 10, qs => 'nw' }, { s => 10, qs => 'ne' },
{ s => 11, qs => 'nw' }, { s => 11, qs => 'ne' },
{ s => 12, qs => 'nw' }, { s => 12, qs => 'ne' }
);
@row3 = (
{ s => 7, qs => 'sw' }, { s => 7, qs => 'se' },
{ s => 8, qs => 'sw' }, { s => 8, qs => 'se' },
{ s => 9, qs => 'sw' }, { s => 9, qs => 'se' },
{ s => 10, qs => 'sw' }, { s => 10, qs => 'se' },
{ s => 11, qs => 'sw' }, { s => 11, qs => 'se' },
{ s => 12, qs => 'sw' }, { s => 12, qs => 'se' }
);
@row4 = (
{ s => 18, qs => 'nw' }, { s => 18, qs => 'ne' },
{ s => 17, qs => 'nw' }, { s => 17, qs => 'ne' },
{ s => 16, qs => 'nw' }, { s => 16, qs => 'ne' },
{ s => 15, qs => 'nw' }, { s => 15, qs => 'ne' },
{ s => 14, qs => 'nw' }, { s => 14, qs => 'ne' },
{ s => 13, qs => 'nw' }, { s => 13, qs => 'ne' }
);
@row5 = (
{ s => 18, qs => 'sw' }, { s => 18, qs => 'se' },
{ s => 17, qs => 'sw' }, { s => 17, qs => 'se' },
{ s => 16, qs => 'sw' }, { s => 16, qs => 'se' },
{ s => 15, qs => 'sw' }, { s => 15, qs => 'se' },
{ s => 14, qs => 'sw' }, { s => 14, qs => 'se' },
{ s => 13, qs => 'sw' }, { s => 13, qs => 'se' }
);
@row6 = (
{ s => 19, qs => 'nw' }, { s => 19, qs => 'ne' },
{ s => 20, qs => 'nw' }, { s => 20, qs => 'ne' },
{ s => 21, qs => 'nw' }, { s => 21, qs => 'ne' },
{ s => 22, qs => 'nw' }, { s => 22, qs => 'ne' },
{ s => 23, qs => 'nw' }, { s => 23, qs => 'ne' },
{ s => 24, qs => 'nw' }, { s => 24, qs => 'ne' }
);
@row7 = (
{ s => 19, qs => 'sw' }, { s => 19, qs => 'se' },
{ s => 20, qs => 'sw' }, { s => 20, qs => 'se' },
{ s => 21, qs => 'sw' }, { s => 21, qs => 'se' },
{ s => 22, qs => 'sw' }, { s => 22, qs => 'se' },
{ s => 23, qs => 'sw' }, { s => 23, qs => 'se' },
{ s => 24, qs => 'sw' }, { s => 24, qs => 'se' }
);
@row8 = (
{ s => 30, qs => 'nw' }, { s => 30, qs => 'ne' },
{ s => 29, qs => 'nw' }, { s => 29, qs => 'ne' },
{ s => 28, qs => 'nw' }, { s => 28, qs => 'ne' },
{ s => 27, qs => 'nw' }, { s => 27, qs => 'ne' },
{ s => 26, qs => 'nw' }, { s => 26, qs => 'ne' },
{ s => 25, qs => 'nw' }, { s => 25, qs => 'ne' }
);
@row9 = (
{ s => 30, qs => 'sw' }, { s => 30, qs => 'se' },
{ s => 29, qs => 'sw' }, { s => 29, qs => 'se' },
{ s => 28, qs => 'sw' }, { s => 28, qs => 'se' },
{ s => 27, qs => 'sw' }, { s => 27, qs => 'se' },
{ s => 26, qs => 'sw' }, { s => 26, qs => 'se' },
{ s => 25, qs => 'sw' }, { s => 25, qs => 'se' }
);
@row10 = (
{ s => 31, qs => 'nw' }, { s => 31, qs => 'ne' },
{ s => 32, qs => 'nw' }, { s => 32, qs => 'ne' },
{ s => 33, qs => 'nw' }, { s => 33, qs => 'ne' },
{ s => 34, qs => 'nw' }, { s => 34, qs => 'ne' },
{ s => 35, qs => 'nw' }, { s => 35, qs => 'ne' },
{ s => 36, qs => 'nw' }, { s => 36, qs => 'ne' }
);
@row11 = (
{ s => 31, qs => 'sw' }, { s => 31, qs => 'se' },
{ s => 32, qs => 'sw' }, { s => 32, qs => 'se' },
{ s => 33, qs => 'sw' }, { s => 33, qs => 'se' },
{ s => 34, qs => 'sw' }, { s => 34, qs => 'se' },
{ s => 35, qs => 'sw' }, { s => 35, qs => 'se' },
{ s => 36, qs => 'sw' }, { s => 36, qs => 'se' }
);
print "Enter a township (10): ";
$t = ; chop($t);
print "Enter a range (10): ";
$r = ; chop($r);
print "Enter a section between 1 and 36 (1): ";
$s = ; chop($s);
print "Enter a quarter-section like ne, nw, se, sw (ne): ";
$qs = ; chop($qs);
print "Enter a search radius less than 2.5 miles (0.5): ";
$sr = ; chop($sr);
$t = 10 if ($t == "");
$r = 10 if ($r == "");
$s = 1 if ($s == "");
$qs = "ne" if ($qs == "");
$sr = 0.5 if ($sr == "");
$num_of_skins = ($sr > 2.5 ? 2.5 / 0.25 : int($sr / 0.25));
#print "s: $s, qs: $qs, r: $r, n: $num_of_skins \n";
for $i (0..11) {
$thisrow = "row" . $i;
# For each row, loop through each hash element by element
for $j (0..11) {
# Check if our s,qs matches the hash
if (($s == $$thisrow[$j]{'s'}) && ($qs eq $$thisrow[$j]{'qs'})) {
# Calculate the number of qs
$num_of_qs = ($num_of_skins * 2 + 1) * ($num_of_skins * 2 + 1);
print "\nThe following $num_of_qs qs were found within $sr miles of $t$r$s$qs\n\n";
# Loop through each row in the "concentric" square of qs around our origin.
# Negative rows are above the origin, positive elements are below.
for ($k = -$num_of_skins; $k <= $num_of_skins; $k++) {
# Find the row number and copy it to a temporary current row
$row = $i + $k;
if ($row < 0) {
$row += 12;
$tw = $t + 1;
} elsif ($row > 11) {
$row -= 12;
$tw = $t - 1;
} else {
$tw = $t;
}
$currrow = "row" . $row;
@currrow = @$currrow;
# Loop through each hash element in the current row. Once again, Negative
# elements are to the left of origin, positive elements are to the right.
for ($l = -$num_of_skins; $l <= $num_of_skins; $l++) {
# Calculate each hash element's position correctly
$cell = $j + $l;
if ($cell < 0) {
$cell += 12;
$rg = $r - 1;
} elsif ($cell > 11) {
$cell -= 12;
$rg = $r + 1;
} else {
$rg = $r;
}
$sec = $currrow[$cell]{'s'};
## Prefix a 0 so the output looks pretty (this script is for
# display only. This step won't be needed in actual computation).
$tw = "0" . $tw if ($tw < 10);
$rg = "0" . $rg if ($rg < 10);
$sec = "0" . $sec if ($sec < 10);
# End prefix
print " $tw$rg$sec$currrow[$cell]{'qs'} ";
}
print "\n";
}
}
}
}
----
back to PerlMapScrip