#!/usr/bin/perl
# Author: Dan Jacobson https://www.jidanni.org/
# Copyright: https://www.gnu.org/licenses/gpl.html
# Created: 2023-11-20T00:49:11+0000
# Last-Updated: 2024-05-16T02:06:09+0000
#     Update #: 174
#
use strict;
use warnings q(all);

package Bou2colrow;

=head1 NAME

Bou2colrow - Boustrophedon to column and row of PLSS and DLS sections and back

=head1 DESCRIPTION

=head2 Forward functions

Input: section number.

Output: column and row. (1,1 is the section in the southwest corner of
a township. (US: 31, CA: 6.)

(For large conversion jobs, it would be better to use these functions
just once to populate a conversion table.)

 my @m = b2crUS(31);    #US Public Land Survey System
 print "@m\n";

1 1

Also available,

 b2crCA #Canadian Dominion Land Survey

(No we haven't made Canadian versions of all components below. Indeed,
do Canadian agencies use the same PLSSid strings?)

=cut

sub b2crUS {    #US Public Land Survey System
    my $y = 6 - int( ( $_[0] - 1 ) / 6 );
    my $x = abs( ( $_[0] - 1 ) % 12 - 6 ) + $y % 2;
    return $x, $y;
}

sub b2crCA {    #Canadian Dominion Land Survey
    my $y = int( ( $_[0] - 1 ) / 6 ) + 1;
    my $x =
      abs( ( $_[0] - 1 ) % 12 - 6 ) + ( $y - 1 ) % 2;
    return $x, $y;
}

sub cr2bUS {
    intcheck(@_);
    my ( $x, $y ) = @_;
    if   ( $y % 2 ) { return 6 * ( 6 - $y ) + $x; }
    else            { return 6 * ( 6 - $y ) + 7 - $x; }
}

sub cr2bCA {
    intcheck(@_);
    my ( $x, $y ) = @_;
    if   ( $y % 2 ) { return 6 * ( $y - 1 ) + 7 - $x; }
    else            { return 6 * ( $y - 1 ) + $x; }
}

sub intcheck {
    for (@_) { die "$_: integers only please" unless $_ == int; }
}

=head3 sec_dir2id

 sec_dir2id( 22, "E"  ); #500340
 sec_dir2id( 23, "W"  ); #500340
 sec_dir2id( 24, "SW" ); #600300
 sec_dir2id( 36, "SE" ); #700100
 ...
 sec_dir2id( 24, "C"  ); #640340 #center

No, I didn't make this into a full scale converter that goes into the next township's 100 for 700, etc.
See trsec_dir2id.

=cut

sub sec_dir2id {
    my @v = b2crUS(@_);
    my ( %x, %y );    #Easier to read than an array
    ( $x{miles}, $y{miles} ) = @v;
    for ( $_[1] ) {
        if (/C/) {
            $x{furlongs} += 4;
            $y{furlongs} += 4;
            last;
        }
        if (/E/) { $x{miles}++; }
        if (/N/) { $y{miles}++; }
        if ( length == 1 ) {
            if (/N|S/) {
                $x{furlongs} += 4;
            }
            elsif (/E|W/) {
                $y{furlongs} += 4;
            }
            else {
                die "$_ weird input.";
            }    #just checked this case. Could check more.
        }
    }

    return sprintf "%d%d0%d%d0", $x{miles}, $x{furlongs} || 0, $y{miles},
      $y{furlongs} || 0;
}

=head3 trsec_dir2id

 print trsec_dir2id(qw/IL030390N0140E0SN100 SW/);

Prints IL030390N0140E0_400500, corner of State and Madison, Chicago.

Yes, knows when to turn 700700 into kitty corner 100100 etc. of next township or range.

Safe when crossing meridians and baselines.

 print trsec_dir2id(qw/IL030010S0010W0SN010 NE/);
 print trsec_dir2id(qw/IL030010N0010E0SN310 SW/);

Both print IL030010N0010E0_100100

Also can do centers (C).

=cut

sub trsec_dir2id {
    my @i = unpack
      ## AZ23 049 0 N 013 0 W 0 SN 35 0
      "  A2A2  A3 A A  A3 A A A A2 A2 A",
      ##  0 1   2 3 4   5 6 7 8  9  0 1
      $_[0];
    die "\"$_[0]\": some expected fields not zero"
      unless 0 eq $i[3] eq $i[6] eq $i[8] eq $i[11];
    die "$_[0]: expected SN" unless $i[9] eq "SN";
    my $xxxyyy = sec_dir2id( $i[10], $_[1] );
    if ( $xxxyyy =~ s/^7/1/ ) {
        if    ( $i[7] eq "E" ) { $i[5]++ }
        elsif ( $i[5] == 1 )   { $i[7] = "E" }
        else                   { $i[5]-- }
    }
    if ( $xxxyyy =~ s/^(...)7/${1}1/ ) {
        if    ( $i[4] eq "N" ) { $i[2]++ }
        elsif ( $i[2] == 1 )   { $i[4] = "N" }
        else                   { $i[2]-- }
    }
    return sprintf "%s%s%03d%s%s%03d%s%s%s_%s", @i[ 0 .. 8 ], $xxxyyy;
}

=head2 Inverse functions

=head3 cr2bUS(); cr2bCA(); xxxyyy2SN_US()

Here we finally provide inverse functions. Let's say we want to know
what the (US) section number of the section in the fifth column, first row,
counting from the southwest corner, is.

 cr2bUS(5 ,1) #returns section 35

And we can also use the _xxxyyy notation, and let's toss an half mile
("4" furlongs) in for fun:

 xxxyyy2SN_US("bla_540100"); #returns "bla_SN350" section 35.

Well it threw away our half mile, before consulting the stricter
cr2bUS. So, no we don't say where it was in the section, NE, SW, W
etc.

=cut

sub xxxyyy2SN_US {
    $_[0] =~ /(.*)_(\d{6})$/
      or die "there should be an underscore and six digits at the back.";
    my @F = unpack "AxxAxx", $2;
    for (@F) { $_ = 1 if $_ == 7; }
    return $1 . sprintf "SN%02d0", cr2bUS @F;
}

=head1 SEE ALSO

https://gis.stackexchange.com/questions/470606/how-to-get-the-row-and-column-of-us-plss-sections/470607

=cut

1;