# Copyright (c) 2007, misch (http://ati.land.cz/)
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#     * Redistributions of source code must retain the above copyright
#       notice, this list of conditions and the following disclaimer.
#     * Redistributions in binary form must reproduce the above copyright
#       notice, this list of conditions and the following disclaimer in the
#       documentation and/or other materials provided with the distribution.
#     * Neither the name of the <organization> nor the
#       names of its contributors may be used to endorse or promote products
#       derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY misch (http://ati.land.cz/) ``AS IS'' AND ANY
# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL <copyright holder> BE LIABLE FOR ANY
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# Author: misch (http://ati.land.cz/)

package TypDecompiler;

use strict;
use utf8;
use FindBin qw($Bin); use lib "$Bin";
use Fcntl qw(:seek);
use Data::Dumper;
use Data::HexDump;
use Image::Magick;
use Digest::SHA1 qw(sha1_hex);
use Encode;
use Carp qw(carp);

our $VERSION = qw($Revision: 1.18 $)[1];

our $debug = 0;
our $outdir = '.';
our $webdir = '';

sub signature {
    return 
        "; Generated by on-line decompiler v${VERSION} from http://ati.land.cz/gps/typdecomp\n";
};

package Garmin::TYP;
use Data::Dumper;

sub DEBUG_OFFSETS {0x0001};
sub DEBUG_LONG_HEADER {0x0002};

sub new {
    my ($class, $raw_data, $debug_flags) = @_;
    my $self = bless({}, $class);

    $self->{_errors} = [];

    $self->{_debug} = $debug_flags;
    $self->{_ranges} = RangeCheck->new();

    $self->{_header} = Garmin::TYP::Header->new($self, $raw_data);
    $self->{_polyplaceholders} = Garmin::TYP::Collection->new($self, 'polyplaceholder', '');

    $self->{_draworder} = Garmin::TYP::DrawOrder->new($self, $self->{_header}->{_raw_draworder});

    $self->{_polygons} = Garmin::TYP::Collection->new($self, 'polygon', $raw_data);
    $self->{_lines} = Garmin::TYP::Collection->new($self, 'line', $raw_data);
    $self->{_points} = Garmin::TYP::Collection->new($self, 'point', $raw_data);
    $self->{_NT1points} = Garmin::TYP::Collection->new($self, 'NT1point', $raw_data);

    $self->{_NTblocks} = Garmin::TYP::NTBlocks->new($self);

    if (defined $raw_data) {

        my $rng = $self->{_ranges};
        $rng->merge();

        if ($rng->get_range(0)->{from} != 0) {

            Carp::carp();

        };
        if ($rng->get_range(0)->{to} != length($raw_data)-1) {
            Carp::carp();

            $self->error("Corrupted file or file in unknown format! Last address in TYP file is " .
                sprintf('0x%x', length($raw_data)-1) . 
                ", but first datablock in TYP ends at address " .
                sprintf('0x%x', $rng->get_range(0)->{to}) . 
                ", so there is " .
                sprintf('0x%x', (length($raw_data)-1) - ($rng->get_range(0)->{to})) . 
                " unknown bytes in this TYP file!");
        };
    };
    return $self;
};

sub debug_offsets {
    my $ret = ($_[0]->{_debug} & DEBUG_OFFSETS);
    return $ret;
};
sub debug_long_header {
    my $ret = ($_[0]->{_debug} & DEBUG_LONG_HEADER);
    return $ret;
};

sub header {die if defined $_[1]; $_[0]->{_header}};
sub lines {die if defined $_[1]; $_[0]->{_lines}};
sub points {die if defined $_[1]; $_[0]->{_points}};
sub NT1points {die if defined $_[1]; $_[0]->{_NT1points}};
sub polygons {die if defined $_[1]; $_[0]->{_polygons}};
sub polyplaceholders {die if defined $_[1]; $_[0]->{_polyplaceholders}};
sub draworder {die if defined $_[1]; $_[0]->{_draworder}};
sub NTblocks {die if defined $_[1]; $_[0]->{_NTblocks}};

sub clear_errors {
    my ($self) = @_;

    $self->{_errors} = [];
};
sub error {
    my ($self, $err) = @_;

    if (!grep {$_ eq $err} @{$self->{_errors}}) {
        push @{$self->{_errors}}, $err;
    };
};
sub error_list {
    my ($self) = @_;
    return @{$self->{_errors}};
};

sub collection_by_kind {
    my ($self, $kind) = @_;
    my $kolekce = undef;
    if ($kind eq 'polygon') {
        $kolekce = $self->polygons;
    } elsif ($kind eq 'polyplaceholder') {
        $kolekce = $self->polyplaceholders;
    } elsif ($kind eq 'line') {
        $kolekce = $self->lines;
    } elsif ($kind eq 'point') {
        $kolekce = $self->points;
    } elsif ($kind eq 'NT1point') {
        $kolekce = $self->NT1points;
    } else {
        die "unknown kind: $kind";
    };
    return $kolekce;
};

sub pid {die if defined $_[1]; $_[0]->header->pid};
sub fid {die if defined $_[1]; $_[0]->header->fid};

sub as_string {
    my ($self) = @_;
    my $ret = '';
    
    if (my @e = $self->error_list) {
        $ret .= "; !!!!!!!!! TYP contained errors: !!!!!!!!!\n";
        $ret .= join('', map {"; $_\n"} @e);
        $ret .= "; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n\n\n";
    };
    $ret .= $self->header->as_string;
    $ret .= 
        $self->NTblocks->as_string .
        $self->draworder->as_string .
        $self->polygons->as_string .
        $self->lines->as_string .
        $self->points->as_string .
        $self->NT1points->as_string;
    return $ret;
};

sub productname_by_fid_and_pid {
    my ($self, $fid, $pid) = @_;

    if ($fid == 0) {

        my %pids = (
            1300    => 'Bulgaria TOPO',
            81    => 'Japan'
        );
        if (exists $pids{$pid}) {
            return $pids{$pid};
        } else {
            return;
        };
    } else {

        return if $pid != 1;
    my %fids = (

    1  => '    Garmin Mapsource Roads and Recreation - Cont. US',
    2  => 'Garmin Mapsource Roads and Recreation - Hawaii',
    3  => 'Garmin Mapsource Roads and Recreation - Alaska',
    5  => 'Garmin Mapsource WorldMap',
    6  => 'Garmin Mapsource US Topo - East',
    7  => 'Garmin Mapsource US Topo - West',
    8  => 'Garmin Mapsource US Topo - Alaska',
    9  => 'Garmin Mapsource US Topo - Hawaii',
    10 => '    Garmin Mapsource MetroGuide USA - West',
    11 => '    Garmin Mapsource MetroGuide USA - East',
    12 => '    Garmin Mapsource MetroGuide USA - Regional maps',
    13 => '    Garmin Mapsource Roads and Recreation - Great Britain',
    14 => '    Garmin Mapsource Roads and Recreation - Germany',
    15 => '    Garmin Mapsource MetroGuide - United Kingdom',
    16 => '    Garmin Mapsource Roads and Recreation - Italy',
    17 => '    Garmin Mapsource MetroGuide - France',
    18 => '    Garmin Mapsource MetroGuide - BeNeLux',
    19 => '    Garmin Mapsource MetroGuide - Germany',
    20 => '    Garmin Mapsource MetroGuide - Italy',
    21 => '    Garmin Mapsource MetroGuide - Sweden&Denmark',
    22 => '    Garmin Mapsource MetroGuide - Austria',
    23 => '    Garmin Mapsource MetroGuide - Switzerland',
    24 => '    Garmin Mapsource MetroGuide - Spain',
    25 => '    Garmin Mapsource Roads and Recreation - France',
    26 => '    Garmin Mapsource Roads and Recreation - BeNeLux',
    27 => '    Garmin Mapsource Roads and Recreation - Sweden&Denmark',
    28 => '    Garmin Mapsource Roads and Recreation - Austria',
    29 => '    Garmin Mapsource Roads and Recreation - Switzerland',
    30 => '    Garmin Mapsource Roads and Recreation - Spain',
    31 => '    Garmin Mapsource Waterways & Lights - Cont. US',
    32 => '    Garmin Mapsource Waterways & Lights - Hawaii',
    33 => '    Garmin Mapsource Waterways & Lights - Alaska',
    36 => '    Garmin Mapsource MetroGuide & Roads and Recreation - Canada',
    70 => '    Slovakia - Roads and Recreation',
    71 => '    Slovakia MetroGuide',
    72 => '    Slovakia TOPO',
    73 => '    reserved for Slovakia maps',
    74 => '    reserved for Slovakia maps',
    75 => '    Slovenia - Roads and Recreation',
    76 => '    Croatia - MetroGuide',
    77 => '    Croatia - BlueChart',
    160=> '    Iberia 1:50.000 (Spain Topo)',
    161=> '    Carta Digital Militar (Spain Road and Recreation)',
    221=> '    Island',
    222=> '    Island',
    223=> '    Island',
    990=> '    NaviGuide Hungary',

    2     => 'Bashkiria Republic (Russia)',
    7     => 'Tversk Area (Russia)',
    8     => 'Kalmikia Republic (Russia)',
    8     => 'Ryazansk Area (Russia)',
    9     => '* a lot of Russian cities and areas',
    10     => 'Karelia Republic (Russia)',
    10     => 'Vladimirsk Area (Russia)',
    11     => 'Novgorodsk Area (Russia)',
    13     => 'Leningradsk Area (Russia)',
    15     => 'Kalujsk Area (Russia)',
    16     => 'Tulsk Area (Russia)',
    23     => 'Krasnodarsk County (Russia)',
    24     => 'Krasnojarsk County (Russia)',
    25     => 'Primorsk County (Russia)',
    26     => 'Stavropolsk County (Russia)',
    26     => 'Pskovsk Area (Russia)',
    28     => 'Amursk Area (Russia)',
    29     => 'Arhangelsk Area (Russia)',
    30     => 'Astrahansk Area (Russia)',
    33     => 'Vladimirsk Area (Russia)',
    34     => 'Volgogradsk Area (Russia)',
    37     => 'Ivanovsk Area (Russia)',
    38     => 'Irkutsk Area (Russia)',
    39     => 'Kaliningradsk Area (Russia)',
    40     => 'Kalujsk Area (Russia)',
    41     => 'Highways Brazil',
    47     => 'Leningradsk Area (Russia)',
    48     => 'Lipetck Area (Russia)',
    50     => 'Moscow Area (Russia)',
    51     => 'Murmansk Area (Russia)',
    52     => 'Nizhegorodsk Area (Russia)',
    53     => 'Novgorodsk Area (Russia)',
    54     => 'Novosibirsk Area (Russia)',
    55     => 'Omsk Area (Russia)',
    56     => 'Oremburg Area (Russia)',
    57     => 'Orlovsk Area (Russia)',
    58     => 'Penzensk Area (Russia) Venezuela con GPS_YV (Venezuela)',
    59     => 'Permsk Area (Russia)',
    60     => 'Pskovsk Area (Russia)',
    61     => 'Rostovsk Area (Russia)',
    62     => 'Ryazansk Area (Russia)',
    63     => 'Samarsk Area (Russia)',
    64     => 'Saratovsk Area (Russia)',
    65     => 'Sakhalinsk Area (Russia)',
    66     => 'Sverdlovsk Area (Russia) Asama (Japan) Sirakomaike (Japan) Kitayatu (Japan)',
    68     => 'Tambovsk Area (Russia)',
    69     => 'Tversk Area (Russia) Geosail Mediterranean Sea',
    70     => 'Tomsk Area (Russia)',
    71     => 'Tulsk Area (Russia)',
    72     => 'Tumensk Area (Russia)',
    73     => 'Uljanovsk Area (Russia)',
    74     => 'Chelyabinsk Area (Russia)',
    75     => 'Chitinsk Area (Russia)',
    76     => 'Yaroslavsk Area (Russia)',
    78     => 'Sankt Peterburg City (Russia)',
    81     => 'Japan',
    84     => 'Illinois (USA)',
    90     => 'Cantu (Italy)',
    100 => '    Russia Thassos (Greece) TrackSource Estadual (Brasil)',
    101 => '    TrackSource Municipal (Brasil) Hamburg (Germany)',
    102 => '    TrackSource Aeronáutico (Brasil)',
    103 => '    South America Marine POI Database',
    104 => '    UAE and Oman (United Arab Emirates/Oman)',
    105 => '    Dagestan Republic (Russia)',
    111 => '    Salzkammergut (Austria) Bitza - Moscow recreation area (Russia)',
    112 => '    Troparevo - Moscow recreation area (Russia) Greece NW region',
    113 => '    Olympus area (Greece)',
    200 => '    * a lot of Russian cities and areas',
    250 => '    Weeki Wachee Preserve - Citrus County, FL (USA)',
    251 => '    Balm-Boyette Preserve, Hillsborough County, FL (USA)',
    252 => '    Homosassa River - Citrus County, FL (USA)',
    253 => '    InfoChallenge South Map Extension, Tampa, FL (USA)',
    255 => '    West Central, Florida (USA)',
    420 => '    TopoGuide Czech Republic',
    421 => '    Slovakia TOPO Outdoor',
    422 => '    Hanggliding GPS sectors (World)',
    426 => '    TOPO50 Czech',
    427 => '    TOPO20 Czech',
    500 => '    Mexico Topo Maps',
    501 => '    Mexico R&R',
    502 => '    Mexico Marine Maps',
    666 => '    New Zealand Street maps',
    667 => '    New Zealand Topo',
    670 => '    Grand Canaria (Spain)',
    671 => '    Tenerife (Spain)',
    728 => '    Kananaskis Area (Canada)',
    729 => '    Calgary Street (Canada)',
    730 => '    Port Renfrew Topographic (Canada)',
    731 => '    Calgary Topographic (Canada)',
    732 => '    Algonquin Provincial Park (Canada)',
    733 => '    Bedrock geology map of Alberta (Canada)',
    734 => '    Bedrock geology map of Alberta (Canada)',
    735 => '    Coarse topographic map of Alberta (Canada)',
    736 => '    Alberta base maps (Canada)',
    963 => '    Test use (Carto-Perso, France)',
    998 => '    Pelion Peninsula (Greece)',
    999 => '    Tenerife (Spain)',
    4602=> '     Carto-Perso (France)',
    9654=> '     IAOI (Africa)',

    );
    if (exists $fids{$fid}) {
        return $fids{$fid};
    } else {
        return;
    };
    };
};

sub language_codes {
    my ($self) = @_;
    return {

        0x00 => 'unspecified',
        0x01 => 'french',
        0x02 => 'german',
        0x03 => 'dutch',
        0x04 => 'english',
        0x05 => 'italian',
        0x06 => 'finnish',
        0x07 => 'swedish',
        0x08 => 'spanish',
        0x09 => 'basque',
        0x0a => 'catalan',
        0x0b => 'galician',
        0x0c => 'welsh',
        0x0d => 'gaelic',
        0x0e => 'danish',
        0x0f => 'norwegian',
        0x10 => 'portuguese',
        0x11 => 'slovak',
        0x12 => 'czech',
        0x13 => 'croatian',
        0x14 => 'hungarian',
        0x15 => 'polish',
        0x16 => 'turkish',
        0x17 => 'greek',
        0x18 => 'slovenian',
        0x19 => 'russian',
        0x1a => 'estonian',
        0x1b => 'latvian',
        0x1c => 'romanian',
        0x1d => 'albanian',
        0x1e => 'bosnian',
        0x1f => 'lithuanian',
        0x20 => 'serbian',
        0x21 => 'macedonian',
        0x22 => 'bulgarian'
    };
};

sub as_binary {
    my ($self) = @_;

    $self->polygons->recalculate;
    $self->lines->recalculate;
    $self->points->recalculate;
    $self->NT1points->recalculate;

    $self->header->recalculate;

    return $self->header->as_binary .    # hlavicka
        $self->polygons->as_binary .
        $self->lines->as_binary .
        $self->points->as_binary .
        $self->NT1points->as_binary .
        $self->draworder->as_binary . 
        $self->NTblocks->as_binary;    
};

package Garmin::TYP::Common;
use Data::Dumper;

sub SmartDump($) {
    return "; (empty block)\n" if CORE::length($_[0]) == 0;
    my @t = split /\n/, TypDecompiler::HexDump($_[0]); 
    splice(@t, 0, 2);
    return join("\n", map {"; $_"} @t). "\n";
};
sub smart_dump {
    my ($self, $co) = @_;
    return SmartDump($co);
};

package Garmin::TYP::Header;
use base qw(Garmin::TYP::Common);
use Data::Dumper;
use POSIX qw(strftime);

sub new {
    my ($class, $parent, $raw_data) = @_;
    my $self = bless({}, $class);
    $self->{_parent} = $parent;

    my $novy_typek = 0;
    if (!defined $raw_data) {
        $novy_typek = 1;
    };

    if ($novy_typek) {

        $raw_data = pack('S', 91);
        $raw_data .= 'GARMIN TYP';
        $raw_data .= pack('S', 1);
        $raw_data .= pack('SCCCCC', 2000,0,1,0,0,0);
        $raw_data .= pack('S', 1252);

        $raw_data .= pack("LLLLLLSSLSLLSLLSLLSL",
            0,0,0,0,0,0,    # dataofs/datalen pro point/line/polygon
            0,0,            # fid, pid
            0,4,0,0,4,0,0,4,0,    # arrayofs/mod/size pro point/line/polygon
            0,5,0            # draworder ofs/mod/size
        );
    };

    my $buf = substr($raw_data, 0, 2);
    $self->{length} = unpack('S', $buf);
    $buf = substr($raw_data, 2, 10);
    my $tmp = unpack('H*', $buf);
    die {delete_file=>1, message=>"Tento soubor neni TYP pro Garmin / Not a Garmin TYP file: >$tmp< ($buf)"} if $buf ne 'GARMIN TYP';

    $buf = substr($raw_data, 0x0c, 2);
    $self->{_version} = unpack('S', $buf);
    $buf = substr($raw_data, 0x0e, 7);
    $self->{_timestamp} = $buf;
    $buf = substr($raw_data, 0x15, 2);
    $self->{_codepage} = unpack('S', $buf);

    $buf = substr($raw_data, 0x17, 4+4+4+4+4+4+2+2+4+2+4+4+2+4+4+2+4+4+2+4);
    my (@header) = unpack("LLLLLLSSLSLLSLLSLLSL", $buf);
    $self->{_fid} = $header[6];
    $self->{_pid} = $header[7];

    $self->{_rozcestnik} = {
        draworder => {
            arrayofs => $header[17],
            arraymod => $header[18],
            arraysize => $header[19]
        },
        point => {
            dataofs => $header[0],
            datalen => $header[1],
            arrayofs => $header[8],
            arraymod => $header[9],
            arraysize => $header[10],
        },
        NT1point => {
            dataofs => 0,
            datalen => 0,
            arrayofs => 0,
            arraymod => 0,
            arraysize => 0
        },
        line => {
            dataofs => $header[2],
            datalen => $header[3],
            arrayofs => $header[11],
            arraymod => $header[12],
            arraysize => $header[13],
        },
        polygon => {
            dataofs => $header[4],
            datalen => $header[5],
            arrayofs => $header[14],
            arraymod => $header[15],
            arraysize => $header[16]
        }
    };
    if ($novy_typek) {
        $self->timestamp(strftime("%Y-%m-%d %H:%M:%S", localtime));
        $self->{_raw_draworder} = '';

        my @draworders = ();

        for (my $i=0; $i<=$#draworders; $i++) {
            foreach (@{$draworders[$i]}) {
                $self->{_raw_draworder} .= pack('CSS', $_, 0);
            };
            if ($i < $#draworders) {

                $self->{_raw_draworder} .= pack('CSS', 0, 0, 0);
            };
        };
    } else {

        $self->{_raw_draworder} = substr($raw_data, 
            $self->{_rozcestnik}->{draworder}->{arrayofs}, 
            $self->{_rozcestnik}->{draworder}->{arraysize});
        $self->TYP->{_ranges}->add($self->{_rozcestnik}->{draworder}->{arrayofs}, $self->{_rozcestnik}->{draworder}->{arraysize});
    };

    my $zatim_zpracovano = 0x5B;
    $self->TYP->{_ranges}->add(0, $zatim_zpracovano);
    my $zbyva = ($self->length - $zatim_zpracovano);
    $self->{_format} = 'OLD';
    $self->{_NT1} = undef;
    $self->{_NT2} = undef;
    $self->{_filler} = undef;
    if ($zbyva > 0) {
        $buf = substr($raw_data, 0x5B, $zbyva);
        $self->TYP->{_ranges}->add(0x5B, $zbyva);

        if ($zbyva >= 0x13) {
            $self->{_format} = 'NT';
            my $buf2 = substr($raw_data, 0x5B, 0x13);
            my (@NT1) = unpack("LSLCLL", $buf2);
            $self->{_rozcestnik}->{NT1point} = {
                arrayofs => $NT1[0],
                arraymod => $NT1[1],
                arraysize => $NT1[2],
                dataofs => $NT1[4],
                datalen => $NT1[5]
            };
            $self->{_NT1} = {
                y        => $NT1[3],    # co to je? Standardne 0x1f :-O
            };

            my $buf2_hex = unpack('H*', $buf2);
            if ($buf2_hex ne '000000000000000000001f0000000000000000') {
                if ($self->TYP->debug_long_header) {

                };
            };

            $zbyva -= 0x13;
        };

        if ($zbyva >= 0x2E) {
            $self->{_format} = 'NT2';
            my $buf2 = substr($raw_data, 0x5B+0x13, 0x2E);
            my (@NT2) = unpack("LLLLLLLLLLLS", $buf2);

            my $blok0 = substr($raw_data, $NT2[1], $NT2[2]);
            $self->TYP->{_ranges}->add($NT2[1], $NT2[2]);
            my $blok1 = substr($raw_data, $NT2[5], $NT2[6]);
            $self->TYP->{_ranges}->add($NT2[5], $NT2[6]);
            my $blok2 = substr($raw_data, $NT2[9], $NT2[10]);
            $self->TYP->{_ranges}->add($NT2[9], $NT2[10]);

            $self->{_NT2} = {
                blok0    => $blok0,    # muze byt i prazdny, pak by se pri kompilaci mela vytvaret kombinace 0/0
                blok1    => $blok1,    # dtto
                blok2    => $blok2,    # dtto
                x        => $NT2[0],
                y        => $NT2[3],
                z        => $NT2[4],
                u        => $NT2[7],
                v        => $NT2[8],
                w        => $NT2[11],
            };

            my $buf2_hex = unpack('H*', $buf2);
            if ($buf2_hex ne '00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000') {
                if ($self->TYP->debug_long_header) {

                    if (CORE::length($self->{_NT2}->{blok0}) > 0) {

                    };
                    if (CORE::length($self->{_NT2}->{blok1}) > 0) {

                    };
                    if (CORE::length($self->{_NT2}->{blok2}) > 0) {

                    };
                };
            };

            $zbyva -= 0x2E;
        };

        if ($zbyva > 0) {
            $self->{_format} = 'UNKNOWN';

            $self->{_NT1} = undef;
            $self->{_NT2} = undef;
            $self->{_filler} = $buf;

            my $buf_hex = unpack('H*', $buf);

        };
    };

    return $self;
};

sub parent {$_[0]->{_parent}};
sub TYP {$_[0]->parent};
sub length {$_[0]->{length}};

sub pid {
    if (defined(my $new = $_[1])) {
        if (($new < 0) || ($new > 65535)) {
            $_[0]->TYP->error("Product ID must be in range 0 - 65535, not $new");
        } else {
            $_[0]->{_pid} = $new;
        };
    };
    $_[0]->{_pid}
};
sub fid {
    if (defined(my $new = $_[1])) {
        if (($new < 0) || ($new > 65535)) {
            $_[0]->TYP->error("Family ID must be in range 0 - 65535, not $new");
        } else {
            $_[0]->{_fid} = $new;
        };
    };
    $_[0]->{_fid}
};
sub version {
    if (defined(my $new = $_[1])) {
        $_[0]->{_version} = $new;
    };
    $_[0]->{_version}
};
sub codepage {
    if (defined(my $new = $_[1])) {
        if ($new =~ /\D/) {
            $_[0]->TYP->error("Invalid codepage, must contain only digits: $new");
        } elsif (($new < 1250) || ($new > 1258)) {
            $_[0]->TYP->error("Invalid codepage, must be 1250 - 1258: $new");
        } else {
            $_[0]->{_codepage} = $new;
        };
    };
    $_[0]->{_codepage}
};

sub format {
    my ($self, $type) = @_;
    if (defined $type) {
        if ($type eq 'OLD') {
            if ($self->{_format} ne 'OLD') {
                $self->{_format} = $type;
                $self->{_filler} = '';
                $self->{length} = 0x5B;
            };
        } elsif ($type eq 'NT') {
            if ($self->{_format} ne 'NT') {
                $self->{_format} = $type;
                $self->{_filler} = '';
                $self->{_NT1} = {
                    y        => 0x1f
                };
                $self->{length} = 0x6E;
            };
        } elsif ($type eq 'NT2') {
            if ($self->{_format} ne 'NT2') {
                $self->{_format} = $type;
                $self->{_filler} = '';
                $self->{_NT1} = {
                    y        => 0x1f
                };
                $self->{_NT2} = {
                    blok0    => '',
                    blok1    => '',
                    blok2    => '',
                    x        => 0,
                    y        => 0,
                    z        => 0,
                    u        => 0,
                    v        => 0,
                    w        => 0
                };
                $self->{length} = 0x9c;
            };
        } else {
            die {message => "unsupported header type, cannot save in this format: $type"};
            $self->{_format} = 'UNKNOWN';
        };
    };
    return $self->{_format};
};

sub timestamp {
    my ($self, $new) = @_;
    if (defined $new) {

        if (my ($yyyy, $mm, $dd, $hh, $mi, $ss) = ($new =~ /^(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/)) {
            $self->{_timestamp} = pack("SCCCCC", $yyyy-1900, $mm-1, $dd, $hh, $mi, $ss);
        } else {
            die {message => "Invalid format of timestamp: $new"};
        };
    };
    my $t = $self->{_timestamp};
    my ($yyyy, $mm, $dd, $hh, $mi, $ss) = unpack("SCCCCC", $self->{_timestamp});
    $mm += 1;
    if ($yyyy <= 200) {
        $yyyy += 1900;
    };
    return (
        y => $yyyy,
        m => $mm,
        d => $dd,
        hh => $hh,
        mm => $mi,
        ss => $ss
    );
};

sub recalculate {
    my ($self) = @_;
    my $r = $self->{_rozcestnik};

    my $pos = $self->length;
    
    $r->{polygon}->{dataofs} = $pos;
    $pos += ($r->{polygon}->{datalen} = $self->parent->polygons->datalength);
    $r->{polygon}->{arrayofs} = $pos;
    $pos += ($r->{polygon}->{arraysize} = $self->parent->polygons->infolength);

    $r->{line}->{dataofs} = $pos;
    $pos += ($r->{line}->{datalen} = $self->parent->lines->datalength);
    $r->{line}->{arrayofs} = $pos;
    $pos += ($r->{line}->{arraysize} = $self->parent->lines->infolength);

    $r->{point}->{dataofs} = $pos;
    $pos += ($r->{point}->{datalen} = $self->parent->points->datalength);
    $r->{point}->{arrayofs} = $pos;
    $pos += ($r->{point}->{arraysize} = $self->parent->points->infolength);

    $r->{NT1point}->{dataofs} = $pos;
    $pos += ($r->{NT1point}->{datalen} = $self->parent->NT1points->datalength);
    $r->{NT1point}->{arrayofs} = $pos;
    $pos += ($r->{NT1point}->{arraysize} = $self->parent->NT1points->infolength);

    foreach (qw(polygon line point NT1point)) {
        $r->{$_}->{dataofs} = 0 if $r->{$_}->{datalen} == 0;
        $r->{$_}->{arrayofs} = 0 if $r->{$_}->{arraysize} == 0;
    };

    $r->{draworder}->{arrayofs} = $pos;
    $pos += ($r->{draworder}->{arraysize} = $self->parent->draworder->length);
    if ($r->{draworder}->{arraysize} == 0) {

        $r->{draworder}->{arrayofs} = 0;
    };

    if ($self->format eq 'NT2') {
        my $NT2 = $self->{_NT2};

        if (CORE::length($NT2->{blok0}) > 0) {
            $NT2->{blok0_pos} = $pos;
            $pos += CORE::length($NT2->{blok0});
        } else {
            $NT2->{blok0_pos} = 0;
        };

        if (CORE::length($NT2->{blok1}) > 0) {
            $NT2->{blok1_pos} = $pos;
            $pos += CORE::length($NT2->{blok1});
        } else {
            $NT2->{blok1_pos} = 0;
        };

        if (CORE::length($NT2->{blok2}) > 0) {
            $NT2->{blok2_pos} = $pos;
            $pos += CORE::length($NT2->{blok2});
        } else {
            $NT2->{blok2_pos} = 0;
        };
    };

    return $pos;
};
sub as_binary {
    my ($self) = @_;
    my $ret = '';
    $ret .= pack('S', $self->length);
    $ret .= 'GARMIN TYP';
    $ret .= pack('S', $self->{_version});
    $ret .= $self->{_timestamp};
    $ret .= pack('S', $self->{_codepage});
    $ret .= pack("LLLLLLSSLSLLSLLSLLSL",
        $self->{_rozcestnik}->{point}->{dataofs},    # 0
        $self->{_rozcestnik}->{point}->{datalen},
        $self->{_rozcestnik}->{line}->{dataofs},    # 2
        $self->{_rozcestnik}->{line}->{datalen},
        $self->{_rozcestnik}->{polygon}->{dataofs},    # 4
        $self->{_rozcestnik}->{polygon}->{datalen},
        $self->{_fid},    # 6
        $self->{_pid},    
        $self->{_rozcestnik}->{point}->{arrayofs},    # 8
        $self->{_rozcestnik}->{point}->{arraymod},
        $self->{_rozcestnik}->{point}->{arraysize},
        $self->{_rozcestnik}->{line}->{arrayofs},    # 11
        $self->{_rozcestnik}->{line}->{arraymod},
        $self->{_rozcestnik}->{line}->{arraysize},
        $self->{_rozcestnik}->{polygon}->{arrayofs},    # 14
        $self->{_rozcestnik}->{polygon}->{arraymod},
        $self->{_rozcestnik}->{polygon}->{arraysize},
        $self->{_rozcestnik}->{draworder}->{arrayofs},    # 17
        $self->{_rozcestnik}->{draworder}->{arraymod},
        $self->{_rozcestnik}->{draworder}->{arraysize},
        );
    if (($self->format eq 'NT') || ($self->format eq 'NT2')) {

        my $NT1 = $self->{_NT1};

        $ret .= pack("LSLCLL", 
            $self->{_rozcestnik}->{NT1point}->{arrayofs}, 
            $self->{_rozcestnik}->{NT1point}->{arraymod}, 
            $self->{_rozcestnik}->{NT1point}->{arraysize}, 
            $NT1->{y}, 
            $self->{_rozcestnik}->{NT1point}->{dataofs},
            $self->{_rozcestnik}->{NT1point}->{datalen}
        );
    }; 
    if ($self->format eq 'NT2') {

        my $NT2 = $self->{_NT2};

        my $blok0_len = CORE::length($NT2->{blok0});
        my $blok1_len = CORE::length($NT2->{blok1});
        my $blok2_len = CORE::length($NT2->{blok2});
        my $total_len = $blok0_len + $blok1_len + $blok2_len;

        $ret .= pack("LLLLLLLLLLLS", 
            $NT2->{x}, 
            $NT2->{blok0_pos},     # spocita metoda recalculate
            $blok0_len, 
            $NT2->{y}, 
            $NT2->{z}, 
            $NT2->{blok1_pos},     # spocita metoda recalculate
            $blok1_len, 
            $NT2->{u}, 
            $NT2->{v}, 
            $NT2->{blok2_pos},     # spocita metoda recalculate
            $blok2_len, 
            $NT2->{w}
            );
    };
    $ret .= $self->{_filler};
    return $ret;
};
sub as_string {
    my ($self, $for_diff) = @_;
    my $debug = 0;
    my $t = '';

    if (!$for_diff) {
        $t .= "; THIS FILE WAS CREATED BY DECOMPILER v${VERSION} AT http://ati.land.cz/gps/typdecomp AND IT MAY NOT\n";
        $t .= "; EXACTLY CORRESPOND TO ORIGINAL .TYP FILE.\n";
        $t .= "; SOME ELEMENTS MAY BE MISSING FROM THIS FILE, AND OTHERS MAY BE INCOMPLETE!\n";
        $t .= "; \n";
        $t .= "; IF YOU USE THIS FILE AS SOURCE FOR cGPSmapper, IT WILL ALMOST CERTAINLY NOT PRODUCE WHAT YOU WANT.\n";
        $t .= "; \n";
        $t .= "; IF YOU WANT JUST TO CHANGE SOMETHING, USE TYP EDITOR AT http://ati.land.cz/gps/typedit\n";
    };
    my ($yyyy, $mm, $dd, $hh, $mi, $ss) = unpack("SCCCCC", $self->{_timestamp});
    $t .= sprintf("; Original TYP was created %d.%d.%04d at %02d:%02d:%02d, probably with %s\n; Text codepage=%d\n; Version=%d\n", 
         $dd, $mm+1, (($yyyy <= 200) ? (1900+$yyyy) : $yyyy), $hh, $mi, $ss,
         (($yyyy <= 200) ? "Garmin compiler" : "cGPSmapper"),
        $self->{_codepage},
        $self->{_version}    # musi byt vzdy 1
        );
    $t .= "\n";
    $t .= sprintf("; Header length: 0x%04x bytes, header format: %s\n", 
        $self->{length},
        $self->format
        );

    if (!$for_diff) {
        $t .= "; Header dump:\n";

        foreach my $kind (qw(draworder polygon point line NT1point)) {
            my %h = %{$self->{_rozcestnik}->{$kind}};
            if ($kind eq 'draworder') {
                $t .= sprintf "; %10s: %38s info\@0x%06x-0x%06x (elem_size=%d, #elements=%d)\n",
                    $kind, 
                    '',
                    $h{arrayofs}, ($h{arraysize} ? ($h{arrayofs} + $h{arraysize} - 1) : 0),
                    $h{arraymod}, ($h{arraymod} ? $h{arraysize}/$h{arraymod} : 0);
            } else {
                $t .= sprintf "; %10s: data\@0x%06x-0x%06x (len=0x%06x), info\@0x%06x-0x%06x (elem_size=%d, #elements=%d)\n",
                    $kind, 
                    $h{dataofs}, ($h{datalen} ? ($h{dataofs}+$h{datalen}-1) : 0), $h{datalen}, 
                    $h{arrayofs}, ($h{arraysize} ? ($h{arrayofs} + $h{arraysize} - 1) : 0),
                    $h{arraymod}, ($h{arraymod} ? $h{arraysize}/$h{arraymod} : 0);
            };
        };
        $t .= "\n";
    };

    $t .= "[_id]\n";
    $t .= sprintf "ProductCode=0x%x\n", $self->{_pid};
    $t .= sprintf "FID=0x%x ; %s\n", $self->{_fid}, $self->parent->productname_by_fid_and_pid($self->{_fid}, $self->{_pid});
    if (CORE::length($self->{_filler}) > 0) {
        $t .= "; unknown data in header:\n" . $self->smart_dump($self->{_filler}) . "\n";
    };
    $t .= "[end]\n";
    $t .= "\n";
};

sub as_diffvalue {
    my ($self) = @_;

    return ($self->{_diffvalue} ||= $self->as_string(1));
};

package Garmin::TYP::Collection;
use base qw(Garmin::TYP::Common);
use Data::Dumper;

sub new {
    my ($class, $parent, $kind, $raw_data) = @_;
    my $self = bless({}, $class);
    $self->{_parent} = $parent;
    $self->{_kind} = $kind;
    $self->{_persistent_id} = 0;
    $self->{_prvky} = [];
    $self->{_xelemref_by_id} = {};

    my $r = $parent->header->{_rozcestnik}->{$kind};

    $self->TYP->{_ranges}->add($r->{dataofs}, $r->{datalen}) if defined $r->{dataofs};
    my $buf = substr($raw_data, $r->{dataofs}, $r->{datalen});
    my $cely_obsah = $buf;

    my @prvky = ();
    if ($r->{arraysize} > 0) {
        $self->TYP->{_ranges}->add($r->{arrayofs}, $r->{arraysize});
        $buf = substr($raw_data, $r->{arrayofs}, $r->{arraysize});
        my $pocet_prvku = $r->{arraysize}/$r->{arraymod};
        for (my $i=0; $i<$pocet_prvku; $i++) {
            my $mod = $r->{arraymod};
            my $tmp = substr($buf, $r->{arraymod}*$i, $mod);
            my ($otyp, $ofs);
            if ($mod == 5) {
                ($otyp, $ofs, my $ofs_hi) = unpack('SSC', $tmp);
                $ofs += ($ofs_hi << 16);
            } elsif ($mod == 4) {
                ($otyp, $ofs) = unpack('SS', $tmp);
            } elsif ($mod == 3) {
                ($otyp, $ofs) = unpack('SC', $tmp);
            } else {

                die {message => "unknown arraymod length: $mod"};
            };

            my $wtyp = ($otyp >> 5) | (($otyp & 0x1F) << 11);    

            my $typ = ($wtyp & 0x7FF);

            my $subtyp = ($wtyp >> 11); 

            push @prvky, {

                _ofs        => $ofs,    # musim ho umet zmenit (a uz to i umim)!

                type        => $typ,
                subtype    => $subtyp
            };

        };
    };

    @prvky = sort {$a->{_ofs} <=> $b->{_ofs}} @prvky;

    my @out_prvky = ();
    my %dupcheck = ();
    for (my $i=0; $i<=$#prvky; $i++) {
        my $p = $prvky[$i];
        my $delka_bloku = undef;
        if ($i < ($#prvky)) {

            $delka_bloku = $prvky[$i+1]->{_ofs} - $p->{_ofs};
        } else {

            $delka_bloku = $r->{datalen} - $p->{_ofs};
        };

        my $dupkey = "$kind/$p->{type}/$p->{subtype}";
        if (++$dupcheck{$dupkey} > 1) {
            $self->TYP->error(sprintf("File contains multiple definitions of $kind type=0x%03x/0x%02x.", $p->{type}, $p->{subtype}));
        };
        my $objtype = undef;
        if ($kind eq 'polygon') {
            $objtype = 'Garmin::TYP::Element::Polygon';
        } elsif ($kind eq 'line') {
            $objtype = 'Garmin::TYP::Element::Line';
        } elsif ($kind eq 'point') {
            $objtype = 'Garmin::TYP::Element::Point';
        } elsif ($kind eq 'NT1point') {
            $objtype = 'Garmin::TYP::Element::NT1Point';
        } else {
            die {message => "unknown element kind: $kind"};
        };
        my $content = substr($cely_obsah, $p->{_ofs}, $delka_bloku);
        if ($content eq '') {

            $self->TYP->error(sprintf("File contains empty element ($kind#$i, type=0x%03x/0x%02x). You are editing damaged TYP file!", $p->{type}, $p->{subtype}));
            next;
        };
        my $elem = Garmin::TYP::Element::new($objtype,    # ano, :: misto ->, presne tohle chci!
            $self, 
            $p->{type},    # zatim to neni objekt, ale jen hash!
            $p->{subtype},    # zatim to neni objekt, ale jen hash!
            $content
            );
        $elem->{_orig_ofs} = $p->{_ofs};
        push @out_prvky, $elem;
    };

    foreach (@out_prvky) {
        $self->add_element($_);
    };

    my @prvky_orig = $self->iterate(1);
    my @prvky_new = $self->iterate;
    if (join('', @prvky_orig) ne join('', @prvky_new)) {

        $self->TYP->error("File contains unsorted elements ($kind) and this causes problem with visibility in GPS.\nSolution is simple: just save this TYP file in editor, and it will produce correct order of elements.");
    };

    return $self;
};

sub parent {die if defined $_[1]; $_[0]->{_parent}};
sub TYP {$_[0]->parent};
sub kind {die if defined $_[1]; $_[0]->{_kind}};

sub iterate {
    my ($self, $unsorted) = @_;
    if ($unsorted) {
        return @{ $_[0]->{_prvky} }
    } else {

        return sort {
            ($a->type <=> $b->type)
            ||
            ($a->subtype <=> $b->subtype)
        }
        @{ $_[0]->{_prvky} }
    };
};
sub get_element_by_id {
    my ($self, $id) = @_;
    return $self->{_xelemref_by_id}->{$id};
    return;
};
sub get_element_by_type_and_subtype {
    my ($self, $type, $subtype) = @_;

    foreach ($self->iterate) {
        return $_ if ($_->type == $type) && ($_->subtype == $subtype);
    };
    return;
};

sub add_element {
    my ($self, $element, $new_id) = @_;
    my $ret = undef;
    $element->{_parent} = $self;
    if (defined $new_id) {
        $element->{_persistent_id} = $new_id;
    } else {
        $element->{_persistent_id} = $self->{_persistent_id}++;
    };

    if ($self->get_element_by_id($element->{_persistent_id})) {
        $self->TYP->error("Duplicit element ".$self->kind.": $element->{_persistent_id}");
    };

    

    if ($self->kind eq 'polygon') {
        my $pps = $self->parent->polyplaceholders;
        foreach ($pps->iterate) {
            if (($_->type == $element->type) && ($_->subtype == $element->subtype)) {

                if (!defined $element->draworder) {

                    $element->draworder($_->draworder);
                };
                $ret = $_;
                $pps->remove_element($_->html_identifier);
            };
        };
    };
    push @{$self->{_prvky}}, $element;
    $self->{_xelemref_by_id}->{$element->{_persistent_id}} = $element;
};

sub remove_element {
    my ($self, $html_id) = @_;
    my $ret = undef;
    my $idx = -1;
    my @nove_prvky = ();
    delete $self->{_xelemref_by_id}->{$html_id};
    for (my $i=0; $i<=$#{ $self->{_prvky} }; $i++) {
        if ($self->{_prvky}->[$i]->html_identifier eq $html_id) {

        } else {
            push @nove_prvky, $self->{_prvky}->[$i];
        };
    };
    $self->{_prvky} = \@nove_prvky;
    return $ret;
};

sub recalculate {
    my ($self) = @_;

    my $ofs=0;

    foreach ($self->iterate) {

        $_->{_ofs} = $ofs;
        $ofs += CORE::length($_->data_as_binary);
    };
    

    my $mod = $self->parent->header->{_rozcestnik}->{$self->kind}->{arraymod};
    if ($ofs > 255) {
        if ($mod < 4) {

            $self->parent->header->{_rozcestnik}->{$self->kind}->{arraymod} = 4;
        };
    };
    if ($ofs > 65535) {
        if ($mod < 5) {

            $self->parent->header->{_rozcestnik}->{$self->kind}->{arraymod} = 4;
        };
    };

    return $ofs;
};

sub datalength {
    my ($self) = @_;
    my $len = 0;
    foreach ($self->iterate) {
        $len += CORE::length($_->data_as_binary);
    };
    return $len;
};

sub infolength {
    my ($self) = @_;
    my $len = 0;
    foreach ($self->iterate) {
        $len += $_->infolength;
    };
    return $len;
};

sub as_binary {
    my ($self) = @_;
    my $ret = '';

    foreach ($self->iterate) {
        $ret .= $_->data_as_binary;

    };

    my $mod = $self->parent->header->{_rozcestnik}->{$self->kind}->{arraymod};
    foreach ($self->iterate) {

        $ret .= $_->info_as_binary;

    };
    return $ret;
};

sub as_string {
    my ($self) = @_;
    my $ret = '';
    $ret .= "; --------------------------------------------------------------------------\n";
    $ret .= "; start of " . $self->kind . " collection\n";
    $ret .= "; --------------------------------------------------------------------------\n";
    foreach ($self->iterate) {

        $ret .= $_->as_string;
    };
    $ret .= "\n";
};

package Garmin::TYP::Element;
use Data::Dumper;
use base qw(Garmin::TYP::Common);

sub new {
    my ($class, $parent, $typ, $subtyp, $content_data) = @_;
    die "je zakazano vytvaret primo obecny element" if (ref($class) || $class) eq __PACKAGE__;
    my $self = bless({}, ref($class) || $class);
    $self->{_raw_original} = $content_data;
    $self->{_parent} = $parent;
    $self->{type} = $typ,
    $self->{subtype} = $subtyp;
    my $kind = $parent->kind;

    if ($kind eq 'polyplaceholder') {
        return $self;
    };

    $self->decode($content_data) if defined $content_data;

    if (defined $content_data) {

        my $ttt = $self->data_as_binary;

        if ($ttt ne $content_data) {

            $self->TYP->error("Error while decoding ${kind}/$typ/$subtyp (unknown structure). Result will be probably incorrect! Use at your own risk");
        };
        if ($self->{unknown_flags}) {

        };
        if (($self->{_neznamy_konec} ne '') && ($kind ne 'NT1point')) {

            $self->TYP->error(sprintf("Element %s (type 0x%03x/0x%02x) contains unknown data at it's end, editor will IGNORE them, even when saving.", $kind, $typ, $subtyp));
            $self->{_neznamy_konec} = '';
        };

    };
    return $self;
};

sub html_identifier {die if defined $_[1]; $_[0]->{_persistent_id}};
sub kind {die if defined $_[1]; $_[0]->parent->kind};

sub parent {die if defined $_[1]; $_[0]->{_parent}};
sub TYP {$_[0]->parent->TYP};
sub type {
    my ($self, $new) = @_;
    if (defined $new) {
        die $new if $new < 0 || $new > 0x7ff;
        $self->{type} = $new;
    };
    return $self->{type}
};
sub subtype {
    my ($self, $new) = @_;
    if (defined $new) {
        die $new if $new < 0 || $new > 0x1f;
        $self->{subtype} = $new;
    };
    return $self->{subtype}
};

sub color_type {
    my ($self, $new) = @_;
    if (defined $new) {
        $self->{color_type} = $new;
    };
    return $self->{color_type};
};
sub bitmap {
    my ($self, $new) = @_;
    if (defined $new) {
        $new = undef if $new eq '';
        $self->{bitmap} = $new;
    };
    return $self->{bitmap};
};

sub id {
    my ($self) = @_;
    return "\n[" . ($self) . ' ' . sprintf("type=%03x/%02x, l18n=%d, ctype=%d, length=%d", $self->type, $self->subtype, $self->{l18n}, $self->color_type, CORE::length($self->{_raw_original})) . "]\n" .
        $self->smart_dump($self->{_raw_original});
};

sub dekoduj_stringy($) {
    my ($self, $rbuf) = @_;
    my @ret = ();
    if (length($$rbuf) == 0) {
        return ();
    };

    my $cp = $self->parent->parent->header->codepage;

    my $nasobek = 1;
    my $delka = unpack("C", substr($$rbuf, 0, 1, ''));
    if (($delka % 2) == 0) {

        my $highbyte = unpack("C", substr($$rbuf, 0, 1, ''));
        $delka += ($highbyte << 8);
        $nasobek = 2;
    };
    $delka -= $nasobek;
    my $cnt=1;
    while ((length($$rbuf) > 0) && ($delka > 0)) {
        my ($lang) = unpack("C", substr($$rbuf, 0, 1, ''));
        $delka -= ($nasobek*2);
        my $text = '';
        C:
        while ((length($$rbuf) > 0) && ($delka > 0)) {
            my $c = substr($$rbuf, 0, 1, '');
            $delka -= ($nasobek*2);
            last C if ord($c) == 0;
            $text .= $c;
        };

        my $utf8text;
        eval {
            $utf8text = Encode::decode("cp${cp}", $text, Encode::FB_CROAK);
        };
        if ($@) {

            eval {

                $utf8text = Encode::decode("cp${cp}", $text, Encode::FB_DEFAULT);
            };

            $self->TYP->error($self->kind."/".$self->type."/".$self->subtype." contains invalid character(s) in language $lang: \"$utf8text\".\nIt is not possible to convert this text successfuly from codepage $cp to utf-8.");
        };

        push @ret, [$lang, $utf8text];
        $cnt++;
    };
    if (length($$rbuf) > 0) {

    };
    return @ret;
};

sub store_strings($) {
    my ($self, $strings) = @_;
    my $ret = '';
    return if !defined $strings;
    my @strings = @{$strings};
    return if $#strings < 0;

    my $cp = $self->parent->parent->header->codepage;

    my $total_len = 0;
    for (my $i=0; $i<=$#strings; $i++) {
        my ($langcode, $utf8str) = ($strings[$i]->[0], $strings[$i]->[1]);
        $ret .= pack('C', $langcode);

        my $enctext;
        eval {
            $enctext = Encode::encode("cp${cp}", $utf8str, Encode::FB_CROAK);
        };
        if ($@) {

            $enctext = Encode::encode("cp${cp}", $utf8str, Encode::FB_DEFAULT);

            my $backtoutf8 = Encode::decode("cp${cp}", $enctext, Encode::FB_DEFAULT);
            $self->TYP->error(sprintf("%s %02x/%02x", $self->kind, $self->type, $self->subtype)." contains invalid character(s) in language #$langcode: \"$utf8str\".\n" .
                "It is not possible to convert this text successfuly from utf-8 to requested codepage $cp.\n" .
                "Resulting text (with invalid chars) is: \"$backtoutf8\".\n".
                "Either change codepage (at top of this page), or use text without diacritics.");
        };
        $ret .= $enctext;

        $ret .= pack('C', 0);
        $total_len += 2*(length($enctext) + 2);
    };

    if (($total_len + 1) > 255) {

        $total_len *= 2;
        $total_len += 2;
        $ret = pack('S', $total_len) . $ret;
    } else {

        $total_len += 1;
        $ret = pack('C', $total_len) . $ret;
    };

    return $ret;
};

sub get_rgb_triplets {
    my ($self, $buffer, $colors, $alfakanal) = @_;

    my $orig = $$buffer;
    my @ret = ();
    if ($alfakanal) {
        my $bajtu = $colors * 3.5;
        if ($bajtu != int($bajtu)) {

            $bajtu = int($bajtu) + 1;
        };
        my $c = substr($$buffer, 0, $bajtu, '');

        $c = unpack('b*', $c);
        for (my $i=1; $i<=$colors; $i++) {

            my $barva = substr($c, 0, 3*8, '');
            my ($b, $g, $r) = unpack("CCC", pack('b*', $barva));
            my $alfa = unpack("C", pack('b*', substr($c, 0, 4, '')));
            $alfa = int(255*$alfa/15);

            push @ret, [$r,$g,$b,$alfa];
        };

    } else {
        for (my $i=1; $i<=$colors; $i++) {
            my $raw = substr($$buffer, 0, 3, '');
            my ($b, $g, $r) = unpack("CCC", $raw);

            push @ret, [$r,$g,$b,0];
        };
    };

    return @ret;
};

sub store_rgb_triplets {
    my ($self, $triplets, $alfakanal) = @_;

    my $ret = '';
    if ($alfakanal) {
        my $colors = 1 + $#{$triplets};
        my $bajtu = $colors * 3.5;
        if ($bajtu != int($bajtu)) {

            $bajtu = int($bajtu) + 1;
        };
        my $c = '';
        for (my $i=1; $i<=$colors; $i++) {
            my $rgba = $triplets->[$i-1];
            my ($r,$g,$b,$a) = @{$triplets->[$i-1]};
            $c .= unpack('b*', pack('CCC', $b, $g, $r));
            $c .= substr(unpack('b*', pack('C', $a)), 0, 4);
        };

        $ret = pack('b*', $c);

        die if length($ret) != $bajtu;
    } else {

        foreach (@{$triplets}) {

            my ($r,$g,$b,$a) = @{$_};

            $ret .= pack('CCC', $b, $g, $r);
        };
    };

    return $ret;
};

sub get_morecolors {
    my ($self, $rbuf, $minfo) = @_;
    my $ret = [];

    my $hlavni = 0;
    my $vedlejsi = 0;
    if ($self->{morecolors_info} & 0xE0) {
        die {message => "unknown morecolors_info flag: >$self->{morecolors_info}<, tmp=".$self->smart_dump($$rbuf)};
    };
    if ($self->{morecolors_info} & 0x10) {
        $hlavni = 1;
    };
    if ($self->{morecolors_info} & 0x08) {
        $vedlejsi = 1;
    };

    $ret = [];
    if (($hlavni + $vedlejsi) > 0) {
        $ret = [$self->get_rgb_triplets($rbuf, $hlavni+$vedlejsi)];
    };

    $ret;
};

sub infolength {
    my ($self) = @_;
    return $self->parent->parent->header->{_rozcestnik}->{$self->parent->kind}->{arraymod};
};

sub info_as_binary {
    my ($self) = @_;
    my $ret = '';
    my $mod = $self->infolength;

    my $otyp = 
        ($self->subtype & 0x1F)
        |
        ($self->type << 5);
    $ret .= pack('S', $otyp);
    if ($mod == 5) {
        die "too small arraymod ($mod) for offset $self->{_ofs}" if $self->{_ofs} > 16777215;
        $ret .= pack('SC', ($self->{_ofs} & 0xFFFF), ($self->{_ofs} >> 16));
    } elsif ($mod == 4) {
        if ($self->{_ofs} > 65535) {
            Carp::carp();
            die "too small arraymod ($mod) for offset $self->{_ofs}" ;
        };
        $ret .= pack('S', $self->{_ofs});
    } elsif ($mod == 3) {
        if ($self->{_ofs} > 255) {
            Carp::carp();
            die "too small arraymod ($mod) for offset $self->{_ofs}" ;
        };
        $ret .= pack('C', $self->{_ofs});
    } else {
        die "neznama delka arraymod: $mod a tim padem i struktura";
    };
    return $ret;
};

sub strings_as_string {
    my ($self, $strings) = @_;
    my $ret = '';
    return if !defined $strings;
    my @strings = @{$strings};
    return if $#strings < 0;

    my $cp = $self->parent->parent->header->codepage;

    for (my $i=0; $i<=$#strings; $i++) {
        my ($langcode, $utf8str) = ($strings[$i]->[0], $strings[$i]->[1]);

        my $enctext;
        eval {
            $enctext = Encode::encode("cp${cp}", $utf8str, Encode::FB_CROAK);
        };
        if ($@) {

            $enctext = Encode::encode("cp${cp}", $utf8str, Encode::FB_DEFAULT);

        };

        $ret .= sprintf("String%d=0x%02x,%s\n", $i+1, $langcode, $enctext);
    };
    return $ret;
};

our $xpmchars = join('', map({$_.$_} split(//, 'X=*#%1234567890ABCDEFGHIJKLMNOPQRSTUVWYZabcdefghijklmnopqrstuvwxyz!@$^&()-+/<>,:')));
foreach my $x1 (split //, 'X=*#%1234567890ABCDEFGHIJKLMNOPQRSTUVWYZabcdefghijklmnopqrstuvwxyz!@$^&()-+/<>,:') {
    foreach my $x2 (split //, 'X=*#%1234567890ABCDEFGHIJKLMNOPQRSTUVWYZabcdefghijklmnopqrstuvwxyz!@$^&()-+/<>,:') {
        next if $x1 eq $x2;
        $xpmchars .= $x1 . $x2;
    };
};

sub bitmap_as_string {
    my ($self, $bmap, $w, $h, $barvy, $bpp, $prefix) = @_;

    sub _assign_color_name($$$) {
        my ($colornumber, $rgb, $ref_nazvy) = @_;
        return $ref_nazvy->[$colornumber] if defined $ref_nazvy->[$colornumber];

        my $nazev = undef;
        if ((!defined $rgb) && ($colornumber == 0)) {
            $nazev = '..';
        } else {
            $nazev = substr($xpmchars, 2*$colornumber, 2);
        };

        $ref_nazvy->[$colornumber] = $nazev;
        return $nazev;
    };

    if ($bmap eq '') {

        $w = 0;
        $h = 0;
    };

    $bpp = 1 if !defined $bpp;
    my $ret = '';
    my $numcolors = 1 + $#{@{$barvy}};

    my $w_bytes = ($w*$bpp)/8;
    if ($w_bytes > int($w_bytes)) {

        $w_bytes = int($w_bytes) + 1;
    };

    my @nazev_barvy = ();
    my @out = ();
    for (my $y=0; $y<$h; $y++) {
        my @l = ();
        my $line = substr($bmap, 0, $w_bytes, '');

        my $b = unpack("b*", $line);
        for (my $x=0; $x<$w; $x++) {
            my $partbits = substr($b, 0, $bpp, '');
            my $colornumber = unpack('C', pack('b*', $partbits));
            push @l, $colornumber;

            if ($colornumber > $#{$barvy}) {

                for (my $i=1+$#{$barvy}; $i<=$colornumber; $i++) {
                    $barvy->[$i] = undef;
                    _assign_color_name($i, $barvy->[$i], \@nazev_barvy);
                };
            };

            _assign_color_name($colornumber, $barvy->[$colornumber], \@nazev_barvy);
        };
        push @out, \@l;
    };

    my $vcetne_prazdne = 0;
    for (my $i=0; $i<=$#{$barvy}; $i++) {
        $vcetne_prazdne = 1 if !defined $barvy->[$i];
    };

    $ret .= "${prefix}XPM=\"${w} ${h} " . ($numcolors + $vcetne_prazdne) . " 2\",\n";
    for (my $i=0; $i<=$#{$barvy}; $i++) {

        _assign_color_name($i, $barvy->[$i], \@nazev_barvy);
        if (defined $barvy->[$i]) {
            $ret .= "\"$nazev_barvy[$i]  c #" . sprintf('%02x%02x%02x', $barvy->[$i]->[0], $barvy->[$i]->[1], $barvy->[$i]->[2]). "\",";
        } else {
            $ret .= "\"$nazev_barvy[$i]  c none\",";
        };
        $ret .= "\n";
    };
    for (my $y=0; $y<=$#out; $y++) {
        $ret .= "\"";
        my $x=0;
        foreach (@{$out[$y]}) {
            $ret .= $nazev_barvy[$_];

            $x++;
        };
        if ($y == $#out) {
            $ret .= qq{"\n};
            $ret .= "};\n";
        } else {
            $ret .= qq{",\n};
        };
    };

    return $ret;
};

sub unknown_data_as_string {
    my ($self, $data, $comment) = @_;
    return if !defined $data;
    return if length($data) == 0;
    my $ret = '';
    $ret .= "; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n";
    $ret .= "; $comment:\n";
    $ret .= $self->smart_dump($data);
    $ret .= "; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n";
    return $ret;
};

package Garmin::TYP::Element::WithDrawOrder;

sub min_level {1};
sub max_level {15};

sub draworder {
    my ($self, $new) = @_;
    if (defined $new) {
        if ($new < $self->min_level) {
            $self->TYP->error("Invalid drawing order: $new, must be in range 0 (undefined) to ".$self->max_level." (maximum), resetting to 1");
            $new = $self->min_level;
        } elsif ($new > $self->max_level) {
            $self->TYP->error("Invalid drawing order: $new, must be in range 0 (undefined) to ".$self->max_level." (maximum), resetting to ".$self->max_level);
            $new = $self->max_level;
        };
        $self->{draworder} = $new;
    };
    return $self->{draworder};
};

package Garmin::TYP::Element::Polygon;
use Data::Dumper;
use base qw(Garmin::TYP::Element Garmin::TYP::Element::WithDrawOrder);

our %polygon_colortypes = (

    0x06    => {numcolors=>1,    commoncolors=>[0],                        bitmap=>0, name=>'~HTML~POLYGON_COLORTYPE_06~~'},
    0x07    => {numcolors=>2,    daycolors=>[0],        nightcolors=>[1],    bitmap=>0, name=>'~HTML~POLYGON_COLORTYPE_07~~'},

    0x08    => {numcolors=>2,    commoncolors=>[0,1],                    bitmap=>1, name=>'~HTML~POLYGON_COLORTYPE_08~~'},

    0x09    => {numcolors=>4,    daycolors=>[0,1],    nightcolors=>[2,3],    bitmap=>1, name=>'~HTML~POLYGON_COLORTYPE_09~~'},

    0x0b    => {numcolors=>3,    daycolors=>[0],        nightcolors=>[1,2],    bitmap=>1, name=>'~HTML~POLYGON_COLORTYPE_0B~~'},    # pruhledna ve dne

    0x0d    => {numcolors=>3,    daycolors=>[0,1],    nightcolors=>[2],    bitmap=>1, name=>'~HTML~POLYGON_COLORTYPE_0D~~'},    

    0x0e    => {numcolors=>1,    commoncolors=>[0],                        bitmap=>1, name=>'~HTML~POLYGON_COLORTYPE_0E~~'},    # pruhledna

    0x0f    => {numcolors=>2,    daycolors=>[0],        nightcolors=>[1],    bitmap=>1, name=>'~HTML~POLYGON_COLORTYPE_0F~~'},    # FIXME ???
);

sub colortype_info {
    my ($self, $ctype, $field, $ignore_errors) = @_;
    my $info = $polygon_colortypes{$ctype};
    if (!defined $info) {
        return if $ignore_errors;

        Carp::carp();
        die {message => "unknown polygon color type: $ctype"};
    };
    if (defined $field) {

        return $info->{$field};
    } else {
        return $info;
    };
};

sub decode {
    my ($self, $content_data) = @_;
    my $tmp = $content_data;

    $self->{l18n} = undef;
    $self->{color_type} = undef;
    $self->{morecolors_info} = undef;
    $self->{unknown_flags} = undef;

    $self->{colors} = undef;
    $self->{bitmap} = undef;
    $self->{strings} = undef;
    $self->{morecolors} = undef;

    my $x = substr($tmp, 0, 1, '');
    $x = unpack("C", $x);
    if ($x & 0x10) {

        $self->{l18n} = 1;
    };
    my $maska_barev = ($x & 0x0f);
    $self->color_type($maska_barev);

    $self->{unknown_flags} = ($x & 0xe0);

    my $numcolors = $self->colortype_info($self->color_type, 'numcolors');

    $self->{colors} = [$self->get_rgb_triplets(\$tmp, $numcolors, $self->{alfakanal})];

    $self->bitmap('');
    if ($self->colortype_info($self->color_type, 'bitmap')) {
        $self->bitmap(substr($tmp, 0, 128, ''));
    };

    $self->{strings} = [$self->dekoduj_stringy(\$tmp)] if $self->{l18n};
    
    if ($self->{unknown_flags} & 0x20) {
        $self->{unknown_flags} &= ~0x20;
        $self->{morecolors_info} = unpack('C', substr($tmp, 0, 1, ''));
        $self->{morecolors} = $self->get_morecolors(\$tmp, $self->{morecolors_info});
    };

    $self->{_neznamy_konec} = $tmp;
};

sub data_as_binary {
    my ($self) = @_;
    my $ret = '';

    $ret .= pack('C', 
        ($self->{l18n} ? 0x10 : 0x00)
        |
        $self->color_type
        |
        (defined($self->{morecolors_info}) ? 0x20 : 0x00)
        |
        $self->{unknown_flags}
        );

    my $req_triplets = $self->colortype_info($self->color_type, 'numcolors');
    my $real_triplets = 1 + $#{$self->{colors}};
    if ($real_triplets != $req_triplets) {
        Carp::carp();

        die "$self: error: required number of color triplets ($req_triplets) != real number ($real_triplets)";
    };
    $ret .= $self->store_rgb_triplets($self->{colors}, $self->{alfakanal});

    my $has_bitmap = $self->colortype_info($self->color_type, 'bitmap');
    if ($has_bitmap) {
        die "no bitmap?" if length($self->bitmap) <= 0;
        $ret .= $self->bitmap;
    } else {
        $self->bitmap('');
    };

    $ret .= $self->store_strings($self->{strings}) if $self->{l18n};

    if (defined $self->{morecolors_info}) {
        $ret .= pack('C', $self->{morecolors_info});
        $ret .= $self->store_rgb_triplets($self->{morecolors}, 0);
    };

    $ret .= $self->{_neznamy_konec};
    return $ret;
};

sub as_string {
    my ($self) = @_;
    my $ret = '';
    $ret .= "[_" . $self->parent->kind . "]\n";
    my $ofset_kolekce = $self->TYP->header->{_rozcestnik}->{ $self->parent->kind }->{dataofs};
    $ret .= sprintf("; Originally \@(0x%06x+0x%06x)=0x%06x\n",  $ofset_kolekce, $self->{_orig_ofs}, $self->{_orig_ofs}+$ofset_kolekce);
    $ret .= "; Drawing order: " . $self->draworder . "\n";
    $ret .= sprintf("Type=0x%03x\n", $self->type);
    if (($self->subtype != 0) || ($self->type >= 0x100)) {
        $ret .= sprintf("SubType=0x%02x\n", $self->subtype);
    };
    my $has_bitmap = $self->colortype_info($self->color_type, 'bitmap');
    if ($has_bitmap) {
        die if length($self->bitmap) <= 0;
        $ret .= $self->bitmap_as_string($self->{bitmap}, 32, 32, $self->{colors}, 1, '');
    } else {
        $ret .= $self->bitmap_as_string(undef, 0, 0, , $self->{colors}, 1, '');
    };

    $ret .= $self->strings_as_string($self->{strings}) if $self->{l18n};
    if (defined $self->{morecolors_info}) {
        my $tmp = pack('C', $self->{morecolors_info});
        $tmp .= $self->store_rgb_triplets($self->{morecolors}, 0);
        $ret .= $self->unknown_data_as_string($tmp, 'additional block with colors');
    };
    $ret .= $self->unknown_data_as_string($self->{_neznamy_konec}, 'unknown data');
    $ret .= "[end]\n\n";
};

sub as_diffvalue {
    my ($self) = @_;

    return $self->{_diffvalue} if defined $self->{_diffvalue};
    my $orig_bitmap = $self->{bitmap};
    if (($self->color_type == 8) || ($self->color_type == 9)) {

        my @c = @{$self->{colors}};

        if ($self->store_rgb_triplets([$c[0]]) eq $self->store_rgb_triplets([$c[1]])) {

            if ($#c >= 3) {

                if ($self->store_rgb_triplets([$c[2]]) eq $self->store_rgb_triplets([$c[3]])) {

                    $self->{bitmap} = pack('C', 0) x 128;
                };
            } else {

                $self->{bitmap} = pack('C', 0) x 128;
            };
        };
    };
    my $ret = $self->data_as_binary;
    $self->{bitmap} = $orig_bitmap;

    return ($self->{_diffvalue} = $ret);
};

package Garmin::TYP::Element::PolyPlaceholder;
use Data::Dumper;
use base qw(Garmin::TYP::Element Garmin::TYP::Element::WithDrawOrder);

sub as_diffvalue {
    my ($self) = @_;
    return $self->type.'/'.$self->subtype.'/'.$self->draworder;

    return ($self->{_diffvalue} ||= $self->data_as_binary);
};

package Garmin::TYP::Element::Line;
use Data::Dumper;
use base qw(Garmin::TYP::Element);

our %line_colortypes = (

    0x00    => {numcolors=>2,    commoncolors=>[0,1],                                    name=>'~HTML~LINE_COLORTYPE_00~~'},    # s okrajem
    0x01    => {numcolors=>4,    daycolors=>[0,1],    nightcolors=>[2,3],                    name=>'~HTML~LINE_COLORTYPE_01~~'},

    0x03    => {numcolors=>3,    daycolors=>[0],        nightcolors=>[1,2],                    name=>'~HTML~LINE_COLORTYPE_03~~'},

    0x05    => {numcolors=>3,    daycolors=>[0,1],        nightcolors=>[2],    borderless=>1,  name=>'~HTML~LINE_COLORTYPE_05~~'},

    0x06    => {numcolors=>1,    commoncolors=>[0],                        borderless=>1,    name=>'~HTML~LINE_COLORTYPE_06~~'},
    0x07    => {numcolors=>2,    daycolors=>[0],        nightcolors=>[1],    borderless=>1,    name=>'~HTML~LINE_COLORTYPE_07~~'},    # borderless je zrejmy, vzhledem k tomu ze je pocet barev 1 pro noc i pro den
);

sub colortype_info {
    my ($self, $ctype, $field, $ignore_errors) = @_;
    my $info = $line_colortypes{$ctype};
    if (!defined $info) {
        return if $ignore_errors;

        Carp::carp();
        die {message => "Unknown line color type: $ctype, probably due to corrupted TYP file"};
    };
    if (defined $field) {

        return $info->{$field};
    } else {
        return $info;
    };
};

sub height {
    my ($self, $new) = @_;
    if (defined $new) {
        die "height too low: $new" if $new < 0;
        die "height too high: $new" if $new > 31;
        $self->{height} = $new;

    };
    return $self->{height};
};
sub orientation {
    my ($self, $new) = @_;
    if (defined $new) {
        $self->{orientation} = ($new ? 1 : 0);
    };
    return $self->{orientation};
};

sub decode {
    my ($self, $content_data) = @_;

    $self->{l18n} = undef;
    $self->{orientation} = undef;
    $self->{unknown_flags} = undef;
    $self->{height} = undef;
    $self->{color_type} = undef;
    $self->{bitmapped} = 0;
    $self->{line_width} = undef;
    $self->{border_width} = undef;
    $self->{morecolors_info} = undef;

    $self->{colors} = undef;
    $self->{bitmap} = undef;
    $self->{strings} = undef;
    $self->{morecolors} = undef;

    my $tmp = $content_data;
    my ($a, $b) = unpack("CC", substr($tmp, 0, 2, ''));

    $self->color_type($a & 0x07);
    my $radku = ($a >> 3);
    $self->height($radku);

    $self->{l18n} = (($b & 0x01) ? 1 : 0);
    $self->orientation(($b & 0x02) ? 1 : 0);
    $self->{unknown_flags} = ($b & 0xfc);

    
    my $numcolors = $self->colortype_info($self->color_type, 'numcolors');
    $self->{colors} = [$self->get_rgb_triplets(\$tmp, $numcolors)];

    if ($radku == 0) {
        $self->bitmap('');
        my ($lsize, $totalsize);
        if ($self->colortype_info($self->color_type, 'borderless')) {
            ($lsize) = unpack("C", substr($tmp, 0, 1, ''));
            $totalsize = $lsize;
        } else {
            ($lsize, $totalsize) = unpack("CC", substr($tmp, 0, 2, ''));
        };
        $self->{line_width} = $lsize;
        $self->{border_width} = ($totalsize - $lsize) / 2;
    } else {
        my $bitmapa = substr($tmp, 0, 4*$radku, '');
        $self->bitmap($bitmapa);

        die if length($self->bitmap) <= 0;
    };

    $self->{strings} = [$self->dekoduj_stringy(\$tmp)] if $self->{l18n};

    if ($self->{unknown_flags} & 0x04) {
        $self->{unknown_flags} &= ~0x04;
        $self->{morecolors_info} = unpack('C', substr($tmp, 0, 1, ''));
        $self->{morecolors} = $self->get_morecolors(\$tmp, $self->{morecolors_info});
    };
    
    $self->{_neznamy_konec} = $tmp;
};

sub data_as_binary {
    my ($self) = @_;
    my $ret = '';

    $ret .= pack('C', 
        $self->color_type
        |
        ($self->height << 3)
        );
    $ret .= pack('C', 
        ($self->{l18n} ? 0x01 : 0x00)
        |
        ($self->orientation ? 0x02 : 0x00)
        |
        (defined($self->{morecolors_info}) ? 0x04 : 0x00)
        |
        $self->{unknown_flags}
        );

    my $req_triplets = $self->colortype_info($self->color_type, 'numcolors');
    my $real_triplets = 1 + $#{$self->{colors}};
    if ($real_triplets != $req_triplets) {
        die "error: required number of color triplets ($req_triplets) != real number ($real_triplets)";
    };
    $ret .= $self->store_rgb_triplets($self->{colors});

    if ($self->height == 0) {

        if ($self->colortype_info($self->color_type, 'borderless')) {

            $ret .= pack('C', $self->{line_width});
        } else {

            $ret .= pack('CC', $self->{line_width}, $self->{line_width} + 2*$self->{border_width});
        };
    } else {

        $ret .= $self->bitmap;
    };

    $ret .= $self->store_strings($self->{strings}) if $self->{l18n};

    if (defined $self->{morecolors_info}) {
        $ret .= pack('C', $self->{morecolors_info});
        $ret .= $self->store_rgb_triplets($self->{morecolors}, 0);

    };

    $ret .= $self->{_neznamy_konec};

    return $ret;
};

sub as_string {
    my ($self) = @_;
    my $ret = '';
    $ret .= "[_" . $self->parent->kind . "]\n";
    my $ofset_kolekce = $self->TYP->header->{_rozcestnik}->{ $self->parent->kind }->{dataofs};
    $ret .= sprintf("; Originally \@(0x%06x+0x%06x)=0x%06x\n",  $ofset_kolekce, $self->{_orig_ofs}, $self->{_orig_ofs}+$ofset_kolekce);
    $ret .= sprintf("Type=0x%03x\n", $self->type);
    if (($self->subtype != 0) || ($self->type >= 0x100)) {
        $ret .= sprintf("SubType=0x%02x\n", $self->subtype);
    };
    if ($self->orientation) {
        $ret .= "UseOrientation=N\n";
    } else {
        $ret .= "UseOrientation=Y\n";
    };
    if ($self->height == 0) {
        $ret .= $self->bitmap_as_string(undef, 0, 0, , $self->{colors}, 1, '');
        if ($self->colortype_info($self->color_type, 'borderless')) {
            $ret .= sprintf "LineWidth=%d\n", $self->{line_width};
        } else {
            $ret .= sprintf "LineWidth=%d\n", $self->{line_width};
            $ret .= sprintf "BorderWidth=%d\n", $self->{border_width};
        };
    } else {

        $ret .= $self->bitmap_as_string($self->{bitmap}, 32, $self->height, $self->{colors}, 1, '');
    };

    $ret .= $self->strings_as_string($self->{strings}) if $self->{l18n};
    if (defined $self->{morecolors_info}) {
        my $tmp = pack('C', $self->{morecolors_info});
        $tmp .= $self->store_rgb_triplets($self->{morecolors}, 0);
        $ret .= $self->unknown_data_as_string($tmp, 'additional block with colors');
    };
    $ret .= $self->unknown_data_as_string($self->{_neznamy_konec}, 'unknown data');
    $ret .= "[end]\n\n";
};

sub as_diffvalue {
    my ($self) = @_;

    return ($self->{_diffvalue} ||= $self->data_as_binary);
};

package Garmin::TYP::Element::Point;
use Data::Dumper;
use base qw(Garmin::TYP::Element);

sub height {
    my ($self, $new) = @_;
    if (defined $new) {
        die "height too low: $new" if $new < 0;
        die "height too high?: $new" if $new > 255;
        $self->{height} = $new;

    };
    return $self->{height};
};
sub width {
    my ($self, $new) = @_;
    if (defined $new) {
        die "width too low: $new" if $new < 0;
        die "width too high?: $new" if $new > 255;
        $self->{width} = $new;

    };
    return $self->{width};
};

sub colors {die if defined $_[1]; $_[0]->{colors}};
sub colors2 {die if defined $_[1]; $_[0]->{colors2}};

sub xflags {die if defined $_[1]; $_[0]->{x3}};
sub xflags2 {die if defined $_[1]; $_[0]->{x3b}};
sub bpp {die if defined $_[1]; $_[0]->{bpp}};
sub bpp2 {die if defined $_[1]; $_[0]->{bpp2}};

sub bitmap2 {
    my ($self, $new) = @_;
    if (defined $new) {
        $new = undef if $new eq '';
        $self->{bitmap2} = $new;
    };
    return $self->{bitmap2};
};

sub bpp_and_width_in_bytes {
    my ($self, $numcolors, $w_pixels, $x3_flag) = @_;

    my $bpp = undef;
    if ($x3_flag == 0x00) {

        $bpp = {

            0    => 16,    # 16 znamena ze se nepouziva paleta, ale primo barvy

            1    => 1,
            2    => 2,
            3    => 2,
            4    => 4,
            5    => 4,

            (map {$_ => 4} (6 .. 15)),
            (map {$_ => 8} (16 .. 31)),

            32    => 8,

            (map {$_ => 8} (33 .. 255))
        }->{$numcolors};
    } elsif ($x3_flag == 0x10) {

        $bpp = {

            0    => 1,    # dulezite, i takove bitmapy (h=0, w=0, bpp=0, bez bitmapy) se tu vyskytuji
            (map {$_ => 2} (1 .. 2)),

            3    => 4,
            4    => 4,
            5    => 4,
            6    => 4,
            7    => 4,
            8    => 4,
            9    => 4,
            10    => 4,
            11    => 4,
            12    => 4,
            13    => 4,
            14    => 4,

            15    => 8,
            16    => 8,
            17    => 8,

            (map {$_ => 8} (18 .. 255))
        }->{$numcolors};
    } elsif ($x3_flag == 0x20) {

        $bpp = {
            0    => 16,    # 16 znamena ze se nepouziva paleta, ale primo barvy
            1    => 1,
            (map {$_ => 2} (2 .. 3)),
            (map {$_ => 4} (4 .. 15)),
            (map {$_ => 8} (16 .. 255))
        }->{$numcolors};
    } else {
        die {message => "unknown image flag: $x3_flag"};
    };
    if (!defined $bpp) {
        die $self->id . "unknown bpp: flag=".sprintf('0x%02x', $x3_flag).", colors=$numcolors";

    };

    my $w_pixels_bytes = ($w_pixels * $bpp) / 8;
    if ($w_pixels_bytes > int($w_pixels_bytes)) {

        $w_pixels_bytes = int($w_pixels_bytes) + 1;
    };
    if ($bpp < 0) {
        $w_pixels_bytes = 0;
    };

    return ($bpp, $w_pixels_bytes);
};

sub decode {
    my ($self, $content_data) = @_;

    $self->{l18n} = undef;
    $self->{unknown_flags} = undef;
    $self->{width} = undef;
    $self->{height} = undef;
    $self->{morecolors_info} = undef;
    

    $self->{colors} = undef;
    $self->{bitmap} = undef;
    $self->{colors2} = undef;
    $self->{bitmap2} = undef;
    $self->{morecolors} = undef;

    $self->{strings} = undef;

    my $tmp = $content_data;
    if (length($tmp) == 0) {

        return;
    };

    my ($a, $w, $h, $colors, $x3) = unpack("CCCCC", substr($tmp, 0, 5, ''));
    
    $self->{l18n} = ($a & 0x04) ? 1 : 0;
    $a &= ~0x04;
    $self->{unknown_flags} = ($a & 0xF8);
    $a &= ~0xF8;

    $self->{width} = $w;
    $self->height($h);
    $self->{x3} = $x3;

    my ($bpp, $w_bytes) = $self->bpp_and_width_in_bytes($colors, $w, $x3);

    $self->{bpp} = $bpp;

    if ($x3 == 0x20) {

        if (($colors == 0) && ($bpp >= 16)) {
            $colors = $w*$h;
        };
        $self->{colors} = [$self->get_rgb_triplets(\$tmp, $colors, 1)];
    } elsif ($x3 == 0x10) {

        $self->{colors} = [$self->get_rgb_triplets(\$tmp, $colors)];
    } elsif ($x3 == 0) {
        if (($colors == 0) && ($bpp >= 16)) {
            $colors = $w*$h;
        };
        $self->{colors} = [$self->get_rgb_triplets(\$tmp, $colors)];
        if ($a == 0) {

        };
    } else {
        die "unknown x3: $x3 (a=$a)";
    };

    my $bitmapa;
    if ($bpp >= 16) {

        $bitmapa = '';
        for (my $i=0; $i<$colors; $i++) {
            $bitmapa .= pack('S', $i);
        };
    } else {
        my $x_zbyva = length($tmp);
        my $x_mam_nacist = $h*$w_bytes;

        if (($x_zbyva-$x_mam_nacist) < 0) {

        };
        $bitmapa = substr($tmp, 0, $x_mam_nacist, '');
    };
    $self->bitmap($bitmapa);

    

    if ($a == 0x01) {

    } elsif ($a == 0x00) {

    } elsif ($a == 0x03) {

        my ($colors2) = unpack("C", (substr($tmp, 0, 1, '')));
        my ($x3b) = unpack("C", (substr($tmp, 0, 1, '')));

        $self->{x3b} = $x3b;

        $self->{colors2} = [$self->get_rgb_triplets(\$tmp, $colors2, ($x3b == 0x20))];
        my ($bpp2, $w_bytes2) = $self->bpp_and_width_in_bytes($colors2, $w, $x3b);
        $self->{bpp2} = $bpp2;
        my $x_zbyva = length($tmp);
        my $x_mam_nacist = $h*$w_bytes2;
        if (($x_zbyva-$x_mam_nacist) < 0) {

        };

        my $bitmapa2 = substr($tmp, 0, $x_mam_nacist, '');
        $self->{bitmap2} = $bitmapa2;

    } elsif ($a == 0x02) {

        my ($colors2) = unpack("C", (substr($tmp, 0, 1, '')));
        my ($x3b) = unpack("C", (substr($tmp, 0, 1, '')));

        $self->{x3b} = $x3b;

        $self->{colors2} = [$self->get_rgb_triplets(\$tmp, $colors2)];
        my ($bpp2, $w_bytes2) = $self->bpp_and_width_in_bytes($colors2, $w, $x3b);
        $self->{bpp2} = $bpp2;
        $self->{bitmap2} = undef;

    } else {
        die $self->id . "neznamy priznak a=$a, zbyva:\n".$self->smart_dump($tmp);
    };

    if (length($tmp) > 0) {

    };
    $self->{strings} = [$self->dekoduj_stringy(\$tmp)] if $self->{l18n};

    if ($self->{unknown_flags} & 0x08) {
        $self->{unknown_flags} &= ~0x08;
        $self->{morecolors_info} = unpack('C', substr($tmp, 0, 1, ''));
        $self->{morecolors} = $self->get_morecolors(\$tmp, $self->{morecolors_info});
    };

    $self->{_neznamy_konec} = $tmp;
};

sub data_as_binary {
    my ($self) = @_;
    my $ret = '';

    my $color_mode = 0;
    if (defined($self->{bitmap})) {
        $color_mode = 0x01;

    } else {

        $color_mode = 0x01;
        $self->{width} = 0;
        $self->{height} = 0;
        $self->{colors} = [];
    };
    if (defined($self->{bitmap2})) {

        $color_mode |= 0x02;
    } elsif (defined($self->{colors2})) {

        $color_mode = 0x02;
    };

    $ret .= pack('CCC', 
            $color_mode
            | 
            ($self->{l18n} ? 0x04 : 0x00)
            | 
            (defined($self->{morecolors_info}) ? 0x08 : 0x00)
            |
            $self->{unknown_flags}
        ,
        $self->width,
        $self->height
        );

    if ($self->bpp >= 16) {
        $ret .= pack('C', 0);
    } else {
        $ret .= pack('C', 1 + $#{$self->colors});
    };
    $ret .= pack('C', $self->xflags);

    $ret .= $self->store_rgb_triplets($self->colors, ($self->xflags == 0x20));

    if ($self->bpp >= 16) {

    } else {
        $ret .= $self->bitmap;
    };

    if (defined $self->colors2) {
        $ret .= pack('C', 1 + $#{$self->colors2});
        $ret .= pack('C', $self->xflags2);

        $ret .= $self->store_rgb_triplets($self->colors2, ($self->xflags2 == 0x20));

    };

    if (defined $self->bitmap2) {
        $ret .= $self->bitmap2;

    };

    $ret .= $self->store_strings($self->{strings}) if $self->{l18n};

    if (defined $self->{morecolors_info}) {
        $ret .= pack('C', $self->{morecolors_info});
        $ret .= $self->store_rgb_triplets($self->{morecolors}, 0);
    };

    $ret .= $self->{_neznamy_konec};

    return $ret;
};

sub as_string {
    my ($self) = @_;
    my $ret = '';
    $ret .= "[_" . $self->parent->kind . "]\n";
    my $ofset_kolekce = $self->TYP->header->{_rozcestnik}->{ $self->parent->kind }->{dataofs};
    $ret .= sprintf("; Originally \@(0x%06x+0x%06x)=0x%06x\n",  $ofset_kolekce, $self->{_orig_ofs}, $self->{_orig_ofs}+$ofset_kolekce);
    $ret .= sprintf("Type=0x%03x\n", $self->type);
    if ($self->subtype != 0) {
        $ret .= sprintf("SubType=0x%02x\n", $self->subtype);
    };
    if (defined $self->{bitmap2}) {
        $ret .= $self->bitmap_as_string($self->bitmap, $self->width, $self->height, $self->colors, $self->bpp, 'Day');
        $ret .= $self->bitmap_as_string($self->bitmap2, $self->width, $self->height, $self->colors2, $self->bpp2, 'Night');
    } else {
        $ret .= $self->bitmap_as_string($self->bitmap, $self->width, $self->height, $self->colors, $self->bpp, '');
    };

    $ret .= $self->strings_as_string($self->{strings}) if $self->{l18n};
    if (defined $self->{morecolors_info}) {
        my $tmp = pack('C', $self->{morecolors_info});
        $tmp .= $self->store_rgb_triplets($self->{morecolors}, 0);
        $ret .= $self->unknown_data_as_string($tmp, 'additional block with colors');
    };
    $ret .= $self->unknown_data_as_string($self->{_neznamy_konec}, 'unknown data');
    $ret .= "[end]\n\n";
};

sub as_diffvalue {
    my ($self) = @_;

    return ($self->{_diffvalue} ||= $self->data_as_binary);
};

package Garmin::TYP::Element::NT1Point;
use Data::Dumper;
use base qw(Garmin::TYP::Element::Point);

sub decode {
    my ($self, $content_data) = @_;

    $self->{_prvni_prefix} = substr($content_data, 0, 3);
    my $ptype = unpack("C", substr($self->{_prvni_prefix}, 2, 1));

    my $rest = substr($content_data, 3);

    $self->SUPER::decode($rest);

};

sub data_as_binary {
    my ($self) = @_;
    my $ret = '';

    $ret .= $self->{_prvni_prefix};

    $ret .= $self->SUPER::data_as_binary();

    $ret .= $self->{_druhy_prefix};
    if (my $d = $self->{_druha_miniatura}) {

        $ret .= $d->data_as_binary();

    };

    return $ret;
};

sub as_string {
    my ($self) = @_;
    my $ret = '';

    my $ofset_kolekce = $self->TYP->header->{_rozcestnik}->{ $self->parent->kind }->{dataofs};
    $ret .= sprintf("; Originally \@(0x%06x+0x%06x)=0x%06x\n",  $ofset_kolekce, $self->{_orig_ofs}, $self->{_orig_ofs}+$ofset_kolekce);

    $ret .= "; First prefix: " . $self->smart_dump($self->{_prvni_prefix});
    $ret .= "; First POI:\n";
    $ret .= $self->SUPER::as_string();
    if (my $d = $self->{_druha_miniatura}) {
        $ret .= "; Second prefix: " . $self->smart_dump($self->{_druhy_prefix});
        $ret .= "; Second POI:\n";
        $ret .= $d->as_string();
    };

    return $ret;
};

package Garmin::TYP::DrawOrder;
use Data::Dumper;
use base qw(Garmin::TYP::Common Garmin::TYP::Element::WithDrawOrder);

sub new {
    my ($class, $parent, $content_data) = @_;
    my $self = bless({}, ref($class) || $class);
    $self->{_parent} = $parent;
    $self->{_raw_original} = $content_data;

    my @parts = ();
    while (1) {
        my $tmp = substr($content_data, 0, 5, '');
        last if length($tmp) <= 0;

        my ($type, $subtype_mask) = unpack('CL', $tmp);
        push @parts, [$type, $subtype_mask];
    };

    my $header_uses_bitmap = ($self->TYP->header->format =~ /^(NT|NT2)$/);
    if (!$header_uses_bitmap) {

        foreach (@parts) {
            my $oldtype = $_->[0];
            my ($oldhighbyte, $foo, $oldsubtype) = unpack('CCS', pack('L', $_->[1]));
            $oldtype += ($oldhighbyte << 8);
            if ($foo != 0) {

                $header_uses_bitmap = 1;

            } elsif ($oldtype > 0x011f) {

                $header_uses_bitmap = 1;    

            } elsif ($oldsubtype > 0x001f) {

                $header_uses_bitmap = 1;    

            };
        };
    };
    if ($self->TYP->header->format =~ /^(NT|NT2)$/) {
        if (!$header_uses_bitmap) {
            $self->TYP->error("Header is in IN format, but DrawOrder sections is in old format. It will be converted to " . $self->TYP->header->format . ".");
        };
    } else {
        if ($header_uses_bitmap) {
            $self->TYP->error("Header is in " . $self->TYP->header->format . " format, but DrawOrder sections uses short types with subtype bitmap. It will be converted automatically.");

        };
    };

    my $lvl = $self->min_level;
    foreach (@parts) {
        my ($type, $subtype_mask) = ($_->[0], $_->[1]);
        if (($type == 0) && ($subtype_mask == 0)) {

            $lvl++;
        } else {
            if ($subtype_mask == 0) {

                my $ph = Garmin::TYP::Element::new('Garmin::TYP::Element::PolyPlaceholder', 
                    $self->parent->polyplaceholders,
                    $type,
                    0
                );
                $ph->draworder($lvl);
                $self->parent->polyplaceholders->add_element($ph, "${type}_0");

            } else {
                if ($header_uses_bitmap) {

                    my $bmaska = unpack('b32', pack('L', $subtype_mask));
                    for (my $start = 0x00; $start <= 0x1f; $start++) {
                        my $bit = substr($bmaska, ($start), 1);
                        if ($bit) {

                            my $ph = Garmin::TYP::Element::new('Garmin::TYP::Element::PolyPlaceholder', 
                                $self->parent->polyplaceholders,
                                $type|0x100,
                                $start
                            );
                            $ph->draworder($lvl);
                            $self->parent->polyplaceholders->add_element($ph, (($type|0x100) . "_".$start));
                        };
                    };
                } else {

                    my ($highbyte, $foo, $subtype) = unpack('CCS', pack('L', $subtype_mask));
                    if ($foo != 0) {
                        $self->TYP->error(sprintf("TYP contains old-format draworder with unknown content: type=0x%02x, subtype=0x%02x, unknown data=%02x", $type, $subtype, $foo));
                    };

                    $type |= ($highbyte << 8);
                    my $ph = Garmin::TYP::Element::new('Garmin::TYP::Element::PolyPlaceholder', 
                        $self->parent->polyplaceholders,
                        $type,
                        $subtype
                    );
                    $ph->draworder($lvl);
                    $self->parent->polyplaceholders->add_element($ph, ($type . "_".$subtype));
                };
            };
        };
    };

    eval {
        my $outbin = $self->as_binary;
        if (length($outbin) != length($self->{_raw_original})) {

        };
    };
    if ($@) {

    };

    return $self;
};

sub parent {die if defined $_[1]; $_[0]->{_parent}};
sub TYP {$_[0]->parent};

sub all_elements_for_level {
    my ($self, $level) = @_;

    my @all_polygons = ();
    my @all_placeholders = $self->parent->polyplaceholders->iterate;
    if ($self->parent->polygons) {

        @all_polygons = $self->parent->polygons->iterate;
    };

    foreach my $poly (@all_polygons) {
        my @b = ();
        foreach my $ph (@all_placeholders) {
            if (($poly->type == $ph->type) && ($poly->subtype == $ph->subtype)) {

            } else {
                push @b, $ph;
            };
        };
        @all_placeholders = @b;
    };

    my @ret = ();
    foreach my $e (@all_placeholders, @all_polygons) {
        push @ret, $e if $e->draworder == $level;
    };

    @ret = sort {
        my $ret = (($a->type & 0xff) <=> ($b->type & 0xff));
        if ($ret == 0) {
            $ret = ($a->subtype <=> $b->subtype);
        };

        $ret;
    } @ret;

    return @ret;
};

sub length {
    my ($self) = @_;
    my $bin = $self->as_binary;
    return length($bin);
};

sub as_string {
    my ($self) = @_;
    my $ret = '';
    $ret .= "[_drawOrder]\n";
    foreach my $lvl ($self->min_level .. $self->max_level) {
        foreach my $e ($self->all_elements_for_level($lvl)) {

            $self->TYP->error("Element type for draworder cannot be 0") if $e->type == 0;
            if ($e->type >= 0x100) {

                $ret .= sprintf("Type=0x%05x,%d\n", ($e->type << 8) + $e->subtype, $lvl);
            } else {
                $ret .= sprintf("Type=0x%02x,%d\n", $e->type, $lvl);
            };    
        };
    };
    $ret .= "[end]\n\n";
    return $ret;
};

sub as_binary {
    my ($self) = @_;
    my $ret = '';

    my %vyuzito = ();
    my $previous_level_is_empty = 1;

    foreach my $lvl ($self->min_level .. $self->max_level) {
        my %vyuzito_zde = ();
        my @elements = $self->all_elements_for_level($lvl);

        if ($#elements >= 0) {

            if (!$previous_level_is_empty) {

                $ret .= pack('CSS', 0,0,0);
            };
            $previous_level_is_empty = 0;
        };

        my %subtypy_podle_typu = ();

        foreach my $e (@elements) {

            $self->TYP->error("Element type for draworder cannot be 0") if $e->type == 0;

            my $key = $e->type . '/' . $e->subtype;
            $vyuzito{$key}++;
            $vyuzito_zde{$key}++;
            if ($vyuzito{$key} > 1) {

                $self->TYP->error(sprintf("TYP contains duplicit placeholder of type 0x%03x/0x%02x!", $e->type, $e->subtype));
            };
            if ($e->type < 0x100) {

                $ret .= pack('CL', $e->type, 0);
            } else {

                if ($self->TYP->header->format =~ /^(NT|NT2)$/) {
                    if ($e->type > 0x1ff) {
                        $self->TYP->error(sprintf("TYP contains draworder with too high element type: 0x%02x, ignoring", $e->type));
                        next;
                    };
                    if ($e->subtype > 0x1f) {
                        $self->TYP->error(sprintf("TYP contains draworder with too high element subtype: 0x%02x, ignoring", $e->subtype));
                        next;
                    };
                } else {
                    if ($e->type > 0xffff) {    
                        $self->TYP->error(sprintf("TYP contains draworder with too high element type: 0x%02x, ignoring", $e->type));
                        next;
                    };
                    if ($e->subtype > 0xfffff) {
                        $self->TYP->error(sprintf("TYP contains draworder with too high element subtype: 0x%02x, ignoring", $e->subtype));
                        next;
                    };
                };
                if (!exists $subtypy_podle_typu{$e->type}) {
                    $subtypy_podle_typu{$e->type} = {};
                };
                $subtypy_podle_typu{$e->type}->{$e->subtype} = 1;
            };
        };

        foreach my $type (sort keys %subtypy_podle_typu) {
            my %sm = ();

            if (exists $subtypy_podle_typu{$type}) {
                %sm = %{$subtypy_podle_typu{$type}};
            };
            if (%sm) {
                if ($self->TYP->header->format =~ /^(NT|NT2)$/) {
                    $ret .= pack('C', ($type & 0xff));
                    my $bmaska = '';
                    for (my $start = 0x00; $start <= 0x1f; $start++) {
                        if ($sm{$start}) {
                            $bmaska .= '1';
                        } else {
                            $bmaska .= '0';
                        };
                    };
                    $ret .= pack('b32', $bmaska);
                } else {

                    foreach my $subtype (sort keys %sm) {

                        $ret .= pack('SCS', $type, 0, $subtype);
                    };
                };
            };
        };
    };
    return $ret;
};

package Garmin::TYP::NTBlocks;
use Data::Dumper;
use base qw(Garmin::TYP::Common);

sub new {
    my ($class, $parent, $content_data) = @_;
    my $self = bless({}, ref($class) || $class);
    $self->{_parent} = $parent;

    return $self;
};

sub parent {die if defined $_[1]; $_[0]->{_parent}};
sub TYP {$_[0]->parent};

sub as_string {
    my ($self) = @_;
    my $ret = '';
    my $hdr = $self->TYP->header;
    if (my $NT1 = $hdr->{_NT1}) {
        $ret .= sprintf("; NT1 header part:\n");
        $ret .= sprintf("; y=0x%02x\n", $NT1->{y});

        $ret .= "\n";
    };
    if (my $NT2 = $hdr->{_NT2}) {
        $ret .= sprintf("; NT2 header part:\n");
        $ret .= sprintf("; x=0x%02x, y=0x%02x, z=0x%02x\n", $NT2->{x}, $NT2->{y}, $NT2->{z});
        $ret .= sprintf("; u=0x%02x, v=0x%02x, w=0x%02x\n", $NT2->{u}, $NT2->{v}, $NT2->{w});

        $ret .= sprintf("; block 0 length=0x%04x:\n", CORE::length($NT2->{blok0}));

        $ret .= sprintf("; block 1 length=0x%04x:\n", CORE::length($NT2->{blok1}));

        $ret .= sprintf("; block 2 length=0x%04x:\n", CORE::length($NT2->{blok2}));

        $ret .= "\n";
    };
    return $ret;
};

sub as_binary {
    my ($self) = @_;
    my $ret = '';

    my $hdr = $self->TYP->header;
    if (my $NT1 = $hdr->{_NT1}) {

    };
    if (my $NT2 = $hdr->{_NT2}) {
        if ($NT2->{blok0_pos} > 0) {
            $ret .= $NT2->{blok0};
        };
        if ($NT2->{blok1_pos} > 0) {
            $ret .= $NT2->{blok1};
        };
        if ($NT2->{blok2_pos} > 0) {
            $ret .= $NT2->{blok2};
        };
    };
    
    return $ret;
};

1;