#!/usr/bin/perl
# Given cadastral coordinates (origin= Taichung park, unit: 日間 ken)
# print out what chart number they are on.
# Only implemented for certain 地段, currently only 台中市東勢區大茅埔段,
# （因該段該時圖號不規則，故特製此程式。）
# and certain old maps' sectorizations of it...
# Copyright       : https://www.fsf.org/copyleft/gpl.html
# Author          : Dan Jacobson 積丹尼 -- https://www.jidanni.org/
# Created On      : Thu Jan 21 12:34:08 2021
# Last Modified On: Mon Jan 25 14:23:08 2021
# Update Count    : 180
use strict;
use warnings q(all);
use utf8;
use open qw/:std :encoding(utf8)/;
my @a55 = (    # A 500 x 400 間 grid. 0: unknown
    [ 22, 14, 0, 0, 0 ],
    [ 23, 15, 9, 5, 45 ],
    [ 24, 16, 10, 50, 46, 39, 36, 52 ],
    [ 25, 17, 11, 6,  47, 40, 37, 53 ],
    [ 26, 18, 12, 7,  48, 41, 55, 54 ],
    [ 0,  19, 29, 30, 49, 42 ],
    [ 0,  20, 32, 31, 34, 43 ],
    [ 0,  21, 33, 28, 4,  3 ],
    [ 0,  0,  13, 8,  35 ],
);
if($ENV{check}){check_a55(); exit;}
my $s = "大茅埔段圖五五幅內";
die "Usage example:
$0 10206 2241
Output:
${s}第 49 之 4 號圖" unless @ARGV == 2;

my @a133 = (    # A 250 x 200 間 grid
    [ 3200,  1 ],
    [ 3400,  3 ],
    [ 3400,  8 ],
    [ 3400,  14 ],
    [ 3400,  20 ],
    [ 3400,  28 ],
    [ 3400,  39 ],
    [ 3600,  51 ],
    [ 3600,  64 ],
    [ 3600,  79 ],
    [ 3400,  94 ],
    [ 3200,  107 ],
    [ 3000,  119 ],
    [ 3000,  129 ],
    [ undef, 137 ]
);
my @r55 = ( { single => 500, first => 8000 }, { single => 400, first => 800 } );
for (@r55) {
    $_->{xy}    = 0 + shift;
    $_->{index} = ( $_->{xy} - $_->{first} ) / $_->{single};
    $_->{half}  = ( $_->{xy} % $_->{single} - $_->{single} / 2 ) >= 0 ? 1 : 0;
}

my $map_no133;
my $error133;
for (0) {

    #A133
    my @r133 =
      ( { single => 250, first => 12000 }, { single => 200, first => undef } );
    my $column = ( $r133[0]{first} - $r55[0]{xy} ) / $r133[0]{single};
    unless ( $column >= 0 && $column < $#a133 ) {
        $error133 = "A";
        last;
    }    #Way off the map.

    $map_no133 =
      ( $a133[$column][0] - $r55[1]{xy} ) / $r133[1]{single} +
      $a133[$column][1] + 1;
    unless ( $map_no133 < $a133[ $column + 1 ][1] ) {
        $error133 = "B";
        last;
    }    #Out of bounds.

    unless ( $map_no133 >= 1 ) { $error133 = "C"; last; }  #Off edge.
    for ($map_no133) {                                     #last column is irregular
        last if $_ < 131;
        if ( $_ < 134 )     { $error133 = "D"; last; }     #No map here.
        if ( $_ > 136 + 1 ) { $error133 = "E"; last; }     #Beyond known area.
        $_ -= 3;
    }
}

printf "1/1200 比例尺 %s第 %d 之 %d 號圖 (%s/133)\n", $s,
  (
    $a55[ -$r55[1]{index} - 1 ][ $r55[0]{index} ]
      or die "Uncharted or unknown territory."
  ),
  $r55[0]{half} ? ( $r55[1]{half} ? 1 : 2 ) : ( $r55[1]{half} ? 4 : 3 ),
  $error133     ? "?$error133"              : int $map_no133;

printf "1/4800 比例尺 4 幅之 %d\n", four( $r55[0]{xy}, $r55[1]{xy} );

sub check_a55 {
    my %c;
    for (@a55) {
        for (@$_) { $c{$_}++; }
    }

    for ( 1 .. 55 ) {
        unless ( $c{$_} ) {
            warn "Missing $_\n";
        }
        elsif ( $c{$_} > 1 ) {

            warn "duplicates of $_\n";
        }
    }
}

sub four
{ # 1/4800 台中縣東勢鎮大茅埔段地籍圖四幅（之內）第幾號圖計算法：
    my ( $x, $y ) = @_;
    return $x < 10500 ? ( $y < 2000 ? 3 : 4 ) : ( $y < 2400 ? 2 : 1 );
}