-- -----------------------------------------------------------------------------

-- Copyright (C) 2003-2019 Stichting Mapcode Foundation (http://www.mapcode.com)

--

-- Licensed under the Apache License, Version 2.0 (the "License");

-- you may not use this file except in compliance with the License.

-- You may obtain a copy of the License at

--

-- http://www.apache.org/licenses/LICENSE-2.0

--

-- Unless required by applicable law or agreed to in writing, software

-- distributed under the License is distributed on an "AS IS" BASIS,

-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.

-- See the License for the specific language governing permissions and

-- limitations under the License.

-- -----------------------------------------------------------------------------

with Ada.Characters.Handling;

with Mapcode_Utils.Str_Tools, Mapcode_Utils.Bits;

use Mapcode_Utils;

with Mapcodes.Languages;

with Ndata;

package body Mapcodes is

subtype Lint is Long_Long_Integer;

-- All functions returning a Integer return a natural or Error

Error : constant Integer := -1;

-- All functions returning a string may return Undefined, on error

Undefined : constant String := "";

subtype Country_Range is Positive range Countries.Territories_Def'Range;

function Iso3166Alpha_Of (Index : Natural) return String is

begin

if Index + 1 <= Country_Range'Last then

return Countries.Territories_Def(Index + 1).Code.Image;

else

return Undefined;

end if;

end Iso3166Alpha_Of;

Aliases : constant String :=

"2UK=2UT,2CG=2CT,1GU=GUM,1UM=UMI,1VI=VIR,1AS=ASM,1MP=MNP,4CX=CXR,4CC=CCK,"

& "4NF=NFK,4HM=HMD,COL=5CL,5ME=5MX,MEX=5MX,5AG=AGU,5BC=BCN,5BS=BCS,5CM=CAM,"

& "5CS=CHP,5CH=CHH,5CO=COA,5DF=DIF,5DG=DUR,5GT=GUA,5GR=GRO,5HG=HID,5JA=JAL,"

& "5MI=MIC,5MO=MOR,5NA=NAY,5NL=NLE,5OA=OAX,5PB=PUE,5QE=QUE,5QR=ROO,5SL=SLP,"

& "5SI=SIN,5SO=SON,5TB=TAB,5TL=TLA,5VE=VER,5YU=YUC,5ZA=ZAC,811=8BJ,812=8TJ,"

& "813=8HE,814=8SX,815=8NM,821=8LN,822=8JL,823=8HL,831=8SH,832=8JS,833=8ZJ,"

& "834=8AH,835=8FJ,836=8JX,837=8SD,841=8HA,842=8HB,843=8HN,844=8GD,845=8GX,"

& "846=8HI,850=8CQ,851=8SC,852=8GZ,853=8YN,854=8XZ,861=8SN,862=8GS,863=8QH,"

& "864=8NX,865=8XJ,871=TWN,891=HKG,892=MAC,8TW=TWN,8HK=HKG,8MC=MAC,BEL=7BE,"

& "KIR=7KI,PRI=7PO,CHE=7CH,KHM=7KM,PER=7PM,TAM=7TT,0US=USA,0AU=AUS,0RU=RUS,"

& "0CN=CHN,TAA=SHN,ASC=SHN,DGA=IOT,WAK=MHL,JTN=UMI,MID=1HI,1PR=PRI,5TM=TAM,"

& "TAM=TAM,2OD=2OR,";

Usa_From : constant := 343;

Usa_Upto : constant := 393;

Ccode_Usa : constant := 410;

Ind_From : constant := 271;

Ind_Upto : constant := 306;

Ccode_Ind : constant := 407;

Can_From : constant := 394;

Can_Upto : constant := 406;

Ccode_Can : constant := 495;

Aus_From : constant := 307;

Aus_Upto : constant := 315;

Ccode_Aus : constant := 408;

Mex_From : constant := 233;

Mex_Upto : constant := 264;

Ccode_Mex : constant := 411;

Bra_From : constant := 316;

Bra_Upto : constant := 342;

Ccode_Bra : constant := 409;

Chn_From : constant := 497;

Chn_Upto : constant := 527;

Ccode_Chn : constant := 528;

Rus_From : constant := 412;

Rus_Upto : constant := 494;

Ccode_Rus : constant := 496;

Ccode_Earth : constant := 532;

-- Parent territories

Parent_Length : constant := 8;

subtype String3 is String (1 .. 3);

Parents3 : constant array (1 .. Parent_Length) of String3

:= ("USA", "IND", "CAN", "AUS", "MEX", "BRA", "RUS", "CHN");

subtype String2 is String (1 .. 2);

Parents2 : constant array (1 .. Parent_Length) of String2

:= ("US", "IN", "CA", "AU", "MX", "BR", "RU", "CN");

-- Returns 2-letter parent country abbreviation (disam in range 1..8)

function Parent_Name2 (Disam : Positive) return String is

(Parents2 (Disam));

-- Given a parent country abbreviation, return disam (in range 1-8) or

-- Error

function Parent_Letter (Territory_Alpha_Code : String) return Integer is

Srch : constant String := Str_Tools.Upper_Str (Territory_Alpha_Code);

begin

if Srch'Length = 2 then

for I in Parents2'Range loop

if Srch = Parents2(I) then

return I;

end if;

end loop;

elsif Srch'Length = 3 then

for I in Parents3'Range loop

if Srch = Parents3(I) then

return I;

end if;

end loop;

end if;

return Error;

end Parent_Letter;

function Image (I : Integer) return String is

Str : constant String := I'Img;

begin

return (if Str(Str'First) /= ' ' then Str

else Str (Integer'Succ(Str'First) .. Str'Last));

end Image;

-- Returns alias of ISO abbreviation (if any), or empty

function Alias2Iso (Territory_Alpha_Code : String) return String is

-- Look for "DigitCrit="

function Match (Crit, Within : String) return Natural is

Occ : Positive := 1;

I : Natural;

begin

loop

I := Str_Tools.Locate (Within, Crit, Occurence => Occ);

exit when I = 0;

if I > 1 and then Within(I - 1) >= '0'

and then Within(I - 1) <= '9' then

return I - 1;

end if;

Occ := Occ + 1;

end loop;

return 0;

end Match;

Index : Natural;

begin

Index := (if Territory_Alpha_Code'Length = 2 then

Match (Territory_Alpha_Code & "=", Aliases)

else Str_Tools.Locate (Aliases, Territory_Alpha_Code & "="));

if Index /= 0 then

return Aliases (Index + 4 .. Index + 6);

else

return Undefined;

end if;

end Alias2Iso;

-- Given ISO code, return Territory_Number or Error

function Find_Iso (Territory_Alpha_Code : String) return Integer is

begin

for I in Country_Range loop

if Countries.Territories_Def(I).Code.Image = Territory_Alpha_Code then

return I - 1;

end if;

end loop;

return Error;

end Find_Iso;

-- Given ISO code, return territoryNumber or Error

function Iso2Ccode (Alpha_Code : String;

Context : in String) return Integer is

function Is_Digit (Char : Character) return Boolean is

(Char >= '0' and then Char <= '9');

function Is_Digits (Str : String) return Boolean is

begin

for I in Str'Range loop

if not Is_Digit (Str(I)) then

return False;

end if;

end loop;

return Str /= "";

end Is_Digits;

N, Sep : Natural;

P, Tmpp : Integer;

Result, Index : Integer;

Isoa : As_U.Asu_Us;

Code2Search, Context2Search : As_U.Asu_Us;

Hyphenated : As_U.Asu_Us;

use all type As_U.Asu_Us;

begin

if Alpha_Code = Undefined then

return Error;

end if;

P := Parent_Letter (Context);

if P = Error and then Context /= "" and then Context /= "AAA" then

return Error;

end if;

Sep := Str_Tools.Locate (Alpha_Code, "-");

Code2Search := Tus (Str_Tools.Upper_Str (Alpha_Code));

if P /= Error and then Sep /= 0 then

-- Cannot provide a context together with territory-subdivision

return Error;

end if;

-- Optims: direct number or code

if P = Error and then Sep = 0 then

-- Direct territory number

if Is_Digits (Code2Search.Image) then

N := Natural'Value (Code2Search.Image);

if N <= Ccode_Earth then

return N;

end if;

end if;

-- Check if a simple territory

if Code2Search.Length = 3 then

Index := Find_Iso (Code2Search.Image);

if Index /= Error then

return Index;

end if;

end if;

-- Find unique occurence of subdivision in ANY context

if Code2Search.Length >= 2 then

Hyphenated := Tus ("-") & Code2Search;

Result := Error;

for I in Country_Range loop

Index := Str_Tools.Locate (Countries.Territories_Def(I).Code.Image,

Hyphenated.Image);

if Index > 0

and then Index = Countries.Territories_Def(I).Code.Length

- Hyphenated.Length + 1 then

-- iso3166alpha ends by Hyphenated

if Result /= Error then

-- Not unique

return Error;

else

Result := I - 1;

end if;

end if;

end loop;

if Result /= Error then

return Result;

end if;

end if;

end if;

-- Set Context and Code for search

if Context /= "" then

-- Context provided

Context2Search.Set (Context);

elsif Sep /= 0 then

-- Code contains a prefix

Context2Search := Code2Search.Uslice (1, Sep - 1);

Code2Search.Delete (1, Sep);

P := Parent_Letter (Context2Search.Image);

if P = Error and then Context2Search.Image /= "AAA" then

return Error;

end if;

end if;

-- Sanity check

if Code2Search.Length /= 2 and then Code2Search.Length /= 3 then

return Error;

end if;

-- Optim: search this prefix and code

if P /= Error then

Index := Find_Iso (Parent_Name2 (P) & "-" & Code2Search.Image);

if Index /= Error then

return Index;

end if;

end if;

-- Resolve alias

if P /= Error then

-- Alias for a subdivision with context

Isoa := Tus (Alias2Iso (Image (P) & Code2Search.Image));

end if;

if Isoa.Is_Null and then Code2Search.Length = 3 then

-- Alias for a territory or subdivision without context

Isoa := Tus (Alias2Iso (Code2Search.Image));

end if;

if Isoa.Is_Null then

Index := Error;

else

if Is_Digit (Isoa.Element (1)) then

-- Alias is a subdivision

Code2Search := Isoa.Uslice (2, Isoa.Length);

Tmpp := Integer'Value (Isoa.Slice (1, 1));

if P /= Error and then Tmpp /= P then

-- Cannot change territory through aliasing

return Error;

end if;

P := Tmpp;

Index := Find_Iso (Parent_Name2 (P) & "-" & Code2Search.Image);

else

-- Alias is a subdivision or territory

Code2Search := Isoa;

-- Search for a territory

Index := Find_Iso (Code2Search.Image);

if Index = Error and then P /= Error then

-- Search for a subdivision

Index := Find_Iso (Parent_Name2 (P) & "-" & Code2Search.Image);

end if;

end if;

end if;

-- Return valid result

if Index /= Error then

return Index;

end if;

if P /= Error then

-- With a context, the search shall have succeded

return Error;

end if;

-- All else failed, try non-disambiguated alphacode

Isoa := Tus (Alias2Iso (Code2Search.Image));

if not Isoa.Is_Null then

if Is_Digit (Isoa.Element (1)) then

-- Starts with digit

Code2Search := Tus (Parent_Name2 (Natural'Value (Isoa.Slice (1, 1)))

& "-" & Isoa.Slice (2, Isoa.Length));

else

Code2Search := Isoa;

end if;

return Iso2Ccode (Code2Search.Image, Context);

end if;

return Error;

end Iso2Ccode;

-- Image of a territory (index starting at 0 for VAT)

function Get_Territory_Number (Territory : Territories) return String is

(Image (Integer (Territory)));

-- Given an alphacode (such As_US-AL), returns the territory number

-- or Error.

-- A context_Territory number helps to interpret ambiguous (abbreviated)

-- AlphaCodes, such as "AL"

function Get_Territory (Territory_Code : String;

Context : in String := "") return Territories is

Num : Integer;

begin

Num := Iso2Ccode (Territory_Code, Context);

if Num = Error then

raise Unknown_Territory;

end if;

return Territories (Num);

end Get_Territory;

-- Return full name of territory

function Get_Territory_Fullname (Territory: in Territories)

return String is

Name : As_U.Asu_Us;

Index : Natural;

begin

Name := Countries.Territories_Def(Positive (Territory) + 1).Name;

Index := Str_Tools.Locate (Name.Image, " (");

if Index > 0 then

return Name.Slice (1, Index - 1);

else

return Name.Image;

end if;

end Get_Territory_Fullname;

-- Return the AlphaCode (usually an ISO 3166 code) of a territory

-- Format: Local (often ambiguous), International (full and unambiguous,

-- DEFAULT), or Shortest

function Get_Territory_Alpha_Code (

Territory : Territories;

Format : Territory_Formats := International) return String is

Full : constant String := Iso3166Alpha_Of (Natural (Territory));

Iso : As_U.Asu_Us;

Hyphen, Index : Natural;

Short : As_U.Asu_Us;

Count : Natural;

begin

Hyphen := Str_Tools.Locate (Full, "-");

if Format = International or else Hyphen = 0 then

-- Format full or no hyphen

return Full;

end if;

Short := As_U.Tus (Full(Hyphen + 1 .. Full'Last));

if Format = Local then

-- Format local

return Short.Image;

end if;

-- Shortest possible

-- Keep parent if it has aliases or if territory occurs multiple times

Count := 0;

if Str_Tools.Locate (Aliases, Short.Image & "=") > 0 then

Count := 2;

else

for I in Country_Range loop

Iso := As_U.Tus (Iso3166Alpha_Of (I));

Index := Str_Tools.Locate (Iso.Image, "-" & Short.Image);

if Index > 0 and then Index + Short.Length = Iso.Length then

Count := Count + 1;

exit when Count = 2;

end if;

end loop;

end if;

return (if Count = 1 then Short.Image else Full);

end Get_Territory_Alpha_Code;

-- Return parent country of subdivision or error (if territory is not a

-- subdivision)

function Get_Parent (Territory : Territories)

return Integer is

begin

return (case Territory is

when Usa_From .. Usa_Upto => Ccode_Usa,

when Ind_From .. Ind_Upto => Ccode_Ind,

when Can_From .. Can_Upto => Ccode_Can,

when Aus_From .. Aus_Upto => Ccode_Aus,

when Mex_From .. Mex_Upto => Ccode_Mex,

when Bra_From .. Bra_Upto => Ccode_Bra,

when Rus_From .. Rus_Upto => Ccode_Rus,

when Chn_From .. Chn_Upto => Ccode_Chn,

when others => Error);

end Get_Parent;

function Get_Parent_Of (Territory : Territories) return Territories is

Code : constant Integer := Get_Parent (Territory);

begin

if Code = Error then

raise Not_A_Subdivision;

else

return Territories (Code);

end if;

end Get_Parent_Of;

-- Return True if Territory is a state

function Is_Subdivision (Territory : Territories)

return Boolean is

(Get_Parent (Territory) /= Error);

-- Return True if Territory is a country that has states

function Has_Subdivision (Territory : Territories)

return Boolean is

Code : constant String := Get_Territory_Alpha_Code (Territory);

begin

for Parent of Parents3 loop

if Code = Parent then

return True;

end if;

end loop;

return False;

end Has_Subdivision;

-- Given a subdivision, return the array of subdivisions with same name

-- with various parents

function Get_Subdivisions_With (Subdivision : String)

return Territories_Array is

Upper_Subd : constant String := Str_Tools.Upper_Str (Subdivision);

Ccodes : array (1 .. Parent_Length) of Integer;

Nb_Ok : Natural := 0;

begin

-- Count and store valid combinations of a Parent and this subdivision

for I in Parents2'Range loop

Ccodes(I) := Iso2Ccode (Upper_Subd, Parents2(I));

if Ccodes(I) /= Error then

Nb_Ok := Nb_Ok + 1;

end if;

end loop;

-- Return array of valid combinations

return Result : Territories_Array (1 .. Nb_Ok) do

Nb_Ok := 0;

for Ccode of Ccodes loop

if Ccode /= Error then

Nb_Ok := Nb_Ok + 1;

Result(Nb_Ok) := Territories (Ccode);

end if;

end loop;

end return;

end Get_Subdivisions_With;

-- Low-level routines for data access

type Min_Max_Rec is record

Minx, Miny, Maxx, Maxy : Lint;

end record;

function Data_First_Record (Territory_Number : Natural) return Integer is

begin

return Ndata.Data_Start(Territory_Number + 1);

exception

when others => return Error;

end Data_First_Record;

function Data_Last_Record (Territory_Number : Natural) return Integer is

begin

return Ndata.Data_Start(Territory_Number + 2) - 1;

exception

when others => return Error;

end Data_Last_Record;

function Min_Max_Setup (I : Natural) return Min_Max_Rec is

Short_Maxy : constant array (Positive range <>) of Natural

:= (0, 122309, 27539, 27449, 149759, 2681190, 60119, 62099,

491040, 86489);

D : Natural;

begin

D := Ndata.Data_Maxy(I + 1);

if D < Short_Maxy'Last then

D := Short_Maxy(D + 1);

end if;

return (Minx => Lint (Ndata.Data_Minx(I + 1)),

Miny => Lint (Ndata.Data_Miny(I + 1)),

Maxx => Lint (Ndata.Data_Minx(I + 1) + Ndata.Data_Maxx(I + 1)),

Maxy => Lint (Ndata.Data_Miny(I + 1) + D));

end Min_Max_Setup;

Xdivider19 : constant array (Positive range <>) of Natural := (

360, 360, 360, 360, 360, 360, 361, 361, 361, 361, -- 5.2429 degrees

362, 362, 362, 363, 363, 363, 364, 364, 365, 366, -- 10.4858 degrees

366, 367, 367, 368, 369, 370, 370, 371, 372, 373, -- 15.7286 degrees

374, 375, 376, 377, 378, 379, 380, 382, 383, 384, -- 20.9715 degrees

386, 387, 388, 390, 391, 393, 394, 396, 398, 399, -- 26.2144 degrees

401, 403, 405, 407, 409, 411, 413, 415, 417, 420, -- 31.4573 degrees

422, 424, 427, 429, 432, 435, 437, 440, 443, 446, -- 36.7002 degrees

449, 452, 455, 459, 462, 465, 469, 473, 476, 480, -- 41.9430 degrees

484, 488, 492, 496, 501, 505, 510, 515, 520, 525, -- 47.1859 degrees

530, 535, 540, 546, 552, 558, 564, 570, 577, 583, -- 52.4288 degrees

590, 598, 605, 612, 620, 628, 637, 645, 654, 664, -- 57.6717 degrees

673, 683, 693, 704, 715, 726, 738, 751, 763, 777, -- 62.9146 degrees

791, 805, 820, 836, 852, 869, 887, 906, 925, 946, -- 68.1574 degrees

-- 73.4003 degrees

968, 990, 1014, 1039, 1066, 1094, 1123, 1154, 1187, 1223,

-- 78.6432 degrees

1260, 1300, 1343, 1389, 1438, 1490, 1547, 1609, 1676, 1749,

-- 83.8861 degrees

1828, 1916, 2012, 2118, 2237, 2370, 2521, 2691, 2887, 3114,

-- 89.1290 degrees

3380, 3696, 4077, 4547, 5139, 5910, 6952, 8443, 10747, 14784,

23681, 59485);

Nc : constant array (Positive range <>) of Natural := (

1, 31, 961, 29791, 923521, 28629151, 887503681);

X_Side : constant array (Positive range <>) of Natural := (

0, 5, 31, 168, 961, 168 * 31, 29791, 165869, 923521, 5141947, 28629151);

Y_Side : constant array (Positive range <>) of Natural := (

0, 6, 31, 176, 961, 176 * 31, 29791, 165869, 923521, 5141947, 28629151);

Decode_Char : constant array (Positive range <>) of Integer := (

-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,

-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,

-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,

0, 1, 2, 3, 4, 5, 6, 7, 8, 9, -1, -1, -1, -1, -1, -1,

-1, -2, 10, 11, 12, -3, 13, 14, 15, 1, 16, 17, 18, 19, 20, 0,

21, 22, 23, 24, 25, -4, 26, 27, 28, 29, 30, -1, -1, -1, -1, -1,

-1, -2, 10, 11, 12, -3, 13, 14, 15, 1, 16, 17, 18, 19, 20, 0,

21, 22, 23, 24, 25, -4, 26, 27, 28, 29, 30, -1, -1, -1, -1, -1,

-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,

-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,

-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,

-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,

-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,

-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,

-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,

-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1);

Encode_Char : constant array (Positive range <>) of Character := (

'0', '1', '2', '3', '4', '5', '6', '7', '8', '9',

'B', 'C', 'D', 'F', 'G', 'H', 'J', 'K', 'L', 'M',

'N', 'P', 'Q', 'R', 'S', 'T', 'V', 'W', 'X', 'Y', 'Z',

'A', 'E', 'U');

function Decode_A_Char (C : Natural) return Integer is (Decode_Char(C + 1));

function Encode_A_Char (C : Natural) return Character is (Encode_Char(C + 1));

-- Given a minimum and maximum latitude, returns a relative stretch factor

-- (in 360th) for the longitud

function Xdivider4 (Miny, Maxy : Lint) return Natural is

use Bits;

begin

if Miny >= 0 then

return Xdivider19(Integer (Shr (Miny, 19)) + 1);

end if;

if Maxy >= 0 then

return Xdivider19(1);

end if;

return Xdivider19(Integer (Shr (-Maxy, 19)) + 1);

end Xdivider4;

type Coord_Rec is record

X, Y : Lint;

end record;

type Frac_Rec is record

Fraclon, Fraclat : Integer;

Coord32 : Coord_Rec;

end record;

-- Return True if x in range (all values in millionths)

function Is_In_Range_X (X, Minx, Maxx : Lint) return Boolean is

Lx : Lint;

begin

if Minx <= X and then X < Maxx then return True; end if;

Lx := X;

if Lx < Minx then

Lx := Lx + 360000000;

else

Lx := Lx - 360000000;

end if;

return Minx <= Lx and then Lx < Maxx;

end Is_In_Range_X;

-- Return True if coordinate inside rectangle (all values in millionths)

function Fits_Inside (Coord : Coord_Rec; Min_Max : Min_Max_Rec)

return Boolean is

(Min_Max.Miny <= Coord.Y

and then Coord.Y < Min_Max.Maxy

and then Is_In_Range_X (Coord.X, Min_Max.Minx, Min_Max.Maxx));

-- Mapcodezone

type Mapcode_Zone_Rec is record

Fminx, Fmaxx, Fminy, Fmaxy : Lint := 0;

end record;

-- Empty Mapcode_Zone

Mz_Empty : constant Mapcode_Zone_Rec := (others => <>);

function Mz_Is_Empty (Zone : Mapcode_Zone_Rec) return Boolean is

(Zone.Fmaxx <= Zone.Fminx or else Zone.Fmaxy <= Zone.Fminy);

-- Construct MapcodeZone based on coordinate and deltas (in Fractions)

function Mz_Set_From_Fractions (Y, X, Ydelta, Xdelta : Lint)

return Mapcode_Zone_Rec is

(if Ydelta < 0 then

(Fminx => X,

Fmaxx => X + Xdelta,

Fminy => Y + 1 + Ydelta, -- y+yDelta can NOT be represented

Fmaxy => Y + 1) -- y CAN be represented

else

(Fminx => X,

Fmaxx => X + Xdelta,

Fminy => Y,

Fmaxy => Y + Ydelta));

function Mz_Mid_Point_Fractions (Zone : Mapcode_Zone_Rec) return Coord_Rec is

( (Y => (Zone.Fminy + Zone.Fmaxy) / 2,

X => (Zone.Fminx + Zone.Fmaxx) / 2));

function Convert_Fractions_To_Coord32 (P : Coord_Rec) return Coord_Rec is

( (Y => P.Y / 810000,

X => P.X / 3240000) );

function Wrap (P : Coord_Rec) return Coord_Rec is

Res : Coord_Rec := P;

begin

if Res.X >= 180 * 3240000 * 1000000 then

Res.X := Res.X - 360 * 3240000 * 1000000;

end if;

if Res.X < -180 * 3240000 * 1000000 then

Res.X := Res.X + 360 * 3240000 * 1000000;

end if;

return Res;

end Wrap;

function Round (Val, Max : Real) return Real is

Epsilon : constant Real := 0.0000005;

begin

if Val < 0.0 then

if Val < -Max and then Val >= -Max - Epsilon then

return -Max;

end if;

else

if Val > Max and then Val <= Max + Epsilon then

return Max;

end if;

end if;

return Val;

end Round;

function Convert_Fractions_To_Degrees (P : Coord_Rec) return Coordinate is

begin

return (Lat => Round (Real (P.Y) / 810000.0 / 1000000.0, 90.0),

Lon => Round (Real (P.X) / 3240000.0 / 1000000.0, 180.0) );

end Convert_Fractions_To_Degrees;

function Mz_Restrict_Zone_To (Zone : Mapcode_Zone_Rec; Mm : Min_Max_Rec)

return Mapcode_Zone_Rec is

Z : Mapcode_Zone_Rec := Zone;

Miny : constant Lint := Mm.Miny * 810000;

Maxy : constant Lint := Mm.Maxy * 810000;

Minx : Lint;

Maxx : Lint;

begin

if Z.Fminy < Miny then

Z.Fminy := Miny;

end if;

if Z.Fmaxy > Maxy then

Z.Fmaxy := Maxy;

end if;

if Z.Fminy < Z.Fmaxy then

Minx := Mm.Minx * 3240000;

Maxx := Mm.Maxx * 3240000;

if Maxx < 0 and then Z.Fminx > 0 then

Minx := Minx + 360000000 * 3240000;

Maxx := Maxx + 360000000 * 3240000;

elsif Minx > 1 and then Z.Fmaxx < 0 then

Minx := Minx - 360000000 * 3240000;

Maxx := Maxx - 360000000 * 3240000;

end if;

if Z.Fminx < Minx then

Z.Fminx := Minx;

end if;

if Z.Fmaxx > Maxx then

Z.Fmaxx := Maxx;

end if;

end if;

return Z;

end Mz_Restrict_Zone_To;

-- High-precision extension routines

function Max_Mapcode_Precision return Natural is (8);

-- PRIVATE lowest-level data access

function Header_Letter (I : Natural) return String is

Flags : constant Integer := Ndata.Data_Flags(I + 1);

use Bits;

begin

if (Shr (Flags, 7) and 3) = 1 then

return Encode_Char((Shr (Flags, 11) and 31) + 1) & "";

end if;

return "";

end Header_Letter;

function Smart_Div (I : Natural) return Integer is

(Ndata.Data_Special1(I + 1));

function Is_Restricted (I : Natural) return Boolean is

use Bits;

begin

return (Ndata.Data_Flags(I + 1) and 512) /= 0;

end Is_Restricted;

function Is_Nameless (I : Natural) return Boolean is

use Bits;

begin

return (Ndata.Data_Flags(I + 1) and 64) /= 0;

end Is_Nameless;

function Is_Auto_Header (I : Natural) return Boolean is

use Bits;

begin

return (Ndata.Data_Flags(I + 1) and Shl (8, 5)) /= 0;

end Is_Auto_Header;

function Codex_Len (I : Natural) return Integer is

use Bits;

Flags : constant Integer := Ndata.Data_Flags (I + 1) and 31;

begin

return Flags / 5 + Flags rem 5 + 1;

end Codex_Len;

function Co_Dex (I : Natural) return Integer is

use Bits;

Flags : constant Integer := Ndata.Data_Flags (I + 1) and 31;

begin

return 10 * (Flags / 5) + Flags rem 5 + 1;

end Co_Dex;

function Is_Special_Shape (I : Natural) return Boolean is

use Bits;

begin

return (Ndata.Data_Flags(I + 1) and 1024) /= 0;

end Is_Special_Shape;

-- 1=pipe 2=plus 3=star

function Rec_Type (I : Natural) return Integer is

use Bits;

begin

return Shr (Ndata.Data_Flags(I + 1), 7) and 3;

end Rec_Type;

function First_Nameless_Record (Index : Natural; First_Code : Natural)

return Natural is

I : Integer := Index;

Codex : constant Natural := Co_Dex (I);

begin

while I >= First_Code and then Co_Dex (I) = Codex

and then Is_Nameless (I) loop

I := I - 1;

end loop;

return I + 1;

end First_Nameless_Record;

function Count_Nameless_Records (Index : Natural; First_Code : Natural)

return Natural is

I : constant Natural := First_Nameless_Record (Index, First_Code);

E : Natural := Index;

Codex : constant Natural := Co_Dex (I);

begin

while Co_Dex(E) = Codex loop

E := E + 1;

end loop;

return E - I;

end Count_Nameless_Records;

-- Return Lint immediately smaller than Real

function Floor (X : Real) return Lint is

Int : Lint;

begin

Int := Lint(X);

if Real(Int) > X then

Int := Int - 1;

end if;

return Int;

end Floor;

function Get_Encode_Rec(Lat, Lon : in Real) return Frac_Rec is

Ilat : Real := Lat;

Ilon : Real := Lon;

D : Real;

Fraclat, Fraclon : Lint;

Lat32, Lon32 : Lint;

begin

if Ilat < -90.0 then

Ilat := -90.0;

elsif Ilat > 90.0 then

Ilat := 90.0;

end if;

Ilat := Ilat + 90.0; -- Ilat now [0..180]

Ilat := Ilat * 810000000000.0;

Fraclat := Floor (Ilat + 0.1);

D := Real (Fraclat) / 810000.0;

Lat32 := Floor (D);

Fraclat := Fraclat - Lat32 * 810000;

Lat32 := Lat32 - 90000000;

Ilon := Ilon - 360.0 * Real (Floor (Ilon / 360.0));

-- Lon now in [0..360>

Ilon := Ilon * 3240000000000.0;

Fraclon := Floor (Ilon + 0.1);

D := Real (Fraclon) / 3240000.0;

Lon32 := Floor (D);

Fraclon := Fraclon - Lon32 * 3240000;

if Lon32 >= 180000000 then

Lon32 := Lon32 - 360000000;

end if;

return (Coord32 => (Y => Lat32, X => Lon32),

Fraclat => Integer (Fraclat),

Fraclon => Integer (Fraclon) );

end Get_Encode_Rec;

function Encode_Base31 (Value : Lint; Nrchars : Natural) return String is

Result : As_U.Asu_Us;

Lv : Lint := Value;

Ln : Natural := Nrchars;

use type As_U.Asu_Us;

begin

while Ln > 0 loop

Ln := Ln - 1;

Result := Encode_Char(Integer (Lv rem 31) + 1) & Result;

Lv := Lv / 31;

end loop;

return Result.Image;

end Encode_Base31;

-- Lowest level encode/decode routines

function Decode_Base31 (Str : String) return Integer is

Value : Integer := 0;

C : Natural;

begin

for I in Str'Range loop

C := Character'Pos (Str(I));

if C = 46 then

-- Dot!

return Value;

end if;

if Decode_Char(C + 1) < 0 then

return Error;

end if;

Value := Value * 31 + Decode_Char(C + 1);

end loop;

return Value;

end Decode_Base31;

function Encode_Triple (Difx, Dify : Lint) return String is

Rx, Ry, Cx, Cy : Lint;

begin

if Dify < 4 * 34 then

Rx := Difx / 28;

Ry := Dify / 34;

Cx := Difx rem 28;

Cy := Dify rem 34;

return Encode_Char(Integer (Rx + 6 * Ry + 1))

& Encode_Base31 (Cx * 34 + Cy, 2);

else

Rx := Difx / 24;

Cx := Difx rem 24;

return Encode_Char(Integer (Rx + 25))

& Encode_Base31 (Cx * 40 + (Dify - 136), 2);

end if;

end Encode_Triple;

function Decode_Triple (Input : String) return Coord_Rec is

Triplex, Tripley : Integer;

C1 : constant Character := Input(Input'First);

I1 : constant Integer := Decode_Char(Character'Pos(C1) + 1);

X : constant Integer

:= Decode_Base31 (Input(Positive'Succ(Input'First) .. Input'Last));

begin

if I1 < 24 then

Triplex := (I1 rem 6) * 28 + X / 34;

Tripley := (I1 / 6) * 34 + X rem 34;

else

Tripley := X rem 40 + 136;

Triplex := X / 40 + 24 * (I1 - 24);

end if;

return (Y => Lint (Tripley), X => Lint (Triplex));

end Decode_Triple;

function Encode_Six_Wide (X, Y, Width, Height : in Integer) return Integer is

D : Integer := 6;

Col : Integer := X / 6;

Maxcol : constant Integer := (Width - 4) / 6;

begin

if Col >= Maxcol then

Col := Maxcol;

D := Width - Maxcol * 6;

end if;

return Height * 6 * Col + (Height - 1 - Y) * D + X - Col * 6;

end Encode_Six_Wide;

function Decode_Six_Wide (V, Width, Height : in Integer) return Coord_Rec is

D : Integer := 6;

Col : Integer := V / (Height * 6);

Maxcol : constant Integer := (Width - 4) / 6;

W, X6, Y6 : Integer;

begin

if Col >= Maxcol then

Col := Maxcol;

D := Width - Maxcol * 6;

end if;

W := V - Col * Height * 6;

X6 := Col * 6 + W rem D;

Y6 := Height - 1 - W / D;

return (Y => Lint (Y6), X => Lint (X6));

end Decode_Six_Wide;

function Encode_Extension (

Input : String;

Enc : Frac_Rec;

Extrax4, Extray, Dividerx4, Dividery : Lint;

Extradigits, Ydirection : Integer) return String is

Factorx, Factory, Valx, Valy : Lint;

Gx, Gy, Column1, Column2, Row1, Row2 : Integer;

Digit : Integer := Extradigits;

Result : As_U.Asu_Us;

begin

if Extradigits = 0 then

return Input;

end if;

if Digit > Max_Mapcode_Precision then

Digit := Max_Mapcode_Precision;

end if;

Result := As_U.Tus (Input);

-- The following are all perfect integers

-- 810000 = 30^4

Factorx := 810000 * Dividerx4;

Factory := 810000 * Dividery;

Valx := 810000 * Extrax4 + Lint (Enc.Fraclon);

Valy := 810000 * Extray + Lint (Enc.Fraclat) * Lint (Ydirection);

-- Protect against floating point errors

if Valx < 0 then

Valx := 0;

elsif Valx >= Factorx then

Valx := Factorx - 1;

end if;

if Valy < 0 then

Valy := 0;

elsif Valy >= Factory then

Valy := Factory - 1;

end if;

Result.Append ('-');

loop

Factorx := Factorx / 30;

Gx := Integer (Valx / Factorx);

Factory := Factory / 30;

Gy := Integer (Valy / Factory);

Column1 := Gx / 6;

Row1 := Gy / 5;

Result.Append (Encode_Char(Row1 * 5 + Column1 + 1));

Digit := Digit - 1;

exit when Digit = 0;

Column2 := Gx rem 6;

Row2 := Gy rem 5;

Result.Append (Encode_Char(Row2 * 6 + Column2 + 1));

Digit := Digit - 1;

exit when Digit = 0;