#!/usr/bin/perl

use utf8;
use Cwd qw/getcwd/;
use Tk 804.000;
use Tk::NoteBook;
use Tk::Tiler;
use Tk::Balloon;
use Tk::Pane;
use Tk::BrowseEntry;
use Tk::widgets qw/PNG JPEG/;
use Encode;
use Image::Magick;
use File::Basename;
use File::Copy;
use File::Path;
use Archive::Tar;
use PDF::API2; #libpdf-api2-perl
use PDF::API2::Annotation; #libpdf-api2-perl
use if $^O eq 'MSWin32', Gedcom;
use if $^O eq 'linux', Gedcomlite;
use if $^O eq 'MSWin32', Win32::Locale;
use if $^O eq 'MSWin32', Win32;
use if $^O eq 'MSWin32', Win32::OLE;
use strict;
#use warnings;
our $debug=0;

binmode(STDOUT, ":utf8");
our $no_persons=0;
our @id_filtered;
our $number_of_photos=10;
our $footer='$page';
our $pr_hl;
our $hl_bx;
our $hl_ex;
our $indi_link;
our $href;
our $FDresult;
our $anotwait;
our $tagswait;
our $wait;
our $wait2;
our $pplwait;
our $urlwait;
our $mydr;
our $igp;
our $htmlgui;
our $townwait;
our $projwait;
our $FDtp;
our $fontm;
our $charw;
our $nfsize;
our $fsize=10; # default fontsize
our $windowsize='';
our $touch_enable=1;
our $geom;
our $save_windowsize=0;
our $popup;
our $hiddenall;
our $maxshortcuts=0;
our %shortcuts=();
our %shortcuts_x=();
our %shortcuts_y=();
our $version='0.3.18'; #version of Rodovid
our $year='2016'; #last year Rodovid's developing
our $arrowtype='classic3'; #Arrow's style. May be classic, classic2, classic3, bold.
our $dist_areas=100;
our $menuback='gray';
our $underlink='darkgray';
our $menufore='black';
our $selectcolor='gray';
our $backcolor='#6ED6FF';
our $balloon_bg='#ffffd8';
our $balloon_fg='black';
our $topback='white';
our ($di,$av,$op)=('','','');
our $showlink='false';
our $linkbut=0;
our $mwc=0;
our $showmess=0;
our $user;
our $home;
our $lang;
our $fontsys;
our $fontmono;
our $mesboxexit=0;# if 1 then will shows messagebox for saving project on exit;
our $OS=$^O; #(MSWin32,linux)
our $encoding;
our $codepage='cp1252';
our $dashmarkbox='-';
our $prevdir = "";
our $graphvizpath='';
our $town='';
our $place='';
our $number_of_tags=0;
our $filter='';
our @fotoext=('jpg','jpeg','JPG','JPEG','gif','GIF','png','PNG','tif','TIF','bmp','BMP','tiff','TIFF');
our @styles=('paper','vyshyvanka','draft');#foldernames of style
our @lang=('Українська','Русский','Беларуская','English','Deutsch');
our @locales=('ua','ru','by','en','de');
our $installed='/usr/share/rodovid'; # folder for installed files
sub decod
{
 my $s=shift;
 if ($OS eq 'linux') {return decode('UTF-8',$s)}
 return decode($codepage,$s); 
}
sub encod
{
 my $s=shift;
 if ($OS eq 'linux') {return $s} #encode('UTF-8',$s)}
 return encode($codepage,$s); 
}

if ($OS eq 'MSWin32')
{
 $encoding=Win32::Locale::get_language();
 if ($encoding eq 'uk') {$codepage='cp1251'}
 if ($encoding eq 'be') {$codepage='cp1251'}
 if ($encoding eq 'ru') {$codepage='cp1251'}
}
if (($OS eq 'freebsd') || ($OS eq 'openbsd')) {$OS='linux';print "This OS not tested for compability...\n"} # Not tested but added for probing...
if ($OS eq 'linux')
{
 $user=$ENV{'USER'};
 if ($user eq 'root')
 {
  print "I can't work under root privileges! Use regular user...";
  exit;
 }
 $home=$ENV{'HOME'};
### copy data from /usr/share/rodovid to home if data not present 
 open(F,$home.'/.rodovid/version');
 my $testversion = <F>;
 close(F); chomp $testversion;
 unless (-d $home.'/.rodovid/') # if rodovid home folder not present
 {
  mkdir($home.'/.rodovid/');
  symlink($installed.'/graphics/',$home.'/.rodovid/graphics');
  symlink($installed.'/locales/',$home.'/.rodovid/locales');
  mkdir($home.'/.rodovid/projects/');
  mkdir($home.'/.rodovid/projects/ryuryk/');
  mkdir($home.'/.rodovid/projects/ryuryk/icons');
  mkdir($home.'/.rodovid/projects/ryuryk/gallery');
  copys($installed.'/projects/ryuryk/*',$home.'/.rodovid/projects/ryuryk/');
  copy($installed.'/projects/ryuryk.rid',$home.'/.rodovid/projects/');
  copys($installed.'/projects/ryuryk/icons/*',$home.'/.rodovid/projects/ryuryk/icons/');
  copys($installed.'/projects/ryuryk/gallery/*',$home.'/.rodovid/projects/ryuryk/gallery/');
  copy($installed.'/version',$home.'/.rodovid/') || print $!;
  my @ryuryk_array=('1','100','11','110','2','20','24','5','74','80');
  foreach $a (@ryuryk_array)
  {
   mkdir($home.'/.rodovid/projects/ryuryk/gallery/'.$a);
   mkdir($home.'/.rodovid/projects/ryuryk/gallery/'.$a.'/icons');
   copys($installed.'/projects/ryuryk/gallery/'.$a.'/*',$home.'/.rodovid/projects/ryuryk/gallery/'.$a.'/');
   copys($installed.'/projects/ryuryk/gallery/'.$a.'/icons/*',$home.'/.rodovid/projects/ryuryk/gallery/'.$a.'/icons/');
  }
  undef @ryuryk_array;
 }
 else # if rodovid home folder present, but may be absent some files
 {
  mkdir($home.'/.rodovid/projects/') if (!(-d $home.'/.rodovid/projects/'));
  if (-d $home.'/.rodovid/locales/')
  {
   rmtree($home.'/.rodovid/locales/');
   symlink($installed.'/locales/',$home.'/.rodovid/locales');
  }
  else 
  {
   symlink($installed.'/locales/',$home.'/.rodovid/locales');
  }
  if (-d $home.'/.rodovid/graphics/')
  {
   rmtree($home.'/.rodovid/graphics/');
   symlink($installed.'/graphics/',$home.'/.rodovid/graphics');
  }
  else
  {
   symlink($installed.'/graphics/',$home.'/.rodovid/graphics');
  }
 }
###
 $lang=$ENV{'LANG'};
}
if ($OS eq 'MSWin32')
{
 $user='user'; #??? Default Win user
 $home=$ENV{'HOMEDRIVE'}.'/rodovid';
 $fontsys='Arial Unicode';
 $lang='';# English by default
 if ($encoding eq 'uk') {$lang='uk_UA.UTF-8'};
 if ($encoding eq 'be') {$lang='be_BY.UTF-8'};
 if ($encoding=~/^de/) {$lang='de_DE.UTF-8'};
 if ($encoding eq 'ru') {$lang='ru_RU.UTF-8'}
}

# Corrected module Tk::MenuButton. Corrected style and cursor for menubutton.
package Tk::MyMenuButton;
use strict;
require Tk;
require Tk::Menubutton;
use Tk::Derived;
use base qw/Tk::Derived Tk::Menubutton/;
Construct Tk::Widget 'MyMenuButton';
import Tk qw(&Ev $XS_VERSION);
sub InitObject
{
 my ($mb,$args) = @_;
 my $menuitems = delete $args->{-menuitems};
 my $tearoff   = delete $args->{-tearoff};
 $mb->SUPER::InitObject($args);
 if ((defined($menuitems) || defined($tearoff)) && %$args)
  {
   $mb->configure(%$args);
   %$args = ();
  }
 $mb->menu(-tearoff => $tearoff) if (defined $tearoff);
 $mb->AddItems(@$menuitems) if (defined $menuitems)
}
sub ClassInit
{
 my ($class,$mw) = @_;
 $mw->bind($class,'<FocusIn>','NoOp');
 $mw->bind($class,'<Enter>','Enter');
 $mw->bind($class,'<Leave>','Leave');
 $mw->bind($class,'<1>','ButtonDown');
 $mw->bind($class,'<Motion>',['Motion','up',Ev('X'),Ev('Y')]);
 $mw->bind($class,'<B1-Motion>',['Motion','down',Ev('X'),Ev('Y')]);
 $mw->bind($class,'<ButtonRelease-1>','ButtonUp');
 $mw->bind($class,'<space>','PostFirst');
 $mw->bind($class,'<Return>','PostFirst');
 return $class;
}
sub ButtonDown
{my $w = shift;
 my $Ev = $w->XEvent;
 $Tk::inMenubutton->Post($Ev->X,$Ev->Y) if (defined $Tk::inMenubutton);
}
sub PostFirst
{
 my $w = shift;
 my $menu = $w->cget('-menu');
 $w->Post();
 $menu->FirstEntry() if (defined $menu);
}
sub Enter
{
 my $w = shift;
 $Tk::inMenubutton->Leave if (defined $Tk::inMenubutton);
 $Tk::inMenubutton = $w;
 if ($w->cget('-state') ne 'disabled')
  {
   $w->configure('-state','active')
  }
}
sub Leave
{
 my $w = shift;
 $Tk::inMenubutton = undef;
 return unless Tk::Exists($w);
 if ($w->cget('-state') eq 'active')
  {
   $w->configure('-state','normal')
  }
}
sub Post
{
 my $w = shift;
 my $x = shift;
 my $y = shift;
 return if ($w->cget('-state') eq 'disabled');
 return if (defined $Tk::postedMb && $w == $Tk::postedMb);
 my $menu = $w->cget('-menu');
 return unless (defined($menu) && $menu->index('last') ne 'none');
 my $tearoff = $Tk::platform eq 'unix' || $menu->cget('-type') eq 'tearoff';
 my $wpath = $w->PathName;
 my $mpath = $menu->PathName;
 unless (index($mpath,"$wpath.") == 0)
  {
   die "Cannot post $mpath : not a descendant of $wpath";
  }
 my $cur = $Tk::postedMb;
 if (defined $cur)
  {
   Tk::Menu->Unpost(undef); # fixme
  }
 $Tk::cursor = $w->cget('-cursor');
 $Tk::relief = $w->cget('-relief');
#corrected this next 3 lines
 $w->configure('-cursor','');
 $w->configure('-borderwidth','1');
 $w->configure('-relief','ridge');
 $Tk::postedMb = $w;
 $Tk::focus = $w->focusCurrent;
 $menu->activate('none');
 $menu->GenerateMenuSelect;
 eval
  {local $SIG{'__DIE__'};
   my $dir = $w->cget('-direction');
   if ($dir eq 'above')
    {
     $menu->post($w->rootx, $w->rooty - $menu->ReqHeight);
    }
   elsif ($dir eq 'below')
    {
     $menu->post($w->rootx, $w->rooty + $w->Height);
    }
   elsif ($dir eq 'left')
    {
     my $x = $w->rootx - $menu->ReqWidth;
     my $y = int((2*$w->rooty + $w->Height) / 2);
     if ($w->cget('-indicatoron') == 1 && defined($w->cget('-textvariable')))
      {
       $menu->PostOverPoint($x,$y,$menu->FindName($w->cget('-text')))
      }
     else
      {
       $menu->post($x,$y);
      }
    }
   elsif ($dir eq 'right')
    {
     my $x = $w->rootx + $w->Width;
     my $y = int((2*$w->rooty + $w->Height) / 2);
     if ($w->cget('-indicatoron') == 1 && defined($w->cget('-textvariable')))
      {
       $menu->PostOverPoint($x,$y,$menu->FindName($w->cget('-text')))
      }
     else
      {
       $menu->post($x,$y);
      }
    }
   else
    {
     if ($w->cget('-indicatoron') == 1 && defined($w->cget('-textvariable')))
      {
       if (!defined($y))
        {
         $x = $w->rootx+$w->width/2;
         $y = $w->rooty+$w->height/2
        }
       $menu->PostOverPoint($x,$y,$menu->FindName($w->cget('-text')))
      }
     else
      {
       $menu->post($w->rootx,$w->rooty+$w->height);
      }
    }
  };
 if ($@)
  {
   Tk::Menu->Unpost;
   die $@
  }
 $Tk::tearoff = $tearoff;
 if ($tearoff)
  {
   $menu->focus;
   if ($w->viewable)
    {
     $w->SaveGrabInfo;
     $w->grabGlobal;
    }
  }
}
sub Motion
{
 my $w = shift;
 my $upDown = shift;
 my $rootx = shift;
 my $rooty = shift;
 return if (defined($Tk::inMenubutton) && $Tk::inMenubutton == $w);
 my $new = $w->Containing($rootx,$rooty);
 if (defined($Tk::inMenubutton))
 {
  if ($new != $w)
  {
   $Tk::inMenubutton->Leave();
  }
 }
 if (defined($Tk::inMenubutton))
 {
  if (!defined($new) || ($new != $Tk::inMenubutton && $w->toplevel != $new->toplevel))
  {
   $Tk::inMenubutton->Leave();
  }
 }
 if (defined($new) && $new->IsMenubutton && $new->cget('-indicatoron') == 0 && $w->cget('-indicatoron') == 0)
  {
   if ($upDown eq 'down')
    {
     $new->Post($rootx,$rooty);
    }
   else
    {
     $new->Enter();
    }
  }
}
sub ButtonUp {
    my $w = shift;
    my $tearoff = $Tk::platform eq 'unix' || (defined($w->cget('-menu')) &&
					      $w->cget('-menu')->cget('-type') eq 'tearoff');
    if ($tearoff && (defined($Tk::postedMb)     && $Tk::postedMb == $w)
	         && (defined($Tk::inMenubutton) && $Tk::inMenubutton == $w)) {
	$Tk::postedMb->cget(-menu)->FirstEntry();
    } else {
      Tk::Menu->Unpost(undef);
    }
}
sub menu
{
 my ($w,%args) = @_;
 my $menu = $w->cget('-menu');
 if (!defined $menu)
  {
   require Tk::Menu;
   $w->ColorOptions(\%args) if ($Tk::platform eq 'unix');
   $menu = $w->Menu(%args);
   $w->configure('-menu'=>$menu);
  }
 else
  {
   $menu->configure(%args);
  }
 return $menu;
}
sub separator   { require Tk::Menu::Item; shift->menu->Separator(@_);   }
sub command     { require Tk::Menu::Item; shift->menu->Command(@_);     }
sub cascade     { require Tk::Menu::Item; shift->menu->Cascade(@_);     }
sub checkbutton { require Tk::Menu::Item; shift->menu->Checkbutton(@_); }
sub radiobutton { require Tk::Menu::Item; shift->menu->Radiobutton(@_); }
sub AddItems
{
 shift->menu->AddItems(@_);
}
sub entryconfigure
{
 shift->menu->entryconfigure(@_);
}
sub entrycget
{
 shift->menu->entrycget(@_);
}
sub FindMenu
{
 my $child = shift;
 my $char = shift;
 my $ul = $child->cget('-underline');
 if (defined $ul && $ul >= 0 && $child->cget('-state') ne 'disabled')
  {
   my $char2 = $child->cget('-text');
   $char2 = substr("\L$char2",$ul,1) if (defined $char2);
   if (!defined($char) || $char eq '' || (defined($char2) && "\l$char" eq $char2))
    {
     $child->PostFirst;
     return $child;
    }
  }
 return undef;
}
1;
#end of corrected module

#Rodovid part
package main;
use vars qw/ %ged $ged $ssp $projectname @tags $id $image $c $current_sex @FDM @messages $key $xcanvas $ycanvas /;
use vars qw/ $begin_father $begin_mother $begin_spouse $son $workfolder $menux $menuy $peoples $maxpeoples /;
use vars qw/ $maxfathers $fathers %father $maxmothers $mothers %mother $maxspouses $spouses %spouse %spouseforkins %motherforkins %fatherforkins %people %sex %peoplex %peopley /;
use vars qw/ %marr_date %marr_place %text %foto %family_name %first_name %second_name %birth_date %birth_place @state %towns_base %tags %colors/;
use vars qw/ %death_date %death_place %gallery %ruler $maxrulers $rulers $x $y $currentruler $TOP @tree $nexttree %size/;
use vars qw/ $m1 $m2 $m3 $menustatus $nextp $prevp $nextpagestat $prevpagestat $galpage @bd @ba @yx @x/;
use vars qw/ $oldx $oldy $foto $file $size_x $size_y $ic_size_small $ic_size $gal_size @fotoext @gallery @texts @c @ct @cc @co @r @bat @lab @in_out @f1 @f2 @p @conf @block @mic @w $opened/;
use vars qw/ @kins $nextkin @t $draggroup $scrollx $scrolly $csex $size $bx $by $cache $exitanot $prog_icon $annotation $ai/;
use vars qw/ $menubar $file $view $tools $sc $help @help $obj %help $ctl $f1tl $menustate $BoxResult %mw %font %fontbold %exit $pplresult/;
use vars qw/ $townresult $mwp @surn @sorted $tile $facestyle $fs $destroyWM $fr/;
use subs qw/ clear annotation deletefoto opengallery savegallery drawgallery raisegallery kins scroll create load save findtree loadoptions saveoptions/;
use subs qw/ fileDialog menuproperties menudelete menudeletespouse menudeletemother menudeletefather menucreatespouse params createmw destroymw/;
use subs qw/ reloadallramka menucreatemother menucreatefather menu2man menu2woman exportged importged endgroup findperson savetowns edittowns showtowns/;
use subs qw/ saveas save2 items_drag items_leave items_start_drag number1 number2 drawmessage deletemessage markkins createruler drawtags/;
use subs qw/ MyMessageBox help menustateon menustateoff keyboardbindings mousebindings exporthtml father mother copys dotpresent fn exitrodovid/;
use subs qw/ importgedpics loadprojprop saveprojprop tar untar loadmessages loadhelp save2pics menugoto destroyallmw export2csv/;
use constant cancel=>"/'\?.";
use constant delta=>5;
use constant width=>2;
use constant boldwidth=>3;
use constant widthruler=>1;
use constant mpad=>5;
use constant rulercolor=>"black";
our $father_this;
our $mother_this;
our %hidden=();
our $tl='';
our $prevfile;
our @messages;
our $locale;
our $language; #current language
$workfolder=$home.'/.rodovid/';
our $projects=$workfolder.'projects/';
our $photodir=$projects;
our $tmpdir=$workfolder.'tmp/';
our $projectname=$user;
$facestyle=$styles[0];
our $noname='?';#Symbol for showing nonamed persons
our $dg5;
our $exit_processing=0;
# variables for export2pdf
our $pdf_loops=1;
our $pdf_opt0=1;
our $pdf_opt1=1;
our $pdf_opt2=1;
our $pdf_opt3=1;
our $pdf_opt4=1;
our $pdf_opt5=1;
our $pdf_opt6=1;
our $pdf_opt7=1;
our $pdf_opt8=1;
our $pdf_opt9=0;
our $pdf_opt10=1;
our $pdf_opt11=1;
our $pdf_opt12=1;
our $pdf_opt13=1;
our $pdf_opt14=1;
our $pdf_bx;
our $pdf_by;
our $txt;
our $gfx;
our $pdf_page;
our $page;
our $cury;
our $cur_pic;
our $i;
our $font_now;
our $pdfgui;
our $pdf_fs;
#fonts for PDF
our $fontu;
our $fontub;
our $fontui;
our $fontubi;
our $fontf;
our $fontfb;
our $pdf;
our %fontnames;
our @fontnames=('Ubuntu','Ubuntu Bold','Ubuntu Italic','Ubuntu Bold Italic','Fira Sans','Fira Sans Bold');
our $document_title_fontsize=20;
our $footer_fontsize=14;
our $content_fontsize=14;
our $name_fontsize=18;
our $about_fontsize=14;
our $parents_fontsize=14;
our $childs_title_fontsize=14;
our $spouse_fontsize=14;
our $spouse_about_fontsize=13;
our $childs_fontsize=14;
our $about_childs_fontsize=13;
our $text_title_fontsize=14;
our $text_fontsize=13;
our $gallery_fontsize=14;
our $annot_fontsize=14;;
our $document_title_font;
our $font13;
our $footer_font;
our $font14;
our $content_font;
our $font0;
our $name_font;
our $font1;
our $about_font;
our $font2;
our $parents_font;
our $font3;
our $childs_title_font;
our $font4;
our $spouse_font;
our $font5;
our $spouse_about_font;
our $font6;
our $childs_font;
our $font7;
our $about_childs_font;
our $font8;
our $text_title_font;
our $font9;
our $text_font;
our $font10;
our $gallery_font;
our $font11;
our $annot_font;
our $font12;
our $font13=$fontnames[5];
our $font14=$fontnames[0];
our $font0=$fontnames[0];
our $font1=$fontnames[1];
our $font2=$fontnames[0];
our $font3=$fontnames[0];
our $font4=$fontnames[1];
our $font5=$fontnames[1];
our $font6=$fontnames[0];
our $font7=$fontnames[0];
our $font8=$fontnames[0];
our $font9=$fontnames[1];
our $font10=$fontnames[0];
our $font11=$fontnames[0];
our $font12=$fontnames[0];
sub initfonts2pdf
{
 #defaults for PDF's fonts
 $pdf=PDF::API2->new;

 $fontu = $pdf->ttfont(fn($workfolder.'/graphics/u.ttf'));
 $fontub = $pdf->ttfont(fn($workfolder.'/graphics/ub.ttf'));
 $fontui = $pdf->ttfont(fn($workfolder.'/graphics/ui.ttf'));
 $fontubi = $pdf->ttfont(fn($workfolder.'/graphics/ubi.ttf'));
 $fontf = $pdf->ttfont(fn($workfolder.'/graphics/f.ttf'));
 $fontfb = $pdf->ttfont(fn($workfolder.'/graphics/fb.ttf'));
 %fontnames=('Ubuntu',$fontu,'Ubuntu Bold', $fontub,'Ubuntu Italic',$fontui,'Ubuntu Bold Italic',$fontubi,'Fira Sans',$fontf,'Fira Sans Bold',$fontfb);
 #set link to font's hash by name
 $document_title_font=$fontnames{$font13};
 $footer_font=$fontnames{$font14};
 $content_font=$fontnames{$font0};
 $name_font=$fontnames{$font1};
 $about_font=$fontnames{$font2};
 $parents_font=$fontnames{$font3};
 $childs_title_font=$fontnames{$font4};
 $spouse_font=$fontnames{$font5};
 $spouse_about_font=$fontnames{$font6};
 $childs_font=$fontnames{$font7};
 $about_childs_font=$fontnames{$font8};
 $text_title_font=$fontnames{$font9};
 $text_font=$fontnames{$font10};
 $gallery_font=$fontnames{$font11};
 $annot_font=$fontnames{$font12};
}
initfonts2pdf;
#create needed file structure
unless (-e fn($workfolder)) {mkdir(fn($workfolder))}
unless (-e fn($projects)) {mkdir(fn($projects))}
unless (-e fn($tmpdir)) {mkdir(fn($tmpdir))}
#load and analize saved options
our $optres=loadoptions;
if (($optres==65536) || (($optres & 1)==1)) # if bad options file or bad language value
{
 if ($lang eq 'ru_RU.UTF-8') {$language=$lang[1];$locale=$locales[1]};
 if ($lang eq 'uk_UA.UTF-8') {$language=$lang[0];$locale=$locales[0]};
 if ($lang eq 'be_BY.UTF-8') {$language=$lang[2];$locale=$locales[2]};
 if ($lang eq 'de_DE.UTF-8') {$language=$lang[4];$locale=$locales[4]};
 if ($language eq '') {$language=$lang[3];$locale=$locales[3]};
 loadmessages;
}
if (($optres==65536) || (($optres & 2)==2)) # if bad options file or bad style value
{
 $facestyle=$styles[0];
}
if (($optres==65536) || (($optres & 4)==4)) # if bad options file or bad cache value
{
 $cache=1; # if cache=0 then ignore saved images. must load or create new image.
}
our %namestyles=($styles[0]=>$messages[130],$styles[1]=>$messages[199],$styles[2]=>$messages[200]);#national names of styles
our $document_title=$messages[305];
our $mashtab=$messages[83];#default set for resizing.
$draggroup=0;# grouping for moving is off
$begin_father=0;
$begin_mother=0;
$begin_spouse=0;
our $findedp=0; # eq 1 if used findperson and person searching has true result
our $showrulers=1; # Show rulers on
our $ki=0; # counter for grouping by ruller
our $xcanvas=100000; #X size of canvas
our $ycanvas=100000; #Y size of canvas
our $scrollxinc=160/$xcanvas; #X scroll increment
our $scrollyinc=60/$ycanvas; #Y scroll increment
$bx=int ($xcanvas/2);# start X Y positions of cursor
$by=int ($ycanvas/4);
$ic_size=170; # size of portrait image
$gal_size=160; # size of prewiev image in gallery
$ic_size_small=40; # size of portrait image on canvas
$size=1; # Size of person's rectangle with data on canvas
$nextpagestat='disabled';# gallery buttons status
$prevpagestat='disabled';
our $step=10; # align person's on desktop size
our $rulerstep=30; # align person's on ruller size
# Main Window
$TOP = Tk::MainWindow->new;
our $screenx;
our $screeny;
chdir($workfolder);
sub getscreensize
{
 if ($OS eq 'linux')
 {
  system('which xrandr 1>/dev/null');
  if ($?==0)
  {
   open (F,'xrandr 2>/dev/null | grep "Screen 0:" | grep current |');$_=<F>;close(F);
   $_=~/current (\d+) x (\d+)/;
   $screenx=$1;
   $screeny=$2;
  }
  else
  {
   $screenx=$TOP->screenwidth;
   $screeny=$TOP->screenheight;
  }
 }
 else
 {
  $screenx=$TOP->screenwidth;
  $screeny=$TOP->screenheight;
 }
 if ($TOP) {$geom=$TOP->geometry;saveoptions}
}
sub setgeometry
{
 my $gx=shift;
 my $gy=shift;
 my $mw=shift;
 getscreensize;
 $gx=int($gx*(1+$fsize/72));
 $gy=int($gy*(1+$fsize/72));
 $mw{$mw}->geometry($gx.'x'.$gy.'+'.(int(($screenx-$gx)/2)).'+'.(int(($screeny-$gy)/2)));
 $size{$mw}=$fsize/9;
}
sub setgeometry2
{
 my $gx=shift;
 my $gy=shift;
 my $mw=shift;
 getscreensize;
 $gx=int($gx*($fsize/9));
 $gy=int($gy*(0.5+$fsize/18));
 $mw{$mw}->geometry($gx.'x'.$gy.'+'.(int(($screenx-$gx)/2)).'+'.(int(($screeny-$gy)/2)));
 $size{$mw}=$fsize/9;
}
sub setgeometry3
{
 my $gx=shift;
 my $gy=shift;
 my $mw=shift;
 getscreensize;
 $gx=int($gx*($fsize/9));
 $gy=int($gy*(0.25+$fsize/12));
 $mw{$mw}->geometry($gx.'x'.$gy.'+'.(int(($screenx-$gx)/2)).'+'.(int(($screeny-$gy)/2)));
 $size{$mw}=$fsize/9;
}
sub setgeometry4
{
 my $gx=shift;
 my $gy=shift;
 my $mw=shift;
 getscreensize;
 $gx=int($gx*($fsize/12));
 $gy=int($gy*(0.25+$fsize/12));
 $mw{$mw}->geometry($gx.'x'.$gy.'+'.(int(($screenx-$gx)/2)).'+'.(int(($screeny-$gy)/2)));
 $size{$mw}=$fsize/9;
}
sub setgeometry5
{
 my $gx=shift;
 my $gy=shift;
 my $mw=shift;
 getscreensize;
 $gx=int($gx);
 $gy=int($gy*(0.25+$fsize/12));
 $mw{$mw}->geometry($gx.'x'.$gy.'+'.(int(($screenx-$gx)/2)).'+'.(int(($screeny-$gy)/2)));
 $size{$mw}=$fsize/9;
}
getscreensize;$x=$screenx;$y=$screeny;
if ($x<640) {$x=640}
if ($y<480) {$y=480}
if ($windowsize != '') # if bad options file or bad cache value
{
 $TOP->geometry($windowsize);
}
else
{
 $TOP->geometry($screenx.'x'.$screeny);
}
$TOP->configure(-title=>$messages[48]);
# Set App Icon
$prog_icon=fn($workfolder.'/graphics/rodovid_win.png');
$TOP->Icon(-image=>$TOP->Photo(-format=>'PNG', -file=>$prog_icon));
# correcting default parameters of Tk design
$TOP->optionAdd("*menu.relief",'ridge');
$TOP->optionAdd("*Cursor",'');
$TOP->optionAdd("*activeBorderWidth",1);
$TOP->optionAdd("*BorderWidth",1);
$TOP->optionAdd("*.cursor",'');
# photo for tiling
if ($OS eq 'linux') {$tile=$TOP->Photo(-file=>$workfolder.'graphics/'.$facestyle.'/center.gif')}
# settings fonts styles
# searching best monospace font(need for filedialog)
our $mono;
our @base;
our @win32fonts=('Courier New','Courier'); # fonts by priority
our @linuxfonts=('dejavu sans mono', 'liberation mono', 'andale mono', 'freemono', 'nimbus mono l', 'DejaVu Sans Mono', 'Liberation Mono', 'Andale Mono', 'FreeMono', 'Nimbus Mono L', 'helvetica','Helvetica');
if ($OS eq 'linux') {@base=@linuxfonts;$mono='monospace'}
if ($OS eq 'MSWin32') {@base=@win32fonts;$mono='Fixedsys'}
nnn:
foreach my $f (@base) 
{
 foreach my $b ($TOP->fontFamilies) 
 {
  if ($b eq $f) {$mono=$f;last nnn}
 }
}
if ($OS eq 'linux') 
{
 @base=('helvetica', 'Verdana', 'FreeSans', 'Ubuntu', 'Helvetica');
endloop: 
 foreach my $f (@base) 
 {
  foreach my $b ($TOP->fontFamilies) 
  {
   if ($b eq $f) {$fontsys=$f;last endloop}
  }
 }
}
undef @base;
undef @win32fonts;
undef @linuxfonts;
our $font = $TOP->fontCreate('font',-family => "$fontsys",-size => $fsize, -weight=>'normal');
our $fontstatus = $TOP->fontCreate('fontstatus',-family => "$fontsys",-size => 10, -weight=>'normal');
our $TOPfontsize=$TOP->fontMetrics('font',-linespace);
our $fontlink = $TOP->fontCreate('fontlink', -family => "$fontsys",-size => ($fsize-1), -weight=>'normal');
our $fontbold = $TOP->fontCreate('fontbold',-family => "$fontsys",-size => $fsize, -weight=>'bold');
our $fsize_sm=int($fsize*6/10);
our $fontsmall = $TOP->fontCreate('fontsmall',-family => "$fontsys",-size => int($fsize*7/10) , -weight=>'normal');
$fontmono=$TOP->fontCreate('mono',-family=>$mono,-size=>$fsize,-weight=>'normal');
# menubar frame
$menubar = $TOP->Frame(-borderwidth=>0)->pack(-side=>'top', -fill=>'x');
$menubar->bind('<Destroy>'=>sub{exitrodovid}); # this frame can be destroyed only if destroyed mainwindow.
menucreate();
#creating label for information messages
$menustatus = $menubar->Label(-relief=>'flat',-font=>$fontstatus,-text =>'')->pack(-side=>'right');
#create canvas
$fs=$TOP->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>'solid')->pack(-side=>'top',-fill=>'x',-expand=>'1');
$menuback=$fs->cget(-background);# get background for activestate in MyMenuButton
$menufore=$fs->cget(-foreground);# get foreground for activestate in MyMenuButton
if ($OS eq 'linux') {$selectcolor=$backcolor;$c=$fs->Scrolled(qw/Canvas -relief solid -borderwidth 0 -scrollbars se/,-height=>$y,-scrollregion=>[0,0,$xcanvas,$ycanvas],-tile=>$tile)} 
else {$selectcolor=$menuback;$c=$fs->Scrolled(qw/Canvas -relief solid -borderwidth 0 -scrollbars se/,-height=>$y,-scrollregion=>[0,0,$xcanvas,$ycanvas],-background=>$topback)} 
our  $cballoon;
$c->pack(qw/-expand yes -fill both /);
menustateoff;#menu off
clear;# reset all values
#draw boundaries of canvas
$c->createLine(2,2,$xcanvas-2,2,,-width=>1,-tags=>'boundaries');
$c->createLine(2,2,2,$ycanvas-2,,-width=>1,-tags=>'boundaries');
$c->createLine($xcanvas-2,2,$xcanvas-2,$ycanvas-2,-width=>1,-tags=>'boundaries');
$c->createLine(3,$ycanvas-2,$xcanvas-2,$ycanvas-2,-width=>1,-tags=>'boundaries');
#set default position
$c->xview(moveto=>.5);
$c->yview(moveto=>.25);
scroll();
sub sizePhoto
{
 my $t=shift; # number of WM
 my $if=shift; # input file
 my $sx; my $sy;
 my $icon=Image::Magick->new;
 copy(fn($if),fn($tmpdir.'tmpf'));
 $icon->Read(fn($tmpdir.'tmpf'));
 (my $x, my $y)=$icon->Get('columns','rows');
 if ($y>=$x) 
 {
  $sy=$y*$size{$t};$sx=int(($sy/$y)*$x);
 }
 else
 {
  $sx=$x*$size{$t};$sy=int(($sx/$x)*$y);
 }
 unless (($sx==$x) && ($sy==$y)) {$icon->Resize(width=>$sx,height=>$sy)}
 $icon->Write(fn($tmpdir.'tmpf'));
 $mw{$t}->Photo(-file=>fn($tmpdir.'tmpf'));
}
sub sizePhoto2
{
 my $t=shift; # WM
 my $if=shift; # input file
 my $sx; my $sy;
 my $icon=Image::Magick->new;
 my $sizeTOP=$fsize/9;
 copy($if,fn($tmpdir.'tmpf'));
 $icon->Read(fn($tmpdir.'tmpf'));
 (my $x, my $y)=$icon->Get('columns','rows');
 if ($y>=$x) 
 {
  $sy=$y*$sizeTOP;$sx=int(($sy/$y)*$x);
 }
 else
 {
  $sx=$x*$sizeTOP;$sy=int(($sx/$x)*$y);
 }
 unless (($sx==$x) && ($sy==$y)) {$icon->Resize(width=>$sx,height=>$sy)}
 $icon->Write(fn($tmpdir.'tmpf'));
 $t->Photo(-file=>fn($tmpdir.'tmpf'));
}

#create start menu
our $tln=createmw($messages[41]);
my $font_sm_tln= $mw{$tln}->fontCreate('font_sm_tln',-family => "$fontsys",-size => int($fsize*7/10), -weight=>'normal');
$mw{$tln}->overrideredirect(1);
$mw{$tln}->bind('<Destroy>'=>sub{unless ($mesboxexit==1) {exit}});
$mw{$tln}->configure(-borderwidth=>4, -background=>'white', -relief=>'ridge');
getscreensize;
setgeometry3(440,380,$tln);
our $cc=$mw{$tln}->Canvas(-width=>int(400*$size{$tln}), -height=>int(238*$size{$tln}), -scrollregion=>[0,0,int(400*$size{$tln}),int(238*$size{$tln})],-borderwidth=>0)->pack(-side=>'top',-expand=>'1',-anchor=>'s',-padx=>5,-pady=>5);
$cc->createImage(int(400*$size{$tln}/2), int(238*$size{$tln}/2), -anchor=>'center', -image => sizePhoto($tln, $workfolder.'/graphics/rodovid.gif'));
#"Create" button
our $tln1;
our $tln2;
our $tln3;
$tln1=$mw{$tln}->Button(-padx=>5, -pady=>5, -font=>$font{$tln},-relief=>'raised',-borderwidth=>2, -text => $messages[42], -command => sub
{
 $tln1->configure(-state=>'disabled');
 $tln2->configure(-state=>'disabled');
 $tln3->configure(-state=>'disabled');
 $mw{$tln}->withdraw;
 my $res=create;
 if ($res==0)
 {
  $mesboxexit=1;
  $mw{$tln}->destroy;
  menustateon;
 } else 
 {
  $mw{$tln}->raise;
  $mw{$tln}->deiconify;
  $tln1->configure(-state=>'active');
  $tln2->configure(-state=>'active');
  $tln3->configure(-state=>'active');
  getscreensize;
  $mw{$tln}->geometry(int(440*$size{$tln}).'x'.int(370*$size{$tln}).'+'.(int(($screenx-440*$size{$tln})/2)).'+'.(int(($screeny-370*$size{$tln})/2)));
  menustateoff;
 }
})->pack(-side=>'top',-expand=>'1',-anchor=>'s');
#"Load" button
$tln2=$mw{$tln}->Button(-padx=>5, -pady=>5, -font=>$font{$tln},-relief=>'raised',-borderwidth=>2,-text => $messages[43], -command => sub
{
 $tln1->configure(-state=>'disabled');
 $tln2->configure(-state=>'disabled');
 $tln3->configure(-state=>'disabled');
 $mw{$tln}->withdraw;
 my $res=load;
 if ($res==0)
 {
  $mesboxexit=1;
  $mw{$tln}->destroy;
  menustateon;
 } else 
 {
  $mw{$tln}->raise;
  $mw{$tln}->deiconify;
  $tln1->configure(-state=>'active');
  $tln2->configure(-state=>'active');
  $tln3->configure(-state=>'active');
  getscreensize;
  $mw{$tln}->geometry(int(440*$size{$tln}).'x'.int(370*$size{$tln}).'+'.(int(($screenx-440*$size{$tln})/2)).'+'.(int(($screeny-370*$size{$tln})/2)));
  menustateoff;
 }
})->pack(-side=>'top',-expand=>'1',-anchor=>'s');
$tln2->focus;
#"Exit" button
$tln3=$mw{$tln}->Button(-padx=>5, -pady=>5, -font=>$font{$tln},-relief=>'raised',-borderwidth=>2,-text => $messages[44], -command => sub
{
 $mw{$tln}->withdraw;
 $mw{$tln}->destroy;
 exit(0);
})->pack(-side=>'top',-expand=>'1',-anchor=>'s');
$mw{$tln}->bind('<KeyPress-Escape>',sub
{
 $mw{$tln}->withdraw;
 $mw{$tln}->destroy;
 exit(0);
});
$mw{$tln}->Label(-relief=>'flat',-background=>'white',-text=>$messages[75],-font=>'font_sm_tln')->pack(-side=>'top',-expand=>'1',-anchor=>'e');
$mw{$tln}->raise;
$mw{$tln}->deiconify;

#main binds
keyboardbindings();
mousebindings();
sub drawmark
{
 $c->createRectangle(shift,shift,shift,shift,-dash=>$dashmarkbox,-width=>2,-tags=>'bmark',-outline=>'blue');
}
our $x1_mark;
our $y1_mark;
our $x2_mark;
our $y2_mark;
our $otstup=15;
our $shift_def=10;
our $shift_spouse=3;

sub getLineY #get coordinate Y from line(x1,y1,x2,y2): y=line(x1,y1,x2,y2,x)
{
 my $x1=shift;
 my $y1=shift;
 my $x2=shift;
 my $y2=shift;
 my $x=shift;
 my $r=$x;
 if ($x2!=$x1) {$r=int(($y2*($x-$x1)+$y1*($x2-$x))/($x2-$x1));}
 return $r;
}
sub getlinefather #get name for line to father
{
 my $s=shift;
 my @t=$c->find('all');
 my @t2;
 my $t2;
 my $t;
 foreach $t2 (@t) 
 {
  @t2=$c->gettags($t2);
  if ($t2[0]=~/$s/) 
  { $t=$t2[0];last} 
  if ($s=~/t2[0]/) 
  { $t=$s;last} 
 };
 undef @t;
 undef @t2;
 return $t;
}
our %hidden2;
sub showallhidden #show all lines which were hidden on canvas
{
 %hidden2=();
 my @t=$c->find('all');
 my @t2;
 my $t2;
 my $t;
 foreach $t2 (@t) 
 {
  @t2=$c->gettags($t2);
  if ($t2[0]=~/\:s$/) 
  {
   $hidden2{$t2[0]}=1;
  } 
 };
 foreach $t2 (keys %hidden2) 
 {
  my ($tag,$from,$to)=$t2=~/^([fathermo]+)(\d+):(\d+):s$/;
  if ($tag eq 'father')
  {
   $c->delete($t2);
   $c->delete("jump$from:$to");
   $c->delete("jump$to:$from");
   arrowFromFather($peoplex{$from}, $peopley{$from}-30*$size,$peoplex{$to}, $peopley{$to}+30*$size,$tag.$from.':'.$to);
  }
  if ($tag eq 'mother')
  {
   $c->delete($t2);
   $c->delete("jump$from:$to");
   $c->delete("jump$to:$from");
   arrowFromMother($peoplex{$from}, $peopley{$from}-30*$size,$peoplex{$to}, $peopley{$to}+30*$size,$tag.$from.':'.$to);
  }
 }
 undef @t2;
 undef @t;
 $hiddenall=1;
}
sub hideallhidden # Hide all lines on desktop which marked as hidden lines
{
 my $t2;
 foreach $t2 (keys %hidden2) 
 {
  my ($tag,$from,$to)=$t2=~/^([fathermo]+)(\d+):(\d+):s$/;
  if ($tag eq 'father')
  {
   $c->delete($tag.$from.':'.$to);
   arrowFromFather($peoplex{$from}, $peopley{$from}-30*$size,$peoplex{$to}, $peopley{$to}+30*$size,$t2);
  }
  if ($tag eq 'mother')
  {
   $c->delete($tag.$from.':'.$to);
   arrowFromMother($peoplex{$from}, $peopley{$from}-30*$size,$peoplex{$to}, $peopley{$to}+30*$size,$t2);
  }
 }
 $hiddenall=0;
}
sub arrowToFather
{
 $c->createLine(shift,shift,shift,shift,-arrow=>'last',-width=>width*$size,-tags=>shift,-fill=>'royalblue1');
}
sub arrowFromFather
{
 my $x=shift;
 my $y=shift;
 my $bx=shift;
 my $by=shift;
 my $t=shift;
 if ($arrowtype eq 'classic3')
 {
  $t=~/father(\d+):(\d+)/;
  my $from=$1;
  my $to=$2;
  my $short=0;
  if ($t=~/:s$/) {$short=1};
  my $shift=-$shift_def;
  my $px=0;
  my $linelength=20;
  foreach $a (values %mother)
  {
   if ($a=~/^$from:(\d+)$/)
   {
    $px=$peoplex{$1}; last;
   }
  }
  if ($peoplex{$to}>$px) {$shift=$shift_def}
  if ($px==0) {$shift=0}
  if ($y>($by-64*$size)) 
  {
   $c->createLine($bx,$by,$bx+1,$by+$otstup*$size,-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
   $c->createLine($x+$shift,$y,$x+$shift+1,$y-$otstup*$size,-arrow=>'first',-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
   if ($short==0) 
   {
    $c->createLine($x+$shift,$y-$otstup*$size,$bx,$by+$otstup*$size,-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
   }
   else
   {
    my $d=0;
    if (($bx-$x-$shift)!=0) 
    {
     $d=abs($y-$otstup*$size - ($by+$otstup*$size) )/abs($bx-$x-$shift);
     my $shiftx=int(sqrt($linelength*$linelength/($d*$d+1)));
     my $shiftx=-$shiftx;
     if ($bx<($x+$shift)) {$shiftx=-$shiftx}
#parrent
     $c->createLine($bx,$by+$otstup*$size,$bx+$shiftx,getLineY($x+$shift,$y-$otstup*$size,$bx,$by+$otstup*$size,$bx+$shiftx),-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
     $c->createImage($bx+$shiftx,getLineY($x+$shift,$y-$otstup*$size,$bx,$by+$otstup*$size,$bx+$shiftx), -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$from:$to");
#child
     $c->createLine($x+$shift,$y-$otstup*$size,$x+$shift-$shiftx,getLineY($x+$shift,$y-$otstup*$size,$bx,$by+$otstup*$size,$x+$shift-$shiftx),-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
     $c->createImage($x+$shift-$shiftx,getLineY($x+$shift,$y-$otstup*$size,$bx,$by+$otstup*$size,$x+$shift-$shiftx), -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$to:$from");
    }
    else
    {
     my $linelength2=$linelength;
     if (abs($by+2*$otstup*$size-$y) < $linelength) {$linelength2=10}
     $c->createLine($bx,$by+$otstup*$size,$bx,$by+$otstup*$size+$linelength2,-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
     $c->createImage($bx,$by+$otstup*$size+$linelength2, -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$from:$to");
     $c->createLine($x+$shift,$y-$otstup*$size,$x+$shift,$y-$otstup*$size-$linelength2,-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
     $c->createImage($x+$shift,$y-$otstup*$size-$linelength2, -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$to:$from");
    }
   }
  }
  else
  {
   $c->createLine($bx,$by-60*$size,$bx+1,$by-$otstup*$size-60*$size,-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
   $c->createLine($x+$shift,$y+60*$size,$x+$shift+1,$y+$otstup*$size+60*$size,-arrow=>'first',-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
   if ($short==0) 
   {
    $c->createLine($x+$shift,$y+$otstup*$size+60*$size,$bx,$by-$otstup*$size-60*$size,-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
   }
   else
   {
    if (($bx-$x-$shift)!=0) 
    {
     my $d=abs($y+2*$otstup*$size+120*$size-$by)/abs($bx-$x-$shift);
     my $shiftx=int(sqrt($linelength*$linelength/($d*$d+1)));
     my $shiftx=-$shiftx;
     if ($bx<($x+$shift)) {$shiftx=-$shiftx}
     $c->createLine($bx,$by-$otstup*$size-60*$size,$bx+$shiftx,getLineY($x+$shift,$y+$otstup*$size+60*$size,$bx,$by-$otstup*$size-60*$size,$bx+$shiftx),-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
     $c->createImage($bx+$shiftx,getLineY($x+$shift,$y+$otstup*$size+60*$size,$bx,$by-$otstup*$size-60*$size,$bx+$shiftx), -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$from:$to");
     $c->createLine($x+$shift,$y+$otstup*$size+60*$size,$x+$shift-$shiftx,getLineY($x+$shift,$y+$otstup*$size+60*$size,$bx,$by-$otstup*$size-60*$size,$x+$shift-$shiftx),-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
     $c->createImage($x+$shift-$shiftx,getLineY($x+$shift,$y+$otstup*$size+60*$size,$bx,$by-$otstup*$size-60*$size,$x+$shift-$shiftx), -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$to:$from");
    }
    else
    {
     my $linelength2=$linelength;
     if (abs($by-$y-2*($otstup*$size+60*$size)) < $linelength) {$linelength2=10}
     $c->createLine($bx,$by-$otstup*$size-60*$size,$bx,$by-$otstup*$size-60*$size-$linelength2,-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
     $c->createImage($bx,$by-$otstup*$size-60*$size-$linelength2, -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$from:$to");
     $c->createLine($x+$shift,$y+$otstup*$size+60*$size,$x+$shift,$y+$otstup*$size+60*$size+$linelength2,-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
     $c->createImage($x+$shift,$y+$otstup*$size+60*$size+$linelength2, -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$to:$from");
    }
   }
  }
 }
 if ($arrowtype eq 'classic')
 {
  $c->createLine($x,$y,$bx,$by,-arrow=>'first',-width=>width*$size,-tags=>$t,-fill=>'royalblue1');
 }
}
sub arrowToMother
{
 $c->createLine(shift,shift,shift,shift,-arrow=>'last',-width=>width*$size,-tags=>shift,-fill=>'indianred1');
}
sub arrowFromMother
{
 my $x=shift;
 my $y=shift;
 my $bx=shift;
 my $by=shift;
 my $t=shift;
 if ($arrowtype eq 'classic3')
 {
  $t=~/mother(\d+):(\d+)/;
  my $from=$1;
  my $to=$2;
  my $short=0;
  if ($t=~/:s$/) {$short=1};
  my $shift=-$shift_def;
  my $px=0;
  my $linelength=20;
  foreach $a (values %father)
  {
   if ($a=~/^$from:(\d+)$/)
   {
    $px=$peoplex{$1}; last;
   }
  }
  if ($peoplex{$to}>$px) {$shift=$shift_def}
  if ($px==0) {$shift=0}
  if ($y>($by-64*$size))
  {
   $c->createLine($bx,$by+1,$bx+1,$by+$otstup*$size,-width=>width*$size,-tags=>$t,-fill=>'indianred1');
   $c->createLine($x+$shift,$y-1,$x+$shift+1,$y-$otstup*$size,-arrow=>'first',-width=>width*$size,-tags=>$t,-fill=>'indianred1');
   if ($short==0) 
   {
    $c->createLine($x+$shift,$y-$otstup*$size,$bx,$by+$otstup*$size,-width=>width*$size,-tags=>$t,-fill=>'indianred1');
   }
   else
   {
    my $d=0;
    if (($bx-$x-$shift)!=0) 
    {
     $d=abs($y-$otstup*$size - ($by+$otstup*$size) )/abs($bx-$x-$shift);
     my $shiftx=int(sqrt($linelength*$linelength/($d*$d+1)));
     my $shiftx=-$shiftx;
     if ($bx<($x+$shift)) {$shiftx=-$shiftx}
#parrent
     $c->createLine($bx,$by+$otstup*$size,$bx+$shiftx,getLineY($x+$shift,$y-$otstup*$size,$bx,$by+$otstup*$size,$bx+$shiftx),-width=>width*$size,-tags=>$t,-fill=>'indianred1');
     $c->createImage($bx+$shiftx,getLineY($x+$shift,$y-$otstup*$size,$bx,$by+$otstup*$size,$bx+$shiftx), -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$from:$to");
#child
     $c->createLine($x+$shift,$y-$otstup*$size,$x+$shift-$shiftx,getLineY($x+$shift,$y-$otstup*$size,$bx,$by+$otstup*$size,$x+$shift-$shiftx),-width=>width*$size,-tags=>$t,-fill=>'indianred1');
     $c->createImage($x+$shift-$shiftx,getLineY($x+$shift,$y-$otstup*$size,$bx,$by+$otstup*$size,$x+$shift-$shiftx), -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$to:$from");
    }
    else
    {
     my $linelength2=$linelength;
     if (abs($by+2*$otstup*$size-$y) < $linelength) {$linelength2=10}
     $c->createLine($bx,$by+$otstup*$size,$bx,$by+$otstup*$size+$linelength2,-width=>width*$size,-tags=>$t,-fill=>'indianred1');
     $c->createImage($bx,$by+$otstup*$size+$linelength2, -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$from:$to");
     $c->createLine($x+$shift,$y-$otstup*$size,$x+$shift,$y-$otstup*$size-$linelength2,-width=>width*$size,-tags=>$t,-fill=>'indianred1');
     $c->createImage($x+$shift,$y-$otstup*$size-$linelength2, -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$to:$from");
    }
   }
  }
  else
  {
   $c->createLine($bx,$by-60*$size,$bx+1,$by-$otstup*$size-60*$size,-width=>width*$size,-tags=>$t,-fill=>'indianred1');
   $c->createLine($x+$shift,$y+60*$size,$x+$shift+1,$y+$otstup*$size+60*$size,-arrow=>'first',-width=>width*$size,-tags=>$t,-fill=>'indianred1');
   if ($short==0) 
   {
    $c->createLine($x+$shift,$y+$otstup*$size+60*$size,$bx,$by-$otstup*$size-60*$size,-width=>width*$size,-tags=>$t,-fill=>'indianred1');
   }
   else
   {
    if (($bx-$x-$shift)!=0) 
    {
     my $d=abs($y+2*$otstup*$size+120*$size-$by)/abs($bx-$x-$shift);
     my $shiftx=int(sqrt($linelength*$linelength/($d*$d+1)));
     my $shiftx=-$shiftx;
     if ($bx<($x+$shift)) {$shiftx=-$shiftx}
     $c->createLine($bx,$by-$otstup*$size-60*$size,$bx+$shiftx,getLineY($x+$shift,$y+$otstup*$size+60*$size,$bx,$by-$otstup*$size-60*$size,$bx+$shiftx),-width=>width*$size,-tags=>$t,-fill=>'indianred1');
     $c->delete("jump$from:$to");
     $c->delete("jump$to:$from");
     $c->createImage($bx+$shiftx,getLineY($x+$shift,$y+$otstup*$size+60*$size,$bx,$by-$otstup*$size-60*$size,$bx+$shiftx), -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$from:$to");
     $c->createLine($x+$shift,$y+$otstup*$size+60*$size,$x+$shift-$shiftx,getLineY($x+$shift,$y+$otstup*$size+60*$size,$bx,$by-$otstup*$size-60*$size,$x+$shift-$shiftx),-width=>width*$size,-tags=>$t,-fill=>'indianred1');
     $c->createImage($x+$shift-$shiftx,getLineY($x+$shift,$y+$otstup*$size+60*$size,$bx,$by-$otstup*$size-60*$size,$x+$shift-$shiftx), -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$to:$from");
    }
    else
    {
     my $linelength2=$linelength;
     if (abs($by-$y-2*($otstup*$size+60*$size)) < $linelength) {$linelength2=10}
     $c->createLine($bx,$by-$otstup*$size-60*$size,$bx,$by-$otstup*$size-60*$size-$linelength2,-width=>width*$size,-tags=>$t,-fill=>'indianred1');
     $c->delete("jump$from:$to");
     $c->delete("jump$to:$from");
     $c->createImage($bx,$by-$otstup*$size-60*$size-$linelength2, -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$from:$to");
     $c->createLine($x+$shift,$y+$otstup*$size+60*$size,$x+$shift,$y+$otstup*$size+60*$size+$linelength2,-width=>width*$size,-tags=>$t,-fill=>'indianred1');
     $c->createImage($x+$shift,$y+$otstup*$size+60*$size+$linelength2, -image => myPhoto(fn($workfolder.'graphics/jump'.$size.'.png')),-tags=>"jump$to:$from");
    }
   }
  }
 }
 if ($arrowtype eq 'classic')
 {
  $c->createLine($x,$y,$bx,$by,-arrow=>'first',-width=>width*$size,-tags=>$t,-fill=>'indianred1');
 }
}
sub arrowSpouse
{
 my $x=shift;
 my $y=shift;
 my $bx=shift;
 my $by=shift;
 my $t=shift;
 if ($arrowtype=~/classic/)
 {
  if ($y==$by) {$by+=1}
  $c->createLine($x,$y-$shift_spouse,$bx,$by-$shift_spouse,-tags=>'1spouse'.$t, -width=>width*$size, -fill=>'royalblue1');
  $c->createLine($x,$y+$shift_spouse,$bx,$by+$shift_spouse,-tags=>'2spouse'.$t, -width=>width*$size, -fill=>'indianred1');
 }
}
sub menugoto #go to person
{
 my $sel=shift;
 $TOP->geometry=~/^(\d+)x(\d+)\+([-]*\d+)\+([-]*\d+)$/;
 my $x=int($1/2);
 my $y=int($2/2);
 $c->xview(moveto=>($peoplex{$sel}-$x)/$xcanvas);
 $c->yview(moveto=>($peopley{$sel}-$y)/$ycanvas);
 $c->createRectangle($c->bbox('people'.$sel),-width=>2,-tags=>'markboxf',-outline=>"red");
 $findedp=1; # if set to 1 then after mouse moving red rectangle will be closed.
}

MainLoop;

sub fileDialog # file open/save/create dialog
{
 my $operation = shift;
 my $file='';
 menustateoff();
 if ($operation eq 'openfoto') 
 {
  if ($OS eq 'linux')
  {
   $file=MyFDialog(fn($photodir),$messages[52].'|*.jpg, *.png, *.bmp, *.gif, *.tif, *.tiff, *.jpeg|'.$messages[63].'|*','load');
  }
  if ($OS eq 'MSWin32')
  {
   $file=MyFDialog(fn($photodir),$messages[52].'|*.jpg, *.png, *.bmp, *.gif, *.tif, *.tiff, *.jpeg','load');
  }
  unless ($file eq '')
  {
   if ($OS eq 'linux')
   {
    my $fl=$file; $fl=~s/ /\\ /g;
    system('file '.fn($fl)." | grep 'image data'  1>/dev/null 2>/dev/null");
    if ($? == 0)
    {
     my($nn,$pp,$ee)=fileparse($fl,'');
     $pp=~s/[^a-zA-Z0-9\/\ \~\!\@\#\$\%\^\&\(\)\-\_\+\=\[\]\:\;\'\"\,\.\<\>\\\`]//g;
     $pp=~s/(\\\ )+\///g;
     $pp=~s/(\\\ )+\\//g;
     $photodir=$pp;
    }
    else {$file=''; MyMessageBox($messages[226],'ok','info'); };
   }
   if ($OS eq 'MSWin32')
   {
    my($nn,$pp,$ee)=fileparse($file,'');
     $photodir=$pp;
   }
  }
 } 
 if ($operation eq 'savefoto') 
 {
  if ($OS eq 'MSWin32')
  {
   $file=MyFDialog(fn($projects),$messages[52].'|*.ps|','save');
  }
  else
  {
   $file=MyFDialog(fn($projects),$messages[52].'|*.jpg, *.png, *.bmp, *.gif, *.tif, *.tiff, *.jpeg, *.ps|'.$messages[63].'|*','save');
  }
 } 
 if ($operation eq 'openrid')
 {
  $file=MyFDialog(fn($projects),$messages[53].'|*.rid|'.$messages[63].'|*','load');
 } 
 if ($operation eq 'openged')
 {
  $file=MyFDialog(fn($projects),$messages[53].'|*.ged|'.$messages[63].'|*','load');
 } 
 if ($operation eq 'opentar')
 {
  $file=MyFDialog(fn($projects),$messages[39].' tar|*.tar|'.$messages[63].'|*','load');
  if ($OS eq 'linux')
  {
    my $fl=$file; $fl=~s/ /\\ /g;
   system("file ".fn($fl)." | grep 'POSIX tar archive'  1>/dev/null 2>/dev/null");
   if ($? == 0)
   {
    my($nn,$pp,$ee)=fileparse($file,'');
    $photodir=$pp;
   }
  else {$file='';MyMessageBox($messages[227],'ok','info');};
  }
 } 
 if ($operation eq 'openany')
 {
  $file=MyFDialog(fn($workfolder),$messages[63].'|*','load');
 } 
 if ($operation eq 'openfile')
 {
  $file=MyFDialog(fn($workfolder),$messages[63].'|*|doc|*.doc|rtf|*.rtf|avi|*.avi|mp3|*.mp3','load');
 } 
 if ($operation eq 'create') 
 {
  $file=MyFDialog(fn($projects),$messages[53].'|*.rid|'.$messages[63].'|*','create');
 } 
 if ($operation eq 'save') 
 {
  $file=MyFDialog(fn($projects),$messages[53].'|*.rid|'.$messages[63].'|*','save');
 }
 if ($operation eq 'saveged') 
 {
  $file=MyFDialog(fn($projects),$messages[53].'|*.ged|'.$messages[63].'|*','save');
 }
 if ($operation eq 'savecsv') 
 {
  $file=MyFDialog(fn($projects),$messages[258].'|*.csv|'.$messages[63].'|*','save');
 }
 if ($operation eq 'savepdf') 
 {
  $file=MyFDialog(fn($projects),$messages[263].'|*.pdf|'.$messages[63].'|*','save');
 }
 if( $file eq '') 
 {
  menustateon();
  return cancel;
 } 
 else 
 {
  menustateon();
  return $file;
 }
}
sub menucreatefather
{
 my $r=0;
 foreach my $p (values %father)
 {
  if ($p=~/^$son\:([0-9]*)$/) {$r=1}
 } 
 if ($r==1)
 {
  MyMessageBox($messages[4],'ok','info');
 }
 else
 {
  $begin_father=1;
  arrowToFather($peoplex{$son}, $peopley{$son}-30*$size ,$bx,$by,'father'.$son);
 }
}
sub menucreatemother
{
 my $r=0;
 foreach my $p (values %mother)
 {
  if ($p=~/^$son\:([0-9]*)$/) {$r=1}
 } 
 if ($r==1)
 {
  MyMessageBox($messages[5],'ok','info');
 }
 else
 {
  $begin_mother=1;
  arrowToMother($peoplex{$son}, $peopley{$son}-30*$size ,$bx,$by,'mother'.$son);
 }
}
sub menucreatespouse
{
 $begin_spouse=1;
 my ($x1,$y1,$x2,$y2);
 if ($peoplex{$son}>$bx)
 {
  $x1=$peoplex{$son};
  $y1=$peopley{$son};
  $x2=$bx;
  $y2=$by;
 }
 else
 {
  $x2=$peoplex{$son};
  $y2=$peopley{$son};
  $x1=$bx;
  $y1=$by;
 }
 arrowSpouse($x1+78*$size,$y1,$x2-78*$size,$y2,$son);
}
sub menudeletefather
{
 my $t;
 my $t2;
 while (my ($k2,$a2)=each(%father))
 {
  $t=number1($a2);
  $t2=number2($a2);
  if (($t eq $son) || ($t2 eq $son))
  {
   $c->delete("jump$t:$t2");
   $c->delete("jump$t2:$t");
   $c->delete('father'.$father{$k2});
   $c->delete('father'.$father{$k2}.':s');
   delete $father{$k2};
  }
 }
}
sub menudeletemother
{
 my $t;
 my $t2;
 my $a2; my $k2;
 foreach $k2 (keys %mother)
 {
  $a2=$mother{$k2};
  $t=number1($a2);
  $t2=number2($a2);
  if (($t eq $son) || ($t2 eq $son))
  {
   $c->delete("jump$t:$t2");
   $c->delete("jump$t2:$t");
   $c->delete('mother'.$mother{$k2});
   $c->delete('mother'.$mother{$k2}.':s');
   delete $mother{$k2};
  }
 }
}
sub gallerylength #number of gallery items
{
 my $count=0;
 my $t=0;
 my $n;
 my $p;
 my $e;
 my $im=shift;
 if ($gallery{$im} eq '')
 {
  return 0;
 }
 open(F,'<:raw',fn($projects.$projectname.'/gallery/'.$im.'.gal'));#$
 while (<F>)
 {
  chomp($_);decode('utf8',$_);
  ($n,$p,$e)=fileparse($_,@fotoext);
  substr($n,-1)='';
  if ($t<$n) {$t=$n};
  <F>;
 }
 close(F);
 return $t;
}
sub opengallery #load gallery items for $image person. $image - global var.
{
 my $ng=0;
 @gallery=();
 @texts=();
 if (-e fn("$projects$projectname/gallery/$image.gal"))
 {
  open(FI,'<:raw',fn("$projects$projectname/gallery/$image.gal"));
  while (<FI>)
  {
   $gallery[$ng]=$_;chomp($gallery[$ng]);$gallery[$ng]=decode('utf8',$gallery[$ng]);
   $texts[$ng]=<FI>;chomp($texts[$ng]);$texts[$ng]=decode('utf8',$texts[$ng]);
   $ng++;
  }
  close(FI);
 }
}
sub savegallery #save gallery items for $image person. $image - global var.
{
 my $i=0;
 if ($gallery{$image} eq '1')
 {
  open(F,'>:raw',fn("$projects$projectname/gallery/$image.gal"));
  for ($i=0;$i<=(@gallery-1);$i++)
  {
   print F encode('utf8',$gallery[$i]);print F "\n";
   print F encode('utf8',$texts[$i]);print F "\n";
  }
  close(F);
 } else # if gallery non exist unlink all files for this gallery
 {
  if (-e fn("$projects$projectname/gallery/$image.gal"))
  {
   unlink fn("$projects$projectname/gallery/$image.gal");
  }
  unlink glob fn("$projects$projectname/gallery/$image/*.gif");
  unlink glob fn("$projects$projectname/gallery/$image/icons/*.gif");
 }
 save2(0);
}
our $balloon;
sub drawgallery #draw gallery items from @gallery.
{
 my $x;
 my $y;
 my $f;
 my $i;
 my $pos;
 my $icon;
 my $sx;
 my $sy;
 my $fs=30; #frame height
 my %bal;
 sub showpicture #show window with picture from gallery
 {
  sub resize_in
  {
    my $p=shift;
    $in_out[$p]=$bat[$p]->cget(-text);
    my $tx=$ct[$p]->screenwidth;
    my $ty=$ct[$p]->screenheight;
    my $pos=$galpage*6+$p;
    my ($name,$path,$ext)=fileparse(fn($gallery[$pos]),'');
    my ($x,$y);
    $conf[$p]=1;
    drawmessage($messages[69]);
    if ($in_out[$p]==1)
    { #resize to small size
     $cc[$p]->delete('bfoto');
     $in_out[$p]=0;
     copy(fn($projects.$projectname."/gallery/$image/$name"),fn($tmpdir.'tmp'));
     my $mic=Image::Magick->new;
     $mic->Read(fn($tmpdir.'tmp'));
     ($x,$y)=$mic->Get('columns','rows');
     $sy=$ty-$fs*2;$sx=int(($sy/$y)*$x);
     $mic->Resize(width=>$sx,height=>$sy);
     $mic->Write(fn($tmpdir."temp$p.jpeg"));
     undef $mic;
     getscreensize;
     $ct[$p]->geometry(($sx).'x'.($sy+$fs).'+'.int(($screenx-$sx)/2).'+'.int(($screeny-$sy)/2));
     $cc[$p]->configure(-width=>$sx,-height=>$sy,-scrollbars=>'',-scrollregion=>[0,0,$sx,$sy]);
     $cc[$p]->createImage(int($sx/2),int($sy/2), -anchor=>'center', -image => $ct[$p]->Photo(-file=>fn($tmpdir."temp$p.jpeg")),-tags=>'bfoto');
     $bat[$p]->configure(-image => sizePhoto2($ct[$p],fn($workfolder."graphics/out.png")));
     $balloon->attach($bat[$p], -initwait=>0,-balloonmsg=>"$messages[240]");
     $bat[$p]->configure(-text => $in_out[$p]);
    }
    else
    { #resize to full size
     $cc[$p]->delete('bfoto');
     my $mic=Image::Magick->new;
     my $f=fn($projects.$projectname."/gallery/$image/$name");
     copy($f,fn($tmpdir.'tmp'));
     $mic->Read(fn($tmpdir.'tmp'));
     ($x,$y)=$mic->Get('columns','rows');
     $mic->Write(fn($tmpdir."tmp$p.jpeg"));
     undef $mic;
     getscreensize;
     $ct[$p]->geometry($tx.'x'.$ty.'+0+0');
     $cc[$p]->configure(-width=>$x,-height=>($y),-scrollregion=>[0,0,$x,$y],-scrollbars=>'se');
     $cc[$p]->createImage(int($x/2),int($y/2), -anchor=>'center', -image => $ct[$p]->Photo(-file=>fn($tmpdir."tmp$p.jpeg")),-tags=>'bfoto');
     $bat[$p]->configure(-image => sizePhoto2($ct[$p],fn($workfolder."graphics/in.png")));
     $balloon->attach($bat[$p], -initwait=>0,-balloonmsg=>"$messages[241]");
     $in_out[$p]=1;
     $bat[$p]->configure(-text => $in_out[$p]);
    }
    $ct[$p]->update;
    $cc[$p]->update;
    $conf[$p]=0;
    deletemessage;
  }
  my $p=shift;
  $p[$p]=$p;
  $conf[$p[$p]]=0;
  my $dic=14;
  my $ic=Image::Magick->new;
  my $sx;
  my $sy;
  $block[$p[$p]]=0;
  my $pos=$galpage*6+$p[$p];
  my ($name,$path,$ext)=fileparse(fn($gallery[$pos]),'');
  drawmessage($messages[69]);
  $ct[$p[$p]]=Tk::MainWindow->new;
  my $tx=$ct[$p[$p]]->screenwidth;
  my $ty=$ct[$p[$p]]->screenheight;
  $ct[$p[$p]]->Icon(-image=>$ct[$p[$p]]->Photo(-file=>$prog_icon));
  $ct[$p[$p]]->maxsize($tx,$ty);
  $f1[$p[$p]]=$ct[$p[$p]]->Frame(-borderwidth=>"0",-relief=>"solid", -height=>'25',-padx=>0,-pady=>0)->pack(-side=>'top',-fill=>'x',-expand=>'1',-anchor=>'s');
  $f2[$p[$p]]=$ct[$p[$p]]->Frame(-borderwidth=>"0",-relief=>"solid", -padx=>0,-pady=>0)->pack(-side=>'top',-fill=>'both',-expand=>'1',-anchor=>'s');
  $ct[$p[$p]]->bind('<Destroy>'=>sub{$ct[$p[$p]]->withdraw;$ct[$p[$p]]->destroy;$co[$p[$p]]=0;$opened=0});
  $ct[$p[$p]]->fontCreate('font2',-family => "$fontsys",-size => $fsize, -weight=>'normal');
  $ct[$p[$p]]->fontCreate('fontboldp',-family => "$fontsys",-size => $fsize, -weight=>'bold');
  $balloon=$ct[$p[$p]]->Balloon(-background=>$balloon_bg,-foreground=>$balloon_fg,-font=>'fontboldp');
  my $f=fn($projects.$projectname."/gallery/$image/$name");
  copy($f,fn($tmpdir.'tmp'));
  $ic->Read(fn($tmpdir.'tmp'));
  ($x,$y)=$ic->Get('columns','rows');
  $in_out[$p[$p]]=0; #0=in 1=out;
  if (($x>$tx) || ($y>$ty)) #if size of picture greater than window size
  {
   $sy=$ty-$fs*2;$sx=int(($sy/$y)*$x);
   if ($sx>=$tx) 
   {
    $sx=$tx-50;$sy=int(($sx/$x)*$y);
   }
   $ic->Resize(width=>$sx,height=>$sy);
   $ic->Write(fn($tmpdir."temp$p[$p].jpeg"));
   undef $ic;
   my $nx=$x;
   my $ny=$y;
   if ($nx<$tx) {$tx=$nx}
   if ($ny<$ty) {$ty=$ny}
   getscreensize;
   $ct[$p[$p]]->geometry($sx.'x'.($sy+$fs).'+'.int(($screenx-$sx)/2).'+'.int(($screeny-$sx-$fs)/2));
   $cc[$p[$p]]=$f2[$p[$p]]->Scrolled(qw/Canvas -relief solid -borderwidth 0 -background white/,-scrollbars=>'',-width=>$sx,-height=>($sy),-scrollregion=>[0,0,$sx,$sy])->pack(-fill=>'both');
   $ct[$p[$p]]->update;
   $cc[$p[$p]]->createImage(int($sx/2),int($sy/2), -anchor=>'center', -image => $ct[$p[$p]]->Photo(-file=>fn($tmpdir."temp$p[$p].jpeg")),-tags=>'bfoto');
   $bat[$p[$p]]=$f1[$p[$p]]->Button(-text=>$in_out[$p[$p]], -relief=>'raised',-width=>int(18*$fsize/9),-height=>int(18*$fsize/9),-borderwidth=>2,-image=>sizePhoto2($ct[$p[$p]],fn($workfolder.'/graphics/out.png')))->pack(-side=>'left',-anchor=>'w');
   $balloon->attach($bat[$p[$p]], -initwait=>0,-balloonmsg=>"$messages[240]");
   $bat[$p[$p]]->configure(-command => sub{ resize_in($p[$p]) });
   $lab[$p[$p]]=$f1[$p[$p]]->Label(-font=>'font2',-relief=>'flat',-text =>'',-justify=>"center")->pack(-anchor=>'center', -fill=>'x');
   $ct[$p[$p]]->update;
  }
  else
  {
   $ic->Write(fn($tmpdir."temp$p[$p].jpeg"));
   undef $ic;
   getscreensize;
   $ct[$p[$p]]->geometry(($x+2).'x'.($y+$fs).'+'.int(($screenx-$x)/2).'+'.int(($screeny-$y-$fs)/2));
   $cc[$p[$p]]=$f2[$p[$p]]->Scrolled(qw/Canvas -relief solid -borderwidth 0 -background white/,-scrollbars=>'',-width=>$x,-height=>($y),-scrollregion=>[0,0,$x,$y])->pack(-fill=>'both');
   $cc[$p[$p]]->createImage(int($x/2),int($y/2), -anchor=>'center', -image => $ct[$p[$p]]->Photo(-file=>fn($tmpdir."temp$p[$p].jpeg")),-tags=>'bfoto');
   $lab[$p[$p]]=$f1[$p[$p]]->Label(-font=>'font2',-relief=>'flat',-text => '',-justify=>"center")->pack(-anchor=>'center',-fill=>'x');
   $ct[$p[$p]]->update;
   $cc[$p[$p]]->update;
   $block[$p[$p]]=1; # not resizable picture (small picture)
  }
  deletemessage;
  $cc[$p[$p]]->CanvasBind('<Configure>' => # if window resized by user 
  sub 
  {
   if ($conf[$p[$p]]==0) #conf=1 App can modifies geometry of picture window by itself
   {
    $conf[$p[$p]]=1;
    $w[$p[$p]] = shift;
    drawmessage($messages[69]);
    $mic[$p[$p]]=Image::Magick->new;
    $mic[$p[$p]]->Read(fn($tmpdir.'tmp'));
    ($x,$y)=$mic[$p[$p]]->Get('columns','rows');
    $ct[$p[$p]]->geometry=~/^(\d+)x(\d+)/;
    my ($gx,$gy)=($1,$2);
    my $tx=$ct[$p[$p]]->screenwidth;
    my $ty=$ct[$p[$p]]->screenheight;
    if (($gx>=$x) || ($gy>=$y)) # If window size greater then picture size
    {
     if ($gx>$x) {$gx=$x}
     if ($gy>$y) {$gy=$y}
     getscreensize;
     $ct[$p[$p]]->geometry(($gx).'x'.($gy+$fs).'+'.int(($screenx-$gx)/2).'+'.int(($screeny-$gy-$fs)/2));
     $cc[$p[$p]]->configure(-width=>$gx,-height=>($gy),-scrollbars=>'', -scrollregion=>[0,0,$gx,$gy]);
    }
    else
    {
     $ct[$p[$p]]->geometry=~/^(\d+)x(\d+)/;
     ($gx,$gy)=($1,$2);
     $sy=$gy-2*$fs;$sx=int(($sy/$y)*$x);
     if ($sx>=$gx)
     {
      $sx=$gx;$sy=int(($sx/$x)*$y);
     }
     unless ($block[$p[$p]]==1) {$mic[$p[$p]]->Resize(width=>$sx,height=>$sy)}
     $mic[$p[$p]]->Write(fn($tmpdir."temp$p[$p].jpeg"));
     $cc[$p[$p]]->delete('icon','bfoto');
     if ($block[$p[$p]]==1) 
     {
      getscreensize;
      $ct[$p[$p]]->geometry(($x+2).'x'.($y+$fs).'+'.int(($screenx-$x)/2).'+'.int(($screeny-$y-$fs)/2));
      $cc[$p[$p]]->configure(-width=>$x,-height=>$y);
      $cc[$p[$p]]->createImage(int($x/2),int($y/2), -anchor=>'center', -image => $ct[$p[$p]]->Photo(-file=>fn($tmpdir."temp$p[$p].jpeg")),-tags=>'bfoto');
     }
     else
     {
      getscreensize;
      $ct[$p[$p]]->geometry($sx.'x'.($sy+$fs).'+'.int(($screenx-$sx)/2).'+'.int(($screeny-$sy-$fs)/2));
      $cc[$p[$p]]->configure(-width=>$sx,-height=>($sy),-scrollbars=>'',-scrollregion=>[0,0,$sx,($sy)]);
      $cc[$p[$p]]->createImage(int($sx/2),int($sy/2), -anchor=>'center', -image => $ct[$p[$p]]->Photo(-file=>fn($tmpdir."temp$p[$p].jpeg")),-tags=>'bfoto');
      $bat[$p[$p]]->configure(-image => sizePhoto2($ct[$p[$p]],fn($workfolder."graphics/out.png")));
      $balloon->attach($bat[$p[$p]], -initwait=>0,-balloonmsg=>"$messages[240]");
      $in_out[$p[$p]]=1;
      $bat[$p]->configure(-text => $in_out[$p[$p]]);
     }
    }
    $ct[$p[$p]]->update;
    $cc[$p[$p]]->update;
    $conf[$p[$p]]=0;
    deletemessage;
   }
  });
  $cc[$p[$p]]->bind('<Destroy>'=>sub{$co[$p[$p]]=0;$opened=0});
  if ($texts[$pos] ne '')
  {
   $lab[$p[$p]]->configure(-text=>$texts[$galpage*6+$p[$p]]);
   $ct[$p[$p]]->update;
  }
  $ct[$p[$p]]->bind('<KeyPress-Escape>',sub
  {
   $ct[$p[$p]]->withdraw;
   $ct[$p[$p]]->destroy;$co[$p[$p]]=0;$opened=0;
  });
  $ct[$p[$p]]->bind('<KeyPress-Return>',sub
  {
   $ct[$p[$p]]->withdraw;
   $ct[$p[$p]]->destroy;$co[$p[$p]]=0;$opened=0;
  });
  $conf[$p[$p]]=0;
 }
 sub createpicture
 {
  my $i=shift;
  $pos=$galpage*6+$i;
  $c[$i]->delete("foto$i");
  if ($gallery[$pos])
  {
   if ($c[$i])
   {
    my ($name,$path,$ext)=fileparse($gallery[$pos],'');
    $name=~/(\d+)\.(.*)/;
    $f=$1;
    unless ($texts[$pos] eq '')
    {
     $icon=Image::Magick->new;
     my $anot=Image::Magick->new;
     my $fon=Image::Magick->new;
     $anot->Read(fn($workfolder.'graphics/annotate.gif'));
     copy(fn($projects.$projectname."/gallery/$image/icons/$f.gif"),fn($tmpdir.'tmp'));
     $icon->Read(fn($tmpdir.'tmp'));
     $fon->Read(fn($workfolder.'graphics/160X160.gif'));
     my $grav='center';if (length($texts[$pos])>28) {$grav='west';}
     $anot->Annotate(family=>'Arial',style=>'Normal',pointsize=>11,text=>$texts[$pos],gravity=>$grav);
     ($x,$y)=$icon->Get('columns','rows');
     if ($y>$x)
     {
      $y=0;$x=int(($gal_size-$x)/2);
     }
     else
     {
      $x=0;$y=int(($gal_size-$y)/2);
     }
     $fon->Composite(image=>$icon,compose=>'over',x=>$x, y=>$y);
     $fon->Composite(image=>$anot,compose=>'over',x=>'2',y=>'147');
     $fon->Write(fn($tmpdir.'tmp.jpeg'));
     $c[$i]->delete('foto$i');
     $c[$i]->createImage(int($gal_size/2),int($gal_size/2), -anchor=>'center', -image => $tl->Photo(-file => fn($tmpdir.'tmp.jpeg')),-tags=>"foto$i");
     $bal{"foto$i"}="$texts[$pos]";
     $balloon->attach($c[$i], -initwait=>0, -msg=>\%bal);

     $c[$i]->CanvasBind('<1>',sub
     {
      if ($opened==0)
      {
      if ($co[$i]==0)
      {
       my $id = $c[$i] ->type('current');
       if ($id eq 'image') 
       {
        $co[$i]=1;
        @tags=$c[$i]->gettags('current');
        if ($tags[0]=~/^foto(\d+)$/)
        {
         $opened=1;
         showpicture($1);
        }
       }
      }
      }
     });
    }
    else
    {
     $icon=Image::Magick->new;
     $bal{"foto$i"}='';
     $balloon->detach($c[$i]);
     my $fon=Image::Magick->new;
     copy(fn($projects.$projectname."/gallery/$image/icons/$f.gif"),fn($tmpdir.'tmp'));
     $icon->Read(fn($tmpdir.'tmp'));
     $fon->Read(fn($workfolder.'graphics/160X160.gif'));
     ($x,$y)=$icon->Get('columns','rows');
     if ($y>$x)
     {
      $y=0;$x=int(($gal_size-$x)/2);
     }
     else
     {
      $x=0;$y=int(($gal_size-$y)/2);
     }
     $fon->Composite(image=>$icon,compose=>'over',x=>$x, y=>$y);
     $fon->Write(fn($tmpdir.'tmp.jpeg'));
     $c[$i]->createImage(int($gal_size/2),int($gal_size/2),-anchor=>'center',image => $TOP->Photo(-file => fn($tmpdir.'tmp.jpeg')),-tags=>"foto$i");
     $c[$i]->CanvasBind('<1>',sub
     {
      if ($co[$i]==0)
      {
       my $id = $c[$i] ->type('current');
       if ($id eq 'image') 
       {
        $co[$i]=1;
        @tags=$c[$i]->gettags('current');
        if ($tags[0]=~/^foto(\d+)$/)
        {
         $opened=1;
         showpicture($1);
        }
       }
      }
     });
    }
   }
   $state[$galpage*6+$i]='active';
   $bd[$i]->configure(-state=>$state[$galpage*6+$i]);
   $ba[$i]->configure(-state=>$state[$galpage*6+$i]);
  } else 
  {
   $state[$galpage*6+$i]='disabled';
   $bd[$i]->configure(-state=>$state[$galpage*6+$i]);
   $ba[$i]->configure(-state=>$state[$galpage*6+$i]);
  }
 }
 for ($i=0;$i<6;$i++)
 {
  $co[$i]=0;
  createpicture($i);
 }
}
sub galleryraise #check and set permissions for drawing gallery buttons
{
 if ($gallery{$image} eq '')
 {
  $prevpagestat='disabled';
  $prevp->configure(-state=>$prevpagestat);
  $nextpagestat='disabled';
  $nextp->configure(-state=>$nextpagestat);
 }
 if (($galpage+1)*6 < @gallery)
 {
  $nextpagestat='active';
  $nextp->configure(-state=>$nextpagestat);
 }
 else
 {
  $nextpagestat='disabled';
  $nextp->configure(-state=>$nextpagestat);
 }
 if ($galpage>0)
 {
  $prevpagestat='active';
  $prevp->configure(-state=>$prevpagestat);
 } 
 else
 {
  $prevpagestat='disabled';
  $prevp->configure(-state=>$prevpagestat);
 } 
}
sub annotation #creating an annotation for an image in a gallery
{
 if ($annotation==1) {return}
 $annotation=1;
 $ai=shift;
 $ba[$ai]->configure(-state=>'disabled');
 getscreensize;
 my $x=$screenx;
 my $y=$screeny;
 menustateoff;
 $r[$ai]=createmw($messages[61]);
 sub exitanot
 {
  $exit{$r[$ai]}=1;
  destroymw($r[$ai]);
  savegallery;drawgallery;
 }
 $mw{$r[$ai]}->bind('<Destroy>'=>sub
 {
  $annotation=0;
  $anotwait=1;
  $ba[$ai]->configure(-state=>'active');
 });
 setgeometry(300,90,$r[$ai]);
 $mw{$r[$ai]}->minsize(300,90);
 $mw{$r[$ai]}->Label(-font=>$font{$r[$ai]},-relief=>'flat',-text => $messages[62],-justify=>"left")->pack(-expand=>1, -anchor=>'w');
 my $ent=$mw{$r[$ai]}->Entry(-font=>$font{$r[$ai]},-relief=>'sunken',-borderwidth=>2,-background=>'white',-textvariable=>\$texts[$galpage*6+$ai],-width=>"128")->pack(-expand=>1, -anchor=>'w');
 $mw{$r[$ai]}->Button(-font=>$font{$r[$ai]},-relief=>'raised',-borderwidth=>2,-text => $messages[18], -command => \&exitanot)->pack(-expand=>1, -anchor=>'e');
 $mw{$r[$ai]}->bind('<KeyPress-Return>'=> sub {exitanot});
 $ent->focusForce;
 $mw{$r[$ai]}->deiconify;
 $mw{$r[$ai]}->waitVariable(\$anotwait);
}
sub deletefoto # delete a photo from a gallery
{
 my $i=shift;
 my $pos=$galpage*6+$i;
 my $f=basename($gallery[$pos],'');
 $f=~/(.*?)\.(.*?)/;
 $f=$1;
 opengallery;
 unlink fn($gallery[$pos]);
 unlink fn("$projects$projectname/gallery/$image/icons/$f.gif");
 splice(@gallery,$pos,1);
 splice(@texts,$pos,1);
 if (@gallery==0)
 {
  unlink fn("$projects$projectname/gallery/$image.gal");
  $gallery{$image}='';save2(0);
 } else {savegallery}
 drawgallery;
}
sub galleryraise2
{
 opengallery;
 galleryraise;
}
my $te;
sub getname # Create a name from all namefields
{
 my $k=shift;
 my $s='';
 unless ($family_name{$k} eq '') {$s=$family_name{$k}}
 unless ($first_name{$k} eq '') 
 {
  unless ($family_name{$k} eq '') {$s.=' '}
  $s.=$first_name{$k};
 }
 unless ($second_name{$k} eq '') 
 {
  unless ($first_name{$k} eq '') {$s.=' '}
  $s.=$second_name{$k};
 }
 return $s;
}
our $tl1;our $tl2;
our $tl3;our $pb1;our $pb2;our $pb3;our $pb4;our $pb5;our $pb6;our $pb7;our $pb8;our $pb9;our $pb10;our $pb11;our $pb12;our $pb13;our $pb14;
our $nb;our $snb2;
our @pb;
sub disablebuttons
{
 $nb->pageconfigure('s1',-state=>'disabled');
 $snb2=$nb->pagecget('s2',-state);
 $nb->pageconfigure('s2',-state=>'disabled');
 $nb->pageconfigure('s3',-state=>'disabled');
 $pb1->configure(-state=>'disabled');
 $pb2->configure(-state=>'disabled');
 $pb3->configure(-state=>'disabled');
 $pb4->configure(-state=>'disabled');
 $pb5->configure(-state=>'disabled');
 $pb6->configure(-state=>'disabled');
 $pb7->configure(-state=>'disabled');
 $pb8->configure(-state=>'disabled');
 $pb9->configure(-state=>'disabled');
 $pb10->configure(-state=>'disabled');
 $pb11->configure(-state=>'disabled');
 $pb12->configure(-state=>'disabled');
 $pb13->configure(-state=>'disabled');
 $pb14->configure(-state=>'disabled');
 $pb[0]->configure(-state=>'disabled');
 $pb[1]->configure(-state=>'disabled');
} 
sub enablebuttons
{
 $nb->pageconfigure('s1',-state=>'normal');
 if ($snb2 eq 'normal') {$nb->pageconfigure('s2',-state=>'normal');}
 $nb->pageconfigure('s3',-state=>'normal');
 $pb1->configure(-state=>'active');
 $pb2->configure(-state=>'active');
 $pb3->configure(-state=>'active');
 $pb4->configure(-state=>'active');
 $pb5->configure(-state=>'active');
 $pb6->configure(-state=>'active');
 $pb7->configure(-state=>'active');
 $pb8->configure(-state=>'active');
 $pb9->configure(-state=>'active');
 $pb10->configure(-state=>'active');
 $pb11->configure(-state=>'active');
 $pb12->configure(-state=>'active');
 $pb13->configure(-state=>'active');
 $pb14->configure(-state=>'active');
 $pb[0]->configure(-state=>'active');
 $pb[1]->configure(-state=>'active');
}
our @project_tags;
our $n_tags;
our $canv;
our $ffe1;
our $ffe2;
our $urlw;
our $entt;
our $tagname;
our $tagmask;
our $chkmask=0;
our $mwp;
our $xc; our $yc;
our $fr;
our @frs;
#our @cfrs;
our @b1frs;
our @b2frs;
our %tagentry;
#our @scv;
sub addtagbymask
{
 my $tag=shift;
 my $mask=shift;
 if (($mask eq "*") || ($mask eq "?")) {$mask='.'.$mask}
 my $search;
 foreach $a (keys %people)
 {
  $search=$family_name{$a}.' '.$first_name{$a}.' '.$second_name{$a};
  if ($search=~/$mask/i)
  {
   unless ($tags{$a}) 
   {
    $tags{$a}=$tag;
    reloadramka($a,2)
   } 
   else 
   {
    unless ($tags{$a}=~/\b$tag\b/)
    {
     $tags{$a}=$tags{$a}.' '.$tag;
     reloadramka($a,2)
    }
   }
  }
 }
}
sub deltagbymask
{
 my $tag=shift;
 my $msk=shift;
 if (($msk eq "*") || ($msk eq "?")) {$msk='.'.$msk}
 my $search;
 foreach $a (keys %people)
 {
  $search=$family_name{$a}.' '.$first_name{$a}.' '.$second_name{$a};
  if ($search=~/$msk/)
  {
    if ($tags{$a}=~/\b$tag\b/)
    {
     $tags{$a}=~s/\b$tag\b//;
     $tags{$a}=~s/  / /g;
     reloadramka($a,2)
    }
  }
 }
}
sub inittags
{
 $n_tags=0;
 my @spl;my %tgs; foreach $a (values %tags) {@spl=split(' ',$a); foreach $b (@spl) {$tgs{$b}=1}}
 my @t=();
 foreach $a (keys %tgs) 
 {
  push(@t,$a);
  $n_tags+=1
 } 
 undef %tgs;
 @project_tags=sort @t;
}
sub edittags
{
 if ($fr) 
 {
  undef $fr;
 }
 my $s=cancel;
 $tagswait=0;
 my $allok=0;
 my $cx=5;my $cy=200;my $cyn;
 our @colors=qw/gray white black turquoise3 blue4 deeppink4 purple4 green seagreen4 green4 yellow4 gold1 darkgoldenrod3 chocolate4 red red4/;
 $mwp=createmw($messages[204]);
 my $balloon=$mw{$mwp}->Balloon(-background=>$balloon_bg,-foreground=>$balloon_fg,-font=>'fontbold'.$mwp);
 getscreensize;
 setgeometry3(270,250,$mwp);
 unless ($OS eq 'linux') {$mw{$mwp}->iconify;}
 $mw{$mwp}->configure(-padx=>5,-pady=>5);
 $mw{$mwp}->bind('<Destroy>'=>sub
 {
  $tagswait=1;
  if ($allok==0) {$s=cancel};
 });
 $mw{$mwp}->bind('<KeyPress-Escape>'=>sub
 {
  $tagswait=1;
 });
 inittags;
 sub delete_tags
 {
  my $aa=0;
  while ($aa<$n_tags)
  {
   if ($frs[$aa]) {$frs[$aa]->destroy}
   $aa+=1;
  }
  @frs=();
  %tagentry=();
#  @scv=();
  if ($fr) 
  {
   $fr->destroy;
   undef $fr;
  }
 }
 sub showtags
 {
  my @tgs=split(' ',$tags{$image});$ctl->delete('tags_pic');
  my $i=0;
  my $item;
  foreach $item (@tgs) 
  {
   unless ($item eq '')
   {
    if ($colors{$item})
    {
     $ctl->createRectangle(5+$i*11,5,13+$i*11,13,-fill=>$colors{$item},-outline=>'snow2',-tags=>'tags_pic');
     $i+=1;
    }
   }
  }
 }
 sub enternewtag
 {
  $wait=0;
  $tagname='';
  $tagmask='';
  $chkmask=0;
  $entt=createmw($messages[207]);
  my $x4=$TOP->screenwidth;
  my $y4=$TOP->screenheight;
  setgeometry3(400,110,$entt);
  $mw{$entt}->bind('<Destroy>'=>sub{$wait=1});
  my $ff1=$mw{$entt}->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid")->pack(-side=>'top',-fill=>'x',-expand=>'1',-anchor=>'s');
  my $ff11=$mw{$entt}->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid")->pack(-side=>'top',-fill=>'x',-expand=>'1',-anchor=>'s');
  my $ff21=$mw{$entt}->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid")->pack(-side=>'top',-fill=>'x',-expand=>'1',-anchor=>'s');
  $ff1->Label(-relief=>'flat',-font=>$fontbold{$entt},-text => $messages[208], -width=>'15')->pack(-side=>"left",-expand=>"0",-anchor=>"nw");
  $ffe1=$ff1->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font{$entt},-textvariable=>\$tagname,-width=>"40")->pack(-side=>"left",-anchor=>"nw");
  $ff11->Checkbutton(-padx=>0,-selectcolor=>$selectcolor,-background=>$menuback, -pady=>0,-font=>$fontbold{$entt}, -relief=>'flat', -variable=>\$chkmask, -text=>$messages[217])->pack(-side=>"left",-expand=>"0",-anchor=>"nw");
  $ff21->Label(-relief=>'flat',-font=>$fontbold{$entt},-text => $messages[220], -width=>'15')->pack(-side=>"left",-expand=>"0",-anchor=>"nw");
  $ffe2=$ff21->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font{$entt},-textvariable=>\$tagmask,-width=>"40")->pack(-side=>"left",-anchor=>"nw");
  $ffe1->focus;
  my $ff31=$mw{$entt}->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid")->pack(-side=>'top',-fill=>'x',-expand=>'1',-anchor=>'s');
  $ff31->Button(-font=>$font{$entt},-relief=>'raised',-borderwidth=>2, -text => $messages[201], -command => sub
  {
   $wait=1;
  })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
  sub entertag
  {
   $ffe1->update;
   if ($tagname ne '')
   {
    unless ($number_of_tags==20)
    {
     if ($tagname=~/ /)
     {
      MyMessageBox($messages[209],'ok','info');
      $tagname=~s/ /_/g;
     }
     my $p=0;
     foreach my $a (@project_tags)
     {
      if ($tagname eq $a)
      {
       MyMessageBox($messages[215],'ok','info');
       $p=1;last
      }
     }
     drawmessage($messages[69]);
     if ($p==0)
     {
      unless ($tags{$image}) 
      {
       $tags{$image}=$tagname;
      } 
      else 
      {
       $tags{$image}=$tags{$image}.' '.$tagname;
      }
      $number_of_tags+=1;
      if ($chkmask ne 0)
      {
       if ($tagmask ne '') # add this tag to person by mask
       {
        my $search;
        foreach my $a (keys %people)
        {
         $search=$family_name{$a}.' '.$first_name{$a}.' '.$second_name{$a};
         if (($search=~/$tagmask/i) && ($a != $image))
         {
          unless ($tags{$a}) 
          {
           $tags{$a}=$tagname;
           reloadramka($a,2)
          } 
          else 
          {
           $tags{$a}=$tags{$a}.' '.$tagname;
           reloadramka($a,2)
          }
         }
        }
       }
      }
      delete_tags;
      inittags;
      drawtags;
      deletemessage;
      $wait=1;
     }
    }
    else
    {
     MyMessageBox($messages[214],'ok','info');
    }
   }
   else
   {
    MyMessageBox($messages[210],'ok','info');
   }
  }
  $ff31->Button(-font=>$font{$entt},-relief=>'raised',-borderwidth=>2, -text => $messages[202], -command => sub
  {
   entertag;
   $wait=1;
  })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
  $mw{$entt}->bind('<KeyPress-Return>'=>sub
  {
   entertag;
   $wait=1;
  });
  $mw{$entt}->bind('<KeyPress-Escape>'=>sub
  {
   $wait=1;
  });
  $mw{$entt}->deiconify;
  $mw{$entt}->waitVariable(\$wait);
  destroymw($entt);
  undef $entt;
 }
 $a=0;
 our $s;
 our $selector=0;
 our $bff;
 sub selectcolor
 {
  $selector=1;
  my $cx=-10;$s=cancel;
  my $tag=shift;
  my $colors=createmw($messages[205]);
  my $fc=$mw{$colors}->Frame(-borderwidth=>"4",-relief=>"ridge")->pack(-side=>"bottom",-fill=>'x',-expand=>'1');
 $wait2=0;
  my $rs=20;
  if ($fsize>12) {$rs=40}
  my $ch=6*$rs+30;
  my $cw=$ch;
  my $cnv=$fc->Canvas(-height=>$ch,-width=>$cw)->pack(-side=>'top', -anchor=>'c');
  $fc->Button(-font=>$font{$colors}, -relief=>'raised',-borderwidth=>2, -text => $messages[201], -command => sub
  {
   destroymw($colors);
  })->pack(-side=>"bottom",-expand=>"0",-anchor=>'e');
  setgeometry(120+$ch,$ch+70,$colors);
  $mw{$colors}->bind('<Destroy>'=>sub
  {
   $wait2=1;
  });
  $cnv->CanvasBind('<1>' =>sub
  {
   my @tags=$cnv->gettags('current');
   $s=$tags[0];
   my $free=1;
   my $a;
   foreach $a (values %colors) { if ($a eq $colors[$s]) {$free=0}}
   if ($free==1) 
   {
    if ($s ne '') {$wait2=1;destroymw($colors)}
   }
   else
   {
    MyMessageBox($messages[203],'ok','info');
   }
  });
  my $tx=1;my $ty=1;
  my $c;
  my @col;
  my $balloon=$mw{$colors}->Balloon(-background=>$balloon_bg,-foreground=>$balloon_fg,-font=>'fontbold'.$colors);
  my %t;
  $balloon->attach($cnv, -initwait=>0,-msg=>\%t);
  my $i=15;
  while ($i>0) {$t{$i}=$messages[239];$i-=1};
  $t{0}=$messages[230];
  while ($ty<5)
  {
   while ($tx<5)
   {
    $c=$tx+($ty-1)*4-1;
    if ($c>0) 
    {
     $cnv->createRectangle($cx+$tx*($rs+10)-1,$cx+$ty*($rs+10)-1,$cx+$tx*($rs+10)+$rs+1,$cx+$ty*($rs+10)+$rs+1,-outline=>'dimgray',-width=>1, -tags=>"$c");
     $cnv->createRectangle($cx+$tx*($rs+10),$cx+$ty*($rs+10),$cx+$tx*($rs+10)+$rs,$cx+$ty*($rs+10)+$rs,-outline=>'black',-width=>1, -fill=>$colors[$c], -tags=>"$c");
    }
    $tx+=1;
   }
   $ty+=1;$tx=1;
  }
  $cnv->createRectangle($cx+$rs+10,$cx+$rs+10,$cx+1+$rs*2+10,$cx+1+$rs*2+10,-outline=>'black',-width=>2, -fill=>$colors[0], -tags=>"0");
  $cnv->createLine($cx+$rs+10,$cx+$rs+10,$cx+$rs*2+10,$cx+$rs*2+10,-width=>2, -fill=>'black', -tags=>"0");
  $cnv->createLine($cx+$rs+10,$cx+$rs*2+10,$cx+$rs*2+10,$cx+$rs+10,-width=>2, -fill=>'black', -tags=>"0");
  $mw{$colors}->deiconify;
  $mw{$colors}->waitVariable(\$wait2);
  undef $cnv;
  undef $wait2;
  $selector=0;
  if ($s ne cancel)
  {
   return $colors[$s];
  }
  return $s;
 }
 our $ff; our $ff2;
 $ff=$mw{$mwp}->Frame(-padx=>"2",-pady=>"3",-height=>'32',-borderwidth=>"0",-relief=>"solid")->pack(-side=>"bottom",-fill=>'x',-expand=>'0');
 $ff->Button(-font=>$font{$mwp},-relief=>'raised',-borderwidth=>2, -text => $messages[202], -command => sub
 {
  foreach $a (keys %tagentry)
  {
   my $old=$project_tags[$a];
   my $new=$tagentry{$a}->cget(-textvariable);
   if ($new ne $old)
   {
    my $b;
    foreach $b (keys %tags)
    {
     $tags{$b}=~s/\b$old\b/$new/;
    }
   }
  }
  $tagswait=1;
  destroymw($mwp);
 })->pack(-side=>"right",-expand=>"0");
 $bff=$ff->Button(-state=>'active',-font=>$font{$mwp},-relief=>'raised',-borderwidth=>2, -text => $messages[207], -command => sub
 {
  $bff->configure(-state=>'disabled');enternewtag;$bff->configure(-state=>'active')
 })->pack(-side=>"right",-expand=>"0");
 $ff2=$mw{$mwp}->Frame(-padx=>"2",-pady=>"3",-borderwidth=>"0",-relief=>"solid")->pack(-side=>"bottom",-fill=>'both',-expand=>'1');
 sub delete_tag
 {
    $yc=shift;$yc+=1;
    MyMessageBox($messages[216].' ('.$project_tags[$yc-1].')?','YesNo','question');
    if ($BoxResult==1)
    {
     if ($project_tags[$yc-1])
     {
      $number_of_tags-=1;
      #%colors
      $s=$colors[$yc-1];
      delete($colors{$s});
      drawmessage($messages[69]);
      inittags;
      #Notification window
      my $mess=createmw($messages[138]);
      setgeometry(400,80,$mess);
      $mw{$mess}->Label(-relief=>'flat',-font=>$font{$mess},-text=>'')->pack(-anchor=>"center");
      $mw{$mess}->Label(-relief=>'flat',-font=>$font{$mess},-text=>$messages[212])->pack(-anchor=>"center");
      $mw{$mess}->Label(-relief=>'flat',-font=>$font{$mess},-text=>$messages[213])->pack(-anchor=>"center");
      $mw{$mess}->deiconify;
      $mw{$mess}->update;
      $s=$project_tags[$yc-1];
      foreach $a (keys %tags) 
      {
     # one tag
       if ($tags{$a} eq $s) 
       {
        $tags{$a}='';
        delete($tags{$a});
        reloadramka($a,1)
       }
      # analize multitags
       if ($tags{$a}=~/^($s )(.+)$/) 
       {
        $tags{$a}=$2;
        reloadramka($a,1)
       }
       if ($tags{$a}=~/^(.+)( $s)$/) 
       {
        $tags{$a}=$1;
        reloadramka($a,1)
       }
       if ($tags{$a}=~/^(.+)( )$s( )(.+)$/) 
       {
        $tags{$a}=$1.' '.$4;
        reloadramka($a,1)
       }
      }
      # delete tag color
      $colors{$s}='';
      delete($colors{$s});
      destroymw($mess);
      delete_tags;
      inittags;
      drawtags;
      deletemessage;
     }
    }
 }
 sub select_color
 {
  $yc=shift;
  if ($project_tags[$yc])
  {
   my $rc=selectcolor;
   drawmessage($messages[69]);
   if ($rc ne cancel)
   {
    if ($rc ne 'gray') 
    {
     $colors{$project_tags[$yc]}=$rc;
     foreach $a (keys %people) #renew all peoples with tag which color changed
     {
      if ($tags{$a}=~/$project_tags[$yc]/)
      {
       reloadramka($a,2)
      }
     }
    }
    else
    {
     $colors{$project_tags[$yc]}='';
    }
    delete_tags;
    inittags;
    drawtags;
    showtags;
   }
   deletemessage;
  }
 }
sub drawtags
{
 if ($fr eq '') 
 {
  if ($n_tags>7) {$fr=$ff2->Scrolled('Frame',-borderwidth=>2,-scrollbars=>'e')->pack(-fill=>'both',-expand=>'1')}
  else {$fr=$ff2->Scrolled('Frame',-borderwidth=>2,-scrollbars=>'')->pack(-fill=>'both',-expand=>'1')}
 }
 my $aa=0;
 our $fss;
 my @subsc;
 sub make_commandc
 {
  my $var = shift;
  return sub 
  {
   $b1frs[$var]->configure(-state=>'disabled');
   $b1frs[$var]->configure(-background=>"gray");
   select_color($var);
   $b1frs[$var]->configure(-state=>'active');
   $b1frs[$var]->configure(-background=>"$colors{$project_tags[$var]}")
  }
 }

 sub make_commandc2
 {
  my $var = shift;
  return sub 
  {
   $b1frs[$var]->configure(-state=>'disabled');
   select_color($var);
   $b1frs[$var]->configure(-state=>'active') 
  }
 }
 sub make_command
 {
  my $var = shift;
  return sub 
  {
   $b2frs[$var]->configure(-state=>'disabled');
   delete_tag($var);
   $b2frs[$var]->configure(-state=>'active')
  }
 }
 while ($aa<$n_tags)
 {
  $frs[$aa]=$fr->Frame()->pack(-side=>'top');
  my $fss=0;
  if ($fsize>8) {$fss=$fsize-9};
  if ($colors{$project_tags[$aa]}) 
  {
   $b1frs[$aa]=$frs[$aa]->Button(-image =>sizePhoto2($mw{$mwp},fn($workfolder.'graphics/'."$colors{$project_tags[$aa]}".'.png')),-relief=>'flat',-borderwidth=>0)->pack(-anchor=>'nw',-side=>'left');
#   $b1frs[$aa]=$frs[$aa]->Button(-state=>'active',-relief=>'flat',-padx=>($fsize),-pady=>$fss,-activebackground=>"$colors{$project_tags[$aa]}",-borderwidth=>1,-background=>"$colors{$project_tags[$aa]}",)->pack(-anchor=>'n',-side=>'left');
   $b1frs[$aa]->configure(-command=>&make_commandc($aa));
   $balloon->attach($b1frs[$aa], -initwait=>0,-balloonmsg=>"$messages[205]");
  }
  else
  {
   $b1frs[$aa]=$frs[$aa]->Button(-image =>sizePhoto2($mw{$mwp},fn($workfolder.'graphics/nocolor.png')),-relief=>'flat',-borderwidth=>0)->pack(-anchor=>'nw',-side=>'left');
   $b1frs[$aa]->configure(-command=>&make_commandc2($aa));
   $balloon->attach($b1frs[$aa], -initwait=>0,-balloonmsg=>"$messages[205]");
  }
  $tagentry{$aa}=$frs[$aa]->Entry(-font=>$font{$mwp},-text=>$project_tags[$aa],-width=>20,-textvariable=>$project_tags[$aa])->pack(-anchor=>'n',-side=>'left',-padx=>2,-pady=>2);
  $balloon->attach($tagentry{$a}, -initwait=>0,-balloonmsg=>"$messages[229]");
  $b2frs[$aa]=$frs[$aa]->Button(-image =>sizePhoto2($mw{$mwp},fn($workfolder.'graphics/delete.png')),-relief=>'flat',-borderwidth=>-1,-padx=>($fsize-1),-pady=>$fss,)->pack(-anchor=>'n',-side=>'left');
  $b2frs[$aa]->configure(-command=>&make_command($aa));
  $balloon->attach($b2frs[$aa], -initwait=>0,-balloonmsg=>"$messages[228] '$project_tags[$aa]'");
  $aa+=1;
 }
 $fr->update;
}
 $mw{$mwp}->bind('<3>' =>sub # 1
 {
  if ($selector==0)
  {
   $xc=$canv->canvasx($Tk::event->x);
   $yc=$canv->canvasy($Tk::event->y);
   $cyn=int($cy*$size{$mwp});
   if (($xc>$cyn) && ($xc<($cyn+10)))
   {
    delete_tag;
   }
   if (($xc>5) && ($xc<40))
   {
    select_color;
   }
  }
 },);
 drawtags;
 unless ($OS eq 'linux') {$mw{$mwp}->update}
 $mw{$mwp}->deiconify;
 $mw{$mwp}->waitVariable(\$tagswait);
}
sub selecttags
{
 my $s=cancel;
 my $tagswait=0;
 my $allok=0;
 my $mwp=createmw($messages[206]);
 getscreensize;
 setgeometry3(220,280,$mwp);
 unless ($OS eq 'linux') {$mw{$mwp}->iconify;}
 $mw{$mwp}->configure(-padx=>5,-pady=>5);
 $mw{$mwp}->bind('<Destroy>'=>sub
 {
  $tagswait=1;
  if ($allok==0) {$s=cancel};
 });
 $mw{$mwp}->bind('<KeyPress-Escape>'=>sub
 {
  $tagswait=1; destroymw($mwp);
 });
 my $tiler=$mw{$mwp}->Scrolled('Tiler');
 my %mytags=();my $a; my @t=();
 foreach $a (values %tags) {@t=split(' ',$a);foreach $a (@t) {$mytags{$a}=1}}
 my $i=0;
 my @t=();
 my @tt;
 my $b;
 my %name=();
 my %t=();
 foreach $a (keys %mytags) 
 {
  @tt=split(' ',$tags{$image});foreach $b (@tt) {if ($b eq $a) {$t[$i]=1}}
  $name{$i}=$a;
  $tiler->Manage($tiler->Checkbutton(-selectcolor=>$selectcolor,-background=>$menuback, -font=>$font{$mwp},-text=>$a,-variable=>\$t[$i], -relief=>'flat', -anchor=>'w', -width=>80));
  $i+=1;
 }
 our $max_tags=$i;
 $tiler->pack(-anchor=>'w',-fill=>'x');
 $mw{$mwp}->Button(-font=>$font{$mwp},-relief=>'raised',-borderwidth=>2, -text => $messages[18], -command => sub
 {
  $a=0;$s='';
  while ($a<$max_tags)
  {
   if ($t[$a]==1) 
   {
    if ($s eq '') {$s=$name{$a}} else {$s.=" $name{$a}"}
   }
   $a+=1;
  }
  $allok=1;$tagswait=1; destroymw($mwp);
 })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
 unless ($OS eq 'linux') { $mw{$mwp}->update}
 $mw{$mwp}->deiconify;
 $mw{$mwp}->waitVariable(\$tagswait);
 undef $mwp;
 undef $tagswait;
 return $s;
}
our $bf20tll;
our $b2f20tll;
sub menuproperties #edit current person data(name, dates, galleries...)
{
 my $f4tl;
 my $f4tlu;
 my $f4tlt;
 my $shppl;
 my $shpplf;
 my $list;
 my @e;
 my $filter='';
 my @sa=();
 my $sp;
 my $md;
 my $mp;
 my $batdel;
 my $stat;
 my $ns=0;
 my $key;
 my ($t1,$t2,$t3,$t11,$t12,$t13);
 my $g=$TOP->geometry;
 $g=~/([0-9]+)x([0-9]+)\+([-]*[0-9]+)\+([-]*[0-9]+)$/;
 my $x=$1; my $y=$2; my $l=$3; my $t=$4;
 sub showpeople
 {
  $pplwait=0;
  sub setlist
  {
   my $f=shift;
   my @ppl=();
   my $s;my $k;my $i=0; my $adds;
   foreach $k (keys %people)
   {
    $s=getname($k);
    if ($s=~/$filter/)
    {
     if ($k<10) {$adds='000'}
     if (($k>9) && ($k<100)) {$adds='00'}
     if (($k>99) && ($k<1000)) {$adds='0'}
     $ppl[$i]=$adds.$k.'.'.$s;
     $i++;
    }
   }
   @sorted=sort {$b cmp $a} @ppl;
   foreach $k (@sorted) 
   {
    $k=~/^[0]+(.+)/;
    $list->insert(0, $1);
   }
   $list->update;
   $list->activate(0);
  }
  sub enterppl
  {
   $showlink='false';$linkbut=0;
   $te->tagConfigure('flink',-foreground=>'blue',-elide=>$showlink,-font=>'fontlink');
   $te->tagConfigure('flink_u',-foreground=>$underlink,-underline=>1, -elide=>'false',-font=>'fontlink');
   $pplresult=$list->get('active');
   $pplresult=~/^(\d+)\.(.*?)$/;
   my $nameppl=$2;
   my $ind=$1;
   $te->insert('insert','<a name=\'indi\' href=\'indi'.$ind.'.html\'>','flink');
   $te->insert('insert',$nameppl,'flink_u');
   $te->insert('insert','</a>','flink');
   $text{$image}=$te->get('0.0','end');
   $pplwait=1;
   destroymw($shppl);
   $tl->update;
  }
  disablebuttons;
  $shppl=createmw($messages[163]);
  $mw{$shppl}->geometry('+'.(int (($x-660)/2)+$l+50).'+'.(int (($y-520)/2)+$t+25));
  $mw{$shppl}->bind('<Destroy>'=>sub{$pplwait=1;enablebuttons;reloadramka($image,1);});
  $shpplf=$mw{$shppl}->Frame(-padx=>"2",-pady=>"3",-borderwidth=>"0",-relief=>"solid")->pack(-side=>"bottom",-fill=>'x',-expand=>'1');
  $shpplf->Label(-relief=>'flat',-font=>$fontbold{$shppl},-text => $messages[164], -width=>'40')->pack(-anchor=>"n",-expand=>"0");
  $list = $shpplf->Scrolled(qw/Listbox -setgrid 1 -scrollbars oe -font/, $font{$shppl})->pack(qw/-expand yes -fill both/);
  $shpplf->Button(-relief=>'raised',-borderwidth=>2, -text=>$messages[18],-font=>$font{$shppl}, -command => sub
  {
   enterppl;
  })->pack(-padx=>'5',-expand=>'0',-anchor=>"n",-side=>'right');
  my $ff=$mw{$shppl}->Frame(-borderwidth=>"0",-relief=>"solid", -height=>'40',-padx=>0,-pady=>3)->pack(-side=>'top',-fill=>'x',-expand=>'1',-anchor=>'s');
  $ff->Label(-font=>$font{$shppl},-relief=>'flat',-text=>$messages[78])->pack(-side=>"left",-expand=>"0",-anchor=>"nw");
  my $fent=$ff->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font{$shppl},-textvariable=>\$filter,-width=>"20")->pack(-expand=>'0',-side=>"left",-padx=>'5',-anchor=>"nw");
  my  $fbl=$ff->Button(-relief=>'raised',-borderwidth=>2, -image =>sizePhoto2($mw{$shppl},fn($workfolder.'graphics/find.png')), -command => sub
  {
   $list->delete(0,'end');
   setlist($filter);
  })->pack(-padx=>2,-side=>"left",-padx=>'5',-expand=>'0',-anchor=>"nw");
  $fbl->focus;
  $fent->bind('<KeyPress-Return>'=>sub
  {
   $list->delete(0,'end');
   setlist($filter);
  });
  setlist($filter);
  $mw{$shppl}->deiconify;
  $list->bind('<Double-ButtonRelease-1>'=>sub
  {
   enterppl;
  });
  $list->bind('<KeyPress-Escape>'=>sub
  {
   $pplwait=1;
   destroymw($shppl);
  });
  $mw{$shppl}->waitVariable(\$pplwait);
 }
 sub urlstate
 {
  if ($showlink eq 'false') {$showlink='true';$linkbut=1;} else {$showlink='false';$linkbut=0;}
  $te->tagConfigure('flink',-foreground=>'blue',-elide=>$showlink,-font=>'fontlink');
  $te->tagConfigure('flink_u',-foreground=>$underlink,-underline=>1, -elide=>'false',-font=>'fontlink');
  $tl->update;
 }
 my $url='http://';
 my $urlname='';
# my $urlw;
 sub enterurl
 {
  unless (($url eq 'http://') || ($urlname eq ''))
  {
   $showlink='false';$linkbut=0;
   $te->tagConfigure('flink',-foreground=>'blue',-elide=>$showlink,-font=>'fontlink');
   $te->tagConfigure('flink_u',-foreground=>$underlink,-underline=>1, -elide=>'false',-font=>'fontlink');
   $te->insert('insert','<a name=\'www\' href=\''.$url.'\'>','flink');
   $te->insert('insert',$urlname,'flink_u');
   $te->insert('insert','</a>','flink');
   $text{$image}=$te->get('0.0','end');
   $urlwait=1;
   destroymw($urlw);
   $tl->update;
  } else {MyMessageBox($messages[167],'ok','info');}
 }
 sub enterfile
 {
  unless (($url eq '') || ($urlname eq ''))
  {
   $showlink='false';$linkbut=0;
   $te->tagConfigure('flink',-foreground=>'blue',-elide=>$showlink,-font=>'fontlink');
   $te->tagConfigure('flink_u',-foreground=>$underlink,-underline=>1, -elide=>'false',-font=>'fontlink');
   $te->insert('insert','<a name=\'file\' href=\''.$url.'\'>','flink');
   $te->insert('insert',$urlname,'flink_u');
   $te->insert('insert','</a>','flink');
   $text{$image}=$te->get('0.0','end');
   $urlwait=1;
   destroymw($urlw);
   $tl->update;
  } else {MyMessageBox($messages[167],'ok','info');}
 }
 sub seturl
 {
  disablebuttons;
  $urlwait=0;
  $url='http://';
  $urlname='';
  $urlw=createmw($messages[163]);
  setgeometry(500,100,$urlw);
  $mw{$urlw}->bind('<Destroy>'=>sub{enablebuttons;$urlwait=1});
  my $ff=$mw{$urlw}->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid")->pack(-side=>'top',-fill=>'x',-expand=>'1',-anchor=>'s');
  $ff->Label(-relief=>'flat',-font=>$fontbold{$urlw},-text => $messages[165], -width=>'15')->pack(-side=>"left",-expand=>"0",-anchor=>"nw");
  my $ffe1=$ff->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font{$urlw},-textvariable=>\$urlname,-width=>"40")->pack(-side=>"left",-anchor=>"nw");
  $ffe1->focus;
  my $ff2=$mw{$urlw}->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid")->pack(-side=>'top',-fill=>'x',-expand=>'1',-anchor=>'s');
  $ff2->Label(-font=>$fontbold{$urlw},-relief=>'flat',-text=>$messages[166], -width=>'15')->pack(-side=>"left",-expand=>"0",-anchor=>"nw");
  my $ffe2=$ff2->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font{$urlw},-textvariable=>\$url,-width=>"40")->pack(-side=>"left",-anchor=>"nw");
  my $ff3=$mw{$urlw}->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid")->pack(-side=>'top',-fill=>'x',-expand=>'1',-anchor=>'s');
  $ff3->Button(-font=>$font{$urlw},-relief=>'raised',-borderwidth=>2, -text => $messages[19], -command => sub
  {
   $urlwait=1;
   destroymw($urlw);
  })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
  $ff3->Button(-font=>$font{$urlw},-relief=>'raised',-borderwidth=>2, -text => $messages[18], -command => sub
  {
   enterurl
  })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
  $mw{$urlw}->bind('<KeyPress-Return>'=>sub
  {
   enterurl
  });
  $mw{$urlw}->bind('<KeyPress-Escape>'=>sub
  {
   $urlwait=1;
   destroymw($urlw);
  });
  $mw{$urlw}->deiconify;
  $mw{$urlw}->waitVariable(\$urlwait);
 }
 sub setfile
 {
  disablebuttons;
  $urlwait=0;
  $url='';
  $urlname='';
  $urlw=createmw($messages[168]);
  setgeometry2(500,100,$urlw);
  $mw{$urlw}->bind('<Destroy>'=>sub{enablebuttons;$urlwait=1});
  my $ff=$mw{$urlw}->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid")->pack(-side=>'top',-fill=>'x',-expand=>'1',-anchor=>'s');
  $ff->Label(-relief=>'flat',-font=>$fontbold{$urlw},-text => $messages[165], -width=>'15')->pack(-side=>"left",-expand=>"0",-anchor=>"nw");
  my $ffe1=$ff->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font{$urlw},-textvariable=>\$urlname,-width=>"40")->pack(-side=>"left",-anchor=>"nw");
  $ffe1->focus;
  my $ff2=$mw{$urlw}->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid")->pack(-side=>'top',-fill=>'x',-expand=>'1',-anchor=>'s');
  $ff2->Label(-font=>$fontbold{$urlw},-relief=>'flat',-text=>$messages[166], -width=>'15')->pack(-side=>"left",-expand=>"0",-anchor=>"nw");
  my $ffe2=$ff2->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font{$urlw},-textvariable=>\$url,-width=>"40")->pack(-side=>"left",-anchor=>"nw");
  $ff2->Button(-relief=>'raised',-borderwidth=>2, -image => sizePhoto2($mw{$urlw},fn($workfolder.'graphics/open.png')), -command => sub
  {
   my $file=fileDialog('openfile');
   unless ($file eq cancel)
   {
    $url=$file;
   }
  })->pack(-padx=>5, -side=>"left",-expand=>"0",-anchor=>'s');
  my $ff3=$mw{$urlw}->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid")->pack(-side=>'top',-fill=>'x',-expand=>'1',-anchor=>'s');
  $ff3->Button(-font=>$font{$urlw},-relief=>'raised',-borderwidth=>2, -text => $messages[19], -command => sub
  {
   $urlwait=1;
   destroymw($urlw);
  })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
  $ff3->Button(-font=>$font{$urlw},-relief=>'raised',-borderwidth=>2, -text => $messages[18], -command => sub
  {
   enterfile
  })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
  $mw{$urlw}->bind('<KeyPress-Return>'=>sub
  {
   enterfile
  });
  $mw{$urlw}->bind('<KeyPress-Escape>'=>sub
  {
   $urlwait=1;
   destroymw($urlw);
  });
  $mw{$urlw}->deiconify;
  $mw{$urlw}->waitVariable(\$urlwait);
 }
 sub exitprop #exit from this toplevel
 {
  $text{$image}=$te->get("0.0","end");
  $tl->withdraw;
  $tl->destroy;
  $tl='';
  reloadramka($image,1);
  my ($oldx,$t)=$c->xview;
  my ($oldy,$t)=$c->yview;
  $TOP->geometry=~/^(\d+)x(\d+)\+([-]*\d+)\+([-]*\d+)$/;
  my $x=int($1/2);
  my $y=int($2/2);
  my $a=20; #count of moves
  my $dx=int(($x-($peoplex{$image}-$oldx*$xcanvas))/$a); #dx of 1 move
  my $dy=int(($y-($peopley{$image}-$oldy*$ycanvas))/$a); #dy of 1 move
  while ($a>=0)
  {
   $c->xview(moveto=>($peoplex{$image}+$dx*$a-$x)/$xcanvas);
   $c->yview(moveto=>($peopley{$image}+$dy*$a-$y)/$ycanvas);
   $c->update;
   $a-=1;
  }
 }
 my $a;
 $galpage=0;
 menustateoff(); 
 @state=('disabled','disabled','disabled','disabled','disabled','disabled');
 while (($key,$a) = each(%spouse))
 {
  if (($a=~/^$image\:(\d+)$/) || ($a=~/^(\d+)\:$image$/))
  {
   $ns++;
   $sa[$ns]=$1;
   if ($ns==1) {$ssp=$key;}
  }
 }
 menustateoff;
 $tl=$TOP->Toplevel;
 $balloon=$tl->Balloon(-background=>$balloon_bg,-foreground=>$balloon_fg,-font=>'fontbold');
 $tl->title($messages[17]);
 $tl->bind('<KeyPress-Escape>',sub
 {
  &exitprop;
 });
 $tl->geometry(int(660*$fsize/9)."x".int(520*(0.5+$fsize/18))."+".(int(($x-660*$fsize/9)/2)+$l).'+'.(int (($y-520*$fsize/9)/2)+$t));
 $tl->minsize(660,520);
 $tl->Icon(-image=>$tl->Photo(-file=>$prog_icon));
 $nb=$tl->NoteBook(-font=>'font')->pack(-fill=>'both',-expand=>1);
 $nb->bind('<Destroy>'=>sub 
 {
  while (chomp($text{$image})>0){};#delete all "\n" in end of text
  createramka($image);
  $c->delete('people'.$image);
  $c->createImage($peoplex{$image},$peopley{$image}, -image => myPhoto($projects.$projectname."/".$image.".gif"), -tags => 'people'.$image);#$
  if ($gallery{$image} eq '1')
  {
   savegallery;
  }
  unlink glob fn($tmpdir.'*.jpeg');
  reloadramka($image,1);
  menustateon;
  $tl='';
 });
 $tl1=$nb->add('s1',-label=>$messages[36],-state=>'normal');
 if ($ns==0) 
 {
  $tl2=$nb->add('s2',-label=>$messages[35],-state=>'disabled');
 }
 else
 {
  $tl2=$nb->add('s2',-label=>$messages[35],-state=>'normal');
 }
 $tl3=$nb->add('s3',-label=>$messages[23],-state=>'normal', -raisecmd=>\&galleryraise2);
 my $f1t3=$tl3->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid", -height=>"26", -width=>"596")->pack(-side=>"bottom",-fill=>'x',-expand=>'1');
 $pb11=$f1t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-text => $messages[18], -command => \&exitprop)->pack(-side=>"right",-expand=>"0",-anchor=>'s');
 $nextp=$f1t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$nextpagestat,-text => $messages[56], -command => sub 
 { 
  $galpage++;
  opengallery;
  drawgallery;
  galleryraise;
 })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
 $prevp=$f1t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$prevpagestat,-text => $messages[57], -command => sub 
 { 
  $galpage--;
  opengallery;
  drawgallery;
  galleryraise;
 })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
 my $bt;
 $bt=$f1t3->Button(-state=>'active',-relief=>'raised',-borderwidth=>2,-font=>$font,-text => $messages[58], -command => sub 
 { 
  $bt->configure(-state=>'disabled');
  my $ng=gallerylength($image);
  if ($ng==0)
  {
   unless (-e fn("$projects$projectname/gallery/")) {mkdir(fn("$projects$projectname/gallery/"))}
   unless (-e fn("$projects$projectname/gallery/$image")) {mkdir(fn("$projects$projectname/gallery/$image"))}
   unless (-e fn("$projects$projectname/gallery/$image/icons/")) {mkdir(fn("$projects$projectname/gallery/$image/icons/"))}
   $gallery{$image}='1';
  }
  my $file=fileDialog("openfoto");
  unless ($file eq cancel)
  {
   $ng++;
   my ($name,$path,$ext)=fileparse($file,@fotoext);

   copy(fn($file),fn("$projects$projectname/gallery/$image/$ng.$ext"));
   open(F,'>>:raw',fn("$projects$projectname/gallery/".$image.".gal"));
   print F "$projects$projectname/gallery/$image/$ng.$ext";print F "\n";
   print F "\n";
   close(F);$gallery{$image}='1';
   my $icon=Image::Magick->new;
   my $sx;
   my $sy;
   copy(fn($file),fn($tmpdir.'tmp'));
   $icon->Read(fn($tmpdir.'tmp'));
   ($x, $y)=$icon->Get('columns','rows');
   if ($y>=$x) {$sy=$gal_size;$sx=int (($sy/$y)*$x)}
   else {$sx=$gal_size;$sy=int (($sx/$x)*$y)}
   unless (($sx==$x) && ($sy==$y)) {$icon->Resize(width=>$sx,height=>$sy)}
   $icon->Write(fn($tmpdir.'tmp'));
   copy(fn($tmpdir.'tmp'),fn("$projects$projectname/gallery/$image/icons/$ng.gif"));
   opengallery;
   if (@gallery>$galpage*6+6) {$galpage++}
   drawgallery;
   galleryraise;
  }
  $bt->configure(-state=>'active');
 })->pack(-side=>"left",-expand=>"0",-anchor=>'s');
 my $f2t3=$tl3->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid", -height=>"526")->pack(-side=>"bottom",-fill=>'x',-expand=>'1');
 my $f22t3=$f2t3->Frame(-padx=>"2",-pady=>"2",-borderwidth=>'1',-relief=>"solid", -height=>"210", -width=>"640")->pack(-side=>"bottom");
 my $f221t3=$f22t3->Frame(-padx=>'1',-pady=>'1',-borderwidth=>'1',-relief=>"solid", -height=>"180", -width=>"180")->pack(-side=>"left",-expand=>'1',-fill=>'x');
 $c[3]=$f221t3->Canvas(-width=>160,-height=>160,-background=>"white",-borderwidth=>'1',-relief=>"raised")->pack(-side=>'top',-anchor=>"n");
 $c[3]->configure(-scrollregion=>[0,0,160,160]);
 $bd[3]=$f221t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$state[3],-text => $messages[37], -command => sub
 {
  deletefoto(3);
 })->pack(-side=>"right",-expand=>'1',-anchor=>'s'); 
 $ba[3]=$f221t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$state[3],-text => $messages[60], -command => sub
 {
  annotation(3);
 })->pack(-side=>"right",-expand=>'1',-anchor=>'s'); 
 my $f222t3=$f22t3->Frame(-padx=>'1',-pady=>'1',-borderwidth=>'1',-relief=>"solid", -height=>"180", -width=>"180")->pack(-side=>"left",-expand=>'1',-fill=>'x');
 $c[4]=$f222t3->Canvas(-width=>160,-height=>160,-background=>"white",-borderwidth=>'1',-relief=>"raised")->pack(-side=>'top',-anchor=>"n");
 $c[4]->configure(-scrollregion=>[0,0,160,160]);
 $bd[4]=$f222t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$state[4],-text => $messages[37], -command => sub
 {
  deletefoto(4);
 })->pack(-side=>"right",-expand=>'1',-anchor=>'s'); 
 $ba[4]=$f222t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$state[4],-text => $messages[60], -command => sub
 {
  annotation(4);
 })->pack(-side=>"right",-expand=>'1',-anchor=>'s'); 
 my $f223t3=$f22t3->Frame(-padx=>'1',-pady=>'1',-borderwidth=>'1',-relief=>"solid", -height=>"180", -width=>"180")->pack(-side=>"left",-expand=>'1',-fill=>'x');
 $c[5]=$f223t3->Canvas(-width=>160,-height=>160,-background=>"white",-borderwidth=>'1',-relief=>"raised")->pack(-side=>'top',-anchor=>"n");
 $c[5]->configure(-scrollregion=>[0,0,160,160]);
 $bd[5]=$f223t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$state[5],-text => $messages[37], -command => sub
 {
  deletefoto(5);
 })->pack(-side=>"right",-expand=>'1',-anchor=>'s'); 
 $ba[5]=$f223t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$state[5],-text => $messages[60], -command => sub
 {
  annotation(5);
 })->pack(-side=>"right",-expand=>'1',-anchor=>'s'); 
 my $f21t3=$f2t3->Frame(-padx=>"2",-pady=>"2",-borderwidth=>'1',-relief=>"solid", -height=>"210", -width=>"640")->pack(-side=>"bottom");
 my $f211t3=$f21t3->Frame(-padx=>'1',-pady=>'1',-borderwidth=>'1',-relief=>"solid", -height=>"180", -width=>"180")->pack(-side=>"left",-expand=>'1',-fill=>'x');
 $c[0]=$f211t3->Canvas(-width=>160,-height=>160,-background=>"white",-borderwidth=>'1',-relief=>"raised")->pack(-side=>'top',-anchor=>"n");
 $c[0]->configure(-scrollregion=>[0,0,160,160]);
 $bd[0]=$f211t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$state[0],-text => $messages[37], -command => sub
 {
  deletefoto(0);
 })->pack(-side=>"right",-expand=>'1',-anchor=>'s'); 
 $ba[0]=$f211t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$state[0],-text => $messages[60], -command => sub
 {
  annotation(0);
 })->pack(-side=>"right",-expand=>'1',-anchor=>'s'); 
 my $f212t3=$f21t3->Frame(-padx=>'1',-pady=>'1',-borderwidth=>'1',-relief=>"solid", -height=>"180", -width=>"180")->pack(-side=>"left",-expand=>'1',-fill=>'x');
 $c[1]=$f212t3->Canvas(-width=>160,-height=>160,-background=>"white",-borderwidth=>'1',-relief=>"raised")->pack(-side=>'top',-anchor=>"n");
 $c[1]->configure(-scrollregion=>[0,0,160,160]);
 $bd[1]=$f212t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$state[1],-text => $messages[37], -command => sub
 {
  deletefoto(1);
 })->pack(-side=>"right",-expand=>'1',-anchor=>'s'); 
 $ba[1]=$f212t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$state[1],-text => $messages[60], -command => sub
 {
  annotation(1);
 })->pack(-side=>"right",-expand=>'1',-anchor=>'s'); 
 my $f213t3=$f21t3->Frame(-padx=>'1',-pady=>'1',-borderwidth=>'1',-relief=>"solid", -height=>"180", -width=>"180")->pack(-side=>"left",-expand=>'1',-fill=>'x');
 $c[2]=$f213t3->Canvas(-width=>160,-height=>160,-background=>"white",-borderwidth=>'1',-relief=>"raised")->pack(-side=>'top',-anchor=>"n");
 $c[2]->configure(-scrollregion=>[0,0,160,160]);
 $bd[2]=$f213t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$state[2],-text => $messages[37], -command => sub
 {
  deletefoto(2);
 })->pack(-side=>"right",-expand=>'1',-anchor=>'s'); 
 $ba[2]=$f213t3->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$state[2],-text => $messages[60], -command => sub
 {
  annotation(2);
 })->pack(-side=>"right",-expand=>'1',-anchor=>'s'); 
 if ($gallery{$image} eq '1')
 {
  opengallery;
  drawgallery;
 }
 my $f1t2=$tl2->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid", -height=>"26", -width=>"596")->pack(-side=>"bottom",-fill=>'x',-expand=>'1');
 $pb10=$f1t2->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-text => $messages[18], -command => \&exitprop)->pack(-side=>"right",-expand=>"0",-anchor=>'s');
 $f1t2->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-text => $messages[37], -command => sub
 { 
  $c->delete('1spouse'.$spouse{$ssp});
  $c->delete('2spouse'.$spouse{$ssp});
  delete $spouse{$ssp};
  exitprop;
 })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
 my $f2t2=$tl2->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid", -height=>"50", -width=>"656")->pack(-side=>"bottom",-fill=>'x',-expand=>'1');
 my $f21t2=$f2t2->Frame(-borderwidth=>"0",-relief=>"solid", -height=>"20", -width=>"446")->pack(-side=>'top',-fill=>'x',-expand=>'1');
 $f21t2->Label(-relief=>'flat',-font=>$fontbold,-text => $messages[27],-width=>"10")->pack(-side=>"left",-anchor=>"n",-expand=>"0");
 $md=$f21t2->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font,-textvariable=>\$marr_date{$ssp},-width=>"20")->pack(-side=>"left",-anchor=>"n",-fill=>'x',-expand=>"0");
 my $f22t2=$f2t2->Frame(-borderwidth=>"0",-relief=>"solid", -height=>"20", -width=>"446")->pack(-side=>'top',-fill=>'x',-expand=>'1');
 $f22t2->Label(-relief=>'flat',-font=>$fontbold,-text => $messages[28],-width=>"10")->pack(-side=>"left",-anchor=>"n",-expand=>"0");
 $mp=$f22t2->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font,-textvariable=>\$marr_place{$ssp},-width=>"20")->pack(-side=>"left",-anchor=>"n",-fill=>'x',-expand=>"0");
 $pb4=$t11=$f22t2->Button(-state=>'active',-relief=>'raised',-borderwidth=>2,-font=>$font,-image=>sizePhoto2($TOP,fn($workfolder.'/graphics/www-add.png')),-command=>sub
 {
  $t11->configure(-state=>'disabled');
  showtowns($marr_place{$ssp});
  $marr_place{$ssp}=$townresult;
  $mp->configure(-textvariable=>\$marr_place{$ssp});
  $t11->configure(-state=>'active')
 })->pack(-padx=>2,-side=>"left",-anchor=>"n",-expand=>'0');
 $balloon->attach($pb4, -initwait=>0,-balloonmsg=>"$messages[231]");
 $pb5=$t1=$f22t2->Button(-state=>'active',-relief=>'raised',-borderwidth=>2,-font=>$font,-image=>sizePhoto2($TOP,fn($workfolder.'/graphics/www-edit.png')),-command=>sub
 {
  $t1->configure(-state=>'disabled');
  edittowns($marr_place{$ssp});
  $t1->configure(-state=>'active')
 })->pack(-side=>"left",-anchor=>"n",-expand=>'0');
 $balloon->attach($pb5, -initwait=>0,-balloonmsg=>"$messages[232]");
 $md->configure(-textvariable=>\$marr_date{$ssp});
 $mp->configure(-textvariable=>\$marr_place{$ssp});
 my $f3t2=$tl2->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid", -height=>"466", -width=>"656")->pack(-side=>"bottom",-fill=>'x',-expand=>'1');
 $f3t2->Label(-relief=>'flat',-font=>$fontbold,-text => $messages[80])->pack(-side=>'top',-anchor=>"w",-expand=>"0");
 my $lb=$f3t2->Scrolled("Listbox",-height=>18,-font=>$font,-scrollbars=>'oe',-selectmode => "single",-background=>'white')->pack(-fill=>'x',-expand=>1);
 my $i=1;
 foreach my $a (@sa)
 {
  if ($a ne '') {$lb->insert('end',"$i.$family_name{$a} $first_name{$a} $second_name{$a}");$i+=1}
 }
 my $t2l=$f3t2->Label(-relief=>'flat',-font=>$fontbold,-text => $messages[81],-justify=>"left")->pack(-side=>'top',-anchor=>"w",-expand=>"0");
 $lb->activate(0);
# $lb->focus;
 $lb->bind('<ButtonRelease-1>'=>sub
 {
  my $f=$lb->get('active');
  $f=~/^\d+\.(.+)$/;$f=$1;
  foreach $a (@sa)
  {
   if ($f eq "$family_name{$a} $first_name{$a} $second_name{$a}") {$sp=$a;last}
  }
  while(($key, $a) = each(%spouse))
  {
   if (($a eq "$image:$sp") || ($a eq "$sp:$image"))
   {
    $ssp=$key;
    $md->configure(-textvariable=>\$marr_date{$ssp});
    $mp->configure(-textvariable=>\$marr_place{$ssp});
    last;
   }
  }
 });
 my $f3tl=$tl1->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid", -height=>"46", -width=>"596")->pack(-side=>"bottom",-fill=>'x',-expand=>'1');
 $csex=$messages[34];
 if ($sex{$image} eq 'man') {$csex=$messages[33]}
 my $csxb;my $pbi=0;
 foreach ($messages[33],$messages[34])
 {
  $pb[$pbi]=$csxb=$f3tl->Radiobutton(-font=>$font,-selectcolor=>$selectcolor,-text=> $_,-value=>$_,-relief=>'flat',-variable =>\$csex,-command=>sub 
  {
   my $csx='man';my $eq=0;
   if ($csex eq $messages[34]) {$csx='woman'}
   foreach my $a (values %spouse)
   {
    $a=~/^(\d+)\:(\d+)$/;
    if ($1 == $image)
    {
     if ($sex{$2} eq $csx)
     {
      $eq=1
     }
    }
    if ($2 == $image)
    {
     if ($sex{$1} eq $csx)
     {
      $eq=1
     }
    }
   }
   if ($eq==0)
   {
    if ($csex eq $messages[33]) {$sex{$image}='man'} else {$sex{$image}='woman'};
    if ($sex{$image} eq 'woman')
    {
     if ($foto{$image} eq 'man')
     {
      $foto{$image}='woman';
      $ctl->delete('foto');
      $ctl->createImage($ic_size/2,$ic_size/2, -anchor=>'center', -image => $TOP->Photo(-file => fn($workfolder."graphics/woman2.gif")),-tags=>'foto');
     }
    }
    if ($sex{$image} eq 'man')
    {
     if ($foto{$image} eq 'woman') 
     {
      $foto{$image}='man';
      $ctl->delete('foto');
      $ctl->createImage($ic_size/2,$ic_size/2, -anchor=>'center', -image => $TOP->Photo(-file => fn($workfolder."graphics/man2.gif")),-tags=>'foto');
     }
    }
   }
   else
   {
    MyMessageBox($messages[189],'ok','info');
    if ($csex eq $messages[33]) {$csex=$messages[34]}
    else
    {
     if ($csex eq $messages[34]) {$csex=$messages[33]}
    }
    $csxb->configure(-variable=>\$csex);$t1->update;
   }
  })->pack(-side=>"left",-expand=>"0",-anchor=>'s'); 
  $balloon->attach($pb[$pbi], -initwait=>0,-balloonmsg=>"$messages[242]");

  $pbi=1;
 }
 $pb12=$f3tl->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-text => $messages[18], -command => \&exitprop)->pack(-side=>"right",-expand=>"0",-anchor=>'s');
 $f4tl=$tl1->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid", -height=>"256", -width=>"656")->pack(-side=>"bottom",-expand=>'0');
 $f4tlu=$f4tl->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid", -height=>"256", -width=>"40")->pack(-side=>"left",-expand=>'0',-anchor=>'n');
 $pb3=$f4tlu->Button(-relief=>'raised',-borderwidth=>2,-image=>sizePhoto2($TOP,fn($workfolder.'/graphics/linkppl.png')), -command => \&showpeople)->pack();
 $balloon->attach($pb3, -initwait=>0,-balloonmsg=>"$messages[233]");
 $pb2=$f4tlu->Button(-relief=>'raised',-borderwidth=>2,-image=>sizePhoto2($TOP,fn($workfolder.'/graphics/linkurl.png')), -command => \&seturl)->pack();
 $balloon->attach($pb2, -initwait=>0,-balloonmsg=>"$messages[235]");
 $pb1=$f4tlu->Button(-relief=>'raised',-borderwidth=>2,-image=>sizePhoto2($TOP,fn($workfolder.'/graphics/link.png')), -command => \&setfile)->pack();
 $balloon->attach($pb1, -initwait=>0,-balloonmsg=>"$messages[234]");
 $pb14=$f4tlu->Checkbutton(-selectcolor=>$selectcolor,-background=>$menuback,-padx=>0, -pady=>0, -relief=>'flat', -variable=>\$linkbut, -image=>sizePhoto2($TOP,fn($workfolder.'/graphics/disablelink.png')), -command => \&urlstate)->pack();
 $balloon->attach($pb14, -initwait=>0,-balloonmsg=>"$messages[236]");
 $f4tlt=$f4tl->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid", -height=>"256", -width=>"616")->pack(-side=>"left",-expand=>'0');
 $te=$f4tlt->Scrolled(qw/Text height 14 -scrollbars oe -wrap word -background white/,-font=>$font)->pack();
 $te->tagConfigure('flink',-foreground=>'blue',-elide=>$showlink,-font=>'fontlink');
 $te->tagConfigure('flink_u',-foreground=>$underlink,-underline=>1, -elide=>'false',-font=>'fontlink');
 #preparing text to show links with another tag 'flink'
 my @a=split /<\/a>/g,$text{$image}; #link may be not only flink!!!
 my $i=0;
 my $tt;
 my $nn;
 my @t=();my @t1;my @t2;
 foreach my $a (@a)
 {
  if ($a=~/\<a\ name\=\'indi\'\ href\='indi/)
  {
   @t=split /<a name='indi' href='indi/g,$a;
   $t1[$i]=$t[0];
   $t[1]=~/^(\d+)/;
   $tt=$1;
   $nn=getname($tt);
   if ($t[1] ne '') {$t2[$i]="<a name='indi' href='indi".$tt.".html'>".$nn."</a>";}
   goto nxta;
  }
  if ($a=~/\<a\ name\=\'www\'\ href\=/)
  {
   @t=split /<a name='www' href=/g,$a;
   $t1[$i]=$t[0];
   if ($t[1] ne '') {$t2[$i]="<a name='www' href=".$t[1]."</a>";}
   goto nxta;
  }
  if ($a=~/\<a\ name\=\'file\'\ href\=/)
  {
   @t=split /<a name='file' href=/g,$a;
   $t1[$i]=$t[0];
   if ($t[1] ne '') {$t2[$i]="<a name='file' href=".$t[1]."</a>";}
   goto nxta;
  }
  $t1[$i]=$a;
  $t2[$i]='';
nxta:
  $i++;
 }
 undef @t;
 undef @a;
 for (my $j=0;$j<$i;$j++)
 {
  $te->insert('insert', $t1[$j]);
  if ($t2[$j] ne '') 
  {
   $t2[$j]=~/(\<a.+\>)(.+)(\<\/a\>)/;
   $te->insert('insert', $1,'flink');
   $te->insert('insert', $2,'flink_u');
   $te->insert('insert', $3,'flink');
  }
 } 
 undef @t1;
 undef @t2;
 $f1tl=$tl1->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid", -height=>"171", -width=>"171")->pack(-side=>"left",-expand=>"0");
 $ctl=$f1tl->Canvas(-width=>$ic_size,-height=>$ic_size,-background=>"white",-borderwidth=>"2",-relief=>"raised")->pack(-side=>'top',-anchor=>"n",-expand=>'1');
 $ctl->configure(-scrollregion=>[0,0,$ic_size,$ic_size]);
 if ($foto{$image} eq 'man')
 {
  $ctl->createImage($ic_size/2,$ic_size/2, -anchor=>'center', -image => $TOP->Photo(-file => fn($workfolder."graphics/man2.gif")),-tags=>'foto');
 }
 elsif ($foto{$image} eq 'woman')
  {
   $ctl->createImage($ic_size/2,$ic_size/2, -anchor=>'center', -image => $TOP->Photo(-file => fn($workfolder."graphics/woman2.gif")),-tags=>'foto');
  }
  else
  {
  $ctl->createImage($ic_size/2,$ic_size/2, -anchor=>'center', -image => myPhoto($projects.$projectname."/icons/".$foto{$image}),-tags=>'foto');
 }
 showtags;
 $pb13=$f1tl->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-text => $messages[22], -command => sub 
 { 
  $foto=fileDialog("openfoto");
  my $x1_mark=50;
  my $y1_mark=50;
  my $pic_x;
  my $pic_y;
  my $pic_bx=100;
  my $pic_by=100;
  $mydr=0;
  my $corner_pressed=0;
  unless ($foto eq cancel)
  {
   my $T=createmw($messages[191]);
   my $dragramka=0;
   $mw{$T}->geometry('35x45');
   $mw{$T}->bind('<Destroy>',sub{$mydr=1});
   $mw{$T}->bind('<KeyPress-Escape>',sub{$mydr=1;$mw{$T}->destroy;});
   my $fsc=$mw{$T}->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>'solid')->pack(-side=>'top',-fill=>'x',-expand=>'1');
   my $cc = $fsc->Canvas(qw/-relief solid -borderwidth 0/)->pack(qw/-expand yes -fill both /);
   $mw{$T}->bind('<ButtonRelease-1>',sub
   {
    if ($dragramka>0)
    {
     if ((abs($x1_mark-$pic_bx)<10) || (abs($y1_mark-$pic_by)<10))
     {
      $x1_mark=$Tk::event->x;
      $y1_mark=$Tk::event->y;
      $pic_bx=$x1_mark+10;
      $pic_by=$y1_mark+10;
      $cc->delete('bmark');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-width=>2,-tags=>'bmark',-outline=>'white');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-dash=>'-',-width=>2,-tags=>'bmark',-outline=>'black');
     }
    }
    $corner_pressed=0;
    $dragramka=0;
   });
   $cc->CanvasBind('<Motion>' => sub
   {
    my $xx=$Tk::event->x;
    my $yy=$Tk::event->y;
    if (($xx>=$x1_mark-5) && ($xx<$x1_mark+5) && ($yy>=$y1_mark-5) && ($yy<$y1_mark+5))
    {
     $cc->createRectangle($x1_mark-5, $y1_mark-5,$x1_mark+5,$y1_mark+5,-width=>3,-tags=>'luc',-outline=>'red');
     $corner_pressed=1;
     goto ignore;
    } 
    if (($xx>=$pic_bx-5) && ($xx<$pic_bx+5) && ($yy>=$pic_by-5) && ($yy<$pic_by+5))
    {
     $cc->createRectangle($pic_bx-5, $pic_by-5,$pic_bx+5,$pic_by+5,-width=>3,-tags=>'rdc',-outline=>'red');
     $corner_pressed=2;
     goto ignore;
    } 
    if (($xx>=$x1_mark-5) && ($xx<$x1_mark+5) && ($yy>=$pic_by-5) && ($yy<$pic_by+5))
    {
     $cc->createRectangle($x1_mark-5, $pic_by-5,$x1_mark+5,$pic_by+5,-width=>3,-tags=>'ldc',-outline=>'red');
     $corner_pressed=3;
     goto ignore;
    } 
    if (($xx>=$pic_bx-5) && ($xx<$pic_bx+5) && ($yy>=$y1_mark-5) && ($yy<$y1_mark+5))
    {
     $cc->createRectangle($pic_bx-5, $y1_mark-5,$pic_bx+5,$y1_mark+5,-width=>3,-tags=>'ruc',-outline=>'red');
     $corner_pressed=4;
     goto ignore;
    } 
    $cc->delete('luc');
    $cc->delete('rdc');
    $cc->delete('ldc');
    $cc->delete('ruc');
    $corner_pressed=0;
ignore:
   });
   $cc->CanvasBind('<ButtonPress-1>' => sub
   {
    if ($corner_pressed==0)
    {
     if ($dragramka==0)
     {
      $x1_mark=$Tk::event->x;
      $y1_mark=$Tk::event->y;
      $pic_bx=$Tk::event->x;
      $pic_by=$Tk::event->y;
      $cc->delete('bmark');
      $dragramka=1;
     }
    }
    else
    {
     if ($corner_pressed==1)
     {
      $dragramka=0;
      $cc->delete('luc');
      $x1_mark=$Tk::event->x;
      $y1_mark=$Tk::event->y;
      $cc->delete('bmark');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-width=>2,-tags=>'bmark',-outline=>'white');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-dash=>'-',-width=>2,-tags=>'bmark',-outline=>'black');
     }
     if ($corner_pressed==2)
     {
      $dragramka=0;
      $cc->delete('rdc');
      $pic_bx=$Tk::event->x;
      $pic_by=$Tk::event->y;
      $cc->delete('bmark');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-width=>2,-tags=>'bmark',-outline=>'white');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-dash=>'-',-width=>2,-tags=>'bmark',-outline=>'black');
     }
     if ($corner_pressed==3)
     {
      $dragramka=0;
      $cc->delete('ldc');
      $x1_mark=$Tk::event->x;
      $pic_by=$Tk::event->y;
      $cc->delete('bmark');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-width=>2,-tags=>'bmark',-outline=>'white');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-dash=>'-',-width=>2,-tags=>'bmark',-outline=>'black');
     }
     if ($corner_pressed==4)
     {
      $dragramka=0;
      $cc->delete('ruc');
      $pic_bx=$Tk::event->x;
      $y1_mark=$Tk::event->y;
      $cc->delete('bmark');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-width=>2,-tags=>'bmark',-outline=>'white');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-dash=>'-',-width=>2,-tags=>'bmark',-outline=>'black');
     }
    }
   });
   $mw{$T}->bind('<KeyPress-Return>' => sub
   {
    if ($x1_mark>$pic_bx) {($x1_mark,$pic_bx)=($pic_bx,$x1_mark)}
    if ($y1_mark>$pic_by) {($y1_mark,$pic_by)=($pic_by,$y1_mark)}
    my $nx;
    my $ny;
    my $icon;
    copy(fn($foto),fn($tmpdir.'tmp'));
    if ($foto=~/\.gif$/)
    {
     $icon=Image::Magick->new;
     $icon->Read(fn($tmpdir.'tmp'));
     $icon->Write(fn($tmpdir.'tmp.jpg'));
     copy(fn($tmpdir.'tmp.jpg'),fn($tmpdir.'tmp'));
     unlink(fn($tmpdir.'tmp.jpg'));
    }
    $icon=Image::Magick->new;
    $icon->Read(fn($tmpdir.'tmp'));
    ($pic_x, $pic_y)=$icon->Get('columns','rows');
    if ($pic_x>=$pic_y) {$nx=480; $ny=int($nx*$pic_y/$pic_x)}
    else {$ny=640; $nx=int($ny*$pic_x/$pic_y)}
    my $x1=int($x1_mark*$pic_x/$nx);my $y1=int($y1_mark*$pic_y/$ny);
    my $x2=int($pic_bx*$pic_x/$nx);my $y2=int($pic_by*$pic_y/$ny);
    $icon->Crop(geometry=>($x2-$x1).'x'.($y2-$y1).'+'.$x1.'+'.$y1,width=>($x2-$x1),height=>($y2-$y1));
    $icon->Write(fn($tmpdir.'tmp2'));copy(fn($tmpdir.'tmp2'),fn($tmpdir.'tmp'));unlink fn($tmpdir.'tmp2');
    $icon=Image::Magick->new;
    $icon->Read(fn($tmpdir.'tmp'));
    ($pic_x, $pic_y)=$icon->Get('columns','rows');
    if ($pic_x>170 || $pic_y>170)
    {
     if (($pic_x)>=($pic_y)) 
     {
      $icon->Resize(height=>int($pic_y*170/$pic_x),width=>170)
     } 
     else 
     {
      $icon->Resize(width=>int($pic_x*170/$pic_y),height=>170)
     }
    }
    $icon->Write(fn($tmpdir.'tmp'));
    copy(fn($tmpdir.'tmp'),fn($projects.$projectname."/icons/$image".'.gif'));
    $foto{$image}="$image.gif";
    $ctl->delete('foto');
    $ctl->createImage($ic_size/2,$ic_size/2, -anchor=>'center', -image => myPhoto($projects.$projectname."/icons/".$foto{$image}),-tags=>'foto');
    showtags;
    $stat='active';
    $batdel->configure(-state=>$stat);
    destroymw($T);
    $mydr=1;$dragramka=0;
   });
   $cc->CanvasBind('<B1-Motion>' => sub
   {
    if ($menustate==1)
    {
     if ($corner_pressed==1)
     {
      $x1_mark=$Tk::event->x;
      $y1_mark=$Tk::event->y;
      $cc->delete('bmark');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-width=>2,-tags=>'bmark',-outline=>'white');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-dash=>'-',-width=>2,-tags=>'bmark',-outline=>'black');
     }
     if ($corner_pressed==2)
     {
      $pic_bx=$Tk::event->x;
      $pic_by=$Tk::event->y;
      $cc->delete('bmark');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-width=>2,-tags=>'bmark',-outline=>'white');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-dash=>'-',-width=>2,-tags=>'bmark',-outline=>'black');
     }
     if ($corner_pressed==3)
     {
      $x1_mark=$Tk::event->x;
      $pic_by=$Tk::event->y;
      $cc->delete('bmark');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-width=>2,-tags=>'bmark',-outline=>'white');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-dash=>'-',-width=>2,-tags=>'bmark',-outline=>'black');
     }
     if ($corner_pressed==4)
     {
      $pic_bx=$Tk::event->x;
      $y1_mark=$Tk::event->y;
      $cc->delete('bmark');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-width=>2,-tags=>'bmark',-outline=>'white');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-dash=>'-',-width=>2,-tags=>'bmark',-outline=>'black');
     }
     if (($dragramka==1))
     {
      $pic_bx=$Tk::event->x;
      $pic_by=$Tk::event->y;
      $cc->delete('bmark');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-width=>2,-tags=>'bmark',-outline=>'white');
      $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-dash=>'-',-width=>2,-tags=>'bmark',-outline=>'black');
     }
    }
   });
   my $sx;
   my $sy;
   my $icon=Image::Magick->new;
   copy(fn($foto),fn($tmpdir.'tmp'));
   $icon->Read(fn($tmpdir.'tmp'));
   ($pic_x, $pic_y)=$icon->Get('columns','rows');
   if ($pic_y>=$pic_x) 
   {
    $sy=640;$sx=int(($sy/$pic_y)*$pic_x);
   }
   else
   {
    $sx=480;$sy=int(($sx/$pic_x)*$pic_y);
   }
   my $maxy=$sy;my $maxx=$sx;
   unless (($sx==$pic_x) && ($sy==$pic_y)) {$icon->Resize(width=>$sx,height=>$sy)}
   $icon->Write(fn($tmpdir.'tmp'));
   $mw{$T}->geometry(($sx+10).'x'.($sy+10).'+'.int(($x-$sx-10)/2).'+'.int(($y-$sy-10)/2));
   $cc->configure(-height=>$sy);
   $cc->configure(-width=>$sx);
   $cc->createImage(int($sx/2),int($sy/2), -image=>$mw{$T}->Photo(-file=>fn($tmpdir."tmp")));
   $cc->update;
   $cc->configure(-scrollregion => [ $c->bbox("all") ]);
   $x1_mark=int($sx/5);
   $y1_mark=int($sy/5);
   $pic_bx=$sx-$x1_mark;
   $pic_by=$sy-$y1_mark;
   $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-width=>2,-tags=>'bmark',-outline=>'white');
   $cc->createRectangle($x1_mark, $y1_mark,$pic_bx,$pic_by,-dash=>'-',-width=>2,-tags=>'bmark',-outline=>'black');
   $mw{$T}->deiconify;
   MyMessageBox($messages[190],'ok','info');
   $mw{$T}->waitVariable(\$mydr);
  }
 })->pack(-side=>"left",-expand=>'1',-anchor=>'s');
 $stat='active';
 if (($foto{$image} eq 'man') ||
    ($foto{$image} eq 'woman'))
 {
  $stat='disabled';
 }
 $batdel=$f1tl->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-state=>$stat, -text =>$messages[37], -command => sub 
 {
  $ctl->delete('foto');
  if ($sex{$image} eq 'man') 
  {
   $foto{$image}='man';
   $ctl->createImage($ic_size/2,$ic_size/2, -anchor=>'center', -image => $TOP->Photo(-file => fn($workfolder."graphics/man2.gif")),-tags=>'foto');
  }
  else 
  {
   $foto{$image}='woman';
   $ctl->createImage($ic_size/2,$ic_size/2, -anchor=>'center', -image => $TOP->Photo(-file => fn($workfolder."graphics/woman2.gif")),-tags=>'foto');
  } 
  createramka($image);
  $stat='disabled';
  $batdel->configure(-state=>$stat);
 })->pack(-side=>"left",-expand=>'1',-anchor=>'s');
 my $f2tl=$tl1->Frame(-padx=>"2",-pady=>"2",-borderwidth=>"0",-relief=>"solid", -width=>"446")->pack(-side=>"left",-anchor=>'n',-fill=>'x',-expand=>'1');
 my $f20tl=$f2tl->Frame(-borderwidth=>"0",-relief=>"solid", -height=>"50", -width=>"446")->pack(-side=>'top',-fill=>'x',-expand=>'1');
 my $f20tll=$f2tl->Frame(-borderwidth=>"0",-relief=>"solid", -height=>"50", -width=>"446")->pack(-side=>'top',-fill=>'x',-expand=>'1');
 my $f21tl=$f2tl->Frame(-borderwidth=>"0",-relief=>"solid", -height=>"50", -width=>"446")->pack(-side=>'top',-fill=>'x',-expand=>'1');
 my $f22tl=$f2tl->Frame(-borderwidth=>"0",-relief=>"solid", -height=>"50", -width=>"446")->pack(-side=>'top',-fill=>'x',-expand=>'1');
 my $f23tl=$f2tl->Frame(-borderwidth=>"0",-relief=>"solid", -height=>"50", -width=>"446")->pack(-side=>'top',-fill=>'x',-expand=>'1');
 my $f24tl=$f2tl->Frame(-borderwidth=>"0",-relief=>"solid", -height=>"60", -width=>"446")->pack(-side=>'top',-fill=>'x',-expand=>'1');
 my $f241tl=$f24tl->Frame(-borderwidth=>"0",-relief=>"solid", -height=>"20", -width=>"446")->pack(-side=>'top',-fill=>'x',-expand=>'1');
 $f241tl->Label(-relief=>'flat',-font=>$fontbold,-text => "",-width=>"10",-justify=>"left")->pack(-side=>"left",-anchor=>"n",-expand=>"0");
 $f241tl->Label(-relief=>'flat',-font=>$fontbold,-text => $messages[27],-width=>"20")->pack(-side=>"left",-anchor=>"n",-expand=>"0");
 $f241tl->Label(-relief=>'flat',-font=>$fontbold,-text => $messages[28],-width=>"20")->pack(-side=>"left",-anchor=>"n",-expand=>'1');
 my $f242tl=$f24tl->Frame(-borderwidth=>"0",-relief=>"solid", -height=>"20", -width=>"446")->pack(-side=>'top',-fill=>'x',-expand=>'1');
 $f242tl->Label(-relief=>'flat',-font=>$fontbold,-text => $messages[29],-width=>"12")->pack(-side=>"left",-anchor=>"n",-expand=>"0");
 $e[5]=$f242tl->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font,-textvariable=>\$birth_date{$image},-width=>"19")->pack(-side=>"left",-anchor=>"n",-fill=>'x',-expand=>"0");
 $e[4]=$f242tl->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font,-textvariable=>\$birth_place{$image},-width=>"18")->pack(-side=>"left",-anchor=>"n",-expand=>'1',-fill=>'x',);
 $pb6=$t12=$f242tl->Button(-state=>'active',-relief=>'raised',-borderwidth=>2,-font=>$font,-image=>sizePhoto2($TOP,fn($workfolder.'/graphics/www-add.png')),-command=>sub
 {
  $t12->configure(-state=>'disabled');
  showtowns($birth_place{$image});
  $birth_place{$image}=$townresult;
  $mp->configure(-textvariable=>\$birth_place{$image});
  $t12->configure(-state=>'active')
 })->pack(-padx=>2,-side=>"left",-anchor=>"n",-expand=>'0');
 $balloon->attach($pb6, -initwait=>0,-balloonmsg=>"$messages[231]");

 $pb7=$t2=$f242tl->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-image=>sizePhoto2($TOP,fn($workfolder.'/graphics/www-edit.png')),-command=>sub
 {
  $t2->configure(-state=>'disabled');
  edittowns($birth_place{$image});
  $t2->configure(-state=>'active');
 })->pack(-side=>"left",-anchor=>"n",-expand=>'0');
 $balloon->attach($pb7, -initwait=>0,-balloonmsg=>"$messages[232]");

 my $f243tl=$f24tl->Frame(-borderwidth=>"0",-relief=>"solid", -height=>"20", -width=>"446")->pack(-side=>'top',-fill=>'x',-expand=>'1');
 $f243tl->Label(-relief=>'flat',-font=>$fontbold,-text => $messages[30],-width=>"12")->pack(-side=>"left",-anchor=>"n",-expand=>"0");
 $e[6]=$f243tl->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font,-textvariable=>\$death_date{$image},-width=>"19")->pack(-side=>"left",-anchor=>"n",-fill=>'x',-expand=>"0");
 $e[0]=$f243tl->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font,-textvariable=>\$death_place{$image},-width=>"18")->pack(-side=>"left",-anchor=>"n",-fill=>'x',-expand=>'1');
 $pb8=$t13=$f243tl->Button(-state=>'active',-relief=>'raised',-borderwidth=>2,-image=>sizePhoto2($TOP,fn($workfolder.'/graphics/www-add.png')),-command=>sub
 {
  $t13->configure(-state=>'disabled');
  showtowns($death_place{$image});
  $death_place{$image}=$townresult;
  $mp->configure(-textvariable=>\$death_place{$image});
  $t13->configure(-state=>'active')
 })->pack(-padx=>2,-side=>"left",-anchor=>"n",-expand=>'0');
 $balloon->attach($pb8, -initwait=>0,-balloonmsg=>"$messages[231]");
 $pb9=$t3=$f243tl->Button(-relief=>'raised',-borderwidth=>2,-font=>$font,-image=>sizePhoto2($TOP,fn($workfolder.'/graphics/www-edit.png')),-command=>sub
 {
  $t3->configure(-state=>'disabled');
  edittowns($death_place{$image});
  $t3->configure(-state=>'active');
 })->pack(-side=>"left",-anchor=>"n",-expand=>'0');
 $balloon->attach($pb9, -initwait=>0,-balloonmsg=>"$messages[232]");
 $f20tl->Label(-relief=>'flat',-font=>$fontbold,-text=>'ID: '.$image, -width=>12)->pack(-side=>"left",-anchor=>"n");
 $f20tll->Label(-width=>12,-relief=>'flat',-font=>$fontbold,-text=>$messages[211],)->pack(-side=>"left",-anchor=>"n");
 $f20tll->Label(-wraplength=>300, -relief=>'flat',-borderwidth=>2,-font=>$font,-textvariable=>\$tags{$image})->pack(-side=>"left",-anchor=>"n",-expand=>'1',-fill=>'x');
 $b2f20tll=$f20tll->Button(-state=>'active',-relief=>'raised',-borderwidth=>2,-image=>sizePhoto2($TOP,fn($workfolder.'/graphics/tag_sel.png')),-command=>sub
 {
  $b2f20tll->configure(-state=>'disabled');my $s=selecttags($image);if ($s ne cancel) {$tags{$image}=$s;showtags;$f20tl->update}
  $b2f20tll->configure(-state=>'active');
 })->pack(-side=>"left",-anchor=>"n",-expand=>'0',-padx=>2);
 $balloon->attach($b2f20tll, -initwait=>0,-balloonmsg=>"$messages[237]");
 $bf20tll=$f20tll->Button(-state=>'active',-relief=>'raised',-borderwidth=>2,-image=>sizePhoto2($TOP,fn($workfolder.'/graphics/tag_add.png')),-command=>sub
 {
  $bf20tll->configure(-state=>'disabled');edittags;reloadramka($image,1);showtags;$bf20tll->configure(-state=>'active');
 })->pack(-side=>"left",-anchor=>"n",-expand=>'0');
 $balloon->attach($bf20tll, -initwait=>0,-balloonmsg=>"$messages[238]");
 $f21tl->Label(-relief=>'flat',-font=>$fontbold,-text => $messages[24],-width=>"12")->pack(-side=>"left",-anchor=>"n");
 $e[1]=$f21tl->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font,-textvariable=>\$family_name{$image})->pack(-side=>"left",-anchor=>"n",-expand=>'1',-fill=>'x');
 $f22tl->Label(-relief=>'flat',-font=>$fontbold,-text => $messages[25],-width=>"12")->pack(-side=>"left",-anchor=>"n");
 $e[2]=$f22tl->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font,-textvariable=>\$first_name{$image})->pack(-side=>"left",-anchor=>"n",-expand=>'1',-fill=>'x');
 $f23tl->Label(-relief=>'flat',-font=>$fontbold,-text => $messages[26],-width=>"12")->pack(-side=>"left",-anchor=>"n");
 $e[3]=$f23tl->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font,-textvariable=>\$second_name{$image})->pack(-side=>"left",-anchor=>"n",-expand=>'1',-fill=>'x');
 for (my $i=0;$i<7;$i++)
 {
  $e[$i]->bind('<KeyPress-Return>'=>sub
  {
   exitprop;
  });
 }
 $nb->pageconfigure("s3",-raisecmd=>$pb11->focus);
 $nb->pageconfigure("s2",-raisecmd=>$pb10->focus);
 $nb->pageconfigure("s1",-raisecmd=>$pb12->focus);
}
sub menudelete #delete current person
{
 my $key;
 my $a;
 $id=$image;
 while(($key,$a) = each(%spouse))
 {
  if ($a=~/^$id:(\d+)$/)
  {
   my $id2=$1;
   $c->delete('1spouse'.$id.':'.$id2);
   $c->delete('2spouse'.$id.':'.$id2);
   delete $spouse{$key};
   delete $marr_date{$key};
   delete $marr_place{$key};
  }
  if ($a=~/^(\d+):$id$/)
  {
   my $id2=$1;
   $c->delete('1spouse'.$id2.':'.$id);
   $c->delete('2spouse'.$id2.':'.$id);
   delete $spouse{$key};
   delete $marr_date{$key};
   delete $marr_place{$key};
  }
 }
 $son=$image;
 menudeletefather(1);
 menudeletemother(1);
 delete $people{$image};
 delete $peoplex{$image};
 delete $peopley{$image};
 delete $family_name{$image};
 delete $first_name{$image};
 delete $second_name{$image};
 delete $sex{$image};
 delete $birth_date{$image};
 delete $birth_place{$image};
 delete $death_date{$image};
 delete $death_place{$image};
 delete $text{$image};
 delete $foto{$image};
 delete $gallery{$image};
 unlink fn($projects.$projectname."/".$image.".gif");
 unlink fn($projects.$projectname."/icons/".$image.".gif");
 if (-e fn($projects.$projectname."/gallery/".$image.".gal"))
 {
  unlink fn($projects.$projectname."/gallery/".$image.".gal");
  unlink glob fn($projects.$projectname."/gallery/".$image."/*");
  unlink glob fn($projects.$projectname."/gallery/".$image."/icons/*");
 }
 $c->delete('people'.$id);
}
sub menu2man #create man
{
 $peoples++;
 $people{$peoples}='people'.$peoples;
 $peoplex{$peoples}=$bx;
 $peopley{$peoples}=$by;
 $sex{$peoples}='man';
 $foto{$peoples}='man';
 $text{$peoples}='';
 $gallery{$peoples}='';
 $family_name{$peoples}='';
 $first_name{$peoples}='';
 $second_name{$peoples}='';
 $birth_date{$peoples}='';
 $birth_place{$peoples}='';
 $death_date{$peoples}='';
 $death_place{$peoples}='';
 createramka($peoples);
 $c->createImage($peoplex{$peoples},$peopley{$peoples}, -image => myPhoto($projects.$projectname."/".$peoples.".gif"), -tags => $people{$peoples});#$
} 
sub menu2woman #create woman
{
 $peoples++;
 $people{$peoples}='people'.$peoples;
 $peoplex{$peoples}=$bx;
 $peopley{$peoples}=$by;
 $sex{$peoples}='woman';
 $foto{$peoples}='woman';
 $text{$peoples}='';
 $gallery{$peoples}='';
 $family_name{$peoples}='';
 $first_name{$peoples}='';
 $second_name{$peoples}='';
 $birth_date{$peoples}='';
 $birth_place{$peoples}='';
 $death_date{$peoples}='';
 $death_place{$peoples}='';
 createramka($peoples);
 $c->createImage($peoplex{$peoples},$peopley{$peoples}, -image => myPhoto($projects.$projectname."/".$peoples.".gif"), -tags => $people{$peoples});#$
}
sub get_number_of_peoples
{
 my $res=0;
 my $a;
 foreach $a (values %people)
 {
  $res=$res+1
 }
 return $res
} 
sub items_start_drag 
{
 my($c, $x, $y) = @_;$oldx=$x;$oldy=$y;
 my $id = $c ->type('current');
 if ($id eq 'image') 
 {
  ($bx,$by)=$c->coords('current');
 }
 @tags=$c->gettags('current');
 if ($tags[0]=~/^ruler(\d+)$/) 
 {
  ($bx,$by)=$c->coords('current');
 }
}
sub reloadallramka #redraw all persons on canvas
{
 menustateoff;
 my $k;
 my $create=shift; # 1 - reload. >1 - not reload 3 - delete $c and create $c as new canvas, after this set reload to 1
 if ($create == 3)
 {
# get scroll
  my $sy;
  my ($sx,$t)=$c->xview;
  ($sy,$t)=$c->yview;
# destroy and create canvas
  $c->destroy;
  if ($OS eq 'linux') 
  {
   $tile=$TOP->Photo(-file=>$workfolder.'graphics/'.$facestyle.'/center.gif');
   $selectcolor=$backcolor;
   $c = $fs->Scrolled(qw/Canvas -relief solid -borderwidth 0 -scrollbars se/,-height=>$y,-scrollregion=>[0,0,$xcanvas,$ycanvas],-tile=>$tile)
  } 
  else {$selectcolor=$menuback;$c = $fs->Scrolled(qw/Canvas -relief solid -borderwidth 0 -scrollbars se/,-height=>$y,-scrollregion=>[0,0,$xcanvas,$ycanvas],-background=>$topback)} 
  $c->pack(qw/-expand yes -fill both /);
# set scroll
  $c->xview(moveto=>$sx);
  $c->yview(moveto=>$sy);
  scroll();
# create borders
  $c->createLine(2,2,$xcanvas-2,2,,-width=>1,-tags=>'boundaries');
  $c->createLine(2,2,2,$ycanvas-2,,-width=>1,-tags=>'boundaries');
  $c->createLine($xcanvas-2,2,$xcanvas-2,$ycanvas-2,-width=>1,-tags=>'boundaries');
  $c->createLine(3,$ycanvas-2,$xcanvas-2,$ycanvas-2,-width=>1,-tags=>'boundaries');
# create rulers
  while (($k,$a)=each(%ruler))
  {
   $c->createLine(3, $a,$xcanvas-3,$a,-tags=>'ruler'.$k, -width=>widthruler, -fill=>rulercolor, -dash=>"-", -activefill=>'red',);
   if ($showrulers==0)
   {
    $c->move('ruler'.$k,0,-$a); # hide ruler
   }
  }
# set bindings
  keyboardbindings;
  mousebindings;
  $create=1;
 }
 unless (defined $create) {$create=2}
# create persons and relations on desktop
 foreach $k (keys %people)
 {
  drawmessage($messages[69].$k);
  reloadramka($k,$create);
 }
 deletemessage;
 menustateon;
}
sub reloadramka #redraw current person  on canvas
{
 my $image=shift;
 my $creat=shift; #see reloadallramka
 my $tag;
 my ($x1,$y1,$x2,$y2);
 $peoplex{$image}=(int($peoplex{$image}/$step)*$step);
 $peopley{$image}=(int($peopley{$image}/$step)*$step);
 foreach $a (values %ruler)
 {
  my $d1=$a-$peopley{$image};
  my $d2=$peopley{$image}-$a;
  if (($d1<$rulerstep*$size) && ($d1>0))
  {
   $peopley{$image}=$a;
   $c->delete("people$image");
   $c->createImage($peoplex{$image},$peopley{$image}, -image => myPhoto($projects.$projectname."/".$image.".gif"), -tags => "people$image");
  }
  if (($d2<$rulerstep*$size) && ($d2>0))
  {
   $peopley{$image}=$a;
   $c->delete("people$image");
   $c->createImage($peoplex{$image},$peopley{$image}, -image => myPhoto($projects.$projectname."/".$image.".gif"), -tags => "people$image");
  }
 }
 foreach $tag (%father)
 {
  if ($tag=~/^$image\:(\d+)$/)
  {
   my $fathern=$1;
   my $t=getlinefather('father'.$image.':'.$fathern);
   if ($t ne '') 
   {
    $c->delete($t);
    if ($t=~/:s$/)
    {
     $c->delete("jump$fathern:$image");
     $c->delete("jump$image:$fathern");
    }
   } else 
   {
    if ($hidden{'father'.$image.':'.$fathern} eq 's')
    {
     $t='father'.$image.':'.$fathern.':s';
    }
    else
    {
     $t='father'.$image.':'.$fathern;
    }
   }
   arrowFromFather($peoplex{$image}, $peopley{$image}-30*$size,$peoplex{$fathern}, $peopley{$fathern}+30*$size,$t);
  }
  if ($tag=~/^(\d+)\:$image$/)
  {
   my $son=$1;
   my $t=getlinefather('father'.$son.':'.$image);
   if ($t ne '') 
   {
    $c->delete($t);
    if ($t=~/:s$/)
    {
     $c->delete("jump$son:$image");
     $c->delete("jump$image:$son");
    }
   }
   else
   {
    if ($hidden{'father'.$son.':'.$image} eq 's')
    {
     $t='father'.$son.':'.$image.':s';
    }
    else
    {
     $t='father'.$son.':'.$image;
    }
   }
   arrowFromFather($peoplex{$son}, $peopley{$son}-30*$size,$peoplex{$image}, $peopley{$image}+30*$size,$t);
  }
 } 
 foreach $tag (%mother)
 {
  if ($tag=~/^$image\:(\d+)$/)
  {
   my $fathern=$1;
   my $t=getlinefather('mother'.$image.':'.$fathern);
   if ($t ne '') 
   {
    $c->delete($t);
    if ($t=~/:s$/)
    {
     $c->delete("jump$fathern:$image");
     $c->delete("jump$image:$fathern");
    }
   } else 
   {
    if ($hidden{'mother'.$image.':'.$fathern} eq 's')
    {
     $t='mother'.$image.':'.$fathern.':s';
    }
    else
    {
     $t='mother'.$image.':'.$fathern;
    }
   }
   arrowFromMother($peoplex{$image}, $peopley{$image}-30*$size,$peoplex{$fathern}, $peopley{$fathern}+30*$size,$t);
  }
  if ($tag=~/^(\d+)\:$image$/)
  {
   my $son=$1;
   my $t=getlinefather('mother'.$son.':'.$image);
   if ($t ne '') 
   {
    $c->delete($t);
    if ($t=~/:s$/)
    {
     $c->delete("jump$son:$image");
     $c->delete("jump$image:$son");
    }
   }
   else
   {
    if ($hidden{'mother'.$son.':'.$image} eq 's')
    {
     $t='mother'.$son.':'.$image.':s';
    }
    else
    {
     $t='mother'.$son.':'.$image;
    }
   }
   arrowFromMother($peoplex{$son}, $peopley{$son}-30*$size,$peoplex{$image}, $peopley{$image}+30*$size,$t);
  }
 } 
 foreach $tag (%spouse)
 {
  if ($tag=~/^(\d+)\:$image$/)
  {
   my $son=$1;
   $c->delete('1spouse'.$son.':'.$image);
   $c->delete('2spouse'.$son.':'.$image);
   my ($x1,$y1,$x2,$y2);
   if ($peoplex{$son}<=$peoplex{$image})
   {
    $x1=$peoplex{$son};
    $y1=$peopley{$son};
    $x2=$peoplex{$image};
    $y2=$peopley{$image};
   }
   else
   {
    $x2=$peoplex{$son};
    $y2=$peopley{$son};
    $x1=$peoplex{$image};
    $y1=$peopley{$image};
   }
   arrowSpouse($x1+78*$size,$y1,$x2-78*$size,$y2,$son.':'.$image);
  }
  if ($tag=~/^$image\:(\d+)$/)
  {
   my $son=$1;
   $c->delete('1spouse'.$image.':'.$son);
   $c->delete('2spouse'.$image.':'.$son);
   if ($peoplex{$image}<=$peoplex{$son})
   {
    $x1=$peoplex{$image};
    $y1=$peopley{$image};
    $x2=$peoplex{$son};
    $y2=$peopley{$son};
   }
   else
   {
    $x2=$peoplex{$image};
    $y2=$peopley{$image};
    $x1=$peoplex{$son};
    $y1=$peopley{$son};
   }
   arrowSpouse($x1+78*$size,$y1,$x2-78*$size,$y2,$image.':'.$son);
  } 
 }
 if ($creat==1) {createramka($image)}
 $c->delete("people$image");
 my @tgs=split(' ',$tags{$image});
 my $i=-1;
 my $item;
 foreach $item (@tgs) 
 {
  unless ($item eq '')
  {
   if ($colors{$item})
   {
    $c->createRectangle($peoplex{$image}+$i*8*$size-$size*64,$peopley{$image}+30*$size+6, $peoplex{$image}+$i*8*$size+3*$size-$size*64+3,$peopley{$image}-30*$size-7, -width=>1, -fill=>$colors{$item}, -outline=>'snow3', -tags => "people$image");
    $i+=1;
   }
  }
 }
 $c->createImage($peoplex{$image},$peopley{$image}, -image => myPhoto($projects.$projectname."/$image.gif"), -tags => "people$image");#$
}
sub items_leave 
{
 my($c, $x, $y) = @_;
 my $id = $c ->type('current');
 my $fam;
 my $indi;
 my $tt;
 my $val;
 my ($x1,$y1,$x2,$y2);
 my @tags=$c->gettags('current');
 if ($id eq 'line') 
 {
  if ($tags[0]=~/ruler(\d+)/)
  {
   if ($draggroup==0)
   {
    my $rdy=int($ruler{$1}/$step)*$step-$ruler{$1}; #align ruller
    $c->move("ruler$1",0,$rdy);$ruler{$1}+=$rdy;
   }
  }
 }
 if ($id eq 'image') 
 {
  $tags[0]=~/people(\d+)/;
  my $image=$1;
  if ($begin_spouse==1)
  {
   if ($sex{$image} eq $sex{$son})
   {
    MyMessageBox($messages[6],'ok','info');
    $begin_spouse=0;
    $c->delete('1spouse'.$son);
    $c->delete('2spouse'.$son);
    return
   }
   foreach $val (values %spouse)
   {
    if (($val eq "$son:$image") || ($val eq "$image:$son"))
    {
     MyMessageBox($messages[38],'ok','info');
     $begin_spouse=0;
     $c->delete('1spouse'.$son);
     $c->delete('2spouse'.$son);
     return
    }
   }
   if ($son==$image)
   {
    MyMessageBox($messages[7],'ok','info');
    return
   }
   else
   {
    $begin_spouse=0;
    $c->delete('1spouse'.$son);
    $c->delete('2spouse'.$son);
    $spouses++;
    $spouse{$spouses}=$son.':'.$image;
    if ($peoplex{$son}<=$bx)
    {
     $x1=$peoplex{$son};
     $y1=$peopley{$son};
     $x2=$bx;
     $y2=$by;
    }
    else
    {
     $x2=$peoplex{$son};
     $y2=$peopley{$son};
     $x1=$bx;
     $y1=$by;
    }
    arrowSpouse($x1+78*$size,$y1,$x2-78*$size,$y2,$spouse{$spouses});
    return
   }
  }
  if ($begin_father==1)
  {
   if ($sex{$image} eq 'woman')
   {
    MyMessageBox($messages[2],'ok','info');
    $begin_spouse=0;
    $c->delete('father'.$son);
    return
   }
   if ($son==$image)
   {
    MyMessageBox($messages[0],'ok','info');
    $begin_spouse=0;
    $c->delete('father'.$son);
    return
   }
   else
   {
    $begin_father=0;
    $c->delete('father'.$son);
    $fathers++;
    $father{$fathers}=$son.':'.$image;
    arrowFromFather($peoplex{$son}, $peopley{$son}-30*$size ,$peoplex{$image},$peopley{$image}+30*$size,'father'.$father{$fathers});
    return
   }
  }
  if ($begin_mother==1)
  {
   if ($sex{$image} eq 'man')
   {
    MyMessageBox($messages[3],'ok','info');
    $begin_spouse=0;
    $c->delete('mother'.$son);
    return
   }
   if ($son==$image)
   {
    MyMessageBox($messages[1],'ok','info');
    $begin_spouse=0;
    $c->delete('mother'.$son);
    return
   }
   else
   {
    $begin_mother=0;
    $c->delete('mother'.$son);
    $mothers++;
    $mother{$mothers}=$son.':'.$image;
    arrowFromMother($peoplex{$son},$peopley{$son}-30*$size,$peoplex{$image},$peopley{$image}+30*$size,'mother'.$mother{$mothers});
    return
   }
  }
  foreach $val (@kins)
  {
   $val=~/^people(\d+)$/;
   reloadramka($1,2);
  }
  if ($draggroup>0)
  {
   $c->delete('markbox');
   $c->createRectangle($c->bbox(@kins),-dash=>$dashmarkbox,-width=>2,-tags=>'markbox',-outline=>'blue');
  }
  ($bx,$by)=$c->coords('current');
 }
}
sub movepersons #move selected (@kids) persons
{
 my $dx=shift;
 my $dy=shift;
 my $aa;
 my $tag;
 my ($x1,$y1,$x2,$y2);
 (my $bx1, my $by1, my $bx2, my $by2)=$c->bbox(@kins);
 if (($bx1<0) || ($bx2<0))
 {
  $dx=40;
 }
 if (($bx1>$xcanvas) || ($bx2>$xcanvas))
 {
  $dx=-40;
 }
 if (($by1<0) || ($by2<0))
 {
  $dy=40;
 }
 if (($by1>$ycanvas) || ($by2>$ycanvas))
 {
  $dy=-40;
 }
 my %kins=();foreach $a (@kins) {$kins{$a}=1}; @kins=(keys %kins); #selected kids in list must be once!
 foreach $aa (@kins)
 {
  my @tags2=$c->gettags($aa);
  $tags2[0]=~/people(\d+)/;
  my $ftag=$1;
  $c->move($tags2[0], $dx, $dy);
  $peoplex{$ftag}+=$dx;
  $peopley{$ftag}+=$dy;
  foreach $tag (values %father)
  {
   if ($tag=~/^$ftag\:(\d+)$/)
   {
    my $tt=$1;
    my $t=getlinefather('father'.$ftag.':'.$tt);
    $c->delete($t);
    if ($t=~/:s$/)
    {
     $c->delete("jump$ftag:$tt");
     $c->delete("jump$tt:$ftag");
    }
    arrowFromFather($peoplex{$ftag}, $peopley{$ftag}-30*$size,$peoplex{$tt}, $peopley{$tt}+30*$size,$t);
   }
   if ($tag=~/^(\d+)\:$ftag$/)
   {
    my $tt=$1;
    my $t=getlinefather('father'.$tt.':'.$ftag);
    $c->delete($t);
    if ($t=~/:s$/)
    {
     $c->delete("jump$tt:$ftag");
     $c->delete("jump$ftag:$tt");
    }
    arrowFromFather($peoplex{$tt}, $peopley{$tt}-30*$size,$peoplex{$ftag}, $peopley{$ftag}+30*$size,$t);
   }
  }
  foreach $tag (values %mother)
  {
   if ($tag=~/^$ftag\:(\d+)$/)
   {
    my $tt=$1;
    my $t=getlinefather('mother'.$ftag.':'.$tt);
    $c->delete($t);
    if ($t=~/:s$/)
    {
     $c->delete("jump$tt:$ftag");
     $c->delete("jump$ftag:$tt");
    }
    arrowFromMother($peoplex{$ftag}, $peopley{$ftag}-30*$size,$peoplex{$tt}, $peopley{$tt}+30*$size,$t);
   }
   if ($tag=~/^(\d+)\:$ftag$/)
   {
    my $tt=$1;
    my $t=getlinefather('mother'.$tt.':'.$ftag);
    $c->delete($t);
    if ($t=~/:s$/)
    {
     $c->delete("jump$tt:$ftag");
     $c->delete("jump$ftag:$tt");
    }
    arrowFromMother($peoplex{$tt}, $peopley{$tt}-30*$size,$peoplex{$ftag}, $peopley{$ftag}+30*$size,$t);
   }
  } 
  foreach $tag (values %spouse)
  {
   if ($tag=~/^$ftag\:(\d+)$/)
   {
    $c->delete('1spouse'.$ftag.':'.$1);
    $c->delete('2spouse'.$ftag.':'.$1);
    if ($peoplex{$ftag}<=$peoplex{$1})
    {
     $x1=$peoplex{$ftag};
     $y1=$peopley{$ftag};
     $x2=$peoplex{$1};
     $y2=$peopley{$1};
    }
    else
    {
     $x2=$peoplex{$ftag};
     $y2=$peopley{$ftag};
     $x1=$peoplex{$1};
     $y1=$peopley{$1};
    }
    arrowSpouse($x1+78*$size,$y1,$x2-78*$size,$y2,$ftag.':'.$1);
   }
   if ($tag=~/^(\d+)\:$ftag$/)
   {
    $c->delete('1spouse'.$1.':'.$ftag);
    $c->delete('2spouse'.$1.':'.$ftag);
    if ($peoplex{$1}<=$peoplex{$ftag})
    {
     $x1=$peoplex{$1};
     $y1=$peopley{$1};
     $x2=$peoplex{$ftag};
     $y2=$peopley{$ftag};
    }
    else
    {
     $x2=$peoplex{$1};
     $y2=$peopley{$1};
     $x1=$peoplex{$ftag};
     $y1=$peopley{$ftag};
    }
    arrowSpouse($x1+78*$size,$y1,$x2-78*$size,$y2,$1.':'.$ftag);
   }
  }
 }
}
sub items_drag 
{
 if (($begin_father==1) || ($begin_mother==1)) { return }
 my($c, $x, $y) = @_;
 my $x2;
 my $y2;
 my $dx=$x-$oldx;
 my $dy=$y-$oldy;
 $oldx=$x;$oldy=$y;
 my $id = $c ->type('current');
 my @tags2=$c->gettags('current');
 if ($draggroup==2)
 {
  $c->move('ruler'.$currentruler, 0, $dy);
  $c->move('markbox', 0, $dy);
  $ruler{$currentruler}+=$dy;
  movepersons(0,$dy);
  return
 }
 if ($id eq 'line')
 {
  if ($tags2[0]=~/^ruler(\d+)$/)
  {
   if ($draggroup==0)
   {
    $c->move('ruler'.$1, 0, $dy);
    (my $nx,$ruler{$1})=$c->coords('ruler'.$1);
    return
   }
  }
 }
 if (($draggroup==1) || ($draggroup==3) || ($draggroup==4) ||($draggroup==5) )
 { 
  (my $bx1, my $by1, my $bx2, my $by2)=$c->bbox(@kins);
  if (($bx1<0) || ($bx2<0))
  {
   $dx=40;
  }
  if (($bx1>$xcanvas) || ($bx2>$xcanvas))
  {
   $dx=-40;
  }
  if (($by1<0) || ($by2<0))
  {
   $dy=40;
  }
  if (($by1>$ycanvas) || ($by2>$ycanvas))
  {
   $dy=-40;
  }
  $c->move('markbox', $dx, $dy)
 }
 movepersons($dx,$dy);
}
sub createramka # create person's rectangle with image and personal data on canvas
{
 my $ic=shift;
 my $sx;
 my $sy;
 my $icon;
 my $ramka;
 my $foto=$foto{$ic};
 if ($foto eq 'man')
 {
  $foto=$workfolder."graphics/man$size.gif";
  goto l;
 }
 if ($foto eq 'woman')
 {
  $foto=$workfolder."graphics/woman$size.gif";
  goto l;
 }
 $foto=$projects.$projectname."/icons/".$foto;
 unless (-e fn($foto))
 {
  MyMessageBox($messages[49].' '.$foto.$messages[40],'ok','info');
  if ($sex{$ic} eq 'man') 
  {
   $foto{$ic}='man';
   $foto=$workfolder."graphics/man$size.gif";
  }
  else 
  {
   $foto{$ic}='woman';
   $foto=$workfolder."graphics/woman$size.gif";
  }
 } 
l:
 $icon=Image::Magick->new;
 copy(fn($foto),fn($tmpdir.'tmp'));
 $icon->Read(fn($tmpdir.'tmp'));
 $ramka=Image::Magick->new;
 $ramka->Read(fn($workfolder."graphics/".$facestyle."/ramka$size.gif"));
 (my $x, my $y)=$icon->Get('columns','rows');
 if ($y>=$x) 
 {
  $sy=$ic_size_small*$size;$sx=int(($sy/$y)*$x);
 }
 else
 {
  $sx=$ic_size_small*$size;$sy=int(($sx/$x)*$y);
 }
 my $maxy=$sy;my $maxx=$sx;
 unless (($sx==$x) && ($sy==$y)) {$icon->Resize(width=>$sx,height=>$sy)}
 $ramka->Composite(image=>$icon,compose=>'over',x=>'5',y=>'5');
 $sx=$maxx+16;
 $sy=3+11*$size;
 my $ts=$size*11+($size-1)*2;
 my $s='';my $dy=11*$size;
 unless ($family_name{$ic} eq '') {$s=$family_name{$ic};$ramka->Annotate(family=>'Arial',style=>'Normal',pointsize=>$ts,text=>$s,geometry=>"+$sx+$sy");}
 unless ($first_name{$ic} eq '') 
 {
  unless ($family_name{$ic} eq '') {$sy+=$dy}
  $s=$first_name{$ic};
  $ramka->Annotate(family=>'Arial',style=>'Normal',pointsize=>$ts,text=>$s,geometry=>"+$sx+$sy");
 }
 unless ($second_name{$ic} eq '') 
 {
  unless ($first_name{$ic} eq '') {$sy+=$dy}
  $s=$second_name{$ic};
  $ramka->Annotate(family=>'Arial',style=>'Normal',pointsize=>$ts,text=>$s,geometry=>"+$sx+$sy");
 }
 unless ($birth_date{$ic} eq '') {$s="$messages[31]: $birth_date{$ic}";$sy+=$dy;$ramka->Annotate(family=>'Arial',style=>'Normal',pointsize=>$ts,text=>$s,geometry=>"+$sx+$sy");}
 unless ($death_date{$ic} eq '') {$s="$messages[32]: $death_date{$ic}";$sy+=$dy;$ramka->Annotate(family=>'Arial',style=>'Normal',pointsize=>$ts,text=>$s,geometry=>"+$sx+$sy");}
 my $mess=$messages[34];
 if ($sex{$ic} eq 'man') {$mess=$messages[33];}
 $sy=$maxy+14*$size+3;
 $sx=3*$size+7;
 $ramka->Annotate(family=>'Arial',style=>'Normal',pointsize=>$ts,text=>$mess,geometry=>"+$sx+$sy");
 $ramka->Write(fn($tmpdir.'tmp'));
 copy(fn($tmpdir.'tmp'),fn($projects.$projectname."/$ic.gif"));
 undef $ic;
} 
sub save
{
 my $wp=shift;
 my $file=shift;
 my @info;
 my $aa;
 my $key;
 my $a;
 my $tk=shift;
 if ($tk==1){drawmessage($messages[69])};
 open(F,'>:raw',$file);
 print F "RODOVID";print F "\n";
 print F "Size\n$size";print F "\n";
 if ($tk==1){scroll}
 print F "Scroll\n$scrollx\n$scrolly";print F "\n";
 print F "Peoples";print F "\n";
 $maxpeoples=0;
 while(($key,$a) = each(%people)) {$maxpeoples++}
 print F "$maxpeoples";print F "\n";
 print F "$peoples";print F "\n";
 for $key (sort(keys(%people)))
 {
  $a=$people{$key};
  print F encode('utf8',$key);print F "\n";
  print F encode('utf8',$a);print F "\n";
  print F "$sex{$key}";print F "\n";
  print F "$peoplex{$key}";print F "\n";
  print F "$peopley{$key}";print F "\n";
  print F encode('utf8',$family_name{$key});
  print F "\n";
  print F encode('utf8',$first_name{$key});print F "\n";
  print F encode('utf8',$second_name{$key});print F "\n";
  print F encode('utf8',$birth_date{$key});print F "\n";
  print F encode('utf8',$birth_place{$key});print F "\n";
  print F encode('utf8',$death_date{$key});print F "\n";
  print F encode('utf8',$death_place{$key});print F "\n";
  print F "$foto{$key}";print F "\n";
  print F "$gallery{$key}";print F "\n";
  print F "BeginText";print F "\n"; 
  while (chomp($text{$key})>0){};
  print F encode('utf8',$text{$key});print F "\n";
  print F "EndText";print F "\n"; 
 }
 print F "Fathers";print F "\n";
 $maxfathers=0;
 while(($key,$a) = each(%father)) {$maxfathers++}
 print F "$maxfathers";print F "\n";
 print F "$fathers";print F "\n";
 while(($key,$a) = each(%father))
 {
  print F encode('utf8',$key);print F "\n";
  print F encode('utf8',$a);print F "\n";
 }
 print F "Mothers";print F "\n";
 $maxmothers=0;
 while(($key,$a) = each(%mother)) {$maxmothers++}
 print F "$maxmothers";print F "\n";
 print F "$mothers";print F "\n";
 while(($key,$a) = each(%mother))
 {
  print F encode('utf8',$key);print F "\n";
  print F encode('utf8',$a);print F "\n";
 }
 print F "Spouses";print F "\n";
 $maxspouses=0;
 while(($key,$a) = each(%spouse)) {$maxspouses++}
 print F "$maxspouses";print F "\n";
 print F "$spouses";print F "\n";
 while(($key,$a) = each(%spouse))
 {
  print F encode('utf8',$key);print F "\n";
  print F encode('utf8',$a);print F "\n";
  print F encode('utf8',$marr_date{$key});print F "\n";
  print F encode('utf8',$marr_place{$key});print F "\n";
 }
 print F "Rullers";print F "\n";
 print F "$maxrulers";print F "\n";
 print F "$rulers";print F "\n";
 while(($key,$a) = each(%ruler))
 {
  print F "$a\n";
 }
 #append all exists person's portraits
 my $str;
 foreach $a (glob fn("$projects$wp/icons/*gif"))
 {
  my $aa=basename($a,my $suff=(''));
  #write image name
  print F "$aa";print F "\n";
  @info=stat($a);#$
  #write image size
  print F "$info[7]";print F "\n";
  #append portrait image in binmode
  open(F1,$a);#$
  binmode(F1);
  read(F1,$str,$info[7]);
  close(F1);
  print F $str;
  undef $str;
 }
 close(F);
# save all hidden lines
 my @t=$c->find('all');
 my $t2;
 my @t2;
 my $file_open=0;
 $file=fn($projects.$projectname.'/hidden_lines.conf');
 for (my $i=0;$i<=$#t;$i++) {@t2=$c->gettags($t[$i]);$t[$i]=$t2[0]}
 my %temp = (); @t = grep ++$temp{$_} < 2, @t;
 foreach $t2 (@t) 
 {
  if ($t2=~/:s$/) 
  {
   if ($file_open==0)
   {
    $file_open=1;
    open(F,'>:raw',fn($file));
   }
   print F $t2;print F "\n";
  } 
 };
 undef %temp;
 undef @info;
 undef @t;
 undef @t2;
 if ($file_open==1) {close(F)}
# save tags
 open(F,">:raw",fn($projects.$projectname.'/tags.conf'));
 my $t;
 foreach $t (sort keys %tags)
 {
  print F encode('utf8',$t.'::'.$tags{$t});print F "\n";
 }
 close(F);
# save shortcuts
 open(F,">:raw",fn($projects.$projectname.'/shortcuts.conf'));
 my $t;
 foreach $t (sort keys %shortcuts)
 {
  print F encode('utf8',$t.'::'.$shortcuts{$t}.'::'.$shortcuts_x{$t}.'::'.$shortcuts_y{$t});print F "\n";
 }
 close(F);
# save colors
 open(F,">:raw",fn($projects.$projectname.'/colors.conf'));
 my $t;
 foreach $t (sort keys %colors)
 {
  print F encode('utf8',$t.'::'.$colors{$t});print F "\n";
 }
 close(F);
 if ($tk==1){deletemessage};
 saveoptions;
}
sub create # create new family tree
{
 my $key;
 my $a;
 my $file=fileDialog('create');
 unless ($file eq cancel)
 {
  menustateoff;#menu off
  $projectname=basename($file,my $suff=('.rid'));
  $TOP->configure(-title=>$messages[48]." : ".$projectname);
  clear;
  if (-e fn($projects.$projectname))
  {
   rmtree(fn("$projects$projectname")) || print $!;
  } else 
  {
   mkdir(fn("$projects$projectname"));
  }
  save2(0);
  reloadmenu();
  menustateon;
  return 0;
 }
 else
 {
  return 1
 }
}
sub clear #clear all varriables for family tree and create needed file structure
{
 my $key;
 my $a;
 endgroup();
 if (-e fn($projects.$projectname))
 {
  if ($cache==0) {unlink glob fn("$projects$projectname/*.gif") || print $!;}
 } else 
 {
  mkdir(fn("$projects$projectname"));
 }
 if (-e fn($projects.$projectname."/icons/"))
 {
  if ($cache==0) {unlink glob fn("$projects$projectname/icons/*.gif") || print $!;}
 } else 
 {
  mkdir(fn("$projects.$projectname/icons"));
 }
 # delete all old objects on desktop
 my @t=$c->find('all');
 my $t2;
 my @t2;
 for (my $i=0;$i<=$#t;$i++) {@t2=$c->gettags($t[$i]);$t[$i]=$t2[0]}
 my %temp = (); @t = grep ++$temp{$_} < 2, @t;
 foreach $t2 (@t) 
 {
  if ($t2=~/^people/) {$c->delete($t2)}
  if ($t2=~/^\dspouse/) {$c->delete($t2)}
  if ($t2=~/^father/) {$c->delete($t2)}
  if ($t2=~/^mother/) {$c->delete($t2)}
  if ($t2=~/^ruler/) {$c->delete($t2)}
  if ($t2=~/^jump/) {$c->delete($t2)}
 };
 # clear vars
 undef @t;
 undef @t2;
 undef %temp;
 %father=();
 %mother=();
 %spouse=();
 %people=();
 %sex=();
 %peoplex=();
 %peopley=(); 
 %marr_date=();
 %marr_place=();
 %text=();
 %foto=();
 %family_name=();
 %first_name=();
 %second_name=();
 %birth_date=();
 %birth_place=();
 %death_date=();
 %death_place=();
 %gallery=();
 %ruler=();
 %hidden=();
 %towns_base=();
 #tags
 %tags=(); 
 %colors=(); 
 @project_tags=();$n_tags=0;
 $number_of_tags=0;
 #project properties
 ($di,$av,$op)=('','','');
 @kins=();
 $peoples=0;
 $maxpeoples=0;
 $fathers=0;
 $maxfathers=0;
 $mothers=0;
 $maxmothers=0;
 $spouses=0;
 $maxspouses=0;
 $rulers=0;
 $maxrulers=0;
 $showrulers=1;
 $c->xview(moveto=>.5);
 $c->yview(moveto=>.25);
}
sub savetowns
{
 open(F,">:raw",fn($projects.$projectname.'/towns.txt'));
 my $t;
 foreach $t (sort keys %towns_base)
 {
  print F encode('utf8',$t.' :: '.$towns_base{$t});print F "\n";
 }
 close(F);
}
sub load # load descent
{
 my $i;
 my $t;
 my $key;
 my $a;
 my $son;
 my $image;
 my $oldsize;
 my $sss=0;
 my $a;
 my $s;
 my $str; 
 my ($x1,$y1,$x2,$y2);
 endgroup();
 my $file=fileDialog('openrid');
 unless ($file eq cancel)
 {
  $projectname=basename($file,my $suff=('.rid'));
  drawmessage($messages[69]);
  menustateoff;
  clear;
  %hidden=();
  if (-e fn($projects.$projectname.'/hidden_lines.conf'))
  {
   open(F,"<:raw",fn($projects.$projectname.'/hidden_lines.conf'));
   while (<F>)
   {
    /^(.+):s$/;
    $hidden{$1}='s';
   }
   close(F);
   $hiddenall=0;
  }
  %towns_base=();
  if (-e fn($projects.$projectname.'/towns.txt'))
  {
   open(F,"<:raw",fn($projects.$projectname.'/towns.txt'));
   my $p;
   while(<F>)
   {
    chomp;
    ($t,$p)=split(/ :: /);$t=decode('utf8',$t);$p=decode('utf8',$p);
    $towns_base{$t}=$p;
   }
   close(F);
  }
  %tags=();
  if (-e fn($projects.$projectname.'/tags.conf'))
  {
   open(F,"<:raw",fn($projects.$projectname.'/tags.conf'));
   my $p;
   while(<F>)
   {
    chomp;
    ($t,$p)=split(/::/);$t=decode('utf8',$t);$p=decode('utf8',$p);
    $tags{$t}=$p;
   }
   close(F);
  }
  #find different tags
  inittags;
  %shortcuts=();
  %shortcuts_x=();
  %shortcuts_y=();
  $maxshortcuts=0;
  if (-e fn($projects.$projectname.'/shortcuts.conf'))
  {
   open(F,"<:raw",fn($projects.$projectname.'/shortcuts.conf'));
   my ($t,$p,$x,$y); 
   while(<F>)
   {
    chomp;
    ($t,$p,$x,$y)=split(/::/);$t=decode('utf8',$t);$p=decode('utf8',$p);
    $shortcuts{$t}=$p;
    $shortcuts_x{$t}=$x;
    $shortcuts_y{$t}=$y;
    $maxshortcuts+=1;
   }
   close(F);
  }
  %colors=();
  if (-e fn($projects.$projectname.'/colors.conf'))
  {
   open(F,"<:raw",fn($projects.$projectname.'/colors.conf'));
   my $p;
   my $p1;
   while(<F>)
   {
    chomp;
    ($t,$p)=split(/::/);
    $t=decode('utf8',$t);$p=decode('utf8',$p); $p1=lc $p;
    $colors{$t}=$p1;
   }
   close(F);
  }
  $townresult='';
  $TOP->configure(-title=>$messages[48]." : ".$projectname);
  open(F,'<:raw',fn($file)) || print "Error open file .rid(".fn($file)."): $!";
  if (<F> eq "RODOVID\n")
  {
   if (<F> ne "Size\n") {MyMessageBox($messages[153].'Size','ok','info');deletemessage;menustateon;return 1} 
   else 
   {
    $oldsize=$size;
    $size=<F>;chomp($size);$size=decode('utf8',$size);
    if ($size==2)
    {
     $mashtab=$messages[84];
     reloadmenu();
     menustateoff;
    }
    if ($size==1)
    {
     $mashtab=$messages[83];
     reloadmenu();
     menustateoff;
    }
   }
   if (<F> ne "Scroll\n") {MyMessageBox($messages[153].'Scroll','ok','info');deletemessage;menustateon;return 1} 
   else 
   {
    $scrollx=<F>;chomp($scrollx);$scrollx=decode('utf8',$scrollx);
    $scrolly=<F>;chomp($scrolly);$scrolly=decode('utf8',$scrolly);
   }
   if (<F> ne "Peoples\n") {MyMessageBox($messages[153].'Peoples','ok','info');deletemessage;menustateon;return 1}
   $maxpeoples=<F>;chomp($maxpeoples);$maxpeoples=decode('utf8',$maxpeoples);
   $peoples=<F>;chomp($peoples);$peoples=decode('utf8',$peoples);
   for ($i=1;$i<=$maxpeoples;$i++)
   {
    $key=<F>;chomp($key);$key=decode('utf8',$key);
    $a=<F>;chomp($a);$a=decode('utf8',$a);
    $people{$key}=$a;
    $sex{$key}=<F>;chomp($sex{$key});$sex{$key}=decode('utf8',$sex{$key});
    $peoplex{$key}=<F>;chomp($peoplex{$key});$peoplex{$key}=decode('utf8',$peoplex{$key});
    $peopley{$key}=<F>;chomp($peopley{$key});$peopley{$key}=decode('utf8',$peopley{$key});
    $peoplex{$key}=(int($peoplex{$key}/$step)*$step);
    $peopley{$key}=(int($peopley{$key}/$step)*$step);
    $family_name{$key}=<F>;chomp($family_name{$key});$family_name{$key}=decode('utf8',$family_name{$key});
    $first_name{$key}=<F>;chomp($first_name{$key});$first_name{$key}=decode('utf8',$first_name{$key});
    $second_name{$key}=<F>;chomp($second_name{$key});$second_name{$key}=decode('utf8',$second_name{$key});
    $birth_date{$key}=<F>;chomp($birth_date{$key});$birth_date{$key}=decode('utf8',$birth_date{$key});
## This two parts (BIRTH and DEATH) can be used for transate some dates to another syntax. In my example I use translate ukrainian monthnames(normal and misspelled) ) to month number
## If you wants update dates in icons, you must turn off caching icons in preferences.
#
## BIRTH
#    my $new_date;
#    $new_date=$birth_date{$key};
#    $new_date=~s/березня/3/;
#    $new_date=~s/вересня/9/;
#    $new_date=~s/грудня/12/;
#    $new_date=~s/жовтня/10/;
#    $new_date=~s/квітня/4/;
#    $new_date=~s/липня/7/;
#    $new_date=~s/листопада/11/;
#    $new_date=~s/лтого/2/;
#    $new_date=~s/лютого/2/;
#    $new_date=~s/Лютого/2/;
#    $new_date=~s/Серпня/8/;
#    $new_date=~s/серпня/8/;
#    $new_date=~s/січна/1/;
#    $new_date=~s/січня/1/;
#    $new_date=~s/травень/5/;
#    $new_date=~s/травня/5/;
#    $new_date=~s/червня/6/;
#    $new_date=~s/Червня/6/;
#    if ($new_date=~/^(.+) (.+) (.+)$/)
#    {
#     $new_date="$3.$2.$1";
#    }
#    print "BD: $birth_date{$key} - $new_date\n";
#    $birth_date{$key}=$new_date;
    $birth_place{$key}=<F>;chomp($birth_place{$key});$birth_place{$key}=decode('utf8',$birth_place{$key});
    $death_date{$key}=<F>;chomp($death_date{$key});$death_date{$key}=decode('utf8',$death_date{$key});
## DEATH
#    $new_date=$death_date{$key};
#    $new_date=~s/березня/3/;
#    $new_date=~s/вересня/9/;
#    $new_date=~s/грудня/12/;
#    $new_date=~s/жовтня/10/;
#    $new_date=~s/квітня/4/;
#    $new_date=~s/липня/7/;
#    $new_date=~s/листопада/11/;
#    $new_date=~s/лтого/2/;
#    $new_date=~s/лютого/2/;
#    $new_date=~s/Лютого/2/;
#    $new_date=~s/Серпня/8/;
#    $new_date=~s/серпня/8/;
#    $new_date=~s/січна/1/;
#    $new_date=~s/січня/1/;
#    $new_date=~s/травень/5/;
#    $new_date=~s/травня/5/;
#    $new_date=~s/червня/6/;
#    $new_date=~s/Червня/6/;
#    if ($new_date=~/^(.+) (.+) (.+)$/)
#    {
#     $new_date="$3.$2.$1";
#    }
#    print "DD: $death_date{$key} - $new_date\n";
#    $death_date{$key}=$new_date;
    $death_place{$key}=<F>;chomp($death_place{$key});$death_place{$key}=decode('utf8',$death_place{$key});
    $foto{$key}=<F>;chomp($foto{$key});$foto{$key}=decode('utf8',$foto{$key});
    $gallery{$key}=<F>;chomp($gallery{$key});$gallery{$key}=decode('utf8',$gallery{$key});
    if ($gallery{$key} eq '')
    {
     unlink glob fn($projects.$projectname."/gallery/$key/icons/*.gif");
     unlink glob fn($projects.$projectname."/gallery/$key/*");
     unlink fn($projects.$projectname."/gallery/$key.gal");
    }
    if (<F> ne "BeginText\n") {MyMessageBox($messages[153]."Text $people{$key}",'ok','info');deletemessage;menustateon;return 1}
    $text{$key}='';
    while ($a=<F>)
    {
     $a=decode('utf8',$a);
     if ($a eq "EndText\n") {last}
     $text{$key}.=$a;
    }
    while (chomp($text{$key})>0){};
   }
   if (<F> ne "Fathers\n") {MyMessageBox($messages[153].'Fathers','ok','info');deletemessage;menustateon;return 1}
   $maxfathers=<F>;chomp($maxfathers);$maxfathers=decode('utf8',$maxfathers);
   $fathers=<F>;chomp($fathers);$fathers=decode('utf8',$fathers);
   if ($maxfathers>0)
   {
    for ($i=1;$i<=$maxfathers;$i++)
    {
     $key=<F>;chomp($key);$key=decode('utf8',$key);
     $a=<F>;chomp($a);$a=decode('utf8',$a);
     $father{$key}=$a;
    }
   } 
   if (<F> ne "Mothers\n") {MyMessageBox($messages[153].'Mothers','ok','info');deletemessage;menustateon;return 1}
   $maxmothers=<F>;chomp($maxmothers);$maxmothers=decode('utf8',$maxmothers);
   $mothers=<F>;chomp($mothers);$mothers=decode('utf8',$mothers);
   if ($maxmothers>0)
   {
    for ($i=1;$i<=$maxmothers;$i++)
    {
     $key=<F>;chomp($key);$key=decode('utf8',$key);
     $a=<F>;chomp($a);$a=decode('utf8',$a);
     $mother{$key}=$a;
    }
   }
   if (<F> ne "Spouses\n") {MyMessageBox($messages[153].'Spouses','ok','info');deletemessage;menustateon;return 1}
   $maxspouses=<F>;chomp($maxspouses);$maxspouses=decode('utf8',$maxspouses);
   $spouses=<F>;chomp($spouses);$spouses=decode('utf8',$spouses);
   if ($maxspouses>0)
   {
    for ($i=1;$i<=$maxspouses;$i++)
    {
     $key=<F>;chomp($key);$key=decode('utf8',$key);
     $a=<F>;chomp($a);$a=decode('utf8',$a);
     $spouse{$key}=$a;
     $marr_date{$key}=<F>;chomp($marr_date{$key});$marr_date{$key}=decode('utf8',$marr_date{$key});
     $marr_place{$key}=<F>;chomp($marr_place{$key});$marr_place{$key}=decode('utf8',$marr_place{$key});
    }
   }
   if (<F> ne "Rullers\n") {MyMessageBox($messages[153].'Rullers','ok','info');deletemessage;menustateon;return 1}
   $maxrulers=<F>;chomp($maxrulers);$maxrulers=decode('utf8',$maxrulers);
   $rulers=<F>;chomp($rulers);$rulers=decode('utf8',$rulers);
   if ($rulers>0)
   {
    for ($i=1;$i<=$rulers;$i++)
    {
     $a=<F>;chomp($a);
     $ruler{$i}=$a;
     $c->createLine(3, $a,$xcanvas-3,$a,-tags=>'ruler'.$i, -width=>widthruler, -fill=>rulercolor, -dash=>"-", -activefill=>'red',);
    }
   }
  } else {MyMessageBox($messages[161],'ok','info');deletemessage;menustateon;return 1}
  unless (-e fn($projects.$projectname."/")) {mkdir(fn($projects.$projectname."/"))}
  unless (-e fn($projects.$projectname."/icons/")) {mkdir(fn($projects.$projectname."/icons/"))}
  $t=0;
  while ()
  {
   $a=<F> || last;chomp($a);
   $s=<F>;chomp($s);
   read(F,$str,$s);
   unless (-e fn($projects.$projectname."/icons/".$a)) # if file present don't replace it;
   {
    open(F2,fn('>'.$projects.$projectname."/icons/".$a));
    binmode(F2,':raw');
    print F2 $str;
    close(F2);
    $t++;
    drawmessage($messages[59].(int(($t*100)/$maxpeoples)).' %');
   }
   else
   {
    if ($cache==0) 
    {
     open(F2,fn('>'.$projects.$projectname."/icons/".$a));
     binmode F2;
     print F2 $str;
     close(F2);
     $t++;
     drawmessage($messages[59].(int(($t*100)/$maxpeoples)).' %');
    }
   }
   undef $str;
  }
  close(F);
  $t=0;
  if ($maxpeoples>0)
  {
   foreach $key (keys %people)
   {
    unless (-e fn("$projects$projectname/$key.gif")) 
    {
     createramka($key);
     $t++;my $pr=int(($t*100)/$maxpeoples);
     drawmessage($messages[70].':'.$pr.' %');
    } # if file not preset then create them
    else
    {
     if (($cache==0) || ($oldsize!=$size)) 
     {
      createramka($key);
      $t++;my $pr=int(($t*100)/$maxpeoples);
      drawmessage($messages[70].':'.$pr.' %');
     } # if cache=0 or changed size then create them
    }
   }
  }
  reloadallramka;
  $c->xview(moveto=>$scrollx);
  $c->yview(moveto=>$scrolly);
  deletemessage;
  menustateon;
  return 0;
 } else 
 {
  return 1;
 }
}
sub scroll #get scroll possitions
{
 my $t;
 ($scrollx,$t) = $c -> xview;
 ($scrolly,$t) = $c -> yview;
}
sub number2 # get second number from structure like "1:2"
{
 my $s=shift;
 $s=~/(\d+)\:(\d+)/;
 return $2;
}
sub number1 # get first number from structure like "1:2"
{
 my $s=shift;
 $s=~/(\d+)\:(\d+)/;
 return $1;
} 
sub addrid # add external descent to current project
{
 my $i;
 my $t;
 my $key;
 my $a;
 my $son;
 my $image;
 my $oldsize;
 my $sss=0;
 my $a;
 my $s;
 my $j=0;
 my $str; 
 my $maxpp;
 my $peopl;
 my $maxm;
 my $moth;
 my $maxf;
 my $fath;
 my $maxs;
 my $spou;
 my $maxr;
 my $rul;
 my $scrx;
 my $scry;
 my ($x1,$y1,$x2,$y2);
 my $oldproj;
 my $scrdy2=0;
 my ($px1,$py1,$px2,$py2);
 my ($px12,$py12,$px22,$py22);
 my @newrul;
 my $j;
 my $sold;
 my $snew;
 my ($minx,$miny,$maxx,$maxy);
 my @kins2=();
 my $file=fileDialog('openrid');
 unless ($file eq cancel)
 {
  endgroup();
  @kins=();$i=0;
  foreach $key (keys %people)
  {
   $kins[$i]='people'.$key;$i++
  }
  if ($maxpeoples==0)
  {
   ($px1,$py1,$px2,$py2)=($bx,$by,$bx+64,$by+32);
  }
  else
  {
   ($px1,$py1,$px2,$py2)=$c->bbox(@kins);
  }
  scroll();
  $oldproj=$projectname;
  $projectname=basename($file,my $suff=('.rid'));
  drawmessage($messages[69]);
  if (-e fn($projects.$projectname.'/towns.txt'))
  {
   open(F,"<:raw",fn($projects.$projectname.'/towns.txt'));
   my $p;
   while(<F>)
   {
    chomp;
    ($t,$p)=split(/ :: /);$t=decode('utf8',$t);$p=decode('utf8',$p);
    $towns_base{$t}=$p; #??? if $t exist?
   }
   close(F);
  }
  $townresult='';
  open(F,'<:raw',fn($file));
  if (<F> eq "RODOVID\n")
  {
   if (<F> ne "Size\n") {MyMessageBox($messages[153].'Size','ok','info');deletemessage;menustateon;return 1} 
   else {<F>}
   if (<F> ne "Scroll\n") {MyMessageBox($messages[153].'Scroll','ok','info');deletemessage;menustateon;return 1} 
   else 
   {
    $scrx=<F>;chomp($scrx);$scrx=decode('utf8',$scrx);
    $scry=<F>;chomp($scry);$scry=decode('utf8',$scry);
   }
   if (<F> ne "Peoples\n") {MyMessageBox($messages[153].'Peoples','ok','info');deletemessage;menustateon;return 1}
   $maxpp=<F>;chomp($maxpp);$maxpp=decode('utf8',$maxpp);
   $peopl=<F>;chomp($peopl);$peopl=decode('utf8',$peopl);
   for ($i=1;$i<=$maxpp;$i++)
   {
    $key=<F>;chomp($key);$key=decode('utf8',$key);
    $key=$maxpeoples+$key;
    $kins2[$i-1]='people'.$key;
    $a=<F>;chomp($a);$a=decode('utf8',$a);
    $a=/(\d+)/;
    $people{$key}='people'.$key;
    $sex{$key}=<F>;chomp($sex{$key});$sex{$key}=decode('utf8',$sex{$key});
    $peoplex{$key}=<F>;chomp($peoplex{$key});$peoplex{$key}=decode('utf8',$peoplex{$key});
    $peopley{$key}=<F>;chomp($peopley{$key});$peopley{$key}=decode('utf8',$peopley{$key});
    $peoplex{$key}=(int($peoplex{$key}/$step)*$step);
    $peopley{$key}=(int($peopley{$key}/$step)*$step);
    $family_name{$key}=<F>;chomp($family_name{$key});$family_name{$key}=decode('utf8',$family_name{$key});
    $first_name{$key}=<F>;chomp($first_name{$key});$first_name{$key}=decode('utf8',$first_name{$key});
    $second_name{$key}=<F>;chomp($second_name{$key});$second_name{$key}=decode('utf8',$second_name{$key});
    $birth_date{$key}=<F>;chomp($birth_date{$key});$birth_date{$key}=decode('utf8',$birth_date{$key});
    $birth_place{$key}=<F>;chomp($birth_place{$key});$birth_place{$key}=decode('utf8',$birth_place{$key});
    $death_date{$key}=<F>;chomp($death_date{$key});$death_date{$key}=decode('utf8',$death_date{$key});
    $death_place{$key}=<F>;chomp($death_place{$key});$death_place{$key}=decode('utf8',$death_place{$key});
    $foto{$key}=<F>;chomp($foto{$key});
    if ($foto{$key}=~/(\d+)/) 
    {
     $foto{$key}=~/(\d+)/;$foto{$key}=($1+$maxpeoples).'.gif';
    }
    $gallery{$key}=<F>;chomp($gallery{$key});$gallery{$key}=decode('utf8',$gallery{$key});
    if ($gallery{$key} eq '')
    {
     unlink glob fn($projects.$projectname."/gallery/$key/icons/*.gif");
     unlink glob fn($projects.$projectname."/gallery/$key/*");
     unlink fn($projects.$projectname."/gallery/$key.gal");
    }
    else # galery exist
    {
     unless (-e fn($projects.$oldproj."/gallery"))
     {
      mkdir(fn($projects.$oldproj."/gallery"));
     }
     unless (-e fn($projects.$oldproj."/gallery/$key"))
     {
      mkdir(fn($projects.$oldproj."/gallery/$key"));
     }
     unless (-e fn($projects.$oldproj."/gallery/$key/icons"))
     {
      mkdir(fn($projects.$oldproj."/gallery/$key/icons"));
     }
     open(FF,fn($projects.$projectname.'/gallery/'.($key-$maxpeoples).'.gal'));
     open(FF2,'>'.fn($projects.$oldproj.'/gallery/'.$key.'.gal'));
     while ($a=<FF>)
     {
      $sold=$projects.$projectname.'/gallery/'.($key-$maxpeoples);
      $snew=$projects.$oldproj.'/gallery/'.$key;
      $a=~s/$sold/$snew/;
      print FF2 $a;
      $a=<FF>;
      print FF2 $a;
     }
     close(FF);
     close(FF2);
     copys(fn($projects.$projectname.'/gallery/'.($key-$maxpeoples).'/*'),fn($projects.$oldproj.'/gallery/'.$key));
     my @files;
     @files=glob fn($projects.$oldproj.'/gallery/'.$key.'/*.gif');
     my $s;
     foreach $s (@files)
     {
      my $icon=Image::Magick->new;
      my $sx;
      my $sy;
      copy(fn($s),fn($tmpdir.'tmp'));
      $icon->Read(fn($tmpdir.'tmp'));
      ($x, $y)=$icon->Get('columns','rows');
      if ($y>=$x) {$sy=$gal_size;$sx=int (($sy/$y)*$x)}
      else {$sx=$gal_size;$sy=int (($sx/$x)*$y)}
      unless (($sx==$x) && ($sy==$y)) {$icon->Resize(width=>$sx,height=>$sy)}
      $icon->Write(fn($tmpdir.'tmp'));
      $s=~/(\d+)\.gif/;
      copy(fn($tmpdir.'tmp'),fn("$projects$oldproj/gallery/$key/icons/$1.gif"));
     }
    }

    if (<F> ne "BeginText\n") {MyMessageBox($messages[153]."Text $people{$key}",'ok','info');deletemessage;menustateon;return 1}
    $text{$key}='';
    while ($a=<F>)
    {
     $a=decode('utf8',$a);
     if ($a eq "EndText\n") {last}
     $text{$key}.=$a;
    }
    while (chomp($text{$key})>0){};
   }
   if (<F> ne "Fathers\n") {MyMessageBox($messages[153].'Fathers','ok','info');deletemessage;menustateon;return 1}
   $maxf=<F>;chomp($maxf);$maxf=decode('utf8',$maxf);
   $fath=<F>;chomp($fath);$fath=decode('utf8',$fath);
   if ($maxf>0)
   {
    for ($i=1;$i<=$maxf;$i++)
    {
     $key=<F>;chomp($key);$key=decode('utf8',$key);
     $a=<F>;chomp($a);$a=decode('utf8',$a);
     $a=~/(\d+):(\d+)/;
     $father{$maxfathers+$key}=($1+$maxpeoples).':'.($2+$maxpeoples);
    }
   } 
   if (<F> ne "Mothers\n") {MyMessageBox($messages[153].'Mothers','ok','info');deletemessage;menustateon;return 1}
   $maxm=<F>;chomp($maxm);$maxm=decode('utf8',$maxm);
   $moth=<F>;chomp($moth);$moth=decode('utf8',$moth);
   if ($maxm>0)
   {
    for ($i=1;$i<=$maxm;$i++)
    {
     $key=<F>;chomp($key);$key=decode('utf8',$key);
     $a=<F>;chomp($a);$a=decode('utf8',$a);
     $a=~/(\d+):(\d+)/;
     $mother{$maxmothers+$key}=($1+$maxpeoples).':'.($2+$maxpeoples);
    }
   }
   if (<F> ne "Spouses\n") {MyMessageBox($messages[153].'Spouses','ok','info');deletemessage;menustateon;return 1}
   $maxs=<F>;chomp($maxs);$maxs=decode('utf8',$maxs);
   $spou=<F>;chomp($spou);$spou=decode('utf8',$spou);
   if ($maxs>0)
   {
    for ($i=1;$i<=$maxs;$i++)
    {
     $key=<F>;chomp($key);$key=decode('utf8',$key);
     $a=<F>;chomp($a);$a=decode('utf8',$a);
     $a=~/(\d+):(\d+)/;
     $spouse{$maxspouses+$key}=($1+$maxpeoples).':'.($2+$maxpeoples);
     $marr_date{$maxspouses+$key}=<F>;chomp($marr_date{$maxspouses+$key});$marr_date{$maxspouses+$key}=decode('utf8',$marr_date{$maxspouses+$key});
     $marr_place{$maxspouses+$key}=<F>;chomp($marr_place{$maxspouses+$key});$marr_place{$maxspouses+$key}=decode('utf8',$marr_place{$maxspouses+$key});
    }
   }
   if (<F> ne "Rullers\n") {MyMessageBox($messages[153].'Rullers','ok','info');deletemessage;menustateon;return 1}
   $maxr=<F>;chomp($maxr);$maxr=decode('utf8',$maxr);
   $rul=<F>;chomp($rul);$rul=decode('utf8',$rul);
   if ($rul>0)
   {
    for ($i=1;$i<=$rul;$i++)
    {
     $a=<F>;chomp($a);
     $ruler{$i+$maxrulers}=$a;
     $newrul[$j]=$i+$maxrulers;$j++;
     $c->createLine(3, $ruler{$i+$maxrulers},$xcanvas-3,$ruler{$i+$maxrulers},-tags=>'ruler'.($i+$maxrulers), -width=>widthruler, -fill=>rulercolor, -dash=>"-", -activefill=>'red',);
    }
   }
  } else {MyMessageBox($messages[161],'ok','info');deletemessage;menustateon;return 1}
  $projectname=$oldproj;
  unless (-e fn($projects.$projectname."/")) {mkdir(fn($projects.$projectname."/"))}
  unless (-e fn($projects.$projectname."/icons/")) {mkdir(fn($projects.$projectname."/icons/"))}
  $t=0;
  while ()
  {
   $a=<F> || last;chomp($a);
   $a=~/(\d+)/;
   $a=($1+$maxpeoples).'.gif';
   $s=<F>;chomp($s);
   read(F,$str,$s);
   unless (-e fn($projects.$projectname."/icons/".$a)) # if file present don't replace it;
   {
    open(F2,fn('>'.$projects.$projectname."/icons/".$a));
    binmode(F2,':raw');
    print F2 $str;
    close(F2);
    $t++;
    if ($maxpeoples>0) {drawmessage($messages[59].(int(($t*100)/$maxpeoples)).' %')}
   }
   else
   {
    if ($cache==0) 
    {
     open(F2,fn('>'.$projects.$projectname."/icons/".$a));
     binmode F2;
     print F2 $str;
     close(F2);
     $t++;
     if ($maxpeoples>0) {drawmessage($messages[59].(int(($t*100)/$maxpeoples)).' %')}
    }
   }
   undef $str;
  }
  close(F);
  $t=0;
  if ($maxpp>0)
  {
   foreach $key (keys %people)
   {
    createramka($key);
    $t++;my $pr=int(($t*100)/($maxpeoples+$maxpp));
    drawmessage($messages[70].':'.$pr.' %');
   }
  }
  $kins2[0]=~/(\d+)/;
  $minx=$peoplex{$1};
  $miny=$peopley{$1};
  $maxx=$peoplex{$1};
  $maxy=$peopley{$1};
  foreach $key (@kins2)
  {
   $key=~/(\d+)/;
   if ($peoplex{$1}<$minx) {$minx=$peoplex{$1}}
   if ($peopley{$1}<$miny) {$miny=$peopley{$1}}
   if ($peoplex{$1}>$maxx) {$maxx=$peoplex{$1}}
   if ($peopley{$1}>$maxy) {$maxy=$peopley{$1}}
  }
  my $area_dx=$maxx-$minx;
  my $area_dy=$maxy-$miny;
  scroll();
  $TOP->geometry=~/(\d+)x(\d+)/;
  my $topx=$1;
  my $topy=$2;
  foreach $key (@kins2)
  {
   $key=~/(\d+)/;
   $peoplex{$1}=($scrollx+($topx/2)/$xcanvas)*$xcanvas+$peoplex{$1}-$minx;
   $peopley{$1}=($scrolly+($topy/2)/$ycanvas)*$ycanvas+$peopley{$1}-$miny;
  }
  my $oldrul;
  foreach $key (@newrul)
  {
   $oldrul=$ruler{$key};
   $ruler{$key}=($scrolly+($topy/2)/$ycanvas)*$ycanvas+$ruler{$key}-$miny;
   $c->move('ruler'.$key,0,$ruler{$key}-$oldrul); # move ruler
  }
  reloadallramka(1);
  ($px12,$py12,$px22,$py22)=$c->bbox(@kins2);
  # if areas are intersect then move one area down by $scrdy2 pixels
  my $mov=0;
  if (($py12<$py2) && ($py1<$py12)) {$scrdy2=$py2-$py12+$step;$mov=1}
  if (($py22>$py1) && ($py2>$py22)) {$scrdy2=$py1-$py22-$step;$mov=1}
  if (($py1>$py12) && ($py2<$py22)) {$scrdy2=$py2-$py12+$step;$mov=1}
  if (($py12>$py1) && ($py2>$py22)) {$scrdy2=$py22-$py1+$step;$mov=1}
  if ($mov==1)
  {
   foreach $key (@kins2)
   {
    $key=~/people(\d+)/;
    $peopley{$1}+=$scrdy2;
   }
   foreach $key (@newrul)
   {
    $ruler{$key}+=$scrdy2;
    $c->move('ruler'.$key,0,$scrdy2); # move ruler
   }
  }
  # if areas has X distance greater then $dist_areas then move one area closer by $scrdy2 pixels
  $mov=0;
  if (($px12-$px2)>$dist_areas) {$scrdy2=$px2-$px12+$step;$mov=1}
  else 
  {
   if (($px1-$px22)>$dist_areas) {$scrdy2=$px1-$px22-$step;$mov=1}
  }
  if ($mov==1) 
  {
   foreach $key (@kins2)
    {
    $key=~/people(\d+)/;
    $peoplex{$1}+=$scrdy2;
   }
  }
  # if areas has Y distance greater then $dist_areas then move one area closer by $scrdy2 pixels
  $mov=0;
  if (($py12-$py2)>$dist_areas) {$scrdy2=$py2-$py12+$step;$mov=1}
  else 
  {
   if (($py1-$py22)>$dist_areas) {$scrdy2=$py1-$py22-$step;$mov=1}
  }
  if ($mov==1) 
  {
   foreach $key (@kins2)
    {
    $key=~/people(\d+)/;
    $peopley{$1}+=$scrdy2;
   }
   foreach $key (@newrul)
   {
    $ruler{$key}+=$scrdy2;
    $c->move('ruler'.$key,0,$scrdy2); # move ruler
   }
  }
  #new box coords
  reloadallramka(1);
  ($px12,$py12,$px22,$py22)=$c->bbox(@kins2);
  $TOP->geometry=~/^(\d+)x(\d+)/;
  my $x=int($1/2);
  my $y=int($2/2);
  $c->xview(moveto=>(($px22+$px12)/2-$x)/$xcanvas);
  $c->yview(moveto=>(($py22+$py12)/2-$y)/$ycanvas);
  endgroup();
  $draggroup=3;
  @kins=@kins2;
  $c->createRectangle($c->bbox(@kins),-dash=>$dashmarkbox,-width=>2,-tags=>'markbox',-outline=>'blue');
  drawmessage($messages[55]);

  $maxpeoples+=$maxpp;
  $peoples+=$peopl;
  $maxfathers+=$maxf;
  $fathers+=$fath;
  $maxmothers+=$maxm;
  $mothers+=$moth;
  $maxspouses+=$maxs;
  $spouses+=$spou;
  $maxrulers+=$maxr;
  $rulers+=$rul;
  deletemessage;
  menustateon;
  return 0;
 } else 
 {
  return 1;
 }
}
sub saveas #save family tree as...
{
 my $file=fileDialog('save');
 unless ($file eq cancel)
 {
  my $saveas=basename($file,my $suff=('.rid'));
  my $k;
  my $a;
  save(fn($projectname),fn("$projects$saveas.rid"),1);
  if (-e fn("$projects$saveas")) 
  {
   rmtree(fn("$projects$saveas/"));
  }
  mkdir(fn("$projects$saveas"));
  mkdir(fn("$projects$saveas/icons"));
  mkdir(fn("$projects$saveas/gallery"));
  drawmessage($messages[69]); 
  copys(fn("$projects$projectname/icons/*"),fn("$projects$saveas/icons/"));
  copys(fn("$projects$projectname/*"),fn("$projects$saveas/"));
  foreach $k (keys %people)
  {
   if ($gallery{$k} eq '1')
   {
    drawmessage($messages[47].$k."..."); 
    $image=$k;
    opengallery();
    open(F,'>:raw',fn("$projects$saveas/gallery/$k.gal"));
    for (my $i=0;$i<=(@gallery-1);$i++)
    {
     print F encode('utf8',"$projects$saveas/gallery/$k/".basename($gallery[$i],''));print F "\n";
     print F encode('utf8',$texts[$i]);print F "\n";
    }
    close(F);
    mkdir(fn("$projects$saveas/gallery/$k/"));
    mkdir(fn("$projects$saveas/gallery/$k/icons/"));
    copys(fn("$projects$projectname/gallery/$k/*"),fn("$projects$saveas/gallery/$k/"));
    copys(fn("$projects$projectname/gallery/$k/icons/*"),fn("$projects$saveas/gallery/$k/icons"));
   }
  }
  $projectname=$saveas;
  $TOP->configure(-title=>$messages[48]." : ".$projectname);
  deletemessage();
  return 0;
 }
 else
 {
  return 1;
 }
}
sub save3
{
 save2(1);
}
sub save2
{
 my $s=shift;
 unless (-e fn($projects.$projectname.'/')) {mkdir(fn($projects.$projectname.'/'))}
 unless (-e fn($projects.$projectname.'/icons/')) {mkdir(fn($projects.$projectname.'/icons/'))}
 save(fn($projectname),fn($projects.$projectname.'.rid'),1);
 if ($s==1) {MyMessageBox($messages[136],'ok','info_n')}
}
sub exportged #export family tree to GEDCOM file
{
 menustateoff;
 my $file=fileDialog('saveged');
 unless ($file eq cancel)
 {
  drawmessage($messages[69]);
  my $f=basename($file,'.ged');
  my $f2=basename($file,'');
  if ($f2 eq $f)
  {
   $f=$f.'.ged';
   if (-e $f)
   {
    MyMessageBox($messages[162],'YesNo','question');
    if ($BoxResult==0)
    {
     deletemessage();
     menustateon;
     return 1;
    }
   }
  }
  else {$f=$f2}
  %ged=();
  if ($^O eq 'MSWin32')
  {
   $ged=Gedcom->new(grammar_version=>5.5);
  }
  if ($^O eq 'linux')
  {
   $ged=Gedcomlite->new(grammar_version=>5.5);
  }
  my $h=$ged->get_header;
  $h->tag_record('CHAR')->{value}='UTF-8';
  my $s=$h->tag_record('NOTE');
  for (split /\n/, <<'EOH')
----------------------------------------------------------------------------
Genealogy tree created by Rodovid %version
Rodovid is Copyright 2010-%year, Alexander Mishchenko (sasha.mishchenko@gmail.com)

Rodovid is free. It is licensed under GPL.

The latest version of Rodovid should be available from project page:
http://sourceforge.net/projects/rodovid/
EOH
  {
   $s->add('CONT',$_);
  };
  my $t=$ged->{record}->get_record('TRLR');
  $t->delete;
  my $key;
  my $a;
  my $imagename;
# export peoples
  foreach $key (keys %people)
  {
   my $indi=$ged->add_individual;
   $indi->{xref}=~/I(\d+)/;
   $ged{$key}=$1;
   $indi->add('NAME',"$first_name{$key} $second_name{$key} /$family_name{$key}/");
   $indi->add('SEX','M');
   if ($sex{$key} eq 'woman') {$indi->tag_record('SEX')->{value}="F"}
   my $b=$indi->add('BIRT');
   $b->add('DATE',$birth_date{$key});
   $b->add('PLAC',$birth_place{$key});
   my $d=$indi->add('DEAT');
   $d->add('DATE',$death_date{$key});
   $d->add('PLAC',$death_place{$key});
   my $note=$indi->add('NOTE');
   while (chomp($text{$key})>0){};
   for (split /\n/, $text{$key})
   {
    $note->add('CONT',$_);
   };
   if ($gallery{$key}==1)
   {
    $image=$key;
    opengallery;
    for (my $i=0;$i<gallerylength($key);$i++)
    {
     my $obj=$indi->add('OBJE');
     my ($nam,$pat,$ext)=fileparse(fn($gallery[$i]),@fotoext);
     $imagename=$projects.$projectname."/gallery/$key/$nam$ext";
     $obj->add('FORM',$ext);
     $obj->add('TITL',$texts[$i]);
     if ($OS eq 'MSWin32')
     {
      $imagename=~s/\//\\/g;
      $imagename=~s/\\\\/\\/g; #convert filename to canonical type if OS=Win32.
      $imagename=encode('UTF8',$imagename);
     }
     $obj->add('FILE',$imagename);
    }
   }
  }
#export spouses
  foreach $a (values %spouse)
  {
   $a=~/(\d+)\:(\d+)/;
   my $son=$1;
   my $image=$2;
   my $indi0=$ged->get_individual("I$ged{$son}");
   my $indi2=$ged->get_individual("I$ged{$image}");
   my $fam;
   $fam=$ged->add_family;
   my $fn=$fam->{xref};
   if ($sex{$son} eq 'woman')
   {
    $fam->add('WIFE',"I$ged{$son}");
    $indi0->add('FAMS',$fn);
   }
   else
   {
    $fam->add('HUSB','I'.$ged{$son});
    $indi0->add('FAMS',$fn);
   }
   if ($sex{$image} eq 'woman')
   {
    $fam->add('WIFE','I'.$ged{$image});
    $indi2->add('FAMS',$fn);
   }
   else
   {
    $fam->add('HUSB','I'.$ged{$image});
    $indi2->add('FAMS',$fn);
   }
  }
# create families by information about fathers and mothers...
  my $d;
  my $k2;
  my $a2;
  foreach $key (keys %people)
  {
   my $indi='';
   my $indi2='';
   my $fk='';
   my $mk='';
   my $fam;
   foreach $a2 (values %father)
   {
    if (number1($a2) eq $key)
    {
     $indi=$key;$fk=number2($a2);
     last
    }
   }
   foreach $a2 (values %mother)
   {
    if (number1($a2) eq $key)
    {
     $indi2=$key;$mk=number2($a2);
     last;
    }
   }
   if (($indi eq '') && ($indi2 eq ''))
   {
    goto nxt7;
   }
# if present father and mother
   my $f;
   if ($indi eq $indi2)
   {
    my $gf=$ged{$fk};
    my $gm=$ged{$mk};
    foreach $f ($ged->families)
    {
     my $w=$f->tag_value('WIFE');
     $w=~/I(\d+)/;
     $w=$1;
     my $h=$f->tag_value('HUSB');
     $h=~/I(\d+)/;
     $h=$1;
     if (($w eq $gm) && ($h eq $gf))
     {
      $d=$f;
      $d->add('CHIL',"I$ged{$key}");
      $indi=$ged->get_individual("I$ged{$key}");
      $indi->add('FAMC',$d->{xref});
      goto nxt3;
     }
    }
# if father and mother present but spouse not exist
    $fam=$ged->add_family;
    $indi=$ged->get_individual("I$gf");
    $indi->add('FAMS',$fam->{xref});
    $indi2=$ged->get_individual("I$gm");
    $indi2->add('FAMS',$fam->{xref});
    $fam->add('CHIL',"I$ged{$key}");
    $fam->add('HUSB',"I$gf");
    $fam->add('WIFE',"I$gm");
    my $pers=$ged->get_individual("I$ged{$key}");
    $pers->add('FAMC',$fam->{xref});
   } 
nxt3:
# if present only father
   if (($indi ne '') && ($indi2 eq ''))
   {
    my $gf=$ged{$fk};
    my $gfp=$ged->get_individual('I'.$gf);
    my $find=0;
    foreach $f ($gfp->fams)
    {
     unless($f->tag_record('WIFE'))
     {
      $fam=$f;$find=1;
      last;
     }
    }
    if ($find==0)
    {
     $fam=$ged->add_family;
     $gfp->add('FAMS',$fam->{xref})
    }
    $fam->add('CHIL',"I$ged{$indi}");
    if ($fam->tag_value('HUSB') ne "I$gf") {$fam->add('HUSB',"I$gf")}
    $indi=$ged->get_individual("I$ged{$indi}");
    $indi->add('FAMC',$fam->{xref});
   }
# if present only mother
   if (($indi2 ne '') && ($indi eq ''))
   {
    my $gm=$ged{$mk};
    my $gfm=$ged->get_individual('I'.$gm);
    my $find=0;
    foreach $f ($gfm->fams)
    {
     unless($f->tag_record('HUSB'))
     {
      $fam=$f;$find=1;
      last;
     }
    }
    if ($find==0)
    {
     $fam=$ged->add_family;
     $gfm->add('FAMS',$fam->{xref})
    }
    $fam->add('CHIL',"I$ged{$indi2}");
    if ($fam->tag_value('WIFE') ne "I$gm") {$fam->add('WIFE',"I$gm")}
    $indi=$ged->get_individual("I$ged{$indi2}");
    $indi->add('FAMC',$fam->{xref});
   }
nxt7:
  }
  $ged->add_trailer;
  $ged->write(fn($f),0);  
  $ged->DESTROY;
  open(F,fn($f));
  open(F1,'>'.fn($f).'.tmp');
  while (<F>)
  {
   s/%version/$version/;
   s/%year/$year/;
   print F1;
  }
  close(F);close(F1);copy(fn($f).'.tmp',fn($f));
  menustateon;
  deletemessage();
  return 0;
 }
 else
 {
  menustateon;
  return 1;
 }
}
sub importged # import descent from GEDCOM file
{
 my $r=dotpresent();
 my $oldpath;
 if ($r==0)
 {
  my $t;
  my $gg=0;
  my $file=fileDialog('openged');
  unless ($file eq cancel)
  {
   menustateoff;
   if ($debug==1)
   {
    print "filename:$file\n";
   }
   $oldpath=getcwd;
   my ($n1,$p1,$fext1)=fileparse(fn($file),'ged');
   if ($debug==1)
   {
    print "parse:$p1 $n1 $fext1\n";
   }
   chdir $p1;
   my ($s1,$s2)=importgedpics();
   if ($debug==1)
   {
    print "DWM:$destroyWM\n";
   }
   if ($destroyWM=='1')
   {
    $destroyWM='0';menustateon; return;
   }
   $destroyWM='0';
   if ($debug==1)
   {
    print "IGP:$s1 $s2\n";
   }
   drawmessage($messages[69]);
   clear;
   $size=1;
   $ged=Gedcom->new(grammar_version=>5.5, gedcom_file=>fn($file)) if $^O eq 'MSWin32';
   $ged=Gedcomlite->new(grammar_version=>5.5, gedcom_file=>fn($file)) if $^O eq 'linux';
   my @indi=$ged->individuals;
   my @fams=$ged->families;
   my @nots=$ged->notes;
   my $scr=0;
   my $a;
   my $w;
   my $h;
   my $b;
   foreach $a (@indi)
   {
    $a->{xref}=~/I(\d+)/;
    $peoples=$1;
    if ($scr==0)
    {
     $scr=$peoples;
    }
    if ($maxpeoples<$peoples) {$maxpeoples=$peoples};
    $people{$peoples}='people'.$peoples;
# create family, first and second names from NAME tag
    if ($a->tag_record('NAME'))
    {
     $t=decode('utf-8',$a->tag_value('NAME'));
     $t=~/^(.*?)\/(.*?)\/$/;
     my $t2=$1;my $fam=$2;
#geting full family name without first and ending spacesymbols.
     my @fam=split(' ',$fam);
     $fam='';
     if (@fam==1)
     {
      $fam=$fam[0];
     }
     else
     {
      foreach my $zfam (@fam)
      {
       if ($fam eq '') {$fam=$zfam}
       else {$fam=$fam.' '.$zfam}
      }
     }
     $family_name{$peoples}=$fam;
# getting first and second names
     my @t=($t2=~/(\w+)/g);
     if (@t==0)#$noname;
     {
      $first_name{$peoples}='';
      $second_name{$peoples}='';
     }
     if (@t==1)
     {
      $first_name{$peoples}=$t[0];
      $second_name{$peoples}='';
     }
     if (@t==2)
     {
      $first_name{$peoples}=$t[0];
      $second_name{$peoples}=$t[1];
     }
     if (@t>2)
     {
      $first_name{$peoples}=$t[0];
      for (my $i=1;$i<@t;$i++)
      {
       if ($i==(@t-1))
       {
        $second_name{$peoples}.=$t[$i];
       }
       else 
       {
        $second_name{$peoples}.=$t[$i].' ';
       }
      }
     }
    }
# create sex
    if ($a->tag_record('SEX'))
    {
     if ($a->tag_value('SEX') eq 'F')
     {
      $sex{$peoples}='woman';
      $foto{$peoples}='woman';
     }
     else
     {
      $sex{$peoples}='man';
      $foto{$peoples}='man';
      if ($a->tag_value('SEX') eq 'M')
      {
       goto nxtsex; # All Ok
      }
      if ($a->tag_value('SEX') eq 'U') # For correcting Drevo program data format
      {
       print "Warning: Line 'SEX U' is not correct to GEDCOM 5.5 format. Set to 'SEX M' by default for person with ID $peoples.";
       goto nxtsex;
      }
      print "Warning: Line 'SEX".$a->tag_value('SEX')."' is not correct to GEDCOM 5.5 format. Set to 'SEX M' by default for person with ID $peoples.";
     }
nxtsex:
    }
# create death date and place
    if ($a->get_value("death date"))
    {
     $death_date{$peoples}=decode('utf-8',$a->get_value("death date"));
    }
    if ($a->get_value("death place"))
    {
     $death_place{$peoples}=decode('utf-8',$a->get_value("death place"));
    }
# create born date and place
    if ($a->get_value("birth date"))
    {
     $birth_date{$peoples}=decode('utf-8',$a->get_value("birth date"));
    }
    if ($a->get_value("birth place"))
    {
     $birth_place{$peoples}=decode('utf-8',$a->get_value("birth place"));
    }
# create notes
    if ($a->tag_record('NOTE'))
    {
     my $nn;
     if ($a->tag_value('NOTE')=~/^N(\d+)/)
     {
      $nn=$nots[$1]->get_value
     }
     else
     {
      $nn=$a->tag_value('NOTE')
     }
     $text{$peoples}=decode('utf-8',$nn);
# if present \n in note's begin then delete it 
     if ($text{$peoples}=~/^\n(.*)/ms)
     {
      $text{$peoples}=$1;
     }
# if present \n in end of notes then delete it 
     while (chomp($text{$peoples})>0){};
    }
# create OBJE
    my @o=$a->get_record('OBJE');
    if (@o)
    {
     my $npfile=1;@gallery=();@texts=();
     foreach my $oo (@o) 
     {
      my $fileformat;
      if ($oo->get_record('FORM')) {$fileformat=$oo->get_record('FORM')->value;} else {next}
	  chop($fileformat) if $fileformat=~/\x0d$/;
      my $ff=0;
      my $fi;
      foreach $fi (@fotoext)
      {
       if ($fi eq $fileformat) {$ff=1; last}
      }
      my $fname=decode('utf-8',$oo->get_record('FILE')->value);
      if ($ff==1)#
      {
       if ($debug==1)
       {
        print "d1:$fname\n";
       }
       chop($fname) if $fname=~/\x0d$/;
       if ($debug==1)
       {
        print "fn1:$fname\ns1:$s1\ns2:$s2";
       }
       if (($s1 ne '') && ($s2 ne '')) 
       {
        $fname=~s/\\/\//g;
        $s1=~s/\\/\//g;
        $s2=~s/\\/\//g;
        $fname=~s/^$s1/$s2/;
        if ($OS eq 'MSWin32') {$fname=~s/\//\\\\/g;}
       }
       if ($debug==1)
       {
        print "fn3: ".fn($fname)."\n";
       }
       if (-e fn("$fname"))
       {
        $gallery{$peoples}=1;
        unless (-e fn($projects.$projectname.'/gallery/'.$peoples.'/')) 
        {
         unless (-e fn($projects.$projectname.'/gallery/'))
         {
          mkdir(fn($projects.$projectname.'/gallery/'))
         }
         mkdir(fn($projects.$projectname.'/gallery/'.$peoples.'/'));
         mkdir(fn($projects.$projectname.'/gallery/'.$peoples.'/icons/'));
        }
        my $fext='';
        if ($debug==1)
        {
	 print "FEXT:".fn($fname)."\n";
        }
        $fname=~/^.+\.(\w+)$/;
	if ($debug==1)
        {
	 print "1:$1\n";
        }
        if (($1) && ($1 ne '')) {$fext=$1};
	copy(fn($fname),fn($projects.$projectname.'/gallery/'.$peoples.'/'.$npfile.'.'.$fext)) || print "Error! Can not copy file to gallery...";
# create icons
        my $icon=Image::Magick->new;
        my $sx;
        my $sy;
        copy(fn($projects.$projectname.'/gallery/'.$peoples.'/'.$npfile.'.'.$fext),fn($tmpdir.'tmp'));
        $icon->Read(fn($tmpdir.'tmp'));
        ($x, $y)=$icon->Get('columns','rows');
        if ($y>=$x) {$sy=$gal_size;$sx=int (($sy/$y)*$x)}
        else {$sx=$gal_size;$sy=int (($sx/$x)*$y)}
        unless (($sx==$x) && ($sy==$y)) {$icon->Resize(width=>$sx,height=>$sy)}
        $icon->Write(fn($tmpdir.'tmp'));
        copy(fn($tmpdir.'tmp'),fn("$projects$projectname/gallery/$peoples/icons/$npfile.gif"));
        $gallery[$npfile-1]=$projects.$projectname.'/gallery/'.$peoples.'/'.$npfile.'.'.$fext;
        if ($oo->get_record('TITL')->value) {$texts[$npfile-1]=decode('utf8',$oo->get_record('TITL')->value)}
        if ($npfile==1)
        {
         my $icon=Image::Magick->new;
         my $sx;
         my $sy;
         copy(fn("$projects$projectname/gallery/$peoples/icons/$npfile.gif"),fn($tmpdir.'tmp'));
         $icon->Read(fn($tmpdir.'tmp'));
         (my $x, my $y)=$icon->Get('columns','rows');
         if ($y>=$x) 
         {
          $sy=$ic_size;$sx=int(($sy/$y)*$x);
         }
         else
         {
          $sx=$ic_size;$sy=int(($sx/$x)*$y);
         }
         unless (($sx==$x) && ($sy==$y)) {$icon->Resize(width=>$sx,height=>$sy)}
         $icon->Write(fn($tmpdir.'tmp'));
         copy(fn($tmpdir.'tmp'),fn($projects.$projectname."/icons/$peoples".'.gif'));
         $foto{$peoples}="$peoples.gif";
         createramka($peoples);
        }
        $npfile++;
       } else 
       {
# Can't open file
        MyMessageBox($messages[170].$fname,'ok','info');
       }
      } else {print "File $fname is not supported for import!\n"}
     }
     $image=$peoples;
     savegallery();
    }
    createramka($peoples);
    drawmessage($messages[72].$peoples.'.');
   }
   foreach $a (@fams)
   {
    $w='';$h='';
    if ($a->tag_record('WIFE'))
    {
     $t=$a->tag_value('WIFE');
     $t=~/^I(\d+)$/;
     $w=$1;
    }
    if ($a->tag_record('HUSB'))
    {
     $t=$a->tag_value('HUSB');
     $t=~/^I(\d+)$/;
     $h=$1;
    }
    if (($w ne '') && ($h ne ''))
    {
     $spouses++;
     $spouse{$spouses}="$h:$w";
     if ($a->tag_record('MARR'))
     {
      $b=$a->tag_record('MARR');
      if ($b->tag_value('DATE'))
      {
       $marr_date{$spouses}=decode('utf-8',$b->tag_value('DATE'));
      }
      if ($b->tag_value('PLAC'))
      {
       $marr_place{$spouses}=decode('utf-8',$b->tag_value('PLAC'));
      }
     }
    }
    foreach $b ($a->children)
    {
     $b->{xref}=~/^I(\d+)$/;
     if ($h ne '')
     {
      $fathers++;
      $father{$fathers}="$1:$h";
     }
     if ($w ne '')
     {
      $mothers++;
      $mother{$mothers}="$1:$w";
     }
    }
   }
   $maxfathers=$fathers;
   $maxmothers=$mothers;
   $maxspouses=$spouses;
   drawmessage($messages[71]);
   open(F,'>:raw',fn($tmpdir.'rodovid'));
   print F 'digraph structs {node [shape=plaintext];'."\n";
   foreach $key (keys %spouse)
   {
    print F 'subgraph cluster'.number1($spouse{$key}).'_'.number2($spouse{$key}).' { structurebig'.number1($spouse{$key}).'; structurebig'.number2($spouse{$key}).'; }'."\n";
   }
   foreach $a (values %father)
   { 
    $a=~/^(\d+)\:(\d+)$/;
    print F 'structurebig'.$1.' -> structurebig'.$2.";\n";
   }
   foreach $a (values %mother)
   {
    $a=~/^(\d+)\:(\d+)$/;
    print F 'structurebig'.$1.' -> structurebig'.$2.";\n";
   }
   print F "}\n";
   close(F);
   if ($OS eq 'linux') {system('dot -Tplain '.fn($tmpdir).'rodovid > '.fn($tmpdir).'rodovid2');}
   else {system($graphvizpath.'\dot.exe -Tplain '.fn($tmpdir).'rodovid > '.fn($tmpdir).'rodovid2');}
   unlink (fn($tmpdir).'rodovid');
   open(F,'<:raw',fn($tmpdir).'rodovid2');
   drawmessage($messages[70].'...');
   while ($t=<F>)
   {
    if ($t=~/^node\sstructurebig(\d+)\s(\d*\.?\d*)\s(\d*\.?\d*)/)
    {
     $peoplex{$1}="$2";$peoplex{$1}=int ($peoplex{$1}*100+$xcanvas/2);
     $peopley{$1}="$3";$peopley{$1}=int ($peopley{$1}*100+$ycanvas/4);
     $c->createImage($peoplex{$1},$peopley{$1}, -image => myPhoto($projects.$projectname."/".$1.".gif"), -tags => $people{$1});#$
    }
   }
   close(F);

   unlink (fn($tmpdir).'rodovid2');
   drawmessage($messages[71]);
   if ($maxfathers>0)
   {
   foreach $a (values %father)
    {
     $a=~/(\d+)\:(\d+)/;
     $son=$1;$image=$2;
     arrowFromFather($peoplex{$son}, $peopley{$son}-30*$size ,$peoplex{$image},$peopley{$image}+30*$size,'father'.$a);
    }
   }
   if ($maxmothers>0)
   {
   foreach $a (values %mother)
    {
     $a=~/(\d+)\:(\d+)/;$son=$1;$image=$2;
     arrowFromMother($peoplex{$son}, $peopley{$son}-30*$size ,$peoplex{$image},$peopley{$image}+30*$size,'mother'.$a);
    }
   }
   if ($maxspouses>0)
   {
   my ($x1,$y1,$x2,$y2);
   foreach $a (values %spouse)
    {
     $a=~/(\d+)\:(\d+)/;$son=$1;$image=$2;
     if ($peoplex{$son}<=$peoplex{$image})
     {
      $x1=$peoplex{$son};
      $y1=$peopley{$son};
      $x2=$peoplex{$image};
      $y2=$peopley{$image};
     }
     else
     {
      $x2=$peoplex{$son};
      $y2=$peopley{$son};
      $x1=$peoplex{$image};
      $y1=$peopley{$image};
     }
     arrowSpouse($x1+78*$size,$y1,$x2-78*$size,$y2,$a);
    }
   }
   deletemessage;
   $TOP->geometry=~/^(\d+)x(\d+)\+(\d+)\+(\d+)$/;
   my $x=int($1/2);
   my $y=int($2/2);
   $c->xview(moveto=>($peoplex{$scr}-$x)/$xcanvas);
   $c->yview(moveto=>($peopley{$scr}-$y)/$ycanvas);
   save2(0);
   chdir $oldpath;
  }
  menustateon;
 }
 else {MyMessageBox($messages[93],'ok','info');}
}
sub drawmessage # show information message
{
 my $m=shift;
 $menustatus->configure(-text=>$m);
 $TOP->update;
}
sub deletemessage # clear information message
{
 if ($menustatus->cget('-text') ne '') 
 {
  $menustatus->configure(-text=>'');
  $TOP->update;
 }
}
sub createruler # create ruller on canvaas
{
 if ($showrulers==0) # if You hide ruller then show them
 {
  $showrulers=1;
  my $k;
  my $a;
  while (($k,$a)=each(%ruler))
  {
   $c->move('ruler'.$k,0,$a); # unhide ruler
  }
 }
 $rulers++;# add new ruller
 if ($rulers>$maxrulers) {$maxrulers=$rulers}
 my $ry=int($by/$step)*$step;
 $ruler{$rulers}=$ry;
 $c->createLine(3, $ry,$xcanvas-3,$ry,-tags=>'ruler'.$rulers, -width=>widthruler, -fill=>rulercolor, -dash=>"-", -activefill=>'red',);
 reloadallramka;# redraw all persons on canvas without recreating image and person's data 
}
sub markkins # searching all kins of current person
{
 if ($draggroup==0)
 {
  $draggroup=1;
  drawmessage($messages[55]);
  @kins=();
  $nextkin=0;
  $kins[$nextkin]="people$son";
  $nextkin++;
  %spouseforkins=%spouse;
  %fatherforkins=%father;
  %motherforkins=%mother;
  kins($son);
  undef %fatherforkins;
  undef %motherforkins;
  undef %spouseforkins;
  my %hash;
  my $i;
  my $j;
  foreach $i (@kins)
  {
   $hash{$i}=$i;
  }
  @kins=();$j=0;
  foreach $i (values %hash)
  {
   $kins[$j]=$i;$j++;
  }
  $c->createRectangle($c->bbox(@kins),-dash=>$dashmarkbox,-width=>2,-tags=>'markbox',-outline=>'blue');
  return
 }
 MyMessageBox($messages[92],'ok','info');
}
sub endgroup #disable grouping 
{
 if ($draggroup==5) {$dg5=0}
 $draggroup=0;
 @kins=();$ki=0;
 $c->delete('markbox');
 deletemessage;
}
sub kins #recursive sub for finding all kins for current person $idk
{
 my ($key,$a);
 my %f=%fatherforkins;
 my %m=%motherforkins;
 my %s=%spouseforkins;
 my $idk=shift;
 while(($key, $a) = each(%f))
 {
  if ($a=~/^(\d+)\:$idk$/)
  {
   $kins[$nextkin]="people$1"; 
   $nextkin++;
   $fatherforkins{$key}='';
   kins($1);
  }
 }
 while(($key, $a) = each(%m))
 {
  if ($a=~/^(\d+)\:$idk$/)
  {
   $kins[$nextkin]="people$1";
   $nextkin++;
   $motherforkins{$key}='';
   kins($1);
  }
 }
 while(($key, $a) = each(%s))
 {
  if ($a=~/^$idk\:(\d+)$/)
  {
   $kins[$nextkin]="people$1";
   $nextkin++;
   $spouseforkins{$key}='';
   kins($1);
  }
  if ($a=~/^(\d+)\:$idk$/)
  {
   $kins[$nextkin]="people$1";
   $nextkin++;
   $spouseforkins{$key}='';
   kins($1);
  }
 }
}
sub kins2 #recursive sub for finding all kins for current person $idk without spouse on first stage of recursion.
{
 my ($key,$a);
 my %f=%fatherforkins;
 my %m=%motherforkins;
 my %s=%spouseforkins;
 my $idk=shift;
 my $level=shift;
 while(($key, $a) = each(%f))
 {
  if ($a=~/^(\d+)\:$idk$/)
  {
   $kins[$nextkin]="people$1"; 
   $nextkin++;
   $fatherforkins{$key}='';
   kins($1,1);
  }
 }
 while(($key, $a) = each(%m))
 {
  if ($a=~/^(\d+)\:$idk$/)
  {
   $kins[$nextkin]="people$1";
   $nextkin++;
   $motherforkins{$key}='';
   kins($1,1);
  }
 }
}
our $lbf;
our $sel;
our %find;
our %find_base;
sub findselect
{
 $sel=$lbf->get('active');
 if ($sel ne $messages[79])
 {
  $TOP->geometry=~/^(\d+)x(\d+)\+([-]*\d+)\+([-]*\d+)$/;
  my $x=int($1/2);
  my $y=int($2/2);
  $c->xview(moveto=>($peoplex{$find{$find_base{$sel}}}-$x)/$xcanvas);
  $c->yview(moveto=>($peopley{$find{$find_base{$sel}}}-$y)/$ycanvas);
  if ($c->find('withtag','markboxf')) {$c->delete('markboxf')};
  $c->createRectangle($c->bbox('people'.$find{$find_base{$sel}}),-width=>2,-tags=>'markboxf',-outline=>"red");$findedp=1;
 }
 menustateon;
 $mw{$tln2}->destroy;
}
sub findperson #find person on canvas
{
 if ($findedp==1) {$findedp=0; $c->delete('markboxf')}
 menustateoff;
 $tln2=createmw($messages[77]);
 $mw{$tln2}->bind('<Destroy>'=>sub{menustateon});
 my $find;
 $sel='';
 my $finded;
 getscreensize;
 my $x=$screenx;
 my $y=$screeny;
 my $k;
 $findedp=0;
 setgeometry3(550,250,$tln2);
 $mw{$tln2}->resizable(1,1);
 $mw{$tln2}->deiconify();
 $mw{$tln2}->raise();
 $mw{$tln2}->bind('<KeyPress-Escape>',sub
 {
  $mw{$tln2}->destroy;
 });
 my $ftln=$mw{$tln2}->Frame(-borderwidth=>"0",-relief=>"solid", -height=>'40',-padx=>0,-pady=>0)->pack(-side=>'top',-fill=>'x',-expand=>'no',-anchor=>'s');
 my $ftln2=$mw{$tln2}->Frame(-borderwidth=>"0",-relief=>"solid",-padx=>0,-pady=>0)->pack(-side=>'top',-fill=>'both',-expand=>'yes',-anchor=>'s');
 my $ftln3=$mw{$tln2}->Frame(-borderwidth=>"0",-relief=>"solid", -height=>'40',-padx=>0,-pady=>0)->pack(-side=>'top',-fill=>'x',-expand=>'no',-anchor=>'s');
 $ftln->Label(-font=>$fontbold{$tln2},-relief=>'flat',-text=>$messages[78])->pack(-side=>"left",-expand=>"0",-anchor=>"nw");
 my $ent=$ftln->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font{$tln2},-textvariable=>\$find,-width=>"37")->pack(-side=>"left",-expand=>'0',-anchor=>"nw");
 $ftln->Button(-relief=>'raised',-borderwidth=>2, -image => sizePhoto($tln2,fn($workfolder.'graphics/find.png')), -command => sub
 {
  %find=();$finded=0;%find_base=();
  $lbf->delete(0,'end');
  foreach $k (keys %people)
  {
   my $s="$family_name{$k} $first_name{$k} $second_name{$k} $birth_place{$k} $birth_date{$k} $death_place{$k} $death_date{$k} $k $tags{$k}";
   my $s2="$family_name{$k} $first_name{$k} $second_name{$k} (ID:$k)";
   if ($s=~/$find/i) 
   { 
    $lbf->insert('end',$s2);$finded=1;
    $find{$s}=$k;
    $find_base{$s2}=$s;
   }
  }
  if ($finded==0) {$lbf->insert('end',$messages[79]);}
 })->pack(-side=>"left",-expand=>'0',-anchor=>"nw");
 $ent->bind('<KeyPress-Return>'=>sub
 {
  %find=();$finded=0;
  $lbf->delete(0,'end');
  foreach $k (keys %people)
  {
   my $s="$family_name{$k} $first_name{$k} $second_name{$k} $birth_place{$k} $birth_date{$k} $death_place{$k} $death_date{$k} $k $tags{$k}";
   my $s2="$family_name{$k} $first_name{$k} $second_name{$k} (ID:$k)";
   if ($s=~/$find/i) 
   { 
    $lbf->insert('end',$s2);$finded=1;
    $find{$s}=$k;
    $find_base{$s2}=$s;
   }
  }
  if ($finded==0) {$lbf->insert('end',$messages[79]);}
 });
 $ent->focus;
 $lbf=$ftln2->Scrolled("Listbox", -font=>$font{$tln2},-scrollbars => 'oe',-selectmode => "single",-background=>'white')->pack(-fill=>'both',-expand=>1);
 $lbf->bind('<ButtonRelease-1>'=>sub
 {
  $sel=$lbf->get('active');
  $lbf->focus;
 });
 $lbf->bind('<KeyPress-Return>'=>sub
 {
  findselect
 });
 $lbf->bind('<Double-ButtonPress-1>'=>sub
 {
  findselect
 });
 $ftln3->Button(-borderwidth=>2,-relief=>'raised',-font=>$font{$tln2}, -text => $messages[18], -command => sub
 {
  if ($sel ne '')
  {
   findselect;
  }
  else
  {
   menustateon;
   $mw{$tln2}->destroy;
  }
 })->pack(-side=>'top',-expand=>'1',-anchor=>'e');
}
our $tln3;
sub importgedpics #import gedcom pictures GUI
{
 my $str1='';
 my $str2='';$destroyWM='0';
 getscreensize;
 my $x=$screenx;
 my $y=$screeny;
 my $k;
 $igp=0;
 my $ent1;
 my $ent2;
 my $impfoto=1;
 $tln3=createmw($messages[171]);
 $mw{$tln3}->bind('<Destroy>'=>sub{$igp=1;unless ($destroyWM==2) {$destroyWM=1};return ($str1,$str2)});
 setgeometry2(300,170,$tln3);
 $mw{$tln3}->deiconify();
 $mw{$tln3}->raise();
 my $ftln=$mw{$tln3}->Frame(-borderwidth=>"0",-relief=>"solid",-padx=>0,-pady=>0)->pack(-side=>'top',-fill=>'x',-expand=>'1',-anchor=>'s');
 $ftln->Checkbutton(-font=>$font{$tln3},-state=>'active',-font=>$fontbold{$tln3},-selectcolor=>$selectcolor,-background=>$menuback,-text=>$messages[174],-offvalue=>0,-onvalue=>1,-relief=>'flat',-variable =>\$impfoto,-command=>sub 
 {
  if ($impfoto==1)
  {
   $ent1->configure(-state=>'normal');
   $ent2->configure(-state=>'normal');
  }
  else
  {
   $ent1->configure(-state=>'disabled');
   $ent2->configure(-state=>'disabled');
  }
 })->pack(-side=>"top",-expand=>"1",-anchor=>"nw");
 $ftln->Label(-font=>$fontbold{$tln3},-relief=>'flat',-text=>$messages[175])->pack(-side=>"top",-expand=>"0",-anchor=>"nw");
 $ftln->Label(-font=>$font{$tln3},-relief=>'flat',-text=>$messages[172])->pack(-side=>"top",-expand=>"0",-anchor=>"nw");
 $ent1=$ftln->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font{$tln3},-textvariable=>\$str1,-width=>"41")->pack(-side=>"top",-expand=>'1',-anchor=>"nw");
 $ftln->Label(-font=>$font{$tln3},-relief=>'flat',-text=>$messages[173])->pack(-side=>"top",-expand=>"0",-anchor=>"nw");
 $ent2=$ftln->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font{$tln3},-textvariable=>\$str2,-width=>"41")->pack(-side=>"top",-expand=>'1',-anchor=>"nw");
 $ent1->focus;
 $mw{$tln3}->Button(-borderwidth=>2,-relief=>'raised',-font=>$font{$tln3}, -text => $messages[18], -command => sub
 {
  $igp=1;$destroyWM='2';
  $mw{$tln3}->destroy;
 })->pack(-side=>'top',-expand=>'1',-anchor=>'e');
 $mw{$tln3}->waitVariable(\$igp);
 return ($str1,$str2);
}
sub menustateon # enabling menu
{
 $file->configure(-state=>'active');
 $view->configure(-state=>'active');
 $tools->configure(-state=>'active');
 $sc->configure(-state=>'active');
 $help->configure(-state=>'active');
 $menustate=1;
 $TOP->update;
}
sub menustateoff #disabling menu
{
 $file->configure(-state=>'disabled');
 $view->configure(-state=>'disabled');
 $tools->configure(-state=>'disabled');
 $sc->configure(-state=>'disabled');
 $help->configure(-state=>'disabled');
 $menustate=0;
 $TOP->update;
}
sub help
{
 menustateoff;
 loadhelp;
 my $tp=createmw($messages[50]);
 getscreensize;
 setgeometry($screenx,$screeny,$tp);
 $mw{$tp}->bind('<Destroy>'=>sub{menustateon});
 my $t = $mw{$tp}->Scrolled(qw/Text -width 100 -height 100 -scrollbars oe -wrap word -background white/, -font=>$font{$tp})->pack(-fill=>'both');
 my $fs_cor=$fontsys;
 $fs_cor=~s/ /\\ /g;
 $t->tagConfigure('norm',-font=>$fs_cor.' '.$fsize.' normal');
 $t->tagConfigure('bold',-font=>$fs_cor.' '.$fsize.' bold');
 my $h;
 my $page;
 sub page_calc
 {
  $mw{$tp}->geometry=~/\d+x(\d+)/;
  $page=int($1/$mw{$tp}->fontMetrics($font{$tp},-linespace));
 }
 foreach $h (@help) 
 {
  if ($h=~/^~b/) 
  {
   $h=~s/~b//;
   $t->insert('end',$h,'bold');
  }
  else
  {
   $t->insert('end',$h,'norm');
  }
 }
 $t->configure(-state=>'disabled',-font=>$font);
 $mw{$tp}->bind('<KeyPress-Down>'=>sub
 {
  $t->yviewScroll(1, "units");
 });
 $mw{$tp}->bind('<Control-Down>'=>sub
 {
  page_calc;
  $t->yviewScroll($page, "units");
 });
 $mw{$tp}->bind('<Next>'=>sub
 {
  page_calc;
  $t->yviewScroll($page, "units");
 });
 $mw{$tp}->bind('<Control-Up>'=>sub
 {
  page_calc;
  $t->yviewScroll(-$page, "units");
 });
 $mw{$tp}->bind('<Prior>'=>sub
 {
  page_calc;
  $t->yviewScroll(-$page, "units");
 });
 $mw{$tp}->bind('<KeyPress-Up>'=>sub
 {
  $t->yviewScroll(-1, "units");
 });
 $mw{$tp}->bind('<KeyPress-Return>'=>sub
 {
  menustateon;
  $mw{$tp}->destroy;
 });
 $mw{$tp}->bind('<KeyPress-F1>'=>sub
 {
  menustateon;
  $mw{$tp}->destroy;
 });
 $mw{$tp}->bind('<KeyPress-Escape>'=>sub
 {
  menustateon;
  $mw{$tp}->destroy;
 });
 $mw{$tp}->deiconify();
 $mw{$tp}->raise();
}
sub resize #change size for persons images on canvas
{
 my $resize=shift;
 my $basepeople=1;
 while (!($people{$basepeople}))
 {$basepeople++}
 my $basex=$peoplex{$basepeople};
 my $basey=$peopley{$basepeople};
 if ($resize==2)
 {
  my @peoples=();my $i=0;
  foreach $a (values %people)
  {
   $peoples[$i]=$a;$i++;
  }
  my ($x1,$y1,$x2,$y2)=$c->bbox(@peoples);
  my $dx1=$basex-$x1;
  my $dx2=$x2-$basex;
  my $dy1=$basey-$y1;
  my $dy2=$y2-$basey;
  if (($basex-$dx1*2)<5) #5 pixels border
  {
   MyMessageBox($messages[85].$messages[86],'ok','info');
   return 1
  }
  if (($basex+$dx2*2)>$xcanvas)
  {
   MyMessageBox($messages[85].$messages[87],'ok','info');
   return 1
  }
  if (($basey-$dy1*2)<5) #5 pixels border
  {
   MyMessageBox($messages[85].$messages[88],'ok','info');
   return 1
  }
  if (($basey+$dy2*2)>$ycanvas)
  {
   MyMessageBox($messages[85].$messages[89],'ok','info');
   return 1
  }
 }
 my $baseruler;my $res=0;
 my $k;
 my $a;
 while (($k,$a)=each(%peoplex))
 {
  if ($k!=$basepeople)
  {
   if (($basex-$a)>0) 
   {
    if ($resize==2) {$peoplex{$k}=$basex-($basex-$a)*2;}
    if ($resize==1) {$peoplex{$k}=$basex-int(($basex-$a)/2);}
   }
   if (($basex-$a)<0) 
   {
    if ($resize==2) {$peoplex{$k}=$basex+($a-$basex)*2;}
    if ($resize==1) {$peoplex{$k}=$basex+int(($a-$basex)/2);}
   }
  }
 }
 while (($k,$a)=each(%peopley))
 {
  if ($k!=$basepeople)
  {
   if (($basey-$a)>0) 
   {
    if ($resize==2) {$peopley{$k}=$basey-($basey-$a)*2;}
    if ($resize==1) {$peopley{$k}=$basey-int(($basey-$a)/2);}
   }
   if (($basey-$a)<0) 
   {
    if ($resize==2) {$peopley{$k}=$basey-($basey-$a)*2;}
    if ($resize==1) {$peopley{$k}=$basey+int(($a-$basey)/2);}
   }
  }
 }
 while (($k,$a)=each(%ruler))
 {
  if ($a==$basey) {$baseruler=$k;$res=1;}
 }
 if ($res==0) 
 {
  $maxrulers++;
  $ruler{$maxrulers}=$basey;
  $baseruler=$maxrulers;
 }
 while (($k,$a)=each(%ruler))
 {
  if (($ruler{$baseruler}-$a)>0) 
  {
   if ($resize==2) {$ruler{$k}=$ruler{$baseruler}-($ruler{$baseruler}-$a)*2;}
   if ($resize==1) {$ruler{$k}=$ruler{$baseruler}-int(($ruler{$baseruler}-$a)/2);}
   $c->move('ruler'.$k,0,$ruler{$k}-$a);
  }
  if (($ruler{$baseruler}-$a)<0) 
  {
   if ($resize==2) {$ruler{$k}=$ruler{$baseruler}+($a-$ruler{$baseruler})*2;}
   if ($resize==1) {$ruler{$k}=$ruler{$baseruler}+int(($a-$ruler{$baseruler})/2);}
   $c->move('ruler'.$k,0,$ruler{$k}-$a);
  }
 }
 if ($res==0) {delete($ruler{$maxrulers});$maxrulers--;}
 return 0
}
sub mapview # show map of pedigree an set position on map
{
 if (($maxpeoples==0) && ($peoples==0)) {return} # Need message "No more persons!"
 our $cmv;
 my $f;
 my $a;
 our $tag_s='';
 getscreensize;
 my $x=$screenx-(100*$fsize/9);
 my $y=$screeny-(100*$fsize/9);
 our @peoples;
 our $cx;
 our $cy;
 my $minx=320; my $miny=200;
# my $si=10;
 our $f1mv;
 our $f2mv;
 our $f3mv;
 our @tbox;
 our $items;
 our $tdx;
 our $tdy;
 our $mv;
 our $tile2;
 our $tag_wait=0;
 our $tx;
 our $ty;
 our $label;
 our $btm;
 sub collect_items
 {
  my $i=0;@peoples=();
  foreach $a (values %people)
  {
   $a=~/people(\d+)/;
   if ($tag_s eq '')
   {
    $peoples[$i]=$a;$i++;
   }
   else
   {
    if ($tags{$1}=~/$tag_s/)
    {
     $peoples[$i]=$a;$i++;
    }
   }
  }
  if (@peoples>0)
  {
   $items=1;
   @tbox=$c->bbox(@peoples);
   $tdx=($tbox[2]-$tbox[0]);
   $tdy=($tbox[3]-$tbox[1]);
   if ($tdx<$minx) {$tdx=$minx}
   if ($tdy<$miny) {$tdy=$miny}
   if (($tdx >= $x) || ($tdy >= $y))
   {
    if ($tdx>$tdy)
    {
     $cx=$x;
     $cy=(int($cx/$x)*$y);
    }
    else
    {
     $cy=$y;
     $cx=(int($cy/$y)*$x);
    }
   } 
   else
   {
    $cx=$tdx;
    $cy=$tdy;
   }
  }
  else
  {
   $items=0;
   $tdx=$minx;
   $tdy=$miny;
   $cx=$tdx;
   $cy=$tdy;
  }
  $tx=$cx+2;
  $ty=$cy+60;
  if ($tx<$minx) {$tx=$minx};
  if ($ty<$miny) {$ty=$miny};
  $mv->geometry(int($tx+100*$fsize/9).'x'.int($ty+100*$fsize/9).'+'.int(($x-int($tx))/2).'+'.int(($y-int($ty))/2));
  $mv->minsize(int($tx),int(($ty)));
 }
 sub drawitems
 {
  my $ox=int(154*$size*$cx/$tdx);
  my $oy=int($ox/2.5);
  if ($ox==0) {$ox=1}
  if ($oy==0) {$oy=1}
  my $k;
  $cmv->configure(-scrollregion=>[0,0,$cx,$cy]);
  if ($items==1)
  {
   foreach $k (keys %people)
   {
    if (($tags{$k}=~/$tag_s/))
    {
     if ($sex{$k} eq 'man') {$f='royalblue1'} else {$f='indianred1'}
     $cmv->createRectangle(int(($peoplex{$k}-$tbox[0])*$cx/$tdx)-int($ox/2),int(($peopley{$k}-$tbox[1])*$cy/$tdy)-int($oy/2),int(($peoplex{$k}-$tbox[0])*$cx/$tdx)+int($ox/2),int(($peopley{$k}-$tbox[1])*$cy/$tdy)+int($oy/2),-fill=>$f,-outline=>$f,-tags=>$k);
    }
   }
  }
 }
 menustateoff;
 $mv=$TOP->Toplevel(-padx=>5, -pady=>5,-borderwidth=>1, -background=>$topback, -relief=>'solid');
 $mv->title($messages[90]);
 $mv->Icon(-image=>$TOP->Photo(-file=>$prog_icon));
 $mv->bind('<Destroy>'=>sub
 {
  menustateon;
  $mv->withdraw;
  $mv->destroy;
 });
 $mv->bind('<KeyPress-Escape>',sub
 {
  $tag_wait=1;
  menustateon;
  $mv->withdraw;
  $mv->destroy;
 });
 collect_items;
 $f1mv=$mv->Frame(-background=>'white', -borderwidth=>"0",-relief=>"solid")->pack(-side=>'top',-fill=>'x',-expand=>'1');
 $f2mv=$mv->Frame(-background=>'white', -borderwidth=>"0",-relief=>"solid")->pack(-side=>'top',-fill=>'x',-expand=>'1');
 $f3mv=$mv->Frame(-background=>'white', -borderwidth=>"0",-relief=>"solid")->pack(-side=>'top',-fill=>'x',-expand=>'1');
 if ($OS eq 'linux') 
 {
  $tile2=$f2mv->Photo(-file=>$workfolder.'graphics/'.$facestyle.'/center.gif');
  $cmv=$f2mv->Canvas(-borderwidth=>0, -width=>$cx, -height=>$cy,-tile=>$tile2)->pack(-side=>'top',-expand=>"0",-anchor=>'s')
 }
 else {
  $cmv=$f2mv->Canvas(-borderwidth=>0, -width=>$cx, -height=>$cy,-background=>$topback)->pack(-side=>'top',-expand=>"0",-anchor=>'s');
 }
 $cmv->configure(-scrollregion=>[0,0,$cx,$cy]);
 $f1mv->Label(-background=>'white', -relief=>'flat',-font=>$fontbold,-text => $messages[208].':',-width=>"8")->pack(-side=>"left",-anchor=>"n");
 $f1mv->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-width=>20,-font=>$font,-textvariable=>\$tag_s)->pack(-side=>"left",-anchor=>"n");
 $f1mv->Button(-font=>$font,-relief=>'raised',-borderwidth=>2, -image => sizePhoto2($mv,fn($workfolder.'graphics/find.png')), -command => sub
 {
  $cmv->delete('all');
  @peoples=();
  collect_items;
  $cmv->configure(-scrollregion=>[0,0,$cx,$cy],-width=>$cx,-height=>$cy);
  drawitems;
  $mv->update;
 })->pack(-padx=>2,-side=>"left",-anchor=>"n");
 $mv->bind('<KeyPress-Return>',sub
 {
  $cmv->delete('all');
  @peoples=();
  collect_items;
  $cmv->configure(-scrollregion=>[0,0,$cx,$cy],-width=>$cx,-height=>$cy);
  drawitems;
  $mv->update;
 });
 $label=$f3mv->Label(-text=>'',-background=>$topback)->pack(-side=>'left',-anchor=>'s',-expand=>0);
 $btm=$f3mv->Button(-font=>$font,-relief=>'raised',-borderwidth=>2, -text => $messages[18], -command => sub
 {
  $tag_wait=1;
   menustateon;
  $mv->withdraw;
  $mv->destroy;
 })->pack(-side=>'right',-anchor=>'s',-expand=>0);
 $btm->focus;
 drawitems;
 $cmv->CanvasBind('<Motion>' =>sub
 {
  @tags=$cmv->gettags('current');
  if ($tags[0]=~/^(\d+)$/)
  {
   my $s='';
   unless ($family_name{$1} eq '') {$s.=$family_name{$1}}
   unless ($first_name{$1} eq '') {$s.=' '.$first_name{$1}}
   unless ($second_name{$1} eq '') {$s.=' '.$second_name{$1}}
   $s.=" (ID:$1)";
   $label->configure(-text=>$s);
  }
  else
  {
   $label->configure(-text=>' ');
  }
  $label->update;
 });
 $cmv->CanvasBind('<ButtonRelease-1>' =>sub
 {
  getscreensize;
  my $px=((($cmv->XEvent->x)/$cx)*$tdx+$tbox[0]-$screenx/2)/$xcanvas;
  my $py=((($cmv->XEvent->y)/$cy)*$tdy+$tbox[1]-$screeny/2)/$ycanvas;
  $c->xview(moveto=>$px);
  $c->yview(moveto=>$py);
  $tag_wait=1;
  menustateon;
  $mv->withdraw;
  $mv->destroy;
 });
}
sub reloadmenu #refresh menu
{
 $file->destroy;$view->destroy;$tools->destroy;$sc->destroy;$help->destroy;
 menucreate();
 $TOP->configure(-title=>$messages[48]." : ".$projectname);
 $TOP->update;
}
sub help_menuitems 
{
 [
  ['command', $messages[50],-font=>$font, -command => [\&help], -accelerator=>'F1'],
  ['cascade', $messages[82],-font=>$font, -tearoff=>0, -menuitems => 
   [
    ['command', $lang[0],-font=>$font, -command => [sub{$language=$lang[0];$locale=$locales[0];loadmessages;reloadmenu();menustateoff;reloadallramka(1);saveoptions;menustateon;}]],
    ['command', $lang[1],-font=>$font, -command => [sub{$language=$lang[1];$locale=$locales[1];loadmessages;reloadmenu();menustateoff;reloadallramka(1);saveoptions;menustateon;}]],
    ['command', $lang[2],-font=>$font, -command => [sub{$language=$lang[2];$locale=$locales[2];loadmessages;reloadmenu();menustateoff;reloadallramka(1);saveoptions;menustateon;}]],
    ['command', $lang[3],-font=>$font, -command => [sub{$language=$lang[3];$locale=$locales[3];loadmessages;reloadmenu();menustateoff;reloadallramka(1);saveoptions;menustateon;}]],
    ['command', $lang[4],-font=>$font, -command => [sub{$language=$lang[4];$locale=$locales[4];loadmessages;reloadmenu();menustateoff;reloadallramka(1);saveoptions;menustateon;}]]
   ]
  ]
 ];
}
sub view_menuitems 
{
 my $k;
 my $a;
 my $select1;
 if ($OS eq 'linux') {$select1=$backcolor} else {$select1='black'}
 [
  ['checkbutton',$messages[68],-selectcolor=>$select1,-background=>$menuback,-font=>$font,-onvalue=>1,-offvalue=>0,-variable=>\$showrulers, -command=>
  [sub
   { 
    if ($showrulers==1)
    {
     while (($k,$a)=each(%ruler))
     {
      $c->move('ruler'.$k,0,$a); # unhide ruler
     }
    }
    else
    {
     while (($k,$a)=each(%ruler))
     {
     $c->move('ruler'.$k,0,-$a); # hide ruler
     }
    } 
   }
  ]
  ],
  ['checkbutton',$messages[244],-selectcolor=>$select1,-background=>$menuback,-font=>$font,-onvalue=>1,-offvalue=>0,-variable=>\$touch_enable,-command=>[\&saveoptions], -accelerator=>'Ctrl-T'],
  ['command',$messages[76],-font=>$font, -command=>[\&reloadallramka]],
  ['command',$mashtab,-font=>$font, -command=>
  [sub
  {
   if ($size==2)
   {
    if (resize(1)==1) {return}
    $size=1;$mashtab=$messages[83];
    reloadallramka(1);
   }
   else
   {
    if (resize(2)==1) {return}
    $size=2;$mashtab=$messages[84];
    reloadallramka(1);
   }
   reloadmenu();
  }
  ]],
  ['command',$messages[91],-font=>$font, -command=>[\&selectall], -accelerator=>'Ctrl-A'],
 ];
}
sub tools_menuitems 
{
 my $k;
 my $a;
 my $select1;
 if ($OS eq 'linux') {$select1=$backcolor} else {$select1='black'}
 [
  ['command',$messages[77], -font=>$font, -command=>[\&findperson], -accelerator=>'Ctrl-F'],
  ['command',$messages[90], -font=>$font, -command=>[\&mapview], -accelerator=>'Ctrl-M'],
  ['command',$messages[219],-font=>$font, -command=>[\&addtagtopersons]],
  ['command',$messages[224],-font=>$font, -command=>[\&deltagfrompersons]],
  ['command',$messages[140],-font=>$font, -command => [\&params]],
 ];
}
sub sc_menuitems 
{
 my @casc=();
 push(@casc,['command', $messages[246],-font=>$font, -command => [\&addshortcut]]);
 push(@casc,['command', $messages[247],-font=>$font, -command => [\&manageshortcut]]);
 if ($maxshortcuts>0)
 {
  my $i=0;
  my @sortsc=sort keys %shortcuts;
  while ($i<$maxshortcuts)
  {
   push(@casc,['command', '➟ '.$shortcuts{$sortsc[$i]},-font=>$font, -command => [\&gotoshortcut,$i]]);
   $i+=1;
  }
 }
 [
  @casc,
 ];
}
our $tlps;
our $scname;
our $addsc;
our $sce;
our $scY;
sub addshortcut
{
 $tlps=createmw;
 getscreensize;
 my $x=$screenx;
 my $y=$screeny;
 my $width=int(320*$fsize/9);
 my $height=int(100*(0.5+$fsize/18));
 $scname='';
 $addsc=0;
 $scY=0;
 sub entershortcut
 {
  $sce=0;
  foreach my $i (values %shortcuts)
  {
   if ($i eq $scname) {$sce=1;last}
  }
  if ($sce==0)
  {
   scroll;
   $shortcuts_x{$maxshortcuts}=$scrollx;
   $shortcuts_y{$maxshortcuts}=$scrolly;
   $shortcuts{$maxshortcuts}=$scname;
   $maxshortcuts+=1;
   $addsc=1;
   reloadmenu;
  }
  else
  {
   $scY=1;
   MyMessageBox($messages[255],"ok","info");$scname='';
   $scY=0;
  }
 }
 my $g=$width.'x'.$height.'+'.(int(($x-$width)/2)).'+'.(int(($y-$height)/2));
 $mw{$tlps}->geometry($g);
 $mw{$tlps}->title($messages[246]);
 $mw{$tlps}->Icon(-image=>$mw{$tlps}->Photo(-file=>$prog_icon));
 $mw{$tlps}->bind('<KeyPress-Escape>'=>sub
 {
  $addsc=1;
 });
 $mw{$tlps}->bind('<KeyPress-Return>'=>sub
 {
  if (($scname ne '') && ($scY==0))
  {
   entershortcut;
  }
 });
 my $f13=$mw{$tlps}->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width, -pady=>3)->pack(-side=>'top',-fill=>'x');
 my $f12=$mw{$tlps}->Frame(-borderwidth=>0,-relief=>'solid',-pady=>3)->pack(-side=>'bottom');
 $f13->Label(-font=>$fontbold{$tlps},-relief=>'flat',-text=>$messages[248])->pack(-side=>'top',-anchor=>'w');
 my $parb=$f13->Entry(-font=>$font{$tlps},-relief=>'sunken',-background=>'white',-borderwidth=>'2',-textvariable=>\$scname)->pack(-side=>'top',-fill=>'x');
 $f12->Button(-font=>$font{$tlps},-borderwidth=>'2',-text=>$messages[19],-command=>sub
 {
  $addsc=1;
 })->pack(-side=>'right',-anchor=>'s');
 $f12->Button(-font=>$font{$tlps},-borderwidth=>'2',-text=>$messages[18],-command=>sub
 {
  if ($scname ne '')
  {
   entershortcut;
  }
 })->pack(-side=>'right',-anchor=>'s');
 $parb->focus;
 $mw{$tlps}->deiconify;
 $mw{$tlps}->raise;
 $mw{$tlps}->waitVariable(\$addsc);
 destroymw($tlps);
}
our $lb;
sub manageshortcut
{
 sub reload_lb
 {
  $lb->delete(0,'end');
  foreach my $i (sort keys %shortcuts)
  {
   $lb->insert('end',"$shortcuts{$i}");$i+=1;
  }
  $lb->update;
  reloadmenu;
 }
 if ($maxshortcuts>0)
 {
  my $tlp=$TOP->Toplevel(-relief=>'flat', -padx=>5, -pady=>5);
  getscreensize;
  my $x=$screenx;
  my $y=$screeny;
  my $width=int(480*$fsize/9);
  my $height=int(270*(0.5+$fsize/18));
  my $scname='';
  my $g=$width.'x'.$height.'+'.(int(($x-$width)/2)).'+'.(int(($y-$height)/2));
  $tlp->geometry($g);
  $tlp->title($messages[246]);
  $tlp->Icon(-image=>$TOP->Photo(-file=>$prog_icon));
  $tlp->bind('<KeyPress-Escape>'=>sub
  {
   $tlp->destroy;
  });
  my $f1=$tlp->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width, -pady=>3)->pack(-side=>'top',-fill=>'x');
  $f1->Label(-font=>$fontbold,-relief=>'flat',-text=>$messages[245])->pack(-side=>'top',-anchor=>'w');
  my $f3=$f1->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width, -pady=>3)->pack(-side=>'left',-fill=>'x',-expand=>1);
  my $f2=$f1->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width, -pady=>3)->pack(-side=>'left',-anchor=>'n');
  my $f4=$tlp->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width, -pady=>3)->pack(-side=>'top',-fill=>'x');
  $lb=$f3->Scrolled("Listbox",-width=>20, -height=>10,-font=>$font,-scrollbars=>'oe',-selectmode => "single",-background=>'white')->pack(-fill=>'x',-expand=>1);
  my $i=0;
  foreach my $i (sort keys %shortcuts)
  {
   $lb->insert('end',"$shortcuts{$i}");$i+=1;
  }
  $lb->activate(0);
  $lb->selectionSet(0);
  $f2->Button(-font=>$font,-borderwidth=>'2',-text=>$messages[249],-command=>sub #Up
  {
   my $shortcut=$lb->get('active');
   my $i;
   my $shortcut_n='';
   foreach $i (keys %shortcuts)
   {
    if ($shortcuts{$i} eq $shortcut)
    {
     $shortcut_n=$i;last
    }
   }
   if ($shortcut_n ne '')
   {
    if ($shortcut_n > 0)
    {
     my ($s,$x,$y);
     ($shortcuts{$shortcut_n},$shortcuts{$shortcut_n-1})=($shortcuts{$shortcut_n-1},$shortcuts{$shortcut_n});
     ($shortcuts_x{$shortcut_n},$shortcuts_x{$shortcut_n-1})=($shortcuts_x{$shortcut_n-1},$shortcuts_x{$shortcut_n});
     ($shortcuts_y{$shortcut_n},$shortcuts_y{$shortcut_n-1})=($shortcuts_y{$shortcut_n-1},$shortcuts_y{$shortcut_n});
     reload_lb;
     $lb->activate($shortcut_n-1);
     $lb->selectionSet($shortcut_n-1);
    }
   }
  })->pack(-side=>'top',-anchor=>'c');
  $f2->Button(-font=>$font,-borderwidth=>'2',-text=>$messages[250],-command=>sub #down
  {
   my $shortcut=$lb->get('active');
   my $shortcut_n='';
   my $i;
   foreach $i (keys %shortcuts)
   {
    if ($shortcuts{$i} eq $shortcut)
    {
     $shortcut_n=$i;last
    }
   }
   if ($shortcut_n ne '')
   {
    if (($shortcut_n+1) < $maxshortcuts)
    {
     my ($s,$x,$y);
     ($shortcuts{$shortcut_n},$shortcuts{$shortcut_n+1})=($shortcuts{$shortcut_n+1},$shortcuts{$shortcut_n});
     ($shortcuts_x{$shortcut_n},$shortcuts_x{$shortcut_n+1})=($shortcuts_x{$shortcut_n+1},$shortcuts_x{$shortcut_n});
     ($shortcuts_y{$shortcut_n},$shortcuts_y{$shortcut_n+1})=($shortcuts_y{$shortcut_n+1},$shortcuts_y{$shortcut_n});
     reload_lb;
     $lb->activate($shortcut_n+1);
     $lb->selectionSet($shortcut_n+1);
    }
   }
  })->pack(-side=>'top',-anchor=>'c');
  $f2->Button(-font=>$font,-borderwidth=>'2',-text=>$messages[251],-command=>sub #Delete
  {
   my $shortcut=$lb->get('active');
   unless ($shortcut eq '')
   {
    my $shortcut_n;
    my $i;
    foreach $i (keys %shortcuts)
    {
     if ($shortcuts{$i} eq $shortcut)
     {
      $shortcut_n=$i;last
     }
    }
    if ($shortcut_n ne '')
    {
     MyMessageBox($messages[252]." '".$shortcuts{$shortcut_n}."'?","YesNo","question");
     if ($BoxResult==1)
     {
      delete $shortcuts{$shortcut_n};
      delete $shortcuts_x{$shortcut_n};
      delete $shortcuts_y{$shortcut_n};
      while ($shortcut_n<($maxshortcuts-1))
      {
       $shortcuts{$shortcut_n}=$shortcuts{$shortcut_n+1};
       $shortcuts_x{$shortcut_n}=$shortcuts_x{$shortcut_n+1};
       $shortcuts_y{$shortcut_n}=$shortcuts_y{$shortcut_n+1};
       $shortcut_n+=1;
      }
      delete $shortcuts{$shortcut_n};
      delete $shortcuts_x{$shortcut_n};
      delete $shortcuts_y{$shortcut_n};$maxshortcuts-=1;
      reload_lb;
      $lb->activate($shortcut_n);
     }
    }
   } else {MyMessageBox($messages[253],"ok","info");}
  })->pack(-side=>'top',-anchor=>'c');
  $f4->Button(-font=>$font,-borderwidth=>'2',-text=>$messages[202],-command=>sub #Yes
  {
   $tlp->destroy;
  })->pack(-side=>'right');
 } else {MyMessageBox($messages[253],"ok","info");}
}
sub gotoshortcut
{
 my $j=shift;
 $c->xview(moveto=>$shortcuts_x{$j});
 $c->yview(moveto=>$shortcuts_y{$j});
}

sub file_menuitems 
{
 [
  ['command',$messages[42],-font=>$font,-command=>[\&create], -accelerator=>'Ctrl-N'],
  ['command',$messages[43],-font=>$font,-command=>[\&load], -accelerator=>'Ctrl-O'],
  ['command',$messages[176],-font=>$font,-command=>[\&addrid]],
  ['command',$messages[45],-font=>$font,-command=>[\&save3], -accelerator=>'Ctrl-S'],
  ['command',$messages[54],-font=>$font,-command=>[\&saveas]],
  ['command',$messages[65],-font=>$font,-command=>[\&importged]],
  ['cascade', $messages[257],-font=>$font, -tearoff=>0, -menuitems => 
   [
    ['command',$messages[64],-font=>$font,-command=>[\&exportged]],
    ['command',$messages[94],-font=>$font,-command=>[\&exporthtml]],
    ['command',$messages[179],-font=>$font,-command=>[\&save2pics]],
    ['command',$messages[256],-font=>$font,-command=>[\&export2csv]],
    ['command',$messages[262],-font=>$font,-command=>[\&export2pdf]],
   ]
  ],
  ['cascade', $messages[154],-font=>$font, -tearoff=>0, -menuitems => 
   [
    ['command', $messages[155],-font=>$font, -command => [\&tar]],
    ['command', $messages[156],-font=>$font, -command => [\&untar]],
   ]
  ],
  ['command',$messages[148],-font=>$font,-command=>[\&projectproperties]],
  ['command',$messages[44],-font=>$font,-command=>[\&exitrodovid], -accelerator=>'Ctrl-X']
 ];
}
sub menucreate
{
 $file = $menubar->MyMenuButton(-pady=>2,-relief=>'flat',-font=>$font,-text=>$messages[49],-menuitems => file_menuitems,-tearoff=>0,-state=>'active',-activebackground=>$menuback,-activeforeground=>$menufore);
 $view = $menubar->MyMenuButton(-pady=>2,-relief=>'flat',-font=>$font,-text=>$messages[51],-menuitems => view_menuitems,-tearoff=>0,-state=>'active',-activebackground=>$menuback,-activeforeground=>$menufore);
 $tools = $menubar->MyMenuButton(-pady=>2,-relief=>'flat',-font=>$font,-text=>$messages[243],-menuitems => tools_menuitems,-tearoff=>0,-state=>'active',-activebackground=>$menuback,-activeforeground=>$menufore);
 $sc = $menubar->MyMenuButton(-pady=>2,-relief=>'flat',-font=>$font,-text=>$messages[245],-menuitems => sc_menuitems,-tearoff=>0,-state=>'active',-activebackground=>$menuback,-activeforeground=>$menufore);
 $help = $menubar->MyMenuButton(-pady=>2,-relief=>'flat',-font=>$font,-text=>$messages[50],-menuitems => help_menuitems,-tearoff=>0,-state=>'active',-activebackground=>$menuback,-activeforeground=>$menufore);
 $file->pack(-side=>'left');
 $view->pack(-side=>'left');
 $tools->pack(-side=>'left');
 $sc->pack(-side=>'left');
 $help->pack(-side=>'left');
}
sub saveoptions
{
 open(F,'>:raw',fn($workfolder.'/rodovid.conf'));
 print F encode('utf8','lang='.$language); print F "\n";
 print F encode('utf8','style='.$facestyle); print F "\n";
 print F encode('utf8','cache='.$cache); print F "\n";
 print F encode('utf8','noname='.$noname); print F "\n";
 print F encode('utf8','font size='.$fsize); print F "\n";
 print F encode('utf8','save windowsize='.$save_windowsize); print F "\n";
 if ($save_windowsize==1)
 {
  $geom=~/^(\d+)x(\d+)/;
  if (($1>640) && ($2>320)) {  print F encode('utf8','windowsize='.$geom); print F "\n"; }
 }
 print F encode('utf8','center='.$touch_enable); print F "\n";
 close(F);
}
sub loadoptions
{
 my $err=0; # 65536 - file not present, 0 - all options in file without errors, 1 - lang err 2 - style err...
 my $b;
 my $a;
 if (-e fn($workfolder.'/rodovid.conf'))
 {
  open(F,'<:raw',fn($workfolder."/rodovid.conf"));
  while ($a=<F>)
  {
   chomp($a);$a=decode('utf8',$a);
   if ($a=~/lang\=(\w+)$/)
   {
    $err=$err | 1;
    foreach $b (@lang)
    {
     if ($b eq $1)
     {
      $language=$1;$err=$err & 65534;
      if ($language eq $lang[0]) {$locale=$locales[0];loadmessages};
      if ($language eq $lang[1]) {$locale=$locales[1];loadmessages};
      if ($language eq $lang[2]) {$locale=$locales[2];loadmessages};
      if ($language eq $lang[3]) {$locale=$locales[3];loadmessages};
      if ($language eq $lang[4]) {$locale=$locales[4];loadmessages};
     }
    }
   }
   if ($a=~/style\=(\w+)$/)
   {
    $err=$err | 2;
    foreach $b (@styles)
    {
     if ($b eq $1)
     {
      $facestyle=$1;$err=$err & 65533;
     }
    }
   }
   if ($a=~/cache\=(\d)$/)
   {
    if (($1==1) || ($1==0))
    {
     $cache=$1;$err=$err & 65531;
    }
   }
   if ($a=~/noname\=(.+)$/)
   {
     $noname=$1;$err=$err & 65527;
   }
   if ($a=~/^windowsize\=(.+)$/)
   {
     $windowsize=$1;
   }
   if ($a=~/^save windowsize\=(\d)$/)
   {
    $save_windowsize=0;
    if (($1==0) || ($1==1))
    {
     $save_windowsize=$1;
    }
   }
   if ($a=~/^center\=(\d)$/)
   {
    $touch_enable=1;
    if (($1==0) || ($1==1))
    {
     $touch_enable=$1;
    }
   }
   if ($a=~/^font size\=(\d+)$/)
   {
    if (($1>7) || ($1<19))
    {
     $fsize=$1;
    }
    else {$fsize=9}
   }
  }
  close(F);
  return $err;
 }
 else {return 65536}
}
sub selectall # select all persons on canvas
{
 if ($draggroup==0)
 {
  $draggroup=3;
  @kins=();my $i=0;
  my $a;
  foreach $a (values %people)
  {
   $kins[$i]=$a;$i++;
  }
  $c->createRectangle($c->bbox(@kins),-dash=>$dashmarkbox,-width=>2,-tags=>'markbox',-outline=>'blue');
  drawmessage($messages[55]);
  return
 }
 if ($draggroup==3)
 {
  endgroup();
  return
 }
 MyMessageBox($messages[92],'ok','info');
}
sub keyboardbindings
{
 $TOP->bind('<Control-t>' => sub { if ($menustate==1) {if ($touch_enable==1) {$touch_enable=0} else {$touch_enable=1}}});
 $TOP->bind('<Control-T>' => sub { if ($menustate==1) {if ($touch_enable==1) {$touch_enable=0} else {$touch_enable=1}}});
 $TOP->bind('<Control-x>' => sub { if ($menustate==1) {exitrodovid}});
 $TOP->bind('<Control-X>' => sub { if ($menustate==1) {exitrodovid}});
 $TOP->bind('<Control-s>' => sub { if ($menustate==1) {save3}});
 $TOP->bind('<Control-S>' => sub { if ($menustate==1) {save3}});
 $TOP->bind('<Control-n>' => sub { if ($menustate==1) {create}});
 $TOP->bind('<Control-N>' => sub { if ($menustate==1) {create}});
 $TOP->bind('<Control-o>' => sub { if ($menustate==1) {load}});
 $TOP->bind('<Control-O>' => sub { if ($menustate==1) {load}});
 $TOP->bind('<Control-F>' => sub { if ($menustate==1) {findperson}});
 $TOP->bind('<Control-f>' => sub { if ($menustate==1) {findperson}});
 $TOP->bind('<Control-M>' => sub { if ($menustate==1) {mapview}});
 $TOP->bind('<Control-m>' => sub { if ($menustate==1) {mapview}});
 $TOP->bind('<Control-a>' => sub { if ($menustate==1) {selectall}});
 $TOP->bind('<Control-A>' => sub { if ($menustate==1) {selectall}});
 $TOP->bind('<KeyPress-Escape>' => sub { #Unselect persons
  if ($menustate==1)
  {
   if ($draggroup>0) #if selected any group for moving then ending selection
   {
    endgroup;
   }
  } 
 });
 $TOP->bind('<KeyPress-Delete>' => sub { if ($menustate==1) #Delete Selected persons
 {
  my $k=@kins;
  if ($k>0)
  {
   MyMessageBox($messages[37].' '.$k.' '.$messages[99],"YesNoList","question",@kins);
   if ($BoxResult==1)
   {
    my $im=$image;
    foreach $i (@kins) 
    { 
     $image=$i;
     $image=~s/people//;
     menudelete;
    }
    $image=$im;
    if ($draggroup>0) #if selected any group for moving then ending selection
    {
     endgroup;
    }
   }
  }
 }});
 $TOP->bind('<KeyPress-F1>' => sub { if ($menustate==1) {help}});
 $TOP->bind('<KeyPress-Left>' =>
 sub
 {
  if ($menustate==1) 
  {
   scroll();
   if (($scrollx-$scrollxinc)>0) {$c->xview(moveto=>($scrollx-$scrollxinc))}
   else{$c->xview(moveto=>0)}
  }
 });
 $TOP->bind('<Control-Left>' =>
 sub
 {
  if ($menustate==1) 
  {
   scroll();
   if (($scrollx-$scrollxinc*4)>0) {$c->xview(moveto=>($scrollx-$scrollxinc*4))}
   else {$c->xview(moveto=>0)}
  }
 });
 $TOP->bind('<KeyPress-Right>' =>
 sub
 {
  if ($menustate==1) 
  {
   scroll();
   if (($scrollx+$scrollxinc)<1) {$c->xview(moveto=>($scrollx+$scrollxinc))}
   else {$c->xview(moveto=>1)}
  }
 });
 $TOP->bind('<Control-Right>' =>
 sub
 {
  if ($menustate==1) 
  {
   scroll();
   if (($scrollx+$scrollxinc*4)<1) {$c->xview(moveto=>($scrollx+$scrollxinc*4))}
   else {$c->xview(moveto=>1)}
  }
 });
 $TOP->bind('<KeyPress-Up>' =>
 sub
 {
  if ($menustate==1) 
  {
   scroll();
   if (($scrolly-$scrollyinc)>0) {$c->yview(moveto=>($scrolly-$scrollyinc))}
   else {$c->yview(moveto=>0)}
  }
 });
 $TOP->bind('<Control-Up>' =>
 sub
 {
  if ($menustate==1) 
  {
   scroll();
   if (($scrolly-$scrollyinc*4)>0) {$c->yview(moveto=>($scrolly-$scrollyinc*4))}
   else {$c->yview(moveto=>0)}
  }
 });
 $TOP->bind('<KeyPress-Down>' =>
 sub
 {
  if ($menustate==1) 
  {
   scroll();
   if (($scrolly+$scrollyinc)<1) {$c->yview(moveto=>($scrolly+$scrollyinc))}
   else {$c->yview(moveto=>1)}
  }
 });
 $TOP->bind('<Control-Down>' =>
 sub
 {
  if ($menustate==1) 
  {
   scroll();
   if (($scrolly+$scrollyinc*4)<1) {$c->yview(moveto=>($scrolly+$scrollyinc*4))}
   else {$c->yview(moveto=>1)}
  }
 });
}
# Mouse bindings on canvas
sub mousebindings
{
 # Press 1st mouse's button
 $c->CanvasBind('<1>' => 
 sub
 {
  if ($menustate==1)
  {
   my($c) = @_;
   my $e = $c->XEvent;
   items_start_drag $c, $e->x, $e->y;
   if ($draggroup==0)
   {
    my @tags=$c->gettags('current');
    if ($tags[0] eq '')
    {
     $draggroup=5;
     $dg5=0;
     (my $menux1,my $menux2) = $c -> xview;
     (my $menuy1,my $menuy2) = $c -> yview;
     $x1_mark=$menux1*$xcanvas+$Tk::event->x;
     $y1_mark=$menuy1*$ycanvas+$Tk::event->y;
     drawmark($x1_mark,$y1_mark,$x1_mark+1,$y1_mark+1);
    }
   }
  }
 });
 # Mouse motion
 $c->CanvasBind('<Motion>' =>
 sub
 {
  if (($menustate==0) || ($peoples==0) || ($exit_processing==1)) {return}
  if ($showmess==1) {$showmess=0}
  my @tags=$c->gettags('current');
  if ($draggroup==0)
  {
   my $cursor_over_line=0;
   if ($tags[0]=~/^\dspouse(\d+):(\d+)/)
   { 
    drawmessage("$family_name{$1} $first_name{$1} $second_name{$1}(ID:$1) <=> $family_name{$2} $first_name{$2} $second_name{$2}(ID:$2)");
    $cursor_over_line=1;
   }
   if ($tags[0]=~/^jump(\d+):(\d+)$/)
   {
    drawmessage($messages[184]." $family_name{$1} $first_name{$1} $second_name{$1}(ID:$1)");
    $cursor_over_line=1;
   }
   if (($tags[0]=~/^father(\d+):(\d+)/) || ($tags[0]=~/^mother(\d+):(\d+)/))
   {
    drawmessage("$family_name{$1} $first_name{$1} $second_name{$1}(ID:$1) <- $family_name{$2} $first_name{$2} $second_name{$2}(ID:$2)");
    $cursor_over_line=1;
   }
   if ($cursor_over_line==0) {deletemessage}
  }
  if ($findedp==1) {$findedp=0; $c->delete('markboxf')}
  (my $menux1,my $menux2) = $c -> xview;
  (my $menuy1,my $menuy2) = $c -> yview;
  my $bx=$menux1*$xcanvas+$Tk::event->x;
  my $by=$menuy1*$ycanvas+$Tk::event->y;
  #if cursor position go to canvas's margins off - correct cursor position.
  if ($peoplex{$son} < $bx)
  {
   $bx=$bx - delta;
  }
  if ($peoplex{$son} > $bx)
  {
   $bx=$bx+delta;
  }
  if ($peopley{$son}-30*$size < $by)
  {
   $by=$by - delta;
  }
  if ($peopley{$son}-30*$size > $by)
  {
   $by=$by+delta;
  }
  # if started creating father
  if ($begin_father==1)
  {
   if ($peoplex{$son} < $bx)
   {
    $bx=$bx - delta;
   }
   if ($peoplex{$son} > $bx)
   {
    $bx=$bx + delta;
   }
   if ($peopley{$son}-30*$size < $by)
   {
    $by=$by - delta;
   }
   if ($peopley{$son}-30*$size > $by)
   {
    $by=$by + delta;
   }
   $c->delete('father'.$son);
   arrowToFather($peoplex{$son}, $peopley{$son}-30*$size,$bx,$by,'father'.$son);
  }
  # if started creating mother
  if ($begin_mother==1)
  {
   if ($peoplex{$son} < $bx)
   {
    $bx=$bx - delta;
   }
   if ($peoplex{$son} > $bx)
   {
    $bx=$bx + delta;
   }
   if ($peopley{$son}-30*$size < $by)
   {
    $by=$by - delta;
   }
   if ($peopley{$son}-30*$size > $by)
   {
    $by=$by + delta;
   }
   $c->delete('mother'.$son);
   arrowToMother($peoplex{$son}, $peopley{$son}-30*$size,$bx,$by,'mother'.$son);
  }
  # if started creating spouse
  if ($begin_spouse==1)
  {
   my $x1;
   if ($peoplex{$son}<=$bx)
   {
    $x1=$peoplex{$son}+78*$size;
   }
   else
   {
    $x1=$peoplex{$son}-78*$size;
   }
   if ($peopley{$son} < $by)
   {
    $by=$by - delta;
   }
   if ($peopley{$son} > $by)
   {
    $by=$by + delta;
   }
   $c->delete('1spouse'.$son);
   $c->delete('2spouse'.$son);
   arrowSpouse($x1, $peopley{$son},$bx,$by,$son);
  }
  undef @tags;
 });
 # Mouse motion with pressed left button
 $c->CanvasBind('<B1-Motion>' => sub
 {
  if ($menustate==1)
  {
   my @tags=$c->gettags('current');
   if ($tags[0]=~/^ruler(\d+)$/) # if no grouping and selected ruller
   {
    if ($draggroup==0)
    { 
     @kins=('current');
    }
   }
   if ($tags[0]=~/^people(\d+)$/) # if no grouping and selected person
   {
    if ($draggroup==0)
    {
     @kins=('current');
    }
   }
   my $k=@kins;
   my $cx=$Tk::event->x;
   my $cy=$Tk::event->y;
   if ($k>0) {items_drag shift,$cx,$cy}
   if (($draggroup==5) && ($dg5==0))
   {
    (my $menux1,my $menux2) = $c -> xview;
    (my $menuy1,my $menuy2) = $c -> yview;
    my $bx=$menux1*$xcanvas+$cx;
    my $by=$menuy1*$ycanvas+$cy;
    $c->delete('bmark');
    drawmark($x1_mark, $y1_mark,$bx,$by);
   }
   undef @tags;
  }
 });
 # mouse left button release
 $c->CanvasBind('<ButtonRelease-1>' =>sub
 {
  if (($draggroup==5) && ($dg5==0))
  {
   $dg5=1;
   (my $menux1,my $menux2) = $c -> xview;
   (my $menuy1,my $menuy2) = $c -> yview;
   my $bx=$menux1*$xcanvas+$Tk::event->x;
   my $by=$menuy1*$ycanvas+$Tk::event->y;
   $c->delete('bmark');
   $x2_mark=$bx;
   $y2_mark=$by;
   my @t=$c->find('overlapping',$x1_mark,$y1_mark,$x2_mark,$y2_mark);
   @kins=();
   my $i=0;
   my @t2;
   foreach my $key (@t)
   {
    @t2=$c->gettags($key);
    if ($t2[0]=~/^people/)
    {
     $kins[$i]=$t2[0];$i+=1;
    }
   }
   undef @t;
   undef @t2;
   my %kins=();foreach $a (@kins) {$kins{$a}=1}; @kins=(keys %kins); #selected kids in list must be once!
   if ($i>0)
   {
    drawmessage($messages[55]);
    $c->createRectangle($c->bbox(@kins),-dash=>$dashmarkbox,-width=>2,-tags=>'markbox',-outline=>'blue');
   } else {endgroup}
  }
  sub move_canvas
  {
   my $id=$c->type('current');
   if (($id eq '') and ($touch_enable==1)) # Only if pressed on clear part of desktop
   {
    my ($oldx,$t)=$c->xview;
    my ($oldy,$t)=$c->yview;
    $TOP->geometry=~/^(\d+)x(\d+)\+([-]*\d+)\+([-]*\d+)$/;
    my $x=int($1/2);
    my $y=int($2/2);
    my $cx=$Tk::event->x;
    my $cy=$Tk::event->y;
    my $dcm=16;   #count of moves
    my $cm=0;
    my $dx; my $dy;
    while (1)
    {
     if ($dcm==0) {$dcm=1}
     $dx=abs(int((($cx-$x)/$dcm)));
     $dy=abs(int((($cx-$x)/$dcm)));
     $cm=$dy;
     if ($dx<$dy) { $cm=$dx }
     if (($cm>3) && ($cm<11)) 
     {
      $dx=abs(int((($cx-$x)/$dcm)));
      $dy=abs(int((($cx-$x)/$dcm)));
      last
     }
     if ($cm>10) {$dcm=$dcm*2;next}
     if ($cm<4) {$dcm=$dcm/2}
     if ($dcm<4) 
     {
      $dcm=1;
      $cm=4;
      $dx=abs(int(($cx-$x/$dcm)));
      $dy=abs(int(($cx-$x/$dcm)));
      last
     }
    }
    my $a=10;
    my $sl=.02;
    my $b=1;
    while ($b<$a)
    {
     $c->delete('oval');
     $c->createOval(int($oldx*$xcanvas+$cx-$b-1),int($oldy*$ycanvas+$cy-$b-1),int($oldx*$xcanvas+$cx+$b+1),int($oldy*$ycanvas+$cy+$b+1),-outline=>'red',-tags=>'oval');
     $c->createOval(int($oldx*$xcanvas+$cx-$b),int($oldy*$ycanvas+$cy-$b),int($oldx*$xcanvas+$cx+$b),int($oldy*$ycanvas+$cy+$b),-outline=>'red4',-tags=>'oval');
     $c->createOval(int($oldx*$xcanvas+$cx-$b+1),int($oldy*$ycanvas+$cy-$b+1),int($oldx*$xcanvas+$cx+$b-1),int($oldy*$ycanvas+$cy+$b-1),-outline=>'red',-tags=>'oval');
     $c->update;
     select(undef,undef,undef, $sl);
     $b+=1;
    }
    $dx=($cx-$x)/$cm;
    $dy=($cy-$y)/$cm;
    $a=0;
    while ($a<=$cm)
    {
     $c->xview(moveto=>($oldx*$xcanvas+$dx*$a)/$xcanvas);
     $c->yview(moveto=>($oldy*$ycanvas+$dy*$a)/$ycanvas);
     $c->update;
     $a+=1;
     select(undef,undef,undef, $sl/2);
    }
    $a=$cm;
    my $b=10;
    while ($b>0)
    {
     $c->delete('oval');
     $c->createOval(int($oldx*$xcanvas+$cx-$b-1),int($oldy*$ycanvas+$cy-$b-1),int($oldx*$xcanvas+$cx+$b+1),int($oldy*$ycanvas+$cy+$b+1),-outline=>'red',-tags=>'oval');
     $c->createOval(int($oldx*$xcanvas+$cx-$b),int($oldy*$ycanvas+$cy-$b),int($oldx*$xcanvas+$cx+$b),int($oldy*$ycanvas+$cy+$b),-outline=>'red4',-tags=>'oval');
     $c->createOval(int($oldx*$xcanvas+$cx-$b+1),int($oldy*$ycanvas+$cy-$b+1),int($oldx*$xcanvas+$cx+$b-1),int($oldy*$ycanvas+$cy+$b-1),-outline=>'red',-tags=>'oval');
     $c->update;
     select(undef,undef,undef, $sl);
     $b-=1;
    }
    $c->delete('oval');
   }
  }
  if ($menustate==1)
  {
   items_leave shift, $Tk::event->x, $Tk::event->y;
   if ($draggroup==0) {@kins=()}
   if (($draggroup==0) && ($begin_spouse==0) && ($begin_mother==0) && ($begin_father==0))
   {
    my $id = $c ->type('current');
    my @tags2=$c->gettags('current');
    if ($id eq 'image') # if type of object on canvas is image
    {
     if ($tags2[0]=~/jump(\d+):(\d+)/)
     {
      my $to=$1;
      menugoto($to);
     }
     else {move_canvas}
    }
    else {move_canvas}
    undef @tags2;
   }
  }
 });
 #Ctrl + Mouse's left button press
 $c->CanvasBind('<Control-ButtonRelease-1>' =>sub
 {
  if ($menustate==1)
  {
   if ($draggroup==0) #first press Ctrl+left but
   {
    $draggroup=4;
    $obj=0;@kins=();
    @tags=$c->gettags('current');
    if ($tags[0]=~/^people([0-9]+)$/)
    {
     $kins[0]=$tags[0];
     $c->createRectangle($c->bbox(@kins),-dash=>$dashmarkbox,-width=>2,-tags=>'markbox',-outline=>'blue');
     drawmessage($messages[55]);
    }
    return
   }
 #  if ($draggroup==4) #second and all next presses Ctrl+left but
   else
   {
    @tags=$c->gettags('current');
    if ($tags[0]=~/^people([0-9]+)$/) # if selected object is person
    {
     for (my $i=0;$i<=$obj;$i++) # see all selected persons in list
     {
      if ($kins[$i] eq $tags[0]) # if current person present then remove it from list
      {
       splice(@kins,$i,1);
       $obj--;
       $c->delete(-tags=>'markbox');
       if ($obj>0) {$c->createRectangle($c->bbox(@kins),-dash=>$dashmarkbox,-width=>2,-tags=>'markbox',-outline=>'blue');}
       return;
      }
     }
     #adding selected person to list
     $obj++;$kins[$obj]=$tags[0];
     $c->delete(-tags=>'markbox');
     $c->createRectangle($c->bbox(@kins),-dash=>$dashmarkbox,-width=>2,-tags=>'markbox',-outline=>'blue');
    }
    return
   }
  }
 });
 #Mouse's left but doublepress
 $c->CanvasBind('<Double-ButtonPress-1>' =>sub
 {
  if ($menustate==1)
  {
   @tags=$c->gettags('current');
   if ($tags[0]=~/^people([0-9]*)$/) # if selected object is person
   {
    $image=$1;
    menuproperties;
   }
  }
 });
 #Rigth mouse's button
 $c->CanvasBind('<ButtonRelease-3>' => sub{
 if ($menustate==1)
 {
  if ($draggroup>0) #if selected any group for moving then ending selection
  {
   endgroup;
   goto end3;
  }
  if ($begin_spouse==1) # end of creating spouse
  { 
   $begin_spouse=0;
   $c->delete('1spouse'.$son);
   $c->delete('2spouse'.$son);
   goto end3;
  }
  if ($begin_father==1) # ending of creating father
  {
   $begin_father=0;
   $c->delete('father'.$son);
   goto end3;
  }
  if ($begin_mother==1) # ending of creating mother
  {
   $begin_mother=0;
   $c->delete('mother'.$son);
  }
  else
  {
   my $id = $c ->type('current');
   my @tags2=$c->gettags('current');
   if ($tags2[0]=~/people([0-9]*)/) {$son=$1}
   (my $menux1,my $menux2) = $c -> xview;
   (my $menuy1,my $menuy2) = $c -> yview;
   $bx=$menux1*$xcanvas+$Tk::event->x;#real coordinates on canvas.
   $by=$menuy1*$ycanvas+$Tk::event->y;
   if ($id eq 'line') # if type of object on canvas is line
   {
    if (($tags2[0]=~/^mother/) || ($tags2[0]=~/^father/)) # if this line is mother or father
    {
     my $linename=$tags2[0];
     if ($linename=~/:s$/)
     {
      $c->Menu(-font=>$font,-tearoff=>0,-relief=>'ridge',-borderwidth=>2,-menuitems=> #popup menu for switch to normal line
      [
       [Button=>$messages[192],-command=>[
       sub
       {
        if ($linename=~/^father(\d+):(\d+):s$/)
        {
         my $i=0;
         my $son=$1;
         my $par=$2;
         $c->delete($linename);
         $c->delete("jump$son:$par");
         $c->delete("jump$par:$son");
         arrowFromFather($peoplex{$son}, $peopley{$son}-30*$size,$peoplex{$par}, $peopley{$par}+30*$size,"father$son:$par");
        }
        else
        {
         if ($linename=~/^mother(\d+):(\d+):s$/)
         {
          my $i=0;
          my $son=$1;
          my $par=$2;
          $c->delete($linename);
          $c->delete("jump$son:$par");
          $c->delete("jump$par:$son");
          arrowFromMother($peoplex{$son}, $peopley{$son}-30*$size,$peoplex{$par}, $peopley{$par}+30*$size,"mother$son:$par");
         }
        }
       }]
       ],
      ])->Popup(-popover=>"cursor",-popanchor=>'nw');
     }
     else
     {
      $c->Menu(-font=>$font,-tearoff=>0,-relief=>'ridge',-borderwidth=>2,-menuitems=> #popup menu for switch to short line
      [
       [Button=>$messages[193],-command=>[
       sub
       {
        if ($linename=~/^father(\d+):(\d+)$/)
        {
         my $i=0;
         my $son=$1;
         my $par=$2;
         $c->delete($linename);
         arrowFromFather($peoplex{$son}, $peopley{$son}-30*$size,$peoplex{$par}, $peopley{$par}+30*$size,$linename.':s');
        }
        else
        {
         if ($linename=~/^mother(\d+):(\d+)$/)
         {
          my $i=0;
          my $son=$1;
          my $par=$2;
         $c->delete($linename);
         arrowFromMother($peoplex{$son}, $peopley{$son}-30*$size,$peoplex{$par}, $peopley{$par}+30*$size,$linename.':s');
         }
        }
       }]
       ],
      ])->Popup(-popover=>"cursor",-popanchor=>'nw');
     }
    }
    my ($k,$v);
    if ($tags2[0]=~/^ruler(\d+)$/) # if this line is ruller
    {
     (my $menux1,my $menux2) = $c -> xview;
     (my $menuy1,my $menuy2) = $c -> yview;
     my $bx=$menux1*$xcanvas+$Tk::event->x; # cursor's x,y absolute
     my $by=$menuy1*$ycanvas+$Tk::event->y;
     $currentruler=$1;my $stat='disabled';if ($draggroup==0) {$stat='active'} #if draging off then enable grouping by ruller
     my $popup=$c->Menu(-font=>$font,-tearoff=>0,-relief=>'ridge',-borderwidth=>2,-menuitems=> #popup menu for ruller
     [
      [Button=>$messages[67],-command=>[sub #delete ruller
       {
        $c->delete($tags2[0]);
        delete($ruler{$currentruler});
        $rulers--;
       }
      ]],
      [Button=>$messages[194],-command=>[sub #push persons
       {
        my @right=();
        my @left=();
	while (($k,$v)=each(%peopley))
	{
	 if ($v==$ruler{$currentruler})
	 {
	  if ($peoplex{$k}>$bx) {push (@right,"people".$k)} else {push (@left,"people".$k)}
	 }
	}
	menustateoff;
	drawmessage($messages[69]);
	if (scalar(@right)>0) {@kins=@right;movepersons(32 + 64*$size,0);}
	if (scalar(@left)>0) {@kins=@left;movepersons(-(32 + 64*$size),0);}
	deletemessage;menustateon;
       }
      ]],
      [Button=>$messages[197],-command=>[sub #push persons
       {
        my @right=();
        my @left=();
	while (($k,$v)=each(%peopley))
	{
	 if ($v==$ruler{$currentruler})
	 {
	  if ($peoplex{$k}>$bx) {push (@right,"people".$k)} else {push (@left,"people".$k)}
	 }
	}
	menustateoff;
        drawmessage($messages[69]);
        %spouseforkins=%spouse;
        %fatherforkins=%father;
        %motherforkins=%mother;
	my @all=();
	if (scalar(@right)>0)
	{
	 foreach $a (@right)
	 {
	  $_=$a;s/people//;@kins=();$kins[0]=$a;$nextkin=1;kins2($_,0);
	  push(@all,@kins);
	 } 
	 @kins=@all;
	 movepersons(32 + 64*$size,0);
	}
	@all=();
	if (scalar(@left)>0)
	{
	 foreach $a (@left)
	 {
	  $_=$a;s/people//;@kins=();$kins[0]=$a;$nextkin=1;kins2($_,0);
	  push(@all,@kins);
	 }
	 @kins=@all;
	 movepersons(-(32 + 64*$size),0);
	}
        undef %fatherforkins;
        undef %motherforkins;
        undef %spouseforkins;
	deletemessage;
	menustateon;
       }
      ]],
      [Button=>$messages[195],-command=>[sub #pop persons
       {
        my @right=();
        my @left=();
        my $nr=0;
        my $nl=0;
	while (($k,$v)=each(%peopley))
	{
	 if ($v==$ruler{$currentruler})
	 {
	  if ($peoplex{$k}>$bx) {push (@right,"people".$k);$nr+=1} else {push (@left,"people".$k);$nl+=1}
	 }
	}
	my $sr=$right[0];$sr=~s/people//;$sr=$peoplex{$sr}; my $a=1;while ($a<$nr) { $_=$right[$a]; s/people//; if ($peoplex{$_}<$sr) {$sr=$peoplex{$_}};$a+=1}
	my $bl=$left[0];$bl=~s/people//;$bl=$peoplex{$bl};  $a=1;while ($a<$bl) { $_=$left[$a]; s/people//; if ($peoplex{$_}>$bl) {$bl=$peoplex{$_}};$a+=1}
	if (($sr-$bl-64*$size*2)>64*3*$size) 
	{
	 menustateoff;
	 if (scalar(@right)>0) {@kins=@right;movepersons(-(32 + 64*$size),0);}
	 if (scalar(@left)>0) {@kins=@left;movepersons(32 + 64*$size,0);}
	 menustateon;
        } else {MyMessageBox($messages[196],'ok','info');}
       }
      ]],
      [Button=>$messages[73],-state=>$stat,-command=>[sub #draging by ruller
       {
        if ($draggroup==0)
        {
         $draggroup=2;
         drawmessage($messages[55]);
         @kins=();$ki=0;
         while ((my $k,my $a)=each(%peopley)) #searching all peoples who has Y coord = Y coord of this ruller
         {
          if ($a==$ruler{$currentruler})
          {
           $kins[$ki]='people'.$k;$ki++;
          }
         }
         if (scalar(@kins)>0)
         {
          $c->createRectangle($c->bbox(@kins),-dash=>$dashmarkbox,-width=>2,-tags=>'markbox',-outline=>'blue');
         }
         else
         {
          $draggroup=0;
          deletemessage;
         }
        }
        else 
        {# message "Grouping is On"
         MyMessageBox($messages[92],'ok','info');
        }
       }
      ]],
     ]);
     $popup->Popup(-popover=>"cursor",-popanchor=>'nw');
    }
   }
   if ($id eq 'image') # if type of object on canvas is image
   {
    if ($tags2[0]=~/jump(\d+):(\d+)/)
    {
     my $to=$1;
     $c->Menu(-font=>$font,-tearoff=>0,-relief=>'ridge',-borderwidth=>2,-menuitems=> #popup menu for Jump
     [
      [Button=>$messages[184]." $family_name{$to} $first_name{$to} $second_name{$to}(ID:$to)",-command=>[sub{menugoto($to)}]
      ],
     ])->Popup(-popover=>"cursor",-popanchor=>'nw');
    }
    if ($tags2[0]=~/people(\d+)/)
    {
     $image=$1;
     my $state_all='disabled';
     my $state_mother='disabled';
     my $state_childs='disabled';
     my $state_father='disabled';
     my $state_mother1='disabled';
     my $state_father1='disabled';
     #if present not father for this person then enable creating father in menu
     foreach $a (values %father)
     {
      if ($a=~/^$son:(\d+)$/)
      {
       $state_father='active'; $father_this=$1;last;
      }
     }
     #if present not mother for this person then enable creating mother in menu
     foreach $a (values %mother)
     {
      if ($a=~/^$son:(\d+)$/)
      {
       $state_mother='active'; $mother_this=$1;last;
      }
     }
     if ($state_mother eq 'disabled') {$state_mother1='active'}
     if ($state_father eq 'disabled') {$state_father1='active'}
     if (($state_mother eq 'active') || ($state_father eq 'active')) {$state_all='active'}
     my $stat2='disabled';if ($draggroup==0) {$stat2='active'} # if draging off then enable grouping from this person
     my @childs=();
     my $i=0;
     foreach $a (values %mother)
     {
      if ($a=~/^(\d+):$son$/)
      {
       $childs[$i]=$1;
       $i+=1;$state_childs='active';
      }
     }
     foreach $a (values %father)
     {
      if ($a=~/^(\d+):$son$/)
      {
       $childs[$i]=$1;
       $i+=1;$state_childs='active';
      }
     }
     my $child;
     my @childs_buttons=();
     if ($state_childs=='active')
     {
      $state_all='active';
      my $ii;
      foreach $ii (@childs)
      {
       push(@childs_buttons,[Button=>$family_name{$ii}.' '.$first_name{$ii}.' '.$second_name{$ii}.' ('.$ii.')',-font=>$font,-command=>[sub{menugoto($ii)}]]);
      }
     }
     $child=[cascade=>$messages[185],-font=>$font,-tearoff=>0,-state=>$state_childs,-menuitems=>\@childs_buttons];
     my $popup=$c->Menu(-font=>$font,-tearoff=>0,-relief=>'ridge',-borderwidth=>2,-menuitems=>
     [
      [cascade=>$messages[182],-font=>$font, -tearoff=>0, -menuitems=>
          [
           [Button=>$messages[10],-font=>$font,-command=>[\&menucreatefather],-state=>$state_father1],
           [Button=>$messages[11],-font=>$font,-command=>[\&menucreatemother],-state=>$state_mother1],
           [Button=>$messages[12],-font=>$font,-command=>[\&menucreatespouse]],
          ],
      ],
      [cascade=>$messages[183],-font=>$font, -tearoff=>0, -menuitems=>
          [
           [Button=>$messages[13],-font=>$font,-command=>[\&menudeletefather,1],-state=>$state_father],
           [Button=>$messages[14],-font=>$font,-command=>[\&menudeletemother,1],-state=>$state_mother],
           [Button=>$messages[16],-font=>$font,-command=>[\&menudelete]],
          ],
      ],
      [cascade=>$messages[184],-font=>$font, -tearoff=>0, -state=>$state_all, -menuitems=>
          [
           [Button=>$messages[180],-font=>$font,-command=>[sub{menugoto($father_this)}],-state=>$state_father],
           [Button=>$messages[181],-font=>$font,-command=>[sub{menugoto($mother_this)}],-state=>$state_mother],
	   $child,
          ],
      ],
      [Button=>$messages[74],-font=>$font,-state=>$stat2,-command=>[\&markkins]],
      [Button=>$messages[17],-font=>$font,-command=>[\&menuproperties]]
     ]);
     $popup->Popup(-popover=>"cursor",-popanchor=>'nw');
    }
   }
   else
   {
    if ($id eq "") # if click on clean part of canvas
    {
     if ($hiddenall eq 0)
     {
      $popup=$c->Menu(-font=>$font,-tearoff=>0,-relief=>'ridge',-borderwidth=>2,-menuitems=>
      [
       [Button=>$messages[20],-command=>[\&menu2man]],
       [Button=>$messages[21],-command=>[\&menu2woman]],
       [Button=>$messages[66],-command=>[\&createruler]],
       [Button=>$messages[186],-command=>[\&showallhidden]]
      ]
      );
     }
     else
     {
      $popup=$c->Menu(-font=>$font,-tearoff=>0,-relief=>'ridge',-borderwidth=>2,-menuitems=>
      [
       [Button=>$messages[20],-command=>[\&menu2man]],
       [Button=>$messages[21],-command=>[\&menu2woman]],
       [Button=>$messages[66],-command=>[\&createruler]],
       [Button=>$messages[187],-command=>[\&hideallhidden]]
      ]
      );
     }
     $popup->Popup(-popover=>"cursor",-popanchor=>'nw');
    }
   }
   undef @tags2;
  }
end3:
 }
});
}
our $style;
our $f_on; # foto on/off 1/0
our $t_on; # tree on/off 1/0
our $d_on; # docs on/off 1/0
our $dp_on; # maiden family on/off 1/0
our $g_max; # Max number of photos in gallery
our $g_size; # Max dimension of photo
our $g_icsize; # Max dimension of photo for icon. It can be only less size
our $g_q; # Gallery photos quality for resizing
our $fs2; # fontsize 2
our $fs; # fontsize 1
our $info;
sub exporthtml
{
 @surn=();
 menustateoff;
 if ($peoples==0) {return}
 #count number of peoples
 my $i=0;
 my $k;
 my $tgn;
 foreach $k (keys %people)
 {
  if (($family_name{$k} eq '') && ($first_name{$k}.$second_name{$k} ne ''))
  {
   if (($first_name{$k} ne '') && ($second_name{$k} ne '')) { $surn[$i]=$noname.' '.$first_name{$k}.' '.$second_name{$k}.'.'.$k};
   if (($first_name{$k} ne '') && ($second_name{$k} eq '')) { $surn[$i]=$noname.' '.$first_name{$k}.'.'.$k};
   if (($first_name{$k} eq '') && ($second_name{$k} ne '')) { $surn[$i]=$noname.' '.$second_name{$k}.'.'.$k};
  }
  else 
  {
   $tgn=getname($k);
   if (($tgn ne '')) {$surn[$i]=$tgn.'.'.$k}
   else 
   {
    $surn[$i]=$noname.'.'.$k;
   }
  }
  $i++;
 }
 my $number_of_indi=$i;
 @sorted=sort @surn;
 # Parameters of html report:
 # General
 my $htmltitle=$messages[95]; # Pedigree Title 
 my $splash=$workfolder."graphics/rodovid.gif"; # splashscreen image
 # poisk pervogo cheloveka
 $i=0; while ($people{$i} ne "people$i"){$i++}
 our $firstperson=$i; # who is on first page
 #Gallery 
 $g_max=10; # Max number of photos in gallery
 $g_size=800; # Max dimension of photo
 $g_icsize=170; # Max dimension of photo for icon. It can be only less size
 $g_q='0.95'; # Gallery photos quality for resizing
 #HTML
 $fs2=2; # fontsize 2
 $fs=1; # fontsize 1
 $style='paper';
 $f_on='1';
 $t_on='1';
 $d_on='1';
 $dp_on='1';
 $info=1; # if 1 then insert link to info page
 sub export
 {
# create index.html
  drawmessage($messages[69]);
  rmtree(fn($workfolder.'html'));
  unless (-e fn($workfolder.'html')) {mkdir(fn($workfolder.'html'))}
  open(F,'>:utf8',fn($workfolder.'html/index.html'));
  print F '<html><head><title>';
  print F $htmltitle;
  print F '</title><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"></head>';print F "\n";
  print F '<frameset rows="24,*,24" border="0" framespacing="0"  frameborder="0">';print F "\n";
  print F '<frameset cols="600,*,19" border="0" frameborder="0" framespacing="0">';print F "\n";
  print F ' <frame src="topleft.html" scrolling="NO" noresize name="frmTopLeft">';print F "\n";
  print F ' <frame src="topright.html" scrolling="NO" noresize name="frmTopRight">';print F "\n";
  print F ' <frame src="right_up.html" scrolling="NO" noresize name="frmUpRight">';print F "\n";
  print F '</frameset>';print F "\n";
  print F '<frameset cols="19,200,*,19" border="0" frameborder="0" framespacing="0">';print F "\n";
  print F ' <frame src="left.html" name="frmLeft" scrolling=no noresize>';print F "\n";
  print F ' <frame src="begin.html" name="frmCenter" scrolling="AUTO">';print F "\n";
  print F ' <frame src="home.html" name="info" scrolling="AUTO">';print F "\n";
  print F ' <frame src="right.html" name="right" scrolling="AUTO">';print F "\n";
  print F '</frameset>';print F "\n";
  print F ' <frameset cols="600,*,19" border="0" frameborder="0" framespacing="0">';print F "\n";
  print F '  <frame src="bottom.html" scrolling="NO" noresize name="frmBottom">';print F "\n";
  print F '  <frame src="bottom_right.html" scrolling="NO" noresize name="frmBottom">';print F "\n";
  print F '  <frame src="right_down.html" scrolling="NO" noresize name="frmBottom">';print F "\n";
  print F ' </frameset>';print F "\n";
  print F '</frameset>';print F "\n";
  print F '<noframes>';print F "\n";
  print F '<body bgcolor="#FFFFFF">';print F "\n";
  print F '<BR><BR><BR><BR><center>We are afraid your browser does not support frames.<br></center>';print F "\n";
  print F '</body></noframes></html>';print F "\n";
  close(F);
 #create bottom.html
  open(F,'>:utf8',fn($workfolder.'html/bottom.html'));
  print F '<html><head><title>bottom frame</title><base target="_top"></head>';print F "\n";
  print F '<body bgcolor="#FFFFFF" background="graphics/bottom.gif" link="blue" vlink="blue"></body></html>';
  close(F);
 #create bottom_right.html
  open(F,'>:utf8',fn($workfolder.'/html/bottom_right.html'));
  print F '<html><body bgcolor="#FFFFFF" background="graphics/bottomright.gif" link="blue" vlink="blue"></body></html>';
  close(F);
 #create left.html
  open(F,'>:utf8',fn($workfolder.'html/left.html'));
  print F '<HTML><BODY BACKGROUND= "graphics/left.gif" ></BODY></HTML>';
  close(F);
 #create right.html
  open(F,'>:utf8',fn($workfolder.'html/right.html'));
  print F '<html><body bgcolor="#FFFFFF" background="graphics/right.gif"></body></html>';
  close(F);
 #create right_down.html
  open(F,'>:utf8',fn($workfolder.'html/right_down.html'));
  print F '<html><body bgcolor="#FFFFFF" background="graphics/bottom_right.gif"></body></html>';
  close(F);
 #create right_up.html
  open(F,'>:utf8',fn($workfolder.'html/right_up.html'));
  print F '<html><body bgcolor="#FFFFFF" background="graphics/right_right.gif"></body></html>';
  close(F);
 #create topleft.html
  open(F,'>:utf8',fn($workfolder.'/html/topleft.html'));
  print F '<html><body bgcolor="#FFFFFF" background="graphics/top.gif"></body></html>';
  close(F);
 #create topright.html
  open(F,'>:utf8',fn($workfolder.'html/topright.html'));
  print F '<html><body bgcolor="#FFFFFF" background="graphics/topright.gif"></body></html>';
  close(F);
 #create info.html
  if ($info==1)
  {
   loadprojprop;
   open (F, '>:utf8',fn($workfolder.'html/info.html'));
   print F "<html><head><title>Info</title></head>";print F "\n";
   print F "<META HTTP-EQUIV=\"Content-type\" CONTENT=\"text\/html; charset=UTF-8\">"; print F "\n";
   print F "<body background=\"graphics\/center.gif\">";
   print F "<p><font color=\"\#000000\" size=\"$fs2\" face=\"Verdana, Helvetica, Sans Serif\">$messages[150]:</font></p>";
   print F "<pre><font color=\"\#000000\" size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$di</font></pre>";
   print F "<p><font color=\"\#000000\" size=\"$fs2\" face=\"Verdana, Helvetica, Sans Serif\">$messages[151]:</font></p>";
   print F "<pre><font color=\"\#000000\" size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$av</font></pre>";
   print F "<p><font color=\"\#000000\" size=\"$fs2\" face=\"Verdana, Helvetica, Sans Serif\">$messages[152]:</font></p>";
   print F "<pre><font color=\"\#000000\" size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$op</font></pre></body></html>";
   close(F);
  }
  #create begin.html
  open (F, '>:utf8',fn($workfolder.'html/begin.html'));
  print F "<html><head><title>$messages[98]</title></head>";print F "\n";
  print F "<META HTTP-EQUIV=\"Content-type\" CONTENT=\"text\/html; charset=UTF-8\">"; print F "\n";
  print F "<script language=\"javascript\" type=\"text/javascript\">";print F "\n";
  print F "function swapMore(num){";print F "\n";
  print F "var obj=document.getElementById(num);";print F "\n";
  print F "if(obj.style.visibility=='hidden'){obj.style.display='';obj.style.visibility='visible';}else{obj.style.display='none';obj.style.visibility='hidden';}return false;}</script>";print F "\n";
  print F "<body background=\"graphics\/center.gif\"><p align=\"center\"><font color=\"\#000000\" size=\"$fs2\" face=\"Verdana, Helvetica, Sans Serif\">$messages[98]";
  if ($info==1)
  {
   print F " (<a href=\"info.html\" target=\"info\">Info</a>)";
  }
  print F "<br>($number_of_indi $messages[99])</font></p>\n<p><font color=\"\#000000\" size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">";print F "\n";
  print F "<a href=\"#l1\">".$messages[96]."</a><br>";print F "\n";
  print F "<a href=\"#l2\">".$messages[97]."</a><br>";print F "\n";
  my $tmpname='';
  my $firstsymnoname=substr($noname,0,1);
  foreach my $nameofindi (@sorted)
  {
   $nameofindi=~/^(.)/;
   if (($1 eq '(') || ($1 eq $firstsymnoname)) {next}
   if ($tmpname ne $1) {$tmpname=$1;print F "<a href=\"#l".$1."\">".$1."</a> "}
  }
  print F "<br>\n";
  print F "<span id=0 style='display:none;visibility:hidden;'>";
  my $def='';
  my $s_fa=1;
  my $fbuk='';
  my $tmps='';
  my $ft=0;
  my $fam='-%-';
  my $name;
  my $id;
  my $fl;
  my $i=0;
  foreach $a (@sorted)
  {
   $a=~/^(.*?)\.(\d+)$/;
   $name=$1;
   $id=$2;
   $fl=substr($name,0,1);
   $tmps=$family_name{$id};
   if ($tmps eq '') {$tmps=$messages[96];$fl='1'}
   print "$dp_on\n";
   if ($dp_on ne '1')
   {
    if ( $tmps=~/^(.*?)\s*?\(/ ) {$tmps=$1;}
   }
   if ($tmps eq '') {$tmps=$messages[97];$fl='2'}
   unless ($fl eq $def)
   {
    $def=$fl;
    $fbuk=$fl;
    if ($fl eq ' ') {$fbuk=')'}
    print F "</span><br>\n";
    print F "<a name=\"l$fbuk\"></a>\n";
    $ft=0;
   }
   print "$fam:$tmps\n";
   unless ($fam eq $tmps) 
   {
    if ($ft==1) 
    {
     print F "</span><br>\n";
    }
    $s_fa++;
    $fam=$tmps;
    if ($fbuk eq ')') {$tmps=$messages[96]}
    print F "<a name=\"fam$s_fa\"></a><a href=\"\#fam$s_fa\" onClick='swapMore(\"$s_fa\");'>$tmps</a><span id=$s_fa style='display:none;visibility:hidden;'><br>\n";
    $ft=1;
   }
   $i++;
   $sorted[$i]=~/^(.*?)\.(\d+)$/;
   if ($1 eq $name) {$name=$name." ID $id"}
   if (($name eq '  ') || ($name eq ' ') || ($name eq '') || ($name eq $noname) || ($name eq $noname.' '.$noname)) {$name=$name." ID $id"}
   print F "&nbsp&nbsp<a href=\"indi/indi$id.html\" target=\"info\"><b>$name</b></a><br>\n";
  }
  print F "</span></font></pre></body></html>\n";
  close(F);

 #prepare folders for for file structure
  unless (-e fn($workfolder.'html/indi/')) {mkdir(fn($workfolder.'html/indi/'))} else {unlink glob fn($workfolder.'html/indi/*')}
  unless (-e fn($workfolder.'html/tree/')) {mkdir(fn($workfolder.'html/tree/'))} else {unlink glob fn($workfolder.'html/tree/*')}
  unless (-e fn($workfolder.'html/docs/')) {mkdir(fn($workfolder.'html/docs/'))} else {unlink glob fn($workfolder.'html/docs/*')}
  unless (-e fn($workfolder.'html/img/')) {mkdir(fn($workfolder.'html/img/'))} else {unlink glob fn($workfolder.'html/img/*')}
  unless (-e fn($workfolder.'html/photo/')) {mkdir(fn($workfolder.'html/photo/'))} else {rmtree(fn($workfolder.'html/photo/'));mkdir(fn($workfolder.'html/photo/'))}
  unless (-e fn($workfolder.'html/graphics/'))
  {
   mkdir(fn($workfolder.'html/graphics'));
   copys(fn($workfolder."graphics/$style/*"), fn($workfolder.'html/graphics/'));
  } else 
  {
   rmtree(fn($workfolder.'html/graphics/'));
   mkdir(fn($workfolder.'html/graphics'));
   copys(fn($workfolder."graphics/$style/*"), fn($workfolder.'html/graphics/'));
  }
  copy(fn($workfolder."graphics/$style/icon0.gif"), fn($workfolder.'html/tree/0.gif'));

 # create home.html
  my $splashname=basename(fn($splash));
  copy(fn($splash), fn($workfolder.'html/graphics/'.$splashname));
  open(F,'>:utf8',fn($workfolder.'html/home.html'));
  print F "<html><head><title>$messages[98]</title></head>";
  print F '<META HTTP-EQUIV="Content-type" CONTENT="text/html; charset=UTF-8"><body background="graphics/center.gif">';print F "\n";
  print F '<table border="0" width="100%" height="100%">';print F "\n";
  print F '<tr><td valigm="top"><center><a href="indi/indi'.$firstperson.'.html"><img src="graphics/'.$splashname.'" border="0"></a></center></td></tr>';print F "\n";
  print F '<tr><td valign="bottom"><center><p><font color="#000000" size="1" face="Verdana, Helvetica, Sans Serif"><a href="http://sourceforge.net/projects/rodovid/" target="_blank">'.$messages[100].'</a>';print F "\n";
  print F '<p align="right"><font color="#000000" size="0" face="Verdana, Helvetica, Sans Serif">';
  my @time=localtime;$time[5]+=1900;$time[4]++;
  print F " $time[3]/$time[4]/$time[5]";
  print F '</table></body></html>';print F "\n";
  close(F);
  my %pib;
  my $k;
  foreach $k (keys %people)
  {
   $pib{$k}="$family_name{$k} $first_name{$k} $second_name{$k}";
  }
  my $fath;
  my $moth;
  if ($size==2) # if size=2 then must create persons images with $size=1
  {
   $size=1;
   drawmessage($messages[15]);
   mkdir(fn($tmpdir.'rodovid/'));
   copys(fn("$projects$projectname/*.gif"),fn($tmpdir.'rodovid/'));
   foreach $k (keys %people)
   {
    createramka($k);
   }
   $size=2;
   deletemessage;
  }
  foreach $k (keys %people)
  {
  #create indi*.html
   drawmessage($messages[115].$pib{$k}.'('.$k.')...');
   open(F,'>:utf8',fn($workfolder."html/indi/indi$k.html"));
   print F "<html><head><title>$pib{$k}</title></head>";
   print F "<META HTTP-EQUIV=\"Content-type\" CONTENT=\"text\/html; charset=UTF-8\">\n"; 
  #body
   print F "<body background=\"..\/graphics\/center.gif\">";
   print F "<table border=\"0\" cellspacing=\"0\" cellpadding=\"0\" align=\"center\" width=\"100%\">\n<tr><td>\n";
   print F "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\" align=\"right\">\n<tr><td>\n";
   print F "<table border=\"0\" cellpadding=\"0\" bgcolor=\"#d8ac12\" cellspacing=\"0\" width=\"220\">\n<tr><td>\n";
   print F "<table border=\"1\" cellpadding=\"5\" cellspacing=\"0\" width=\"220\">\n<tr><td allign=\"center\" bgcolor=\"#d8ac12\">\n";
   print F "<font color=\"\#FFFFFF\" size=\"$fs2\" face=\"Verdana, Helvetica, Sans Serif\"><center><b>$messages[101]</b></center></font></td></tr><tr><td bgcolor=\"\#f1d73d\">";
   print F "<table cellspacing=\"0\" cellpadding=\"0\" border=\"0\" valign=\"top\" align=\"left\" width=\"100%\">\n";
   #poisk otca i materi
   $fath=0;
   $moth=0;
   my $tag;
   foreach $tag (values %father)
   {
    if ($tag=~/^$k\:(\d+)$/)
    {
     $fath=$1;
     print F "<tr><td valign=\"top\" colspan=\"2\">\n<font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">\n<b>$messages[102]:</b><br><a href=\"indi$1.html\">$pib{$1}</a></font>"; 
     print F "</td>\n<td></td>\n</tr>\n";last;
    }
   }
   foreach $tag (values %mother)
   {
    if ($tag=~/^$k\:(\d+)$/)
    {
     $moth=$1;
     print F "<tr><td valign=\"top\" colspan=\"2\">\n<font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">\n<b>$messages[103]:</b><br><a href=\"indi$1.html\">$pib{$1}</a></font>";
     print F "</td>\n<td></td>\n</tr>\n";last;
    }
   }
   if (($fath==0) && ($moth==0)) {print F "<tr><td valign=\"top\" colspan=\"2\"><font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$messages[112]</font></td><td></td></tr>";}
   #suprugi
   my $fs=0;
   my $sf=0;
   my @childs=();
   my $n_childs=0;
   my $k2;
   while (($k2,$tag)=each(%spouse))
   {
    if (($tag=~/^$k\:([0-9]*)$/) || ($tag=~/^([0-9]*)\:$k$/))
    {
     if ($fs==0) {print F "<tr><td colspan=\"2\"><hr size=\"1\" color=\"#000000\"></td><td></td></tr>\n";$fs=1}
     if ($sf==1) {print F "<tr><td>&nbsp</td><td>&nbsp</td></tr>\n";}
     if ($sex{$k} eq 'man') {print F "<tr><td valign=\"top\"><font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$messages[106]</font></td><td valign=\"top\"><a href=\"indi$1.html\">\n<font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$pib{$1}";}
     else {print F "<tr><td valign=\"top\"><font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$messages[105]</font></td><td valign=\"top\"><a href=\"indi$1.html\">\n<font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$pib{$1}";}
     print F "</font></a></td></tr>";
     if ($marr_date{$k2}) {print F "<tr><td valign=\"top\"><font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\"><i>$messages[109]</i></td><td valign=\"top\">\n<font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$marr_date{$k2}</font></td></tr>"}
     if ($marr_place{$k2}) {print F "<tr><td valign=\"top\"><font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\"><i>$messages[110]</i></td><td valign=\"top\">\n<font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$marr_place{$k2}</font></td></tr>"}
   #kids
     $tag=~/^(\d+)\:(\d+)$/;
     my $f=$2;
     my $m=$1;
     if ($sex{$1} eq 'man')
     {
      $f=$1;$m=$2
     }
     my $ds=0;
     my $a3;
     my $a4;
     my $fp=0;
     my $son;
ch_nxt:
     foreach $a3 (values %father)
     {
      if ($a3=~/^(\d+)\:$f$/)
      {
       $son=$1;
       foreach $a4 (values %mother)
       {
        if ($a4=~/^$son\:$m$/)
        {
         if ($fp==0) 
         {
          print F "<tr>\n<td valign=\"top\" colspan=\"2\">\n<font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">\n<b>$messages[104]:</b></td></tr>\n";
          $fp=1;
         }
         print F "<tr><td colspan=\"2\" valign=\"top\"><a href=\"indi$son.html\"><font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$pib{$son}</font></a></td></tr>";
         $childs[$n_childs]=$son;$n_childs++;
        }
       }
      }
     }
     $sf=1;
    }
   }
    my $fp=0;
    my $a3;
    if ($sex{$k} eq 'man')
    {
     foreach $a3 (values %father)
     {
      if ($a3=~/^(\d+)\:$k$/)
      {
       $son=$1;
       my $fin=0;
       foreach $a (@childs)
       {
        if ($a==$son)
        {
         $fin=1;
        }
       }
       if ($fin==0)
       { 
        if ($fp==0)
        {
         print F "<tr><td colspan=\"2\"><hr size=\"1\" color=\"#000000\"></td><td></td></tr>\n";
         print F "<tr>\n<td valign=\"top\" colspan=\"2\">\n<font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">\n<b>$messages[133]</b></td></tr>\n";
         $fp=1;
        }
        print F "<tr><td colspan=\"2\" valign=\"top\"><a href=\"indi$son.html\"><font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$pib{$son}</font></a></td></tr>";
        $childs[$n_childs]=$son;$n_childs++;
       }
      }
     }
    }
    if ($sex{$k} eq 'woman')
    {
     foreach $a3 (values %mother)
     {
      if ($a3=~/^(\d+)\:$k$/)
      {
       $son=$1;
       my $fin=0;
       foreach $a (@childs)
       {
        if ($a==$son)
        {
         $fin=1;
        }
       }
       if ($fin==0)
       { 
        if ($fp==0) 
        {
         print F "<tr><td colspan=\"2\"><hr size=\"1\" color=\"#000000\"></td><td></td></tr>\n";
         print F "<tr>\n<td valign=\"top\" colspan=\"2\">\n<font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">\n<b>$messages[133]</b></td></tr>\n";
         $fp=1;
        }
        print F "<tr><td colspan=\"2\" valign=\"top\"><a href=\"indi$son.html\"><font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$pib{$son}</font></a></td></tr>";
        $childs[$n_childs]=$son;$n_childs++;
       }
      }
     }
    }
  #siblings
   my $ss=0;
   my $sons;
   my $a4;
   my $a5;
   foreach $a4 (values %father)
   {
    if ($a4=~/^(\d+)\:$fath$/)
    {
     $sons=$1;
     foreach $a5 (values %mother)
     {
      if ($a5=~/^$sons\:$moth$/)
      {
       if ($ss==0) 
       {
        $ss=1;
        print F "<tr><td colspan=\"2\"><hr size=\"1\" color=\"#000000\"></td><td></td></tr>\n";
        print F "<tr><td valign=\"top\" colspan=\"2\"><font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\"><b>$messages[111]</b></font></td><td></td></tr>";
       }
       unless ($k==$sons){print F "<tr><td valign=\"top\" colspan=\"2\"><font size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\"><a href=\"indi$sons.html\">$pib{$sons}</a></font></td><td></td></tr>";}
      }
     }
    }
   }
   print F "</table>\n";
   print F "</td></tr></table>\n</td></tr></table>\n</td></tr></table>\n";
   print F "<p><font color=\"\#000000\" size=\"$fs2\" face=\"Verdana, Helvetica, Sans Serif\"><a href=\"indi$k.html\"><b>$pib{$k}</b></a></font></p>";
   print F "<p><font color=\"\#000000\" size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">";
   if (($birth_date{$k}) || ($birth_place{$k})) 
   {
    print F "<b>$messages[108]</b>: ";
    if ($birth_date{$k}) {print F "$birth_date{$k}.<br>"} else {print F $messages[113]}
    if ($birth_place{$k})
    {
     print F "&nbsp&nbsp&nbsp&nbsp<b>$messages[28]</b>: ";
     if ($towns_base{$birth_place{$k}})
     {
      print F "<a href=\"javascript:void()\" onClick=\"window.open('".$towns_base{$birth_place{$k}}."','mywindow').focus();\"'>".$birth_place{$k}."</a><br>";
     }
     else
     {
      print F $birth_place{$k}."<br>";
     }
    }
   }
   if (($death_date{$k}) || ($death_place{$k})) 
   {
    print F "<b>$messages[107]</b>: ";
    if ($death_date{$k}) {print F "$death_date{$k}.<br>"} else {print F $messages[114]}
    if ($death_place{$k})
    {
     print F "&nbsp&nbsp&nbsp&nbsp<b>$messages[28]</b>: ";
     if ($towns_base{$death_place{$k}})
     {
      print F "<a href=\"javascript:void()\" onClick=\"window.open('".$towns_base{$death_place{$k}}."','mywindow').focus();\"'>".$death_place{$k}."</a><br>";
     }
     else
     {
      print F $death_place{$k}."<br>";
     }
    }
   }
   if (($gallery{$k} eq '1') && ($f_on eq '1')) {print F "<a href=\"javascript:void()\" onClick=\"window.open('../img/img$k.html','mywindow','width=".($g_size+50).",height=".($g_size+100).",left=80,top=80').focus();\">$messages[23]</a><br>"}
   if ($t_on eq '1' ) {print F "<a href=\"../tree/tree$k.html\">Родове дерево</a>";}
   print F "<br></font><HR size=1 color=\"#000000\">";
   unless (($foto{$k} eq 'man') || ($foto{$k} eq 'woman'))
   {
    print F "<table border=\"0\" align=\"left\" width=\"50\" cellpadding=\"5\" cellspacing=\"0\"><tr><td><img src=\"..\/photo\/$k\/s200.jpg\" border=\"0\"></td></tr></table>\n";
   }
   unless ($text{$k} eq '')
   {
    print F "<font color=\"\#000000\" size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">";
    my $t=$text{$k};#$t=~s/\"/\\\"/g;
    my @s=split /\n/,$t;
    my $s;
    foreach $s (@s)
    {
     if ($s=~/^(.*?)\<a\ name\=\'file\'\ href\=\'(.*?)\'\>(.*?)$/)
     {
      my $beg=$1;
      my $from=$2;
      my $end=$3;
      $beg=~s/\^//;
      $end=~/^(.*?)\<\/a\>(.*?)$/;
      my $fromtext=$1;
      my $fromend=$2;
      if ($d_on eq '1')
      {
       my ($name,$path,$ext)=fileparse(fn($from),'');
       copy(fn($from),$workfolder."html/docs/$name") or die "File copy from ".fn($from)." to ".$workfolder."html/docs/$name failed!";
       print F $beg."<a href='../docs/$name'>".$fromtext."</a>".$fromend."<br>\n";
      }
      goto hrefnxt;
     }
     if ($s=~/^(.*?)\<a\ name\=\'www\'\ href\=\'(.*?)\'\>(.*?)$/)
     {
      my $beg=$1;
      my $from=$2;
      my $end=$3;
      $beg=~s/\^//;
      $end=~/^(.*?)\<\/a\>(.*?)$/;
      my $fromtext=$1;
      my $fromend=$2;
      print F $beg."<a href='".$from."'>".$fromtext."</a>".$fromend."<br>\n";
      goto hrefnxt;
     }
     if ($s=~/^(.*?)\<a\ name\=\'indi\'\ href\=\'(.*?)\'\>(.*?)$/)
     {
      my $beg=$1;
      my $from=$2;
      my $end=$3;
      $beg=~s/\^//;
      $end=~/^(.*?)\<\/a\>(.*?)$/;
      my $fromtext=$1;
      my $fromend=$2;
      print F $beg."<a href='".$from."'>".$fromtext."</a>".$fromend."<br>\n";
      goto hrefnxt;
     }
     print F $s."<br>\n";
hrefnxt:
    }
    print F "</font>\n";
   }
   print F "</body></html>\n";
   close(F);
  #create individual photo
   my $sx;
   my $sy;
   unless (($foto{$k} eq '') || ($foto{$k} eq 'man') || ($foto{$k} eq 'woman'))
   {
    unless (-e fn($workfolder."html/photo/$k")) {mkdir(fn($workfolder."html/photo/$k"));}
    my $icon=Image::Magick->new;
    copy(fn($projects.$projectname.'/icons/'.$foto{$k}),fn($tmpdir.'tmp'));
    $icon->Read(fn($tmpdir.'tmp'));
    (my $x, my $y)=$icon->Get('columns','rows');
    if ($y>=$x) 
    {
     $sy=$g_icsize;$sx=int(($sy/$y)*$x);
    }
    else
    {
     $sx=$g_icsize;$sy=int(($sx/$x)*$y);
    }
    unless ($y<170) {$icon->Resize(width=>$sx,height=>$sy,blur=>$g_q)}
    $icon->Write(fn($workfolder."html/photo/$k/s200.jpg"));
    undef $icon;
   }
   #create galleries for individuals
   if ($f_on eq '1')
   {
    if ($gallery{$k} eq '1')
    {
     unless (-e fn($workfolder."html/photo/$k")) {mkdir(fn($workfolder."html/photo/$k"));}
     open(F,'>:utf8',fn($workfolder."/html/img/img$k.html"));
     print F "<html><head><title>$messages[23]: $pib{$k}</title></head>";
     print F "<META HTTP-EQUIV=\"Content-type\" CONTENT=\"text\/html; charset=UTF-8\">\n"; 
     print F "<script language=\"javascript\" type=\"text/javascript\">\n";
     $image=$k;opengallery;
     my $i=0;
     my $maxf=@gallery;
     if ($maxf>$g_max) {$maxf=$g_max}
     while ($i<$maxf)
     {
      my $icon=Image::Magick->new;
      copy(fn($gallery[$i]),fn($tmpdir.'tmp'));
      $icon->Read(fn($tmpdir.'tmp'));
      (my $x, my $y)=$icon->Get('columns','rows');
      if ($y>=$x) 
      {
       $sy=$g_size;$sx=int(($sy/$y)*$x);
      }
      else
      {
       $sx=$g_size;$sy=int(($sx/$x)*$y);
      }
      unless (($y<=$g_size) && ($x<=$g_size)) {$icon->Resize(width=>$sx,height=>$sy,blur=>$g_q)}
      $icon->Write($workfolder."html/photo/$k/$i.jpg");
      drawmessage($messages[115].$pib{$k}.'('.$k.'):'.$messages[22].' '.$i.'...');
      undef $icon;
      $i++;
     }
     print F "var txt_array=new Array(".($i-1).");\n";
     my $firsttext;
     for (my $j=0;$j<$i;$j++)
     {
      if ($j==0) {$firsttext=$texts[0]}
      my $t=$texts[$j];$t=~s/\"/\\\"/g;
      print F "txt_array[$j]=\"$t\";\n";
     }
     print F "var img_array=new Array(".($i-1).");\n";
     print F "for (n=0;n<=";
     print F $i-1;
     print F ";n++)\n";
     print F "{img_array[n]=new Image();\n";
     print F "img_array[n].title=txt_array[n];\nimg_array[n].src=\"..\/photo\/$k\/\"+n+\".jpg\";\n\}\ni=0;\nfunction show()\n\{i=i+1;\nif (i==$i) i=0;\nfoto.src=img_array[i].src;\nfoto.title=img_array[i].title;\ndocument.all.text.innerHTML='<font color=\"\#000000\" size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">'+img_array[i].title\n\}\nfunction show2()\n\{i=i-1;\nif (i==-1) i=";
     print F $i-1;
     print F ";\nfoto.src=img_array[i].src;\nfoto.title=img_array[i].title;\ndocument.all.text.innerHTML='<font color=\"\#000000\" size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">'+img_array[i].title+'</font>'\n\}\n";
     print F "</script>\n";
     print F "<body background=\"..\/graphics\/center.gif\">\n<center>\n<table width=\"90%\" border=\"0\"><tr><td align=\"left\"><font color=\"\#000000\" size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\"><a href=\# onClick='return show2()'>$messages[57]<\/a></font></td><td align=\"center\"><font color=\"\#000000\" size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$messages[23]</font></td><td align=\"right\"><font color=\"\#000000\" size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\"><a href=\# onClick='return show()'>$messages[56]<\/a></font></td></tr></table><br><a href=\# onClick='return show()'><img src=\"../photo/$k/0.jpg\" border=\"0\" id=\"foto\"></a>";
     print F "<p id=\"text\"><font color=\"\#000000\" size=\"$fs\" face=\"Verdana, Helvetica, Sans Serif\">$firsttext</font></p>\n";
     print F "</body></html>\n";
     close(F);
    }
   }
#trees
   $nexttree=0;
   @tree=();
   for (my $i=0;$i<=3;$i++) {for (my $j=0;$j<=8;$j++) {$yx[$i][$j]=-1}}
   $yx[1][1]=0;$yx[1][2]=0;
   $yx[2][1]=0;$yx[2][2]=0;$yx[2][3]=0;$yx[2][4]=0;
   $yx[3][1]=0;$yx[3][2]=0;$yx[3][3]=0;$yx[3][4]=0;$yx[3][5]=0;$yx[3][6]=0;$yx[3][7]=0;$yx[3][8]=0;
   %fatherforkins=%father;
   %motherforkins=%mother;
   findtree($k,0,1);
   $yx[1][4]=$yx[1][1];$yx[1][5]=$yx[1][2];
   $yx[1][1]=-1;$yx[1][2]=-1;
   $yx[2][6]=$yx[2][4];$yx[2][5]=$yx[2][3];$yx[2][4]=$yx[2][2];$yx[2][3]=$yx[2][1];
   $yx[2][1]=-1;$yx[2][2]=-1;
   open (FT,">$workfolder"."html/tree/tree$k.html");
   print FT "<http><body background=\"../graphics/center.gif\"><table border=\"0\"cellspacing=\"0\" cellpadding=\"0\"><tr>\n";
   my $t="<td><table border=\"0\" cellspacing=\"0\" cellpadding=\"0\"><tr><td>\n<a href=\"../indi/indi$k.html\"><img src=\"$k.gif\" border=\"0\"></a><br>\n</td><td>\n";
   unless (-e $workfolder."html/tree/$k.gif") {copy(fn("$projects$projectname/$k.gif"),fn($workfolder."html/tree/$k.gif"))}
   if ((father($k)>0)||(mother($k)>0))
   {
    $t=$t."<img src=\"../graphics/1.gif\">\n</td><td>\n";
   }
   for (my $i=1;$i<=3;$i++)
   {
    $t=$t."<td><table border=\"0\" cellspacing=\"0\" cellpadding=\"0\"><tr><td>\n";
    for (my $j=1; $j<=8; $j++)
    {
     if ($yx[$i][$j]>0) 
     {
      $t=$t."<a href=\"../indi/indi$yx[$i][$j].html\"><img src=\"$yx[$i][$j].gif\" border=\"0\"></a><br>\n";
      unless(-e fn($workfolder."html/tree/$yx[$i][$j].gif")) {copy(fn("$projects$projectname/$yx[$i][$j].gif"),fn($workfolder."html/tree/$yx[$i][$j].gif"))}
     }
     if ($yx[$i][$j]==0)
     {
      $t=$t."<img src=\"0.gif\" border=\"0\"></a><br>\n";
     }
    } 
    $t=$t."</td><td>\n";
    if ($i==1) 
    {
     if ((father($yx[1][4])>0)||(mother($yx[1][4])>0)) {$t=$t."<img src=\"../graphics/22.gif\"><br>\n"}
     else {$t=$t."<img src=\"../graphics/22b.gif\"><br>\n"}
     $t=$t."<img src=\"../graphics/23.gif\"><br>\n";
     if ((father($yx[1][5])>0)||(mother($yx[1][5])>0)) {$t=$t."<img src=\"../graphics/24.gif\">\n"}
     else {$t=$t."<img src=\"../graphics/24b.gif\"><br>\n"}
    }
    if ($i==2) 
    {
     if ((father($yx[2][3])>0)||(mother($yx[2][3])>0)) {$t=$t."<img src=\"../graphics/21.gif\"><br>\n"}
     else {$t=$t."<img src=\"../graphics/21b.gif\"><br>\n"}
     if ((father($yx[2][4])>0)||(mother($yx[2][4])>0)) {$t=$t."<img src=\"../graphics/22.gif\"><br>\n"}
     else {$t=$t."<img src=\"../graphics/22b.gif\"><br>\n"}
     $t=$t."<img src=\"../graphics/23.gif\"><br>\n";
     if ((father($yx[2][5])>0)||(mother($yx[2][5])>0)) {$t=$t."<img src=\"../graphics/24.gif\"><br>\n"}
     else {$t=$t."<img src=\"../graphics/24b.gif\"><br>\n"}
     if ((father($yx[2][6])>0)||(mother($yx[2][6])>0)) {$t=$t."<img src=\"../graphics/25.gif\"><br>\n"}
     else {$t=$t."<img src=\"../graphics/25b.gif\"><br>\n"}
    }
    $t=$t."</td></tr></table></td>";
   }
   print FT "$t</tr></table></body></html>";
   close (FT);
  }
  if ($size==2) # if size=2 then must return reserved persons images
  {
   unlink glob fn("$projects$projectname/*.gif");
   copys(fn($tmpdir."rodovid/*.gif"),fn("$projects$projectname/"),);
   rmtree(fn($tmpdir.'rodovid/'));
  }
  deletemessage;
 }
 #export's menu
 getscreensize;
 my $x=$screenx;
 my $y=$screeny;
 my $etl=$TOP->Toplevel(-relief=>'flat');
 $etl->bind('<Destroy>'=>sub{$htmlgui=3;menustateon});
 $etl->title($messages[94]);
 my $gx=400;
 my $gy=320;
 $gx=int($gx*$fsize/9);
 $gy=int($gy*(1+$fsize/18-0.5));
 $etl->geometry($gx.'x'.$gy.'+'.(int(($x-$gx)/2)).'+'.(int(($y-$gy)/2)));
 $etl->minsize($gx,$gy);
 $etl->Icon(-image=>$TOP->Photo(-file=>$prog_icon));
 $etl->bind('<KeyPress-Escape>'=>sub
 {
  $etl->destroy;
 });
 my $nb2=$etl->NoteBook(-font=>'font')->pack(-fill=>'both',-expand=>1);
 my $etl1=$nb2->add("sn1",-label=>$messages[116],-state=>'normal');
 my $etl2=$nb2->add("sn2",-label=>$messages[23],-state=>'normal');
 my $etl3=$nb2->add("sn3",-label=>$messages[117],-state=>'normal');
 my $ef11=$etl1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'n');
 my $ef13=$etl1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid", -height=>30, -width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'n');
 my $ef12=$etl1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid", -height=>30, -width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'s');
 my $ef21=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>1, -anchor=>'n');
 my $ef22=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid", -height=>30, -width=>400)->pack(-fill=>'x',-expand=>1, -anchor=>'s');
 my $ef31=$etl3->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'n');
 my $ef32=$etl3->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid", -height=>30, -width=>400)->pack(-fill=>'x',-expand=>1, -anchor=>'s');
 $ef11->Label(-relief=>'flat',-text => $messages[118],-justify=>"left",-font=>$fontbold)->pack(-expand=>1, -anchor=>'w');
 $ef11->Entry(-font=>$font,-background=>'white',-relief=>'sunken',-borderwidth=>2,-textvariable=>\$htmltitle,-width=>128)->pack(-expand=>1, -anchor=>'w');
 $ef11->Label(-relief=>'flat',-text => $messages[125],-justify=>"left",-font=>$fontbold)->pack(-expand=>1, -anchor=>'w');
 my %fullname=();
 my @full=();$i=0;
 my $k;
 my $aa;
 my $adds;
 my $s;
 $htmlgui=0;
 foreach $k (keys %people)
 {
  $s=getname($k);
  if ($k<10) {$adds='0000'}
  if (($k>9) && ($k<100)) {$adds='000'}
  if (($k>99) && ($k<1000)) {$adds='00'}
  if (($k>999) && ($k<10000)) {$adds='0'}
  $full[$i]=$adds.$k.'.'.$s;
  $i++;
 }
 my @sorted=sort @full;
 @full=();$i=0;
 foreach $k (@sorted) 
 {
  $k=~/^[0]+(.+)/;
  $full[$i]=$1;
  $full[$i]=~/^(\d+)\.(.+)$/;
  $fullname{$1}=$full[$i];
  $i++;
 }
 my $fp=$fullname{$firstperson};
 my $pef1=$ef11->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>128,-variable => \$fp,-font=>$font,-disabledforeground => '#000000',-disabledbackground => '#FFFFFF',-command=>sub
 {
  while (($k,$aa)=each(%fullname))
  {
   if ($aa eq $fp) 
   {
    $firstperson=$k;
   }
  }
 }
 )->pack(-expand=>1, -anchor=>'w');
 $pef1->insert("end", @full);
 $ef11->Label(-font=>$fontbold,-relief=>'flat',-text => $messages[120],-justify=>"left")->pack(-expand=>1, -anchor=>'w');
 $ef11->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[121],-onvalue=>'1',-offvalue=>'0', -variable => \$f_on)->pack(-expand=>1, -anchor=>'w');
 $ef11->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[122],-onvalue=>'1',-offvalue=>'0', -variable => \$t_on)->pack(-expand=>1, -anchor=>'w');
 $ef11->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[123],-onvalue=>'1',-offvalue=>'0', -variable => \$d_on)->pack(-expand=>1, -anchor=>'w');
 $ef11->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[318],-onvalue=>'1',-offvalue=>'0', -variable => \$dp_on)->pack(-expand=>1, -anchor=>'w');
 $ef11->Label(-font=>$fontbold,-relief=>'flat',-text => $messages[119],-justify=>"left")->pack(-expand=>1, -anchor=>'w');
 $ef21->Label(-relief=>'flat',-text => $messages[126],-justify=>"left",-font=>$fontbold)->pack(-expand=>1, -anchor=>'w');
 $ef21->Entry(-font=>$font,-background=>'white',-relief=>'sunken',-borderwidth=>2,-textvariable=>\$g_max,-width=>5)->pack(-expand=>1, -anchor=>'w');
 $ef21->Label(-relief=>'flat',-text => $messages[127],-justify=>"left",-font=>$fontbold)->pack(-expand=>1, -anchor=>'w');
 $ef21->Entry(-font=>$font,-background=>'white',-relief=>'sunken',-borderwidth=>2,-textvariable=>\$g_size,-width=>5)->pack(-expand=>1, -anchor=>'w');
 $ef21->Label(-relief=>'flat',-text => $messages[128],-justify=>"left",-font=>$fontbold)->pack(-expand=>1, -anchor=>'w');
 $ef21->Entry(-font=>$font,-background=>'white',-relief=>'sunken',-borderwidth=>2,-textvariable=>\$g_icsize,-width=>5)->pack(-expand=>1, -anchor=>'w');
 $ef21->Label(-relief=>'flat',-text => $messages[129],-justify=>"left",-font=>$fontbold)->pack(-expand=>1, -anchor=>'w');
 $ef21->Entry(-font=>$font,-background=>'white',-relief=>'sunken',-borderwidth=>2,-textvariable=>\$g_q,-width=>5)->pack(-expand=>1, -anchor=>'w');
 $ef31->Label(-relief=>'flat',-text => $messages[131],-justify=>"left",-font=>$fontbold)->pack(-expand=>1, -anchor=>'w');
 $ef31->Entry(-font=>$font,-background=>'white',-relief=>'sunken',-borderwidth=>2,-textvariable=>\$fs2,-width=>5)->pack(-expand=>1, -anchor=>'w');
 $ef31->Label(-relief=>'flat',-text => $messages[132],-justify=>"left",-font=>$fontbold)->pack(-expand=>1, -anchor=>'w');
 $ef31->Entry(-font=>$font,-background=>'white',-relief=>'sunken',-borderwidth=>2,-textvariable=>\$fs,-width=>5)->pack(-expand=>1, -anchor=>'w');
 $ef31->Label(-relief=>'flat',-text => $messages[134],-justify=>"left",-font=>$fontbold)->pack(-expand=>1, -anchor=>'w');
 my $st=$namestyles{$style};
 my $pef2=$ef31->BrowseEntry(-style=>'MSWin32',-width=>128,-state=>'readonly',-variable => \$st,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',-command=>sub
 {
  while (($k,$aa)=each(%namestyles))
  {
   if ($aa eq $st) 
   {
    $style=$k;
    $splash=$workfolder."graphics/".$style."/rodovid.gif"; # splashscreen image
   }
  }
 })->pack(-expand=>1, -anchor=>'w');
 $pef2->insert("end", values %namestyles);
 $ef13->Entry(-font=>$font,-background=>'white',-relief=>'sunken',-borderwidth=>2,-textvariable=>\$splash,-width=>43)->pack(-side=>"left",-expand=>"0",-fill=>'x',-anchor=>'s');
 my $nb2b;
 my $nb2b1;
 my $nb2b2;
 $nb2b=$ef13->Button(-padx=>2,-pady=>2,-font=>$font,-relief=>'raised',-borderwidth=>2,-image=>sizePhoto2($TOP,fn($workfolder.'graphics/open.png')), -command => sub
 {
  $nb2b->configure(-state=>'disabled');
  $nb2b1->configure(-state=>'disabled');
  $nb2b2->configure(-state=>'disabled');
  $nb2->pageconfigure('sn1',-state=>'disabled');
  $nb2->pageconfigure('sn2',-state=>'disabled');
  $nb2->pageconfigure('sn3',-state=>'disabled');
  my $file=fileDialog("openfoto");
  $nb2b->configure(-state=>'active');
  $nb2b1->configure(-state=>'active');
  $nb2b2->configure(-state=>'active');
  $nb2->pageconfigure('sn1',-state=>'normal');
  $nb2->pageconfigure('sn2',-state=>'normal');
  $nb2->pageconfigure('sn3',-state=>'normal');
  unless ($file eq cancel)
  {
   $splash=$file;
  }
 })->pack(-side=>"left",-expand=>'0',-anchor=>'s');
 $nb2b1=$ef12->Button(-font=>$font,-relief=>'raised',-borderwidth=>2, -text => $messages[19], -command => sub
 {
  $etl->withdraw;
  $etl->destroy;
  $htmlgui=1;
 })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
 $nb2b2=$ef12->Button(-font=>$font,-relief=>'raised',-borderwidth=>2, -text => $messages[18], -command => sub
 {
  $etl->withdraw;
  export();
  $etl->destroy;
  $htmlgui=1;
 })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
 $ef22->Button(-font=>$font,-relief=>'raised',-borderwidth=>2, -text => $messages[19], -command => sub
 {
  $etl->withdraw;
  $etl->destroy;
  $htmlgui=1;
 })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
 my $nb2b21=$ef22->Button(-font=>$font,-relief=>'raised',-borderwidth=>2, -text => $messages[18], -command => sub
 {
  $etl->withdraw;
  export();
  $etl->destroy;
  $htmlgui=1;
 })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
 $ef32->Button(-font=>$font,-relief=>'raised',-borderwidth=>2, -text => $messages[19], -command => sub
 {
  $etl->withdraw;
  $etl->destroy;
  $htmlgui=1;
 })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
 my $nb2b3=$ef32->Button(-font=>$font,-relief=>'raised',-borderwidth=>2, -text => $messages[18], -command => sub
 {
  $etl->withdraw;
  export();
  $etl->destroy;
  $htmlgui=1;
 })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
 $nb2->pageconfigure('sn1',-raisecmd=>$nb2b2->focus);
 $nb2->pageconfigure('sn2',-raisecmd=>$nb2b21->focus);
 $nb2->pageconfigure('sn3',-raisecmd=>$nb2b3->focus);
 $etl->waitVariable(\$htmlgui);
 menustateon;
}
sub father #who is father of this person
{
 my $p=shift;
 my $a;
 foreach $a (values %father)
 {
  if ($a=~/^$p\:(\d+)$/)
  {
   return $1;
  }
 }
 return 0;
}
sub mother #who is mother of this person
{
 my $p=shift;
 my $a;
 foreach $a (values %mother)
 {
  if ($a=~/^$p\:(\d+)$/)
  {
   return $1;
  }
 }
 return 0;
}
#serch persons for exporthtml(drawing tree) / recursive procedure
sub findtree # searching only father,mother,grandfathers,grandmothers and fathers and mothers of grandfathers and grandmothers
{
 my ($level,$idk,$key,$a);
 my %f=%fatherforkins;
 my %m=%motherforkins;
 $idk=shift;
 $level=shift;
 my $y=shift;
 my $k=shift;
 my $oldy;
 if ($level>2) {return}
 while(($key, $a) = each(%f))
 {
  if ($a=~/^$idk\:(\d+)$/)
  {
   $level++;
   $oldy=$y;
   $y+=$y;
   $yx[$level][$y]=$1;
   $nexttree++;
   $fatherforkins{$key}='';
   findtree($1,$level,$y); last;
  }
 }
 $y-=$oldy;
 $level--;
 while(($key, $a) = each(%m))
 {
  if ($a=~/^$idk\:(\d+)$/)
  {
   $level++;
   $y+=$y-1;
   $yx[$level][$y]=$1;
   $nexttree++;
   $motherforkins{$key}='';
   findtree($1,$level,$y);
  }
 }
}
sub copys # copy files by mask
{
 my $s=shift;
 my $t=shift;
 my @c=glob $s;
 foreach my $c (@c) {copy($c, $t)}
}
sub dotpresent # return 1 if executable file "dot" not installed in system else 0
{
 if ($OS eq 'linux') { if (system('which dot > '.fn($tmpdir.'tmp')) eq 0){return 0}}
 else
 {
  my $t;
  open(F,'dir \A D "'.$ENV{'ProgramFiles'}.'\" |');
  while ($t=<F>)
  {
   if ($t=~/(.+)Graphviz(.+)/) {$graphvizpath='"'.$ENV{'ProgramFiles'}.'\Graphviz'.$2.'\bin"';last;}
  }
  close(F);
  if ($graphvizpath ne '') {return 0;}
 }
 return 1;
}
sub fn
{
 my $s=shift;
 if ($OS eq 'MSWin32')
 {
  $s=~s/\//\\\\/g; #for Windows change Unix path in filenames / to \\
  $s=encode($codepage,$s);
 }
 $s=~s/\/\//\//g;
 return $s
}
sub exitrodovid
{
 $exit_processing=1;
 if ($mesboxexit==1)
 {
  MyMessageBox($messages[135],"YesNo","question");
  if ($BoxResult==1)
  {
   unless (-e fn($projects.$projectname.'/')) {mkdir(fn($projects.$projectname.'/'))}
   unless (-e fn($projects.$projectname.'/icons/')) {mkdir(fn($projects.$projectname.'/icons/'))}
   save(fn($projectname),fn($projects.$projectname.'.rid'),0);
  }
 }
 saveoptions;
 unlink(fn($tmpdir.'myphototmp'));
 unlink(fn($tmpdir.'tmp'));
 unlink(fn($tmpdir.'tmpf'));
 destroyallmw;
 exit;
}
our $tb;
sub MyMessageBox
{
 my ($stringbox,$typebox,$iconbox,@arr) = @_;
 my $height=1;
 my $bh;
 my $foc;
 my $fno;
 my $aa;
 my $ms='';
 my $width;
 getscreensize;
 my $x=$screenx;
 my $y=$screeny;
 my $focus=1;
 $BoxResult=100;
 while($stringbox=~/(\\n)/gi)
 {
  $height++
 }
 foreach $aa (split/\\n/,$stringbox)
 {
  if (length($aa)>$width) {$width=length($aa);$ms=$aa}
 }
 $tb=createmw($messages[138]);
 setgeometry5(100,100,$tb);
 my $ls = $mw{$tb}->fontMetrics($font{$tb}, -linespace);
 $width=int(($mw{$tb}->fontMeasure($font{$tb},$ms) + 40)*$size{$tb});
 $bh=100+$height*$ls;
 my $bh0=$bh;
 my $bw=int(55*$size{$tb})+$width;
 my $bw0=$bw;
 $mw{$tb}->bind('<Destroy>'=>sub{$BoxResult=0});
 my $f=$mw{$tb}->Frame(-borderwidth=>0,-relief=>'ridge')->pack;
 my $f0=$f->Frame(-borderwidth=>0,-relief=>'flat',-padx=>5,-pady=>0)->pack;
 my $f1=$f->Frame(-borderwidth=>0,-relief=>'flat',-padx=>0,-pady=>10)->pack;
 my $f2=$f->Frame(-borderwidth=>0,-padx=>5,-pady=>2)->pack;
 my $mc;
 my $pos=1;
 if ($typebox eq 'YesNoList')
 {
  my $lh=5;
  my $lw=28;
  my $lb;
  my $ae=@arr;
  if ($ae<$lh) {$lh=$ae}
  my $lls='';
  my $el;
  foreach $el (@arr)
  {
   $el=~s/people//;
   if (length("$el.$family_name{$el} $first_name{$el} $second_name{$el}")>$lw) {$lls='s'};
  }
  my $lhc=0;
  if ($lls eq 's') {$lhc=1}
  print $ls;
  $bh=120+$lh*($ls+2)+$lhc*20+10;
  $bw=int(55*$size{$tb})+$width+40;
  setgeometry5($bw,$bh,$tb);
  $mc=$f0->Canvas(-borderwidth=>0,-highlightbackground=>$f0->cget(-background),-height=>int(($bh0-50)*$size{$tb}),-width=>int($bw0*$size{$tb}),-relief=>'flat',-state=>'disabled')->pack;
  $mc->createImage(int(30*$size{$tb}),int(($bh0-50)*$size{$tb}/2),-image=>sizePhoto($tb,fn($workfolder.'graphics/quest.png')));
  foreach $aa (split/\\n/,$stringbox)
  {
   $mc->createText(int(($width-40)/2+55*$size{$tb}),$pos*$ls+int($ls/2+5*$size{$tb}),-font=>$font{$tb},-text=>$aa,-tags=>'ctext');
   $pos++;
  }
  $foc=$f2->Button(-borderwidth=>2,-font=>$font{$tb},-text=>$messages[18],-command=>sub{destroymw($tb);$BoxResult=1})->pack(-side=>'left');
  if ($ae>$lh)
  {
   $lb=$f1->Scrolled("Listbox", -scrollbars=>$lls.'e', -font=>$font{$tb}, -height=>$lh, -width=>$lw,-selectmode => "single",-background=>'white')->pack(-side=>'top');
  } else
  {
   $lb=$f1->Scrolled("Listbox", -scrollbars=>$lls, -font=>$font{$tb}, -height=>$lh, -width=>$lw,-selectmode => "single",-background=>'white')->pack(-side=>'top');
  }
  foreach $el (@arr)
  {
   $el=~s/people//;
   $lb->insert('end',"$el.$family_name{$el} $first_name{$el} $second_name{$el}");
  }
  $f2->Label(-text=>' ')->pack(-side=>'left');
  $fno=$f2->Button(-borderwidth=>2,-font=>$font{$tb},-text=>$messages[19],-command=>sub{destroymw($tb);$BoxResult=0})->pack(-side=>'left');
  $mw{$tb}->bind('<KeyPress-Right>'=>sub
  {
   $focus=$focus^1;
   if ($focus==1) {$foc->focusForce;} else {$fno->focusForce;}
   $mw{$tb}->update;
  });
  $mw{$tb}->bind('<KeyPress-Left>'=>sub
  {
   $focus=$focus^1;
   if ($focus==1) {$foc->focusForce;} else {$fno->focusForce;}
   $mw{$tb}->update;
  });
 }
 if ($typebox eq 'YesNo')
 {
  setgeometry5($bw,$bh,$tb);
  $mc=$f0->Canvas(-borderwidth=>0,-highlightbackground=>$f0->cget(-background),-height=>int(($bh-50)*$size{$tb}),-width=>int($bw*$size{$tb}),-relief=>'flat',-state=>'disabled')->pack;
  $mc->createImage(int(30*$size{$tb}),int(($bh-50)*$size{$tb}/2),-image=>sizePhoto($tb,fn($workfolder.'graphics/quest.png')));
  foreach $aa (split/\\n/,$stringbox)
  {
   $mc->createText(int(($width-40)/2+55*$size{$tb}),$pos*$ls+int($ls/2+5*$size{$tb}),-font=>$font{$tb},-text=>$aa,-tags=>'ctext');
   $pos++;
  }
  $foc=$f2->Button(-borderwidth=>2,-font=>$font{$tb},-text=>$messages[18],-command=>sub{destroymw($tb);$BoxResult=1})->pack(-side=>'left');
  $f2->Label(-text=>' ')->pack(-side=>'left');
  $fno=$f2->Button(-borderwidth=>2,-font=>$font{$tb},-text=>$messages[19],-command=>sub{destroymw($tb);$BoxResult=0})->pack(-side=>'left');
  $mw{$tb}->bind('<KeyPress-Right>'=>sub
  {
   $focus=$focus^1;
   if ($focus==1) {$foc->focusForce;} else {$fno->focusForce;}
   $mw{$tb}->update;
  });
  $mw{$tb}->bind('<KeyPress-Left>'=>sub
  {
   $focus=$focus^1;
   if ($focus==1) {$foc->focusForce;} else {$fno->focusForce;}
   $mw{$tb}->update;
  });
 }
 if ($typebox eq 'ok')
 {
  setgeometry5($bw,$bh,$tb);
  $mc=$f0->Canvas(-borderwidth=>0,-highlightbackground=>$f0->cget(-background),-height=>int(($bh-50)*$size{$tb}),-width=>int($bw*$size{$tb}),-relief=>'flat',-state=>'disabled')->pack;
  $mc->createImage(int(30*$size{$tb}),int(($bh-50)*$size{$tb}/2),-image=>sizePhoto($tb,fn($workfolder.'graphics/'.$iconbox.'.png')));
  foreach $aa (split/\\n/,$stringbox)
  {
   $mc->createText(int(($width-40)/2+55*$size{$tb}),$pos*$ls+int($ls/2+5*$size{$tb}),-font=>$font{$tb},-text=>$aa,-tags=>'ctext');
   $pos++;
  }
  $foc=$f2->Button(-borderwidth=>2,-font=>$font{$tb},-text=>$messages[18],-command=>sub{destroymw($tb);$BoxResult=1})->pack(-side=>'left');
 }
 $foc->focusForce;
 $mw{$tb}->deiconify;
 $mw{$tb}->waitVariable(\$BoxResult);
}
our $sb_fs;
sub params
{
 my $old_fsize=$fsize;
 my $k;
 my $a;
 my $tlp=$TOP->Toplevel(-relief=>'flat', -padx=>5, -pady=>5);
 getscreensize;
 my $x=$screenx;
 my $y=$screeny;
 my $width=320;
 my $height=180;
 my $gx=int($width*($fsize/9));
 my $gy=int($height*(1+($fsize/18-0.5)));
 $tlp->geometry($gx.'x'.$gy.'+'.(int(($screenx-$gx)/2)).'+'.(int(($screeny-$gy)/2)));
 $tlp->title($messages[140]);
 $tlp->Icon(-image=>$TOP->Photo(-file=>$prog_icon));
 $tlp->bind('<KeyPress-Escape>'=>sub
 {
  $tlp->destroy;
 });
 my $f11=$tlp->Frame(-borderwidth=>0,-relief=>'solid', -pady=>3)->pack(-side=>'top');
 my $f13=$tlp->Frame(-borderwidth=>0,-relief=>'solid', -pady=>3)->pack(-side=>'top',-fill=>'x');
 my $f14=$tlp->Frame(-borderwidth=>0,-relief=>'solid', -pady=>3)->pack(-side=>'top',-fill=>'x');
 my $f12=$tlp->Frame(-borderwidth=>0,-relief=>'solid',-pady=>3)->pack(-side=>'bottom');
 $f11->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[141],-onvalue=>1,-offvalue=>0, -variable => \$cache)->pack(-expand=>1, -anchor=>'w');
 $f11->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[198],-onvalue=>1,-offvalue=>0, -variable => \$save_windowsize)->pack(-expand=>1, -anchor=>'w');
 my $st=$namestyles{$facestyle};
 my $pef2=$f11->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-label=>$messages[134],-width=>128,-variable => \$st,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
 -command=>sub
 {
  while (($k,$a)=each(%namestyles))
  {
   if ($a eq $st) 
   {
    $facestyle=$k;
    $TOP->update;
    reloadallramka(3);
    $c->update;
   }
  }
 })->pack(-expand=>1, -anchor=>'w');
 $f13->Label(-font=>$font,-relief=>'flat',-text=>$messages[169])->pack(-side=>'left',-anchor=>'w');
 $f13->Entry(-font=>$font,-relief=>'sunken',-background=>'white',-borderwidth=>'2',-textvariable=>\$noname)->pack(-side=>'left',-fill=>'x');
 $f14->Label(-font=>$font,-relief=>'flat',-text=>$messages[225])->pack(-side=>'left',-anchor=>'w');
 $sb_fs=$f14->Spinbox( qw/-from 8 -to 18 -width 2 -validate key/,-font=>$font, -textvariable=>$fsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g;
    },
    )->pack(-side=>'bottom',-anchor=>'s');; 
 $pef2->insert("end", values %namestyles);
 my $parb=$f12->Button(-font=>$font,-borderwidth=>'2',-text=>$messages[18],-command=>sub
 {
  $fsize=$sb_fs->cget(-textvariable);
  saveoptions;
  if ($fsize!=$old_fsize) 
  {
   $TOP->update;
   $TOP->fontDelete('fontlink');
   $TOP->fontDelete('fontbold');
   $TOP->fontDelete('font');
   $TOP->fontDelete('mono');
   $fontlink = $TOP->fontCreate('fontlink', -family => "$fontsys",-size => ($fsize-1), -weight=>'normal');
   $fontbold = $TOP->fontCreate('fontbold',-family => "$fontsys",-size => $fsize, -weight=>'bold');
   $font = $TOP->fontCreate('font',-family => "$fontsys",-size => $fsize, -weight=>'normal');
   $fontmono=$TOP->fontCreate('mono',-family=>$mono,-size=>$fsize,-weight=>'normal');
  }
  $tlp->destroy
 })->pack(-side=>'bottom',-anchor=>'s');
 $parb->focus;
}
sub addtagtopersons
{
 my $k;
 my $a;
 inittags;
 if ($n_tags eq 0)
 {
  MyMessageBox($messages[222],'ok','info')
 }
 else
 {
  if (get_number_of_peoples eq 0)
  {
   MyMessageBox($messages[223],'ok','info')
  }
  else
  {
   my $tlp=$TOP->Toplevel(-relief=>'flat', -padx=>5, -pady=>5);
   getscreensize;
   my $x=$screenx;
   my $y=$screeny;
   my $width=int(350*$fsize/9);
   my $height=int(140*(0.5+$fsize/18));
   my $tag='';
   my $mask='';
   my $g=$width.'x'.$height.'+'.(int(($x-$width)/2)).'+'.(int(($y-$height)/2));
   $tlp->geometry($g);
   $tlp->title($messages[219]);
   $tlp->Icon(-image=>$TOP->Photo(-file=>$prog_icon));
   $tlp->bind('<KeyPress-Escape>'=>sub
   {
    $tlp->destroy;
   });
   my $f11=$tlp->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width, -pady=>3)->pack(-side=>'top',-fill=>'x');
   my $f13=$tlp->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width, -pady=>3)->pack(-side=>'top',-fill=>'x');
   my $f12=$tlp->Frame(-borderwidth=>0,-relief=>'solid',-pady=>3)->pack(-side=>'bottom');
   my $st=$project_tags[0];
   $tag=$st;
   my $parb=$f11->BrowseEntry(-font=>$fontbold,-style=>'MSWin32',-label=>$messages[208],-state=>'readonly',-width=>128,-variable => \$st,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
   {
    $tag=$st;
   })->pack(-expand=>1, -anchor=>'w');
   $parb->insert("end", @project_tags);
   $f13->Label(-font=>$fontbold,-relief=>'flat',-text=>$messages[218])->pack(-side=>'top',-anchor=>'w');
   $f13->Entry(-font=>$font,-relief=>'sunken',-background=>'white',-borderwidth=>'2',-textvariable=>\$mask)->pack(-side=>'top',-fill=>'x');
   $f12->Button(-font=>$font,-borderwidth=>'2',-text=>$messages[19],-command=>sub
   {
    $tlp->destroy
   })->pack(-side=>'right',-anchor=>'s');
   $f12->Button(-font=>$font,-borderwidth=>'2',-text=>$messages[18],-command=>sub
   {
    if (length($mask) eq 0)
    {
     MyMessageBox($messages[221],'ok','info')
    }
    else
    {
     addtagbymask($tag,$mask);
     $tlp->destroy;
    }
   })->pack(-side=>'right',-anchor=>'s');
   $parb->focus;
  }
 }
}
sub deltagfrompersons
{
 my $k;
 my $a;
 inittags;
 if ($n_tags eq 0)
 {
  MyMessageBox($messages[222],'ok','info')
 }
 else
 {
  if (get_number_of_peoples eq 0)
  {
   MyMessageBox($messages[223],'ok','info')
  }
  else
  {
   my $tlp=$TOP->Toplevel(-relief=>'flat', -padx=>5, -pady=>5);
   getscreensize;
   my $x=$screenx;
   my $y=$screeny;
   my $width=int(350*$fsize/9);
   my $height=int(140*(0.5+$fsize/18));
   my $tag='';
   my $mask='';
   my $g=$width.'x'.$height.'+'.(int(($x-$width)/2)).'+'.(int(($y-$height)/2));
   $tlp->geometry($g);
   $tlp->title($messages[224]);
   $tlp->Icon(-image=>$TOP->Photo(-file=>$prog_icon));
   $tlp->bind('<KeyPress-Escape>'=>sub
   {
    $tlp->destroy;
   });
   my $f11=$tlp->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width, -pady=>3)->pack(-side=>'top',-fill=>'x');
   my $f13=$tlp->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width, -pady=>3)->pack(-side=>'top',-fill=>'x');
   my $f12=$tlp->Frame(-borderwidth=>0,-relief=>'solid',-pady=>3)->pack(-side=>'bottom');
   my $st=$project_tags[0];
   $tag=$st;
   my $parb=$f11->BrowseEntry(-font=>$fontbold,-style=>'MSWin32',-label=>$messages[208],-state=>'readonly',-width=>128,-variable => \$st,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
   {
    $tag=$st;
   })->pack(-expand=>1, -anchor=>'w');
   $parb->insert("end", @project_tags);
   $f13->Label(-font=>$fontbold,-relief=>'flat',-text=>$messages[218])->pack(-side=>'top',-anchor=>'w');
   $f13->Entry(-font=>$font,-relief=>'sunken',-background=>'white',-borderwidth=>'2',-textvariable=>\$mask)->pack(-side=>'top',-fill=>'x');
   $f12->Button(-font=>$font,-borderwidth=>'2',-text=>$messages[19],-command=>sub
   {
    $tlp->destroy
   })->pack(-side=>'right',-anchor=>'s');
   $f12->Button(-font=>$font,-borderwidth=>'2',-text=>$messages[18],-command=>sub
   {
    if (length($mask) eq 0)
    {
     MyMessageBox($messages[221],'ok','info')
    }
    else
    {
     deltagbymask($tag,$mask);
     $tlp->destroy;
    }
   })->pack(-side=>'right',-anchor=>'s');
   $parb->focus;
  }
 }
}
sub edittowns
{
 $town=shift;disablebuttons;
 $place=$towns_base{$town};
 my $k;
 my $a;
 my $tlp=createmw($messages[143]);
 $mw{$tlp}->bind('<Destroy>'=>sub{enablebuttons;$townwait=1});
 getscreensize;
 my $x=$screenx;
 my $y=$screeny;
 my $width=640;
 my $height=450;
 setgeometry3($width,$height,$tlp);
 my $f21=$mw{$tlp}->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width,-padx=>5,-pady=>5)->pack(-side=>'top');
 my $f22=$mw{$tlp}->Frame(-borderwidth=>0,-relief=>'solid',-padx=>5,-pady=>5)->pack(-side=>'bottom');
 my $f211=$f21->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width)->pack(-side=>'top',-expand=>1);
 my $f2111=$f211->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width)->pack(-side=>'top');
 my $f2112=$f211->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width)->pack(-side=>'top');
 my $f212=$f21->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width)->pack(-side=>'top',-expand=>1);
 my $f2121=$f212->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width)->pack(-side=>'left');
 my $f2122=$f212->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width,-padx=>5,-pady=>5)->pack(-side=>'left');
 $f2111->Label(-relief=>'flat',-font=>$fontbold{$tlp},-text=>$messages[144],-width=>'15')->pack(-side=>'left');
 my $et=$f2111->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font{$tlp},-textvariable=>\$town,-width=>"60")->pack(-side=>'left');
 $f2112->Label(-relief=>'flat',-font=>$fontbold{$tlp},-text=>$messages[145],-width=>'15')->pack(-side=>'left');
 my $ep=$f2112->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font{$tlp},-textvariable=>\$place,-width=>"60")->pack(-side=>'left');
 my $lb=$f2121->Scrolled("Listbox",-height=>19,-width=>60,-font=>$font{$tlp},-scrollbars => 'oe',-background=>'white',-selectmode => "single")->pack(-fill=>'x',-expand=>1);
 foreach $a (sort keys %towns_base)
 {
  if ($a ne '') {$lb->insert('end',$a)}
 }
 $lb->bind('<ButtonRelease-1>'=>sub
 {
  $town=$lb->get('active');
  $place=$towns_base{$town};
  $et->configure(-textvariable=>\$town);
  $ep->configure(-textvariable=>\$place);
 });
 $lb->update;
 my $etb=$f22->Button(-font=>$font{$tlp},-borderwidth=>'2',-text=>$messages[18],-command=>sub{saveoptions;savetowns;$townwait=1;destroymw($tlp);})->pack(-side=>'bottom',-anchor=>'s');
 $etb->focus;
 # add town and place
 $f2122->Button(-font=>$font{$tlp},-borderwidth=>'2',-text=>$messages[146],-command=>sub
 {
  unless ($town eq '')
  {
   my $tmp=0;
   foreach $k (keys %towns_base)
   {
    if ($k eq $town) {$tmp=1;MyMessageBox($messages[147],'ok','info');last;}
   }
   if ($tmp==0)
   {
    $towns_base{$town}=$place;
    $lb->insert('0',$town);
    savetowns;
   }
  }
 })->pack;
 # delete town and place
 $f2122->Button(-font=>$font{$tlp},-borderwidth=>'2',-text=>$messages[37],-command=>sub
 {
  unless ($town eq '')
  {
   delete $towns_base{$town};
   $lb->delete(0,'end');
   foreach $a (sort keys %towns_base)
   {
    if ($a ne '') {$lb->insert('end',$a)}
   }
   savetowns;
  }
 })->pack;
 $mw{$tlp}->deiconify;
 $mw{$tlp}->waitVariable(\$townwait);
}
sub showtowns
{
 my $townwait;
 my $k;
 my $a;disablebuttons;
 my $tlp=createmw($messages[143]);
 $mw{$tlp}->bind('<Destroy>'=>sub{enablebuttons;$townwait=1;$townresult=''});
 getscreensize;
 my $x=$screenx;
 my $y=$screeny;
 my $width=440;
 my $height=380;
 $townresult='';
 my $oldtown=shift;
 setgeometry3($width,$height,$tlp);
 my $f21=$mw{$tlp}->Frame(-borderwidth=>0,-relief=>'solid',-width=>$width,-padx=>5,-pady=>5)->pack(-side=>'top');
 my $f23=$mw{$tlp}->Frame(-borderwidth=>0,-relief=>'solid',-padx=>5,-pady=>5)->pack(-side=>'top');
 my $f22=$mw{$tlp}->Frame(-borderwidth=>0,-relief=>'solid',-padx=>5,-pady=>5)->pack(-side=>'bottom');
 $f21->Label(-relief=>'flat',-font=>$fontbold{$tlp},-text=>$messages[142])->pack(-anchor=>'w');
 my $find;
 my $lb;
 sub findtown
 {
  $lb->delete(0,'end');
  foreach $k (keys %towns_base)
  {
   if ($k=~/$find/i) 
   { 
    $lb->insert('end',$k);
   }
  }
 }
 my $ent=$f21->Label(-font=>$font{$tlp},-text=>$messages[254],-width=>"10")->pack(-side=>"left");
 my $ent=$f21->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font{$tlp},-textvariable=>\$find,-width=>"40")->pack(-side=>"left",-anchor=>"nw");
 $f21->Button(-font=>$font{$tlp},-borderwidth=>'2',-image => sizePhoto($tlp,fn($workfolder.'graphics/find.png')),-command=>\&findtown)->pack(-padx=>2,-side=>'left',-anchor=>'n');
 $ent->bind('<KeyPress-Return>'=>sub
 {
  findtown;
 });
 $ent->focus;
 $lb=$f23->Scrolled("Listbox",-height=>"15",-width=>"50",-font=>$font{$tlp},-scrollbars => 'oe',-background=>'white',-selectmode => "single")->pack(-side=>'left', -fill=>'x',-expand=>1);
 $mw{$tlp}->bind('<KeyPress-Escape>'=>sub
 {
  $townwait=1;destroymw($tlp);$townresult=$oldtown
 });
 foreach $a (sort keys %towns_base)
 {
  if ($a ne '') {$lb->insert('end',$a)}
 }
 $lb->bind('<ButtonRelease-1>'=>sub
 {
  $townresult=$lb->get('active');
 });
 $lb->bind('<Double-Button-1>'=>sub
 {
  $townresult=$lb->get('active');
  if ($townresult ne '') {$oldtown=$townresult;$townwait=1;destroymw($tlp);$townresult=$oldtown}
 });
 $lb->update;
 my $stb=$f22->Button(-font=>$font{$tlp},-borderwidth=>'2',-text=>$messages[18],-command=>sub{$oldtown=$townresult;$townwait=1;destroymw($tlp);$townresult=$oldtown})->pack(-side=>'bottom',-anchor=>'s');
 $stb->focus;
 $mw{$tlp}->deiconify;
 $mw{$tlp}->waitVariable(\$townwait);
}
sub createmw
{
 my $t=shift;
 $mwc++;
 $mw{$mwc} = Tk::MainWindow->new;
 $mw{$mwc}->withdraw;
 $mw{$mwc}->resizable(1,1);
 $mw{$mwc}->title($t);
 $mw{$mwc}->Icon(-image=>$mw{$mwc}->Photo(-file=>$prog_icon));
 $mw{$mwc}->optionAdd("*menu.relief",'ridge');
 $mw{$mwc}->optionAdd("*Cursor",'');
 $mw{$mwc}->optionAdd("*activeBorderWidth",1);
 $mw{$mwc}->optionAdd("*BorderWidth",1);
 $mw{$mwc}->optionAdd("*.cursor",'');
 $font{$mwc} = $mw{$mwc}->fontCreate('font'.$mwc,-family => "$fontsys",-size => $fsize, -weight=>'normal');
 $fontbold{$mwc} = $mw{$mwc}->fontCreate('fontbold'.$mwc,-family => "$fontsys",-size => $fsize, -weight=>'bold');
 $exit{$mwc}=0;
 return $mwc;
}
sub destroymw
{
 my $mw=shift;
 if (Tk::Exists($mw{$mw}))
 {
  $mw{$mw}->withdraw;
  $mw{$mw}->destroy;
  delete $mw{$mw};
  delete $exit{$mw};
  delete $font{$mw};
  delete $fontbold{$mw};
  undef $mw{$mw};
  undef $exit{$mw};
  undef $font{$mw};
  undef $fontbold{$mw};
 }
}
sub destroyallmw # Destroy all windows which is waiting for variable chsnges
{
 $anotwait=1;
 $tagswait=1;
 $wait=1;
 $wait2=1;
 $pplwait=1;
 $urlwait=1;
 $mydr=1;
 $igp=1;
 $htmlgui=1;
 $BoxResult=1;
 $townwait=1;
 $projwait=1;
 $FDresult=1;
 $addsc=1;
}
sub loadprojprop
{
 if (-e fn($projects.$projectname.'/properties.conf'))
 {
  open(F,'<:raw',fn($projects.$projectname.'/properties.conf'));
  my $t=<F>;
  if ($t eq "Sources\n")
  {
   $di='';
   while ($t=<F>)
   {
    $t=decode('utf8',$t);
    if ($t eq "EndSources\n") {last}
    $di.=$t;
   }
  } else {MyMessageBox($messages[153].'Sources','ok','info')}
  $t=<F>;
  if ($t eq "Authors\n")
  {
   $av='';
   while ($t=<F>)
   {
    $t=decode('utf8',$t);
    if ($t eq "EndAuthors\n") {last}
    $av.=$t;
   }
  } else {MyMessageBox($messages[153].'Authors','ok','info')}
  $t=<F>;
  if ($t eq "About\n")
  {
   $op='';
   while ($t=<F>)
   {
    $t=decode('utf8',$t);
    if ($t eq "EndAbout\n") {last}
    $op.=$t;
   }
  } else {MyMessageBox($messages[153].'About','ok','info')}
  close(F);
 } else {$av='';$op='';$di=''}
}
sub saveprojprop
{
 open(F,'>:raw',fn($projects.$projectname.'/properties.conf'));
 print F "Sources\n";
 while (chomp($di)>0){};
 while (chomp($av)>0){};
 while (chomp($op)>0){};
 print F encode('utf8',$di);print F "\n";
 print F "EndSources\n";
 print F "Authors\n";
 print F encode('utf8',$av);print F "\n";
 print F "EndAuthors\n";
 print F "About\n";
 print F encode('utf8',$op);print F "\n";
 print F "EndAbout\n";
 close(F);
}
sub projectproperties
{
 menustateoff;
 loadprojprop;
 my $mwp=createmw($messages[148]);
 getscreensize;
 setgeometry3(400,370,$mwp);
 unless ($OS eq 'linux') {$mw{$mwp}->iconify;}
 my $np=0;foreach (keys %people) {$np++}
 $mw{$mwp}->configure(-padx=>5,-pady=>5);
 $mw{$mwp}->bind('<Destroy>'=>sub
 {
  $projwait=1;
 });
 $mw{$mwp}->bind('<KeyPress-Escape>'=>sub
 {
  $mw{$mwp}->destroy;
  $projwait=1;
 });
 $mw{$mwp}->Label(-font=>$font{$mwp},-text=>$messages[149].' : '.$np)->pack(-anchor=>'w');
 $mw{$mwp}->Label(-font=>$fontbold{$mwp},-text=>$messages[150])->pack(-anchor=>'w');
 my $dit=$mw{$mwp}->Scrolled(qw/Text height 5 -scrollbars oe -wrap word -background white/,-font=>$font{$mwp})->pack(-anchor=>'w');
 $dit->insert('0.0', $di);
 $mw{$mwp}->Label(-font=>$fontbold{$mwp},-text=>$messages[151])->pack(-anchor=>'w');
 my $avt=$mw{$mwp}->Scrolled(qw/Text height 5 -scrollbars oe -wrap word -background white/,-font=>$font{$mwp})->pack(-anchor=>'w');
 $avt->insert('0.0', $av);
 $mw{$mwp}->Label(-font=>$fontbold{$mwp},-text=>$messages[152])->pack(-anchor=>'w');
 my $opt=$mw{$mwp}->Scrolled(qw/Text height 5 -scrollbars oe -wrap word -background white/,-font=>$font{$mwp})->pack(-anchor=>'w');
 $opt->insert('0.0', $op);
 my $projpb=$mw{$mwp}->Button(-borderwidth=>'2',-font=>$font{$mwp},-text=>$messages[18],-command=>sub{$av=$avt->get("0.0","end");$op=$opt->get("0.0","end");$di=$dit->get("0.0","end");saveprojprop;destroymw($mwp);})->pack(-side=>'bottom',-anchor=>'s');
 $projpb->focus;
 unless ($OS eq 'linux') { $mw{$mwp}->update;$mw{$mwp}->deiconify}
 $mw{$mwp}->deiconify;
 $mw{$mwp}->waitVariable(\$projwait);
 undef $mwp;
 undef $projwait;
 menustateon;
}
sub tar
{
 my $taring=1;
 if (-e fn($projects.$projectname.'.tar'))
 {
  MyMessageBox($messages[162],'YesNo','question');
  $taring=0 if $BoxResult==0;
 }
 if ($taring==1)
 {
  menustateoff;
  drawmessage($messages[157]);
  my $tar=Archive::Tar->new();
  my $md=getcwd;
  my $f;
  chdir(fn($projects));
  copy(fn($projectname.'.rid'),'tmpfile.rodovid');
  $tar->add_files('tmpfile.rodovid');
  chdir(fn($projects.$projectname));
  $tar->add_files(glob fn('./*'));
  if (-e fn('./icons/')) {$tar->add_files(glob fn('./icons/*'));}
  my @info;
  if (-e fn('./gallery/')) 
  {
   foreach $f (glob fn('./gallery/*'))
   {
    if (-d fn($f)) 
    {
     $tar->add_files(glob fn($f.'/*'));
     $tar->add_files(glob fn($f.'/icons/*'));
    } else 
    {
     $tar->add_files($f);
    }
   }
  }
  chdir(fn($projects));
  $tar->write(fn($projectname.'.tar'));
  unlink 'tmpfile.rodovid';
  chdir($md);
  deletemessage;
  MyMessageBox($messages[159],'ok','info_n');
  menustateon;
 }
}
sub untar
{
 my ($name,$path,$ext);
 my $tar;
 my $f;
 my $projectn;
 menustateoff;
 my $file=fileDialog("opentar");
 unless ($file eq cancel)
 {
  drawmessage($messages[158]);
  ($name,$path,$ext)=fileparse($file,'.tar');
  $projectn=basename($name,'.tar');
  $BoxResult=1;
  if (-e fn($projects.$projectn.'.rid')) {MyMessageBox($messages[162],'YesNo','question')}
  if ($BoxResult==1)
  {
   $tar=Archive::Tar->new();
   $tar->read(fn($file));
   unless (-e fn($projects.$projectn)) {mkdir(fn($projects.$projectn))}
   foreach $f ($tar->list_files)
   {
    $tar->extract_file($f,fn($projects.$projectn.'/'.$f));
   }
   copy(fn($projects.$projectn.'/tmpfile.rodovid'),fn($projects.$projectn.'.rid'));
   unlink(fn($projects.$projectn.'/tmpfile.rodovid'));
   MyMessageBox($messages[160],'ok','info_n');
  }
  deletemessage;
 }
 menustateon;
}
sub loadmessages
{
 open(FM,'<:raw',fn($workfolder.'locales/'.$locale.'/if'));
 my $i=0;
 my $s;
 @messages=();
 while($s=<FM>)
 {
  chomp($s);
  $messages[$i]=decode('utf8',$s);
  $i++;
 }
 close(FM);
 open(FM,'<:raw',fn($workfolder.'locales/'.$locale.'/if2'));
 my $i=0;
 my $s;
 @FDM=();
 while($s=<FM>)
 {
  chomp($s);
  $FDM[$i]=decode('utf8',$s);
  $i++;
 }
 close(FM);
}
sub loadhelp
{
 open(F,'<:raw',fn($workfolder.'locales/'.$locale.'/help'));
 my $i=0;
 my $s;
 @help=();
 while($s=<F>)
 {
  $help[$i].=decode('utf8',$s);
  $i++;
 }
 close(F);
}
sub myPhoto
{
 my $f=shift;
 copy(fn($f),fn($tmpdir.'myphototmp'));
 $TOP->Photo(-file=>fn($tmpdir.'myphototmp'));
}
our $FDc;
our $fil;
our $tmb;
our $f1;
our $fc;
our $f2;
our $f3;
our $foldi;
our $filei;
our $filerid;
our $filecsv;
our $filepdf;
our $fileged;
our $fileimg;
our $filetar;
our $fileup;
our $filesys;
our $fd1;
our $tpdestroy;
our $FDfont;
our $bUp;
our $fEnt;
our $bOk;
our $bCancel;
our $FDdr;
our $curdir;
our $option;
our $cwd;
our $dir;
our $filter;
our (@folders, @sorted, %ftypes);
our @files;
our $currenttag;
our $key_down;
our @bb;
our $poscan;
our $dot_show=1;
sub MyFDialog
{
 my $FDworkfolder=shift;
 $FDworkfolder=~s/\\ / /g;
 $key_down=0;
 my $FDFilter=shift;
 $option=shift;
 sub mchdir
 {
  my $s=shift;
  $s=~s/\\ / /g;
  if (!(-X "$s")) {MyMessageBox($FDM[7].$s.$FDM[8],'ok','info')}
  else {chdir "$s" || print "Can't chdir $s: $!"}
 }
 my $t=$FDM[15];
 if ($option eq 'save') {$t=$FDM[16];}
 if ($option eq 'create') {$t=$FDM[23];}
 my $height=15;
 $FDtp=createmw($t);
 $nfsize=$fsize;
 if ($fsize>14) {$nfsize=14}
 $fontm=$mw{$FDtp}->fontCreate(-family=>$mono,-size=>$nfsize,-weight=>'normal');
 $FDfont=$font{$FDtp};
 my $charh=18;
 $charw=$mw{$FDtp}->fontMeasure($fontm,'M');
 my $charnw=int($mw{$FDtp}->fontMeasure($font{$FDtp},'Mo')/2);
 my @FDF=split('\|',$FDFilter);
 my $cFDF=@FDF;
 my $t;
 my $maxfdf=0;
 my $maxt='';
 my $i;
 for ($i=0;$i<$cFDF;$i++)
 {
  $t=$FDF[$i].$FDF[$i+1].'   ';
  if (length($t)>$maxfdf) {$maxfdf=length($t);$maxt=$t} 
  $i++;
 } 
 my $widthtp=$mw{$FDtp}->fontMeasure($font{$FDtp},$maxt)+300;#600;
 $widthtp=458 if $widthtp<458;
 my $pathlength;
 setgeometry($widthtp,($height*$charh+140),$FDtp);
 $mw{$FDtp}->resizable(1, 0);
 $tpdestroy=0;
 $foldi=$mw{$FDtp}->Photo(-file=>$workfolder.'graphics/folder.png');
 $filei=$mw{$FDtp}->Photo(-file=>$workfolder.'graphics/file.png');
 $filerid=$mw{$FDtp}->Photo(-file=>$workfolder.'graphics/rid.png');
 $filecsv=$mw{$FDtp}->Photo(-file=>$workfolder.'graphics/csv.png');
 $filepdf=$mw{$FDtp}->Photo(-file=>$workfolder.'graphics/pdf.png');
 $fileged=$mw{$FDtp}->Photo(-file=>$workfolder.'graphics/ged.png');
 $fileimg=$mw{$FDtp}->Photo(-file=>$workfolder.'graphics/image.png');
 $filetar=$mw{$FDtp}->Photo(-file=>$workfolder.'graphics/tar.png');
 $fileup=sizePhoto2($mw{$FDtp},$workfolder.'graphics/go-up.png');
 $filesys=$mw{$FDtp}->Photo(-file=>$workfolder.'graphics/system.png');
 $fd1=$mw{$FDtp}->Photo(-file=>$workfolder.'graphics/fd1.png');
 $f1=$mw{$FDtp}->Frame(-borderwidth=>3,-height=>'20')->pack(-fill=>'x');
 unless ($OS eq 'linux')
 {
  $FDdr=$f1->MyMenuButton(-image=>$filesys,-tearoff=>0,-relief=>'flat',-state=>'active',-activebackground=>$menuback,-activeforeground=>$menufore)->pack(-side=>'left',-anchor=>'w');
  drives();
 }
 $bUp=$f1->Button(-image=>$fileup,-relief=>'flat',-borderwidth=>1,-font=>$FDfont,-command=>sub
 {
  mchdir('..');
  $cwd=getcwd;
  $curdir=$cwd;
  showcanvas($curdir);
  ChangeDir($curdir)
 })->pack(-side=>'left',-anchor=>'e',-pady=>5);
 $mw{$FDtp}->bind('<KeyPress-Prior>',sub
 {
  mchdir('..');
  $cwd=getcwd;
  $curdir=$cwd;
  showcanvas($curdir);
  ChangeDir($curdir)
 });
 $mw{$FDtp}->bind('<KeyPress-Escape>',sub
 {
  $FDresult='';
 });
 $fc=$mw{$FDtp}->Frame(-borderwidth=>1, -relief=>'sunken', -width=>$widthtp, -height=>$height*$charh)->pack(-fill=>'x',-expand=>'yes');
 if ($OS eq 'linux') {$FDc=$fc->Scrolled(qw/Canvas -scrollbars os/,-width=>$widthtp, -height => ($height*$charh), -tile=>$fd1)->pack(-fill=>'x',-expand=>'yes');}
 else {$FDc=$fc->Scrolled(qw/Canvas -width/,$widthtp, -height=>($height*$charh))->pack(-fill=>'x',-expand=>'yes');}
 $f2=$mw{$FDtp}->Frame(-height=>'25')->pack(-fill=>'x');
 $f2->Label(-text=>$FDM[5],-width=>14,-relief=>'flat',-font=>$FDfont)->pack(-side=>'left',-anchor=>'w');
 my $ent=$projectname;
 if ($option eq 'load') {$ent=''}
 $fEnt=$f2->Entry(-textvariable=>$ent,-relief=>'ridge',-font=>$FDfont)->pack(-padx=>10,-side=>'left',-fill=>'x',-expand=>'yes');
 $t=$FDM[0];
 if ($option eq 'load') {$t=$FDM[3]}
 if ($option eq 'create') {$t=$FDM[24]}
 my $l=6;
 if (length($t)>$l) {$l=length($t)}
 if (length($FDM[2])>$l) {$l=length($FDM[2])}
 $bOk=$f2->Button(-borderwidth=>2,-text=>$t,-font=>$FDfont,-width=>$l,-command=>sub
 {
  resOk();
 })->pack(-side=>'right',-pady=>5);
 $f3=$mw{$FDtp}->Frame(-height=>'25')->pack(-fill=>'x');
 $f3->Label(-text=>$FDM[6],-relief=>'flat',-font=>$FDfont,-width=>14)->pack(-side=>'left',-anchor=>'w');
 $fil=$f3->MyMenuButton(-text=>'Filter',-tearoff=>0,-relief=>'flat',-font=>$FDfont,-state=>'active',-activebackground=>$menuback,-activeforeground=>$menufore)->pack(-padx=>10,-side=>'left',-fill=>'x',-expand=>'yes');
 $bCancel=$f3->Button(-borderwidth=>2,-text=>$FDM[2],-width=>$l,-font=>$FDfont,-command=>sub
 {
  $FDresult='';
 })->pack(-side=>'right');
 $bOk->bind('<Destroy>'=>sub{if (!($FDresult)) {$FDresult=''};$tpdestroy=1});
 $mw{$FDtp}->bind('<Control-Prior>'=>sub
 {
  mchdir('..');$key_down=0;
  $cwd=getcwd;
  $curdir=$cwd;
  showcanvas($curdir);
  ChangeDir($curdir)
 });
 $mw{$FDtp}->bind('<Control-period>'=>sub
 {
  $key_down=0;
  $cwd=getcwd;
  $curdir=$cwd;$dot_show=$dot_show ^ 1;
  showcanvas($curdir);
  ChangeDir($curdir)
 });
 my $fpos='';
 $FDc->CanvasBind('<Double-ButtonPress-1>',sub
 {
  my @tags=$FDc->gettags('current');
  if ($tags[0]=~/^?d(\d+)$/)
  {
   $cwd=getcwd();
   $dir=$cwd.'/'.$folders[$1];mchdir($dir);
   $curdir=getcwd();
   showcanvas($curdir);
   ChangeDir($curdir)
  } 
  if ($tags[0]=~/^?f(\d+)$/)
  {
   $fEnt->configure(-textvariable=>decod($sorted[$1]));$fpos=$1;
   resOk();
  }
 });
 $FDc->CanvasBind('<ButtonRelease-1>',sub
 {
  if ($currenttag eq '') {$currenttag='bd0'}
  $currenttag=~/^?([fd])(\d+)$/;
  $FDc->itemconfigure('b'.$1.$2,-fill=>'');
  my @tags=$FDc->gettags('current');
  $currenttag=$tags[0];
  if ($tags[0]=~/^?d(\d+)$/)
  {
   $fEnt->configure(-textvariable=>' ');
   $FDc->itemconfigure('bd'.$1,-fill=>$backcolor);$fpos=$1;
  }
  if ($tags[0]=~/^?f(\d+)$/)
  {
   $FDc->itemconfigure('bf'.$1,-fill=>$backcolor);#43ACE8 more black color
   $fEnt->configure(-textvariable=>decod($sorted[$1]));$fpos=$1;
  }
 });
 $mw{$FDtp}->bind('<KeyPress-Return>'=>sub
 {
  $mw{$FDtp}->update;
  my $t=$fEnt->cget(-textvariable);
  if ($t=~/^\s*$/)
  {
   if ($currenttag=~/^?d(\d+)/)
   {
    $cwd=getcwd();$key_down=0;
    $dir=$cwd.'/'.$folders[$1];mchdir($dir);
    $curdir=getcwd();
    showcanvas($curdir);
    ChangeDir($curdir);
    $currenttag='bd0';
   } 
   if ($currenttag=~/^?f(\d+)$/)
   {
    $fEnt->configure(-textvariable=>decod($sorted[$1]));$fpos=$1;
    resOk();
   }
  } else {resOk()}
 });
 my $page=5;
 $mw{$FDtp}->bind('<KeyPress-Right>'=>sub
 {
  if ((@folders>15) || (@sorted>15) || (@sorted+@folders>15))
  {
   @bb=$FDc->bbox('all');$poscan=$FDc->canvasx(0);
   $FDc->xviewMoveto(($poscan+32*$charw+1.5)/$bb[2]);
   if ($currenttag eq '') {$currenttag='bd0'}
   if ($currenttag=~/^?d(\d+)/)
   {
    $FDc->itemconfigure("bd$1",-fill=>'');
    $fpos=$1+$height;
    if ($fpos > (@folders-1)) 
    {
     if (@sorted)
     {
      if (($fpos-@folders)<(@sorted-1))
      {
       $fEnt->configure(-textvariable=>decod($sorted[0]));
       $currenttag='bf'.($fpos-@folders);
      }
      else
      {
       $currenttag='bf'.(@sorted-1);
       $fpos=@sorted-1;$key_down=$fpos % 15;
       $fEnt->configure(-textvariable=>decod($sorted[@sorted-1]));
      }
     }
     else
     {
      $currenttag='bd'.(@folders-1);
      $fpos=@folders-1;$key_down=$fpos % 15;
      $fEnt->configure(-textvariable=>' ');
     }
    } else 
    {
     $currenttag='bd'.$fpos;
     $fEnt->configure(-textvariable=>' ');
    }
    $FDc->itemconfigure($currenttag,-fill=>$backcolor);
    return;
   }
   if ($currenttag=~/^?f(\d+)/)
   {
    $FDc->itemconfigure("bf$1",-fill=>'');
    $fpos=$1+$height;
    if ($fpos > (@sorted-1)) {$fpos=@sorted-1;$key_down=($fpos+@folders) % 15;}
    $FDc->itemconfigure('bf'.$fpos,-fill=>$backcolor);#43ACE8 more black color
    $fEnt->configure(-textvariable=>decod($sorted[$fpos]));
    $currenttag="bf$fpos";
   }
  }
 });
 $mw{$FDtp}->bind('<KeyPress-Left>'=>sub
 {
  @bb=$FDc->bbox('all');$poscan=$FDc->canvasx(0);
  $FDc->xviewMoveto(($poscan-32*$charw+1.5)/$bb[2]);
  if ($currenttag eq '') {$currenttag='bd0'}
  if ($currenttag=~/^?d(\d+)/)
  {
   $FDc->itemconfigure("bd$1",-fill=>'');
   $fpos=$1-$height;
   if ($fpos < 0) {$fpos=0;$key_down=0}
   $FDc->itemconfigure('bd'.$fpos,-fill=>$backcolor);
   $fEnt->configure(-textvariable=>' ');
   $currenttag="bd$fpos";
   return;
  }
  if ($currenttag=~/^?f(\d+)/)
  {
   $FDc->itemconfigure("bf$1",-fill=>'');
   $fpos=$1-$height;
   my $pref='bf';
   if ($fpos < 0) 
   {
    $pref='bd';
    $fpos=@folders+$fpos;
    if ($fpos<0) {$fpos=0;$key_down=0}
    $fEnt->configure(-textvariable=>' ');
   } 
   else
   {
    $fEnt->configure(-textvariable=>decod($sorted[$fpos]));
   }
   $FDc->itemconfigure($pref.$fpos,-fill=>$backcolor);#43ACE8 more black color
   $currenttag="$pref$fpos";
  }
 });
 $mw{$FDtp}->bind('<KeyPress-Up>'=>sub
 {
  @bb=$FDc->bbox('all');$poscan=$FDc->canvasx(0);
  if ($currenttag eq '') {$currenttag='bd0'}
  if ($currenttag=~/^?d(\d+)/)
  {
   $FDc->itemconfigure("bd$1",-fill=>'');
   $fpos=$1-1;
   if ($fpos < 0) {$fpos=0;$key_down=0}
   $FDc->itemconfigure('bd'.$fpos,-fill=>$backcolor);
   $fEnt->configure(-textvariable=>' ');
   $currenttag="bd$fpos";
  $key_down-=1;
  if ($key_down<0) 
  {
   if ($fpos>0)
   {
    $FDc->xviewMoveto(($poscan-32*$charw+1.5)/$bb[2]);
    $key_down=15;
   } else {$key_down=0;}
  }
   return;
  }
  if ($currenttag=~/^?f(\d+)/)
  {
   $FDc->itemconfigure("bf$1",-fill=>'');
   $fpos=$1-1;
   my $pref='bf';
   if ($fpos < 0) 
   {
    $pref='bd';
    $fpos=@folders-1;
    $fEnt->configure(-textvariable=>' ');
   } 
   else
   {
    $fEnt->configure(-textvariable=>decod($sorted[$fpos]));
   }
   $FDc->itemconfigure($pref.$fpos,-fill=>$backcolor);#43ACE8 more black color
   $currenttag="$pref$fpos";
  }
  $key_down-=1;
  if ($key_down<0) 
  {
   if ($fpos>0)
   {
    $FDc->xviewMoveto(($poscan-32*$charw+1.5)/$bb[2]);
    $key_down=15;
   } else {$key_down=0;}
  }
 });
 $mw{$FDtp}->bind('<KeyPress-Down>'=>sub
 {
   @bb=$FDc->bbox('all');$poscan=$FDc->canvasx(0);
   $key_down+=1;
   if ($key_down>14) 
   {
    my $f=@folders; my $s=@sorted;
    if ($f!=15)
    {
     if (($s+$f)!=15)
     {
      $key_down=0;$FDc->xviewMoveto(($poscan+32*$charw+1.5)/$bb[2]);
     } else {$key_down-=1;return}
    } else {$key_down-=1;return}
   }
   if ($currenttag eq '') {$currenttag='bd0'}
   if ($currenttag=~/^?d(\d+)/)
   {
    $FDc->itemconfigure("bd$1",-fill=>'');
    $fpos=$1+1;
    if ($fpos > (@folders-1)) 
    {
     if (@sorted)
     {
      $fEnt->configure(-textvariable=>decod($sorted[0]));$currenttag='bf0';
     }
     else
     {
      $currenttag='bd'.(@folders-1);
      $fEnt->configure(-textvariable=>' ');
      $key_down=(@folders-1) % 15;
     }
    } else {$currenttag='bd'.$fpos}
    $FDc->itemconfigure($currenttag,-fill=>$backcolor);
    return;
   }
   if ($currenttag=~/^?f(\d+)/)
   {
    $FDc->itemconfigure("bf$1",-fill=>'');
    $fpos=$1+1;
    if ($fpos > (@sorted-1)) {$fpos=@sorted-1;$key_down=($fpos + @folders) % 15; }
    $FDc->itemconfigure('bf'.$fpos,-fill=>$backcolor);#43ACE8 more black color
    $fEnt->configure(-textvariable=>decod($sorted[$fpos]));
    $currenttag="bf$fpos";
   }
 });
 $mw{$FDtp}->deiconify;
 return FDialog($FDworkfolder,$FDFilter);
 sub resOk
 {
  my $t=$fEnt->cget(-textvariable);
  $t=~s/^\s{1}(.+)$/\1/;
  if ($t ne '')
  {
   my $cd=getcwd();
   chdir(fn($curdir));
   if ($option eq 'load')
   {
    if (-e fn($t))
    {
     if (-R fn($t)) 
     {
      if ($curdir!~/(\/|\\)$/)
      {
       $FDresult=$curdir.'/'.$t;
      }
      else
      {
       $FDresult=$curdir.$t;
      }
     } else {MyMessageBox($FDM[14],'ok','info');}
    } else {MyMessageBox($FDM[9],'ok','info')}
   }
   if (($option eq 'save') || ($option eq 'create'))
   {
    if ((-W fn($t)) && (-e fn($t)))
    {
     if (-f fn($t)) 
     {
      MyMessageBox($FDM[10].$curdir.'/'.$t.$FDM[11],'YesNo','question');
      if ($BoxResult==1) 
      {
       if ($curdir!~/(\/|\\)$/)
       {
        $FDresult=$curdir.'/'.$t;
       }
       else
       {
        $FDresult=$curdir.$t;
       }
      }
     }
     else
     {
      if ($curdir!~/(\/|\\)$/)
      {
       $FDresult=$curdir.'/'.$t;
      }
      else
      {
       $FDresult=$curdir.$t;
      }
     }
    } else
    {
     if ((-W '.') && (!(-e fn($t))))
     {
      if ($curdir!~/(\/|\\)$/)
      {
       $FDresult=$curdir.'/'.$t;
      }
      else
      {
       $FDresult=$curdir.$t;
      }
     } else {MyMessageBox($FDM[13],'ok','info');}
    }
   }
   chdir(fn($cd));
   $FDresult=decod($FDresult);
  }
 }
 my $fe;
 sub ChangeDir
 {
  my $cdir=shift;
  mchdir "$cdir";
  $curdir=$cdir;
  my @tmpdir=split('/',$cdir);
  my @dir;
  my $i=0;
  my $t='';
  foreach my $d (@tmpdir) {$t=$t.$tmpdir[$i].'/';$dir[$i]=$t;$i++}
  $tmb->destroy if ($tmb);
  $tmb=$f1->MyMenuButton(-text=>'',-font=>$FDfont, -tearoff=>0,-relief=>'flat',-state=>'active',-activebackground=>$menuback,-activeforeground=>$menufore)->pack(-after=>$bUp,-side=>'left');
  $tmb->configure(-relief=>'flat');
  my $short_cdir;
  $pathlength=int($widthtp/$charnw);
  if (length $cdir>$pathlength)
  {$short_cdir='... '.(substr($cdir,-($pathlength-5)))}
  else 
  {
   $short_cdir=$cdir
  }
  $tmb->configure(-text=>$FDM[4].' '.decod($short_cdir));
  foreach my $d (@dir) 
  {
   $tmb->command(-font=>$font{$FDtp},-label=>decod($d),-command=>sub
   {
    $cdir=$d;
    $tmb->configure(-text=>decod($cdir));
    mchdir $cdir;$curdir=$cdir;
    showcanvas($cdir,$FDc)
   })
  };
 }
 sub FDialog
 {
  my $mdir=shift;
  my $ft=shift;
  if ($debug==1)
  {
   print "ft:$ft\n";
  }
  my @ftypes=split('\|',$ft);
  my $i=0;
  while ($ftypes[$i+1])
  {
   $ftypes{$ftypes[$i]}=$ftypes[$i+1];
   if ($debug==1)
   {
    print "fth1:$ftypes[$i]; fth2:$ftypes[$i+1]\n";
   }
   $i=$i+2;
  }
  $fil->configure(-relief=>'flat');
  $fil->configure(-text=>$ftypes[0]." ($ftypes[1])");
  $filter=$ftypes[1];
  $i=0;
  foreach my $d (@ftypes) 
  {
   if (int(($i/2))*2==$i)
   {
    $fil->command(-font=>$font{$FDtp},-label=>$d." ($ftypes{$d})",-command=>sub
    {
     $filter=$ftypes{$d}; $key_down=0;
     $fil->configure(-text=>$d." ($ftypes{$d})");
     showcanvas($curdir,$FDc);
    })
   }
   $i++;
  };
  ChangeDir($mdir);
  showcanvas($mdir);
  $mw{$FDtp}->raise;
  $mw{$FDtp}->waitVariable(\$FDresult);
  if ($tpdestroy==0) {
   destroymw($FDtp);
  };
  undef @folders;
  undef @sorted;
  undef %ftypes;
  undef $filter;
  undef $cwd;
  undef $dir;
  undef $option;
  undef $curdir;
  undef $tmb;
  undef $fil;
  undef $FDc;
  undef $f1;
  undef $f2;
  undef $f3;
  undef $fc;
  undef $foldi;
  undef $filei;
  undef $filerid;
  undef $filecsv;
  undef $filepdf;
  undef $fileged;
  undef $fileimg;
  undef $filetar;
  undef $fileup;
  undef $filesys;
  undef $fd1;
  undef $FDtp;
  undef $fontm;
  undef $FDfont;
  undef $tpdestroy;
  undef $bUp;
  undef $fEnt;
  undef $bOk;
  undef $bCancel;
  undef $FDdr;
  my $t=$FDresult;
  undef $FDresult;
  return $t;
 }
 sub showcanvas
 {
  my $sdir=shift;
  my $width=32;
  my $maxfn=$width-4;
  my $lh=$height;
  $lh++ if ($OS eq 'MSWin32');
  $FDc->delete('all');
  @folders=();@files=();my $fold=0;
  my $file=0;
  my $f;my $t=0;
  my $cwd=getcwd;
  opendir(FD,$sdir);
  foreach $f (sort readdir(FD))
  {
   if ($f eq '.') {next}
   if ($dot_show == 0)
   {
    unless (($f=~/^\./) && ($f ne '..'))
    {
     if (-d "$cwd/$f") {$folders[$fold]=$f;$fold++;}
     if (-f "$cwd/$f") {$files[$file]=$f;$file++;}
     $t++;
    }
   }
   else
   {
    if (-d "$cwd/$f") {$folders[$fold]=$f;$fold++;}
    if (-f "$cwd/$f") {$files[$file]=$f;$file++;}
    $t++;
   }
  }
  close(FD);
  my $p=0;my $fo=0;
  my ($x,$y);
  my ($tx,$ty);
  my $fp;
  foreach $f (@folders)
  {
   $f=basename($f,'');
   $fp=decod($f);
   if (length($fp)>$maxfn) {$fp=substr($fp,0,$maxfn);}
   $x=int($p / $lh);
   $y=$p-$x*$lh;
   $tx=length($fp);
   $FDc->createRectangle($x*$width*$charw,$y*$charh,$x*$width*$charw+$width*$charw-1,$y*$charh+18,-fill=>'',-outline=>'',-tag=>'bd'.$fo);
   $FDc->createImage($x*$width*$charw+10,$y*$charh+9,-image=>$foldi,-tag=>'id'.$fo);
   $FDc->createText(23+int($tx*$charw/2)+$x*$width*$charw,9+$y*$charh,-font=>$fontm,-text=>$fp,-tag=>'td'.$fo);
   $fo++;$p++;
  }
  $fo=0;
  my @filtered;my $i=0;
  my @filters=split(', ',$filter);
  foreach my $d (@files)
  {
   foreach my $f (@filters)
   {
    if ($d=~/^(.+)$f$/i) {$filtered[$i]=$d;$i++}
   }
  }
  @sorted=sort @filtered;
  my $filec;
  foreach $f (@sorted)
  {
   $f=basename($f,'');
   $fp=decod($f);
   if (length($fp)>$maxfn) {$fp=substr($fp,0,$maxfn);}
   $x=int($p / $lh);
   $y=$p-$x*$lh;
   $tx=length($fp);
   $filec=$filei;
   if ($f=~/^(.*)\.rid$/i) {$filec=$filerid}
   if ($f=~/^(.*)\.csv$/i) {$filec=$filecsv}
   if ($f=~/^(.*)\.pdf$/i) {$filec=$filepdf}
   if ($f=~/^(.*)\.ged$/i) {$filec=$fileged}
   if ($f=~/^(.*)\.tar$/i) {$filec=$filetar}
   if ($f=~/^(.*)\.jpg$/i) {$filec=$fileimg}
   if ($f=~/^(.*)\.gif$/i) {$filec=$fileimg}
   if ($f=~/^(.*)\.png$/i) {$filec=$fileimg}
   if ($f=~/^(.*)\.tif$/i) {$filec=$fileimg}
   if ($f=~/^(.*)\.tiff$/i) {$filec=$fileimg}
   if ($f=~/^(.*)\.jpeg$/i) {$filec=$fileimg}
   $FDc->createRectangle($x*$width*$charw,$y*$charh,$x*$width*$charw+$width*$charw-1,$y*$charh+18,-fill=>'',-outline=>'',-tag=>'bf'.$fo);
   $FDc->createImage($x*$width*$charw+10,$y*$charh+9,-image=>$filec,-tag=>'if'.$fo);
   $FDc->createText(23+int($tx*$charw/2)+$x*$width*$charw,9+$y*$charh,-font=>$fontm,-text=>$fp,-tag=>'tf'.$fo);
   $fo++;$p++;
  }
  if ($x==0)
  {$FDc->configure(-scrollregion=>[0,0,$width*($x+2)*$charw+1,16*$charh+1],-scrollbars=>'os');}
  else
  {$FDc->configure(-scrollregion=>[0,0,$width*($x+1)*$charw,15*$charh],-scrollbars=>'os');}
  $FDc->itemconfigure('bd0',-fill=>$backcolor,-outline=>'');
  $currenttag='bd0';
  $FDc->xviewMoveto(0);
  $fEnt->configure(-textvariable=>' ');
 }
 sub drives
 {
  my @driveTypes = ($FDM[17],$FDM[18],$FDM[19],$FDM[20],$FDM[21],$FDM[22]);
  my $obj = "Scripting.FileSystemObject";
  my $fs = Win32::OLE->new($obj);
  my $drives = $fs->Drives;
  my $max = $drives->{count};
  foreach my $drv ( Win32::OLE::in($drives)) 
  {
   my $typ = $drv->{DriveType};
   $FDdr->command(-label=>($drv->{DriveLetter} . ": - ".$driveTypes[$typ]),-command=>sub
   {
    mchdir $drv->{DriveLetter}.":\\";$curdir=getcwd();
    showcanvas($curdir);
    ChangeDir($curdir);
   });
  }
 }
}
sub save2pics
{
 my $test=0;
 my ($nn,$pp,$ee);
s2ploop:
 if ($test==1) 
 {
  my $t=$messages[177];
  if ($OS eq 'MSWin32') {$t=$messages[188]}
  MyMessageBox($t,'ok','info');
 }
 my $file=fileDialog('savefoto');
 ($nn,$pp,$ee)=fileparse($file,'');
 $test=1;
 if ($OS!='MSWin32')
 {
  unless (($file eq cancel)||($nn=~/.+\.jpg$/)||($nn=~/.+\.JPG$/)||($nn=~/.+\.jpeg$/)
     ||($nn=~/.+\.JPEG$/)||($nn=~/.+\.png$/)||($nn=~/.+\.PNG$/)||($nn=~/.+\.bmp$/)
     ||($nn=~/.+\.BMP$/)||($nn=~/.+\.gif$/)||($nn=~/.+\.GIF$/)||($nn=~/.+\.tif$/)||($nn=~/.+\.TIF$/)
     ||($nn=~/.+\.tiff$/)||($nn=~/.+\.TIFF$/)||($nn=~/.+\.ps$/)||($nn=~/.+\.PS$/)) 
  {
   goto s2ploop
  }
 }
 else
 {
  unless (($file eq cancel)||($nn=~/.+\.ps$/)||($nn=~/.+\.PS$/)) 
  {
   goto s2ploop
  }
 }
 unless ($file eq cancel)
 {
  menustateoff;
  drawmessage($messages[69]);
  my @capture=();
  @kins=();
  my $i=0; my $a; my $k;
  foreach $a (values %people)
  {
   $kins[$i]=$a;$i++;
  }
  my ($x0,$y0,$x1,$y1)=$c->bbox(@kins);
  @capture=('-x'=>$x0,'-y'=>$y0,'-height'=>$y1-$y0,'-width'=>$x1-$x0,'-pageheight'=>$y1-$y0,'-pagewidth'=>$x1-$x0);
  while (($k,$a)=each(%ruler))
  {
   $c->move('ruler'.$k,0,-$a); # hide ruler
  }
  showallhidden;
  $c->postscript(-colormode=>'color',-file=> fn($tmpdir.'tmp'),-rotate=>0,@capture);
  hideallhidden;
  while (($k,$a)=each(%ruler))
  {
   $c->move('ruler'.$k,0,$a); # unhide ruler
  }
  @kins=();
  drawmessage($messages[178]);
  my $magick = new Image::Magick;
  my $status = $magick->Read( filename => fn($tmpdir.'tmp') );
  if ($OS!='MSWin32')
  {
   if ($file=~/.+\.[pP][sS]$/)
   {
    copy(fn($tmpdir.'tmp'),fn($file))
   }
   else
   {
    $status = $magick->Write(fn($file));
   }
  }
  else
  {
   copy(fn($tmpdir.'tmp'),fn($file))
  }
  unlink(fn($tmpdir.'tmp'));
 }
 deletemessage;
 menustateon;
}
sub export2csv
{
 menustateoff;
 &filter;
 if ($no_persons eq 0)
 {
  my $file=fileDialog('savecsv');
  unless ($file eq cancel)
  {
   drawmessage($messages[69]);
   my $f=basename($file,'.csv');
   my $f2=basename($file,'');
   if ($f2 eq $f)
   {
    $file=$file.'.csv';
    if (-e $file)
    {
     MyMessageBox($messages[162],'YesNo','question');
     if ($BoxResult==0)
     {
      deletemessage();
      menustateon;
      return 1;
     }
    }
   } # if enterd file without .csv extension it will be added
   my @sorted_id=sort { $a <=> $b } (@id_filtered); #sorted IDs by number
   open(F,">:utf8",fn($file));
   my $i;
   #header
   print F '"ID","'.$messages[259].'","'.$messages[108].'","'.$messages[260].'","'.$messages[107].'","'.$messages[261].'","'.$messages[102].'","","'.$messages[103].'","","'.$messages[104].'","'.$messages[36].'"'."\n";
   print F '"","","","","","","ID.'.$messages[259].'","'.$messages[31].'","ID.'.$messages[259].'","'.$messages[31].'","ID",""'."\n";
   foreach $i (@sorted_id)
   {
    my $f=father($i);
    my $m=mother($i);
    my $j;my $child='';
    #collect children IDs
    if ($sex{$j} == 'man')
    {
     foreach $j (keys %father)
     {
      if (number2($father{$j})==$i) {$child.=number1($father{$j}).', '}
     }
    }
    if ($sex{$j} == 'woman')
    {
     foreach $j (keys %mother)
     {
      if (number2($mother{$j})==$i) {$child.=number1($mother{$j}).', '}
     }
    }
    chop($child); chop($child); #delete last ', '
    my $pib=$family_name{$i}.' '.$first_name{$i}.' '.$second_name{$i};
    $pib=~s/\s+/ /g;
    $pib=~s/^\s//;
    $pib=~s/\s$//; #get person's Name for all variants
    my $fpib='';
    if ($f != 0) 
    {
     $fpib=$f.'. '.$family_name{$f}.' '.$first_name{$f}.' '.$second_name{$f};
     $fpib=~s/\s+/ /g;
     $fpib=~s/^(\d+\.)\s/\1 /;
     $fpib=~s/\s$//#get person's father Name for all variants
    }
    my $mpib='';
    if ($m != 0) 
    {
     $mpib=$m.'. '.$family_name{$m}.' '.$first_name{$m}.' '.$second_name{$m};
     $mpib=~s/\s+/ /g;
     $mpib=~s/^(\d+\.)\s/\1 /;
     $mpib=~s/\s$//#get person's mather Name for all variants
    }
    my $text=$text{$i};
    $text=~s/\n/ /g;
    #print person's line
    print F '"'.$i.'","'.$pib.'","'.$birth_date{$i}.'","'.$birth_place{$i}.'","'.$death_date{$i}.'","'.$death_place{$i}.'","'.$fpib.'","'.$birth_date{$f}.'","'.$mpib.'","'.$birth_date{$m}.'","'.$child.'","'.$text.'"'."\n";
   }
   close(F);
   deletemessage();
  }
 }
 menustateon;
}
sub export2pdf
{
 my $para_left=15;
 menustateoff;
 &filter;
 if ($no_persons eq 0)
 {
 my $file=fileDialog('savepdf');
 unless ($file eq cancel)
 {
  menustateoff;
  drawmessage($messages[69]);
  my $f=basename($file,'.pdf');
  my $f2=basename($file,'');
  if ($f2 eq $f)
  {
   $file=$file.'.pdf';
   if (-e $file)
   {
    MyMessageBox($messages[162],'YesNo','question');
    if ($BoxResult==0)
    {
     deletemessage();
     menustateon;
     return 1;
    }
   }
  }# if enterd file without .pdf extension it will be added
  save2(0);#save project
  menustateoff;
  drawmessage($messages[69]);
  my $pdf_maxy=842;#size of pdf document in pixels
  my $pdf_maxx=596;
  my ($pdf_w,$pdf_h)=($pdf_maxx, $pdf_maxy);
  $font_now=$fontu;#defaul font
  $pdf_fs=24; #default fontsize 
  my $pdf_l=1.2; #defaul line spacing
  my $pdf_fill='#221E1F'; #color of text
  my $pdf_url='darkblue'; #color of links
  my $bottom_page=50;
  my $epdf;
  $pdf_page=1;
  sub setexport2pdf
  {
   getscreensize;
   my $x=$screenx;
   my $y=$screeny;
   $pdfgui=0;
   $epdf=$TOP->Toplevel(-relief=>'flat');
   $epdf->title($messages[283]);
   my $gx=500;
   my $gy=550;
   $gx=int($gx*$fsize/9);
   $gy=int($gy*(1+$fsize/18-0.5));
   $epdf->geometry($gx.'x'.$gy.'+'.(int(($x-$gx)/2)).'+'.(int(($y-$gy)/2)));
   $epdf->minsize($gx,$gy);
   $epdf->Icon(-image=>$TOP->Photo(-file=>$prog_icon));
   $epdf->bind('<Destroy>'=>
   sub
   {
    $pdfgui=1;
   });
   $epdf->bind('<KeyPress-Escape>'=>sub
   {
    $epdf->destroy;
   });
   my $balloon=$epdf->Balloon(-background=>$balloon_bg,-foreground=>$balloon_fg,-font=>'fontbold');
   my $nb2=$epdf->NoteBook(-font=>'font')->pack(-fill=>'both',-expand=>1);
   my $etl1=$nb2->add("sn1",-label=>$messages[284],-state=>'normal');
   my $etl2=$nb2->add("sn2",-label=>$messages[285],-state=>'normal');
   #Structure part
   my $etl1f=$etl1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top',-padx=>10,-pady=>10);
   my $etl1f1=$etl1f->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'left');
   # Show
   my $ef11=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $bal0=$ef11->Label(-font=>$fontbold,-relief=>'flat',-text=>$messages[287])->pack(-side=>'left',-anchor=>'w');
   $etl1f->Label(-text=>' ')->pack(-side=>'top',-anchor=>'w',-pady=>1); #blank label
   # Title
   my $ef1a=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $bal1;
   my $bal2;
   my $bal0=$ef1a->Checkbutton(-font=>$font,-relief=>'flat',-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[304],-onvalue=>1,-offvalue=>0, -variable => \$pdf_opt12, -command=>
   sub
   {
    $bal1->configure(-state=>'disabled');
    if ($pdf_opt12==1) 
    {
     $bal1->configure(-state=>'normal');
    }
   }
   )->pack(-side=>'top',-anchor=>'w');
   $bal1=$etl1f->Entry(-font=>$font,-relief=>'sunken',-borderwidth=>2,-background=>'white',-textvariable=>\$document_title,-width=>"30")->pack(-side=>'top',-anchor=>'w');
   $balloon->attach($bal1, -initwait=>0,-balloonmsg=>"$messages[309]");
   $balloon->attach($bal0, -initwait=>0,-balloonmsg=>"$messages[309]");
   # Footer
   my $ef114=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $bal3=$ef114->Checkbutton(-font=>$font,-relief=>'flat',-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[308],-onvalue=>1,-offvalue=>0, -variable => \$pdf_opt13, -command=>
   sub
   {
    $bal2->configure(-state=>'disabled');
    if ($pdf_opt13==1) 
    {
     $bal2->configure(-state=>'normal');
    }
   }
   )->pack(-side=>'top',-anchor=>'w');
   $bal2=$etl1f->Entry(-font=>$font,-relief=>'sunken',-borderwidth=>2,-background=>'white',-textvariable=>\$footer,-width=>"30")->pack(-side=>'top',-anchor=>'w',);
   $balloon->attach($bal2, -initwait=>0,-balloonmsg=>"$messages[310]");
   $balloon->attach($bal3, -initwait=>0,-balloonmsg=>"$messages[310]");
   my $ef10=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   $ef10->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[306],-onvalue=>1,-offvalue=>0, -variable => \$pdf_opt0)->pack(-expand=>1, -anchor=>'w');
   my $ef13=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   $ef13->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[288],-onvalue=>1,-offvalue=>0, -variable => \$pdf_opt1)->pack(-expand=>1, -anchor=>'w');
   my $ef14=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   $ef14->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[289],-onvalue=>1,-offvalue=>0, -variable => \$pdf_opt2)->pack(-expand=>1, -anchor=>'w');
   my $ef15=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $efo4;
   my $efo5;
   my $efo6;
   $ef15->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[290],-onvalue=>1,-offvalue=>0, -variable => \$pdf_opt3, -command=>
   sub
   {
    $efo4->configure(-state=>'disabled');
    $efo5->configure(-state=>'disabled');
    $efo6->configure(-state=>'disabled');
    if ($pdf_opt3==1) 
    {
     $efo4->configure(-state=>'active');
     $efo5->configure(-state=>'active');
     $efo6->configure(-state=>'active');
    }
   })->pack(-expand=>1, -anchor=>'w');
   my $ef1d=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   $efo4=$ef1d->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[300],-onvalue=>1,-offvalue=>0, -variable => \$pdf_opt10,-command=>
   sub
   {
    $efo5->configure(-state=>'disabled');
    $efo6->configure(-state=>'disabled');
    if ($pdf_opt10==1) 
    {
     $efo5->configure(-state=>'active');
     $efo6->configure(-state=>'active');
    }
   })->pack(-expand=>1, -anchor=>'w');
   my $ef1e=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   $efo5=$ef1e->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[301],-onvalue=>1,-offvalue=>0, -variable => \$pdf_opt11,-command=>
   sub
   {
    $efo6->configure(-state=>'disabled');
    if ($pdf_opt11==1) 
    {
     $efo6->configure(-state=>'active');
    }
   })->pack(-expand=>1, -anchor=>'w');
   my $ef16=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   $efo6=$ef16->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[291],-onvalue=>1,-offvalue=>0, -variable => \$pdf_opt4)->pack(-expand=>1, -anchor=>'w');
   my $ef17=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   $ef17->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[292],-onvalue=>1,-offvalue=>0, -variable => \$pdf_opt5)->pack(-expand=>1, -anchor=>'w');
   my $ef18=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top',-padx=>10);
   $ef18->Label(-state=>'active',-font=>$fontbold,-relief=>'flat',-text=>$messages[293])->pack(-side=>'left',-anchor=>'w');
   my $ef19=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   $ef19->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[294],-onvalue=>1,-offvalue=>0, -variable => \$pdf_opt6)->pack(-expand=>1, -anchor=>'w');
   my $ef1a=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   $ef1a->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[295],-onvalue=>1,-offvalue=>0, -variable => \$pdf_opt7)->pack(-expand=>1, -anchor=>'w');
   my $ef1b=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   $ef1b->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[296],-onvalue=>1,-offvalue=>0, -variable => \$pdf_opt8)->pack(-expand=>1, -anchor=>'w');
   my $etl1f3=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   $etl1f3->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text=>$messages[312],-onvalue=>2,-offvalue=>1, -variable => \$pdf_loops,-command=>
    sub
    {
    }
   )->pack(-expand=>1, -anchor=>'w');
   $etl1f3->Label(-relief=>'flat',-font=>$fontsmall,-text =>$messages[313])->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'bottom');
   my $ef1c=$etl1f1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $etl1f2l;
   my $etl1f2s;
   $ef1c->Checkbutton(-relief=>'flat',-font=>$font,-selectcolor=>$selectcolor,-background=>$menuback,-text => $messages[297],-onvalue=>1,-offvalue=>0, -variable => \$pdf_opt9,-command=>
   sub
   {
    $etl1f2l->configure(-state=>'disabled');
    $etl1f2s->configure(-state=>'disabled');
    if ($pdf_opt9==1) 
    {
     $etl1f2l->configure(-state=>'active');
     $etl1f2s->configure(-state=>'normal');
    }
   })->pack(-expand=>1, -anchor=>'w');
   my $etl1f2=$etl1f->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'bottom');
   $etl1f2l=$etl1f2->Label(-relief=>'flat',-font=>$font,-text =>$messages[302])->pack(-side=>'left');
   $etl1f2s=$etl1f2->Spinbox(qw/-from 0 -to 99 -width 2 -validate key/,-state=>'disabled',-font=>$font, -textvariable=>\$number_of_photos,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');

   # frame for Yes/No Buttons
   my $ef12a=$etl1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'bottom');
   #Fonts part
   my $ef220a=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef2210a=$ef220a->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef2210a->Label(-relief=>'flat',-font=>$font,-text =>$messages[304])->pack(-side=>'left');
   my $pef20a=$ef220a->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font13,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $document_title_font=$fontnames{$font13}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef220a->Spinbox(qw/-from 9 -to 48 -width 2 -validate key/,-font=>$font, -textvariable=>\$document_title_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef20a->insert("end", sort(keys %fontnames));
   my $ef12=$etl1->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'bottom');
   #Fonts part
   my $ef220=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef2210=$ef220->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef2210->Label(-relief=>'flat',-font=>$font,-text =>$messages[303])->pack(-side=>'left');
   my $pef20=$ef220->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font0,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $content_font=$fontnames{$font0}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef220->Spinbox(qw/-from 9 -to 24 -width 2 -validate key/,-font=>$font, -textvariable=>\$content_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef20->insert("end", sort(keys %fontnames));
   my $ef22=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef221=$ef22->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef221->Label(-relief=>'flat',-font=>$font,-text =>$messages[273])->pack(-side=>'left');
   my $pef2=$ef22->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font1,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $name_font=$fontnames{$font1}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef22->Spinbox(qw/-from 9 -to 24 -width 2 -validate key/,-font=>$font, -textvariable=>\$name_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef2->insert("end", sort(keys %fontnames));
   my $ef23=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef231=$ef23->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef231->Label(-relief=>'flat',-font=>$font,-text =>$messages[274])->pack(-side=>'left');
   my $pef3=$ef23->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font2,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $about_font=$fontnames{$font2}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef23->Spinbox(qw/-from 9 -to 24 -width 2 -validate key/,-font=>$font, -textvariable=>\$about_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef3->insert("end", sort(keys %fontnames));
   my $ef24=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef241=$ef24->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef241->Label(-relief=>'flat',-font=>$font,-text =>$messages[275])->pack(-side=>'left');
   my $pef4=$ef24->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font3,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $parents_font=$fontnames{$font3}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef24->Spinbox(qw/-from 9 -to 24 -width 2 -validate key/,-font=>$font, -textvariable=>\$parents_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef4->insert("end", sort(keys %fontnames));
   my $ef25=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef251=$ef25->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef251->Label(-relief=>'flat',-font=>$font,-text =>$messages[276])->pack(-side=>'left');
   my $pef5=$ef25->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font4,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $childs_title_font=$fontnames{$font4}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef25->Spinbox(qw/-from 9 -to 24 -width 2 -validate key/,-font=>$font, -textvariable=>\$childs_title_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef5->insert("end", sort(keys %fontnames));
   my $ef26=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef261=$ef26->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef261->Label(-relief=>'flat',-font=>$font,-text =>$messages[277])->pack(-side=>'left');
   my $pef6=$ef26->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font5,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $spouse_font=$fontnames{$font5}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef26->Spinbox(qw/-from 9 -to 24 -width 2 -validate key/,-font=>$font, -textvariable=>\$spouse_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef6->insert("end", sort(keys %fontnames));
   my $ef27=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef271=$ef27->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef271->Label(-relief=>'flat',-font=>$font,-text =>$messages[278])->pack(-side=>'left');
   my $pef7=$ef27->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font6,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $spouse_about_font=$fontnames{$font6}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef27->Spinbox(qw/-from 9 -to 24 -width 2 -validate key/,-font=>$font, -textvariable=>\$spouse_about_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef7->insert("end", sort(keys %fontnames));
   my $ef28=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef281=$ef28->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef281->Label(-relief=>'flat',-font=>$font,-text =>$messages[279])->pack(-side=>'left');
   my $pef8=$ef28->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font7,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $childs_font=$fontnames{$font7}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef28->Spinbox(qw/-from 9 -to 24 -width 2 -validate key/,-font=>$font, -textvariable=>\$childs_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef8->insert("end", sort(keys %fontnames));
   my $ef29=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef291=$ef29->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef291->Label(-relief=>'flat',-font=>$font,-text =>$messages[280])->pack(-side=>'left');
   my $pef9=$ef29->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font8,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $about_childs_font=$fontnames{$font8}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef29->Spinbox(qw/-from 9 -to 24 -width 2 -validate key/,-font=>$font, -textvariable=>\$about_childs_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef9->insert("end", sort(keys %fontnames));
   my $ef2a=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef2a1=$ef2a->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef2a1->Label(-relief=>'flat',-font=>$font,-text =>$messages[281])->pack(-side=>'left');
   my $pef10=$ef2a->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font9,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $text_title_font=$fontnames{$font9}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef2a->Spinbox(qw/-from 9 -to 24 -width 2 -validate key/,-font=>$font, -textvariable=>\$text_title_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef10->insert("end", sort(keys %fontnames));
   my $ef2b=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef2b1=$ef2b->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef2b1->Label(-relief=>'flat',-font=>$font,-text =>$messages[282])->pack(-side=>'left');
   my $pef11=$ef2b->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font10,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $text_font=$fontnames{$font10}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef2b->Spinbox(qw/-from 9 -to 24 -width 2 -validate key/,-font=>$font, -textvariable=>\$text_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef11->insert("end", sort(keys %fontnames));
   my $ef2c=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef2c1=$ef2c->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef2c1->Label(-relief=>'flat',-font=>$font,-text =>$messages[298])->pack(-side=>'left');
   my $pef12=$ef2c->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font11,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $text_font=$fontnames{$font11}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef2c->Spinbox(qw/-from 9 -to 24 -width 2 -validate key/,-font=>$font, -textvariable=>\$gallery_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef12->insert("end", sort(keys %fontnames));
   my $ef2d=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef2d1=$ef2d->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef2d1->Label(-relief=>'flat',-font=>$font,-text =>$messages[299])->pack(-side=>'left');
   my $pef13=$ef2d->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font12,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $text_font=$fontnames{$font12}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef2d->Spinbox(qw/-from 9 -to 24 -width 2 -validate key/,-font=>$font, -textvariable=>\$annot_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef13->insert("end", sort(keys %fontnames));
   my $ef220b=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid")->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'top');
   my $ef2210b=$ef220b->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>150)->pack(-expand=>1,-anchor=>'w',-side=>'left');
   $ef2210b->Label(-relief=>'flat',-font=>$font,-text =>$messages[307])->pack(-side=>'left');
   my $pef20b=$ef220b->BrowseEntry(-style=>'MSWin32',-state=>'readonly',-width=>15,-variable => \$font14,-font=>$font,-disabledforeground => '#000000', -disabledbackground => '#FFFFFF',
   -command=>sub
    {
     $footer_font=$fontnames{$font14}
    }
   )->pack(-side=>'left',-expand=>0);
   $ef220b->Spinbox(qw/-from 9 -to 24 -width 2 -validate key/,-font=>$font, -textvariable=>\$footer_fontsize,
        -validatecommand => sub { my ($proposed, $changes, $current, $index, $type) = @_;
        return not $proposed =~ m/[^\d]/g },)->pack(-side=>'left');
   $pef20b->insert("end", sort(keys %fontnames));
   # frame for Yes/No Buttons
   my $ef21=$etl2->Frame(-padx=>2,-pady=>2,-borderwidth=>0,-relief=>"solid",-width=>400)->pack(-fill=>'x',-expand=>0, -anchor=>'w',-side=>'bottom');
   # Yes/No Buttons
   $ef12->Button(-font=>$font,-relief=>'raised',-borderwidth=>2, -text => $messages[19], -command => sub # No
   {
    $epdf->withdraw;
    $epdf->destroy;
    $pdfgui=1;
   })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
   my $nb2b2=$ef12->Button(-font=>$font,-relief=>'raised',-borderwidth=>2, -text => $messages[18], -command => sub #yes
   {
    $epdf->withdraw;
    $epdf->destroy;
    $pdfgui=2;
   })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
   $ef21->Button(-font=>$font,-relief=>'raised',-borderwidth=>2, -text => $messages[19], -command => sub # No
   {
    $epdf->withdraw;
    $epdf->destroy;
    $pdfgui=1;
   })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
   my $nb2b21=$ef21->Button(-font=>$font,-relief=>'raised',-borderwidth=>2, -text => $messages[18], -command => sub #yes
   {
    $epdf->withdraw;
    $epdf->destroy;
    $pdfgui=2;
   })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
   $ef21->Button(-font=>$font,-relief=>'raised',-borderwidth=>2, -text => $messages[286], -command => sub #Reset to defaults
   {
    $document_title_fontsize=20;
    $footer_fontsize=14;
    $content_fontsize=14;
    $name_fontsize=18;
    $about_fontsize=14;
    $parents_fontsize=14;
    $childs_title_fontsize=14;
    $spouse_fontsize=14;
    $spouse_about_fontsize=13;
    $childs_fontsize=14;
    $about_childs_fontsize=13;
    $text_title_fontsize=14;
    $text_fontsize=13;
    $gallery_fontsize=14;
    $annot_fontsize=14;
    $font13=$fontnames[5];
    $font14=$fontnames[0];
    $font0=$fontnames[0];
    $font2=$fontnames[0];
    $font3=$fontnames[0];
    $font4=$fontnames[1];
    $font5=$fontnames[1];
    $font6=$fontnames[0];
    $font7=$fontnames[0];
    $font8=$fontnames[0];
    $font9=$fontnames[1];
    $font10=$fontnames[0];
    $font11=$fontnames[0];
    $font12=$fontnames[0];
    $document_title_font=$fontnames{$font13};
    $footer_font=$fontnames{$font14};
    $content_font=$fontnames{$font0};
    $name_font=$fontnames{$font1};
    $about_font=$fontnames{$font2};
    $parents_font=$fontnames{$font3};
    $childs_title_font=$fontnames{$font4};
    $spouse_font=$fontnames{$font5};
    $spouse_about_font=$fontnames{$font6};
    $childs_font=$fontnames{$font7};
    $about_childs_font=$fontnames{$font8};
    $text_title_font=$fontnames{$font9};
    $text_font=$fontnames{$font10};
    $gallery_font=$fontnames{$font11};
    $annot_font=$fontnames{$font12};
    $epdf->update;
   })->pack(-side=>"right",-expand=>"0",-anchor=>'s');
    $bal1->configure(-state=>'disabled');
    if ($pdf_opt12==1) 
    {
     $bal1->configure(-state=>'normal');
    }
    $bal2->configure(-state=>'disabled');
    if ($pdf_opt13==1) 
    {
     $bal2->configure(-state=>'normal');
    }
    $efo6->configure(-state=>'disabled');
    if ($pdf_opt11==1) 
    {
     $efo6->configure(-state=>'active');
    }
    $efo5->configure(-state=>'disabled');
    $efo6->configure(-state=>'disabled');
    if ($pdf_opt10==1) 
    {
     $efo5->configure(-state=>'active');
     $efo6->configure(-state=>'active');
    }
    $efo4->configure(-state=>'disabled');
    $efo5->configure(-state=>'disabled');
    $efo6->configure(-state=>'disabled');
    if ($pdf_opt3==1) 
    {
     $efo4->configure(-state=>'active');
     $efo5->configure(-state=>'active');
     $efo6->configure(-state=>'active');
    }
    $etl1f2l->configure(-state=>'disabled');
    $etl1f2s->configure(-state=>'disabled');
    if ($pdf_opt9==1) 
    {
     $etl1f2l->configure(-state=>'active');
     $etl1f2s->configure(-state=>'normal');
    }
   $nb2->pageconfigure('sn1',-raisecmd=>$nb2b2->focus);
   $nb2->pageconfigure('sn2',-raisecmd=>$nb2b21->focus);
   $epdf->waitVariable(\$pdfgui);
  }
  sub pdf_font #set font
  {
   $font_now=shift;
  }
  sub print_footer
  {
   if ($pdf_opt13==1)
   {
    my $f1=$font_now;
    my $f2=$pdf_fs;
    my $s=shift;my $f=$footer; $f=~s/\$page/$s/g;
    pdf_font($footer_font);
    $txt->font($font_now,$footer_fontsize);
    $txt->translate(50,20);
    $txt->text("$s");
    $txt->font($f1,$f2);
   }
  }
  sub page #set page
  {
   my $p=shift;
   $page = $pdf->page($p);
   $page->mediabox($pdf_w,$pdf_h);
   $txt=$page->text;
   $txt->font($font_now,$pdf_fs);
   $gfx=$page->gfx;
   print_footer($p);
   $cury=$pdf_maxy-30;
   $pdf_by=$cury;
   $cur_pic=0;
  }
  sub page_end  # test by bottom page was reached? If yes add new page
  {
   if ($cury<$bottom_page) {$pdf_page+=1;page($pdf_page)}
  }
  sub downfeed # scroll down cursor by interval*fontsize
  {
   my $d=shift; #interval
   $cury-=int($d*$pdf_fs*$pdf_l);
   page_end;
  }
  sub downfeed2 # scroll down cursor by interval*14
  {
   my $d=shift;
   $cury-=int($d*14*$pdf_l);
   page_end;
  }
  sub print2pdf  #print text to pdf
  {
   my $x=shift;  #X coord
   my $s=shift;  # text
   my $fs=shift; # fontsize
   if ($fs ne '') {$pdf_fs=$fs}
   $txt->font($font_now,$pdf_fs);
   $txt->fillcolor($pdf_fill);
   my $y=$cury-int($pdf_fs*$pdf_l);
   $txt->translate($x,$y);
   $txt->text("$s");
   $cury=$y;
   page_end;
  }
  sub link2pdf
  {
   my $x=shift;  # X coord
   my $s1=shift; # first test without link
   my $s=shift;  # linked text
   my $fs=shift; #fontsize
   my $l=shift;  # link var
   if ($fs ne '') {$pdf_fs=$fs}
   $txt->font($font_now,$pdf_fs);
   my $y=$cury;
   $txt->translate($x,$y);
   $txt->fillcolor($pdf_fill);
   $x+=$txt->text("$s1");
   $txt->fillcolor($pdf_url);
   my $ex=$txt->text("$s");
   my $an=$page->annotation;
   $an->rect($x,$cury+$pdf_fs,$ex+$x,$cury);
   $an->link('#indi'.$l);
   $gfx->strokecolor($pdf_url);
   $gfx->rectxy($x,$cury-2,$ex+$x,$cury-2);
   $gfx->stroke;
   $cury=$y;
   page_end;
  }
  sub hline2pdf #print horizontal line 
  {
   my $x=shift;      # X coord
   my $length=shift; # Length in pexels
   my $w=shift;      # width
   my $c=shift;      # color
   if ($w eq '') {$w=1}
   if ($c eq '') {$c='black'}
   $gfx->linewidth($w);
   $gfx->strokecolor($c);
   $gfx->move($length, $cury); #600 - length of hor.line
   $gfx->hline($x); # X pos of hor.line
   $gfx->stroke;
   $gfx->fill(1);
   $gfx->fillstroke;
  }
  sub image2pdf # print image
  {
   my $x=shift; # X coord
   my $y=shift; # Y coord (bottom of image)
   my $s=shift; # filename
   my $i=$pdf->image_png($s);
   $gfx->image($i,$x,$y,0.6);
   $gfx->stroke;
  }
  sub text2pdf # print text as text block with links and hyphenation
  {
   my $u;
   $pdf_bx=shift;  # X coord
   $pdf_by=shift;  # Y coord
   my $j=0;
   my $w=shift;    # Width of block
   my $fs=shift;   # fonsize
   $pdf_fs=$fs;
   my $text=shift; # Text
   my $abz=shift;  # if 1 then indent on begining of paragraph
   my $x=$pdf_bx;
   if ($abz==1) {$x+=$para_left;}
   $text=~s/\n/ \n /g;
   my @text=split(/ /,$text);
   $txt->fillcolor($pdf_fill);
   $txt->font($font_now,$fs);
   $txt->translate($x,$pdf_by);
   my $ffs=int($fs*0.5);
   my $tag_a=0;
   $href='';
   $pr_hl=0;
   my $end;
   my $an;
   foreach $u (@text) # get word by word
   {
    if ($u=~/^href\=\'(.+)\'\>(.*)$/)  # if word consist with href the get reference part($1) and text after tag($2)
    {
     $href=$1;
     $u=$2;
     if ($pr_hl==2) # link to person?
     {
      $href=~/^(.+)\.html$/;
      $indi_link=$1;
     }
     if ($pdf_opt7==1) # if can create link to person
     {
      if ($pr_hl==2) {$txt->fillcolor($pdf_url);}# link to person?
     }
     if ($pdf_opt8==1) # if can create link to www
     {
      if ($pr_hl==1) {$txt->fillcolor($pdf_url);} # link to www?
     }
    }
    if ($u=~/^(.*)\<\/a\>(.*)$/) # end of reference? if yes then geting end of reference($1) and text after reference($2)
    {
     $end=$2;
     if ($1 ne '')
     {
      $u=$1;
      $x+=$txt->text($u);
     }
     $hl_ex=$x;
     $tag_a=0; #end of tag
     if ($pr_hl==2) # link to person?
     {
      if ($pdf_opt7==1) # if can create link to person
      {
       $an=$page->annotation; #create link to individual
       $an->rect($hl_bx,$cury+$fs,$hl_ex,$cury);
       $an->link('#'.$indi_link);
       $indi_link='';
      }
     }
     sub url_underline
     {
      if ($pr_hl==1) # link to www? 
      {
       if ($pdf_opt8==1) # if can create link to www
       {
        $an=$page->annotation; #create link area to $href
        $an->url($href,-rect=>[$hl_bx,$cury+$fs,$hl_ex,$cury],-border=>[0,0,0]);
       }
      }
      if ($pdf_opt7==1) # if can create link to person
      {
       if ($pr_hl==2) # link to person?
       {
        $gfx->strokecolor($pdf_url); # create underline
        $gfx->rectxy($hl_bx,$cury-2,$hl_ex,$cury-2);
        $gfx->stroke;
       }
      }
      if ($pdf_opt8==1) # if can create link to www
      {
       if ($pr_hl==1) # link to www? 
       {
        $gfx->strokecolor($pdf_url); # create underline
        $gfx->rectxy($hl_bx,$cury-2,$hl_ex,$cury-2);
        $gfx->stroke;
       }
      }
     }
     url_underline; #create underline and link area
     $txt->fillcolor($pdf_fill); #normal text color
     if ($end ne '') # print endings part of text
     {
      $u=$end;
     }
     else
     {
      $x+=$txt->text(' '); # print space
      next
     }
    }
    if ($u=~/^(.*)\<a$/) # if begin of reference
    {
     if ($1 ne '') # print begin text part if present
     {
      $x+=$txt->text($1);
     }
     $hl_bx=$x; 
     $tag_a=1; # reference part begins
     next
    }
    if ($u=~/^name\=\'www\'$/) {$pr_hl=1;next} # set link to www
    if ($u=~/^name\=\'indi\'$/) 
    {
     $pr_hl=2;# set link to person
     next
    }
    if ($u=~/^name\=\'file\'$/) {$pr_hl=0;next} # drop references to local files
    if ($u eq "\n") #  \n Part
    {
     $pdf_by-=$fs;$x=$pdf_bx;
     if ($abz==1) {$x+=$para_left;}
     $cury-=$fs;
     page_end;
     $txt->translate($x,$pdf_by);
     next;
    }
    if (($x+length($u)*$ffs)>$w) # if text will be printed righter then $w border. $ffs average width of symbols
    {
     if ($tag_a == 1) # If link part runs
     {
      $hl_ex=$x;      # end of link in x coord
      if ($pr_hl==2) # if individual link
      {
       if ($pdf_opt7==1) # if can create link to person
       {
        $an=$page->annotation; # create link to person
        $an->rect($hl_bx,$cury+$fs,$hl_ex,$cury);
        $an->link('#'.$indi_link);
       }
      }
      url_underline;
     }
     $pdf_by-=$fs;$x=$pdf_bx;$cury-=$fs; # get new row coordinates
     page_end; # test end of page
     if ($tag_a == 1) # link part runs now?
     {
      $hl_bx=$x; # get begin of link in X coord
     }
     $txt->translate($pdf_bx,$pdf_by);
    }
    $x+=$txt->text($u.' '); # print text
   }
  }
  sub feedforpic # if portrait picture present then feed down text output
  {
   if ($pdf_opt6==1)
   {
    if ($cur_pic != 0) 
    {
     if (($cur_pic-$cury)<0)
     {
      page_end;
     }
     else
     {
      while (($cur_pic-$cury)<140)
      {
       downfeed(0.1);
      }
     }
    }
   }
  }
  setexport2pdf;
  if ($pdfgui != 2) {deletemessage;menustateon;return 1}
#  my %id=%people;
#  foreach my $v (keys %id) {$id{$v}=~s/people//}
#  my @id=values %id;
  my @sorted_id=sort { $family_name{$a}.' '.$first_name{$a}.' '.$second_name{$a} cmp $family_name{$b}.' '.$first_name{$b}.' '.$second_name{$b} } (@id_filtered);
  my $loop;
  my $tmp;
  my @pdf_person_page=();
  my %pdf_person_page_by_pib=();
  my @pdf_gal_page=();
  my $list_n=1;
  my %list_n=();
  for ($loop=1;$loop<=$pdf_loops;$loop++)
  {
   if ($loop==2) # if second stage then create pdf anew
   {
    undef $pdf;
    initfonts2pdf;$font_now=$fontu;
    $pdf_page=1;
    $list_n=1;
   }
# printing to pdf file
   page(1); 
   print_footer('1');
   my $maxi=@sorted_id;
   my $ni=1;
   my $nd;
   if ($pdf_opt12==1)
   {
    pdf_font($document_title_font);
    downfeed2(8);
    downfeed(1);text2pdf(70,$cury,520,$document_title_fontsize,$document_title,0);
    $pdf_page+=1;page($pdf_page);
   }
   if ($pdf_opt0==1)
   {
    pdf_font($content_font);
    print2pdf(170,$messages[303],$content_fontsize);
    foreach $i (@sorted_id)
    {
     my $pib=$family_name{$i}.' '.$first_name{$i}.' '.$second_name{$i};
     $pib=~s/\s+/ /g; $pib=~s/^\s//; $pib=~s/\s$//;
     $tmp='';
     if (($pdf_loops==2) && ($loop==2)) {$tmp=' ('.$pdf_person_page[$i].$messages[311].')'}
     if ($pdf_opt7==1) {downfeed(1);link2pdf(70,$list_n.'. ',$pib.$tmp,$content_fontsize,$i)} 
     else {print2pdf(70,$list_n.'. '.$pib.$tmp,$content_fontsize)}
     $list_n{$pib}=$list_n;
     $list_n+=1;
    }
    $pdf_page+=1;page($pdf_page)
   }
   foreach $i (@sorted_id)
   {
    drawmessage($messages[69].' '.$loop.':'.$i);
    if ($cury<190)
    {
     $pdf_page+=1;page($pdf_page)
    }
    my $f=father($i);
    my $m=mother($i);
    my $pib=$family_name{$i}.' '.$first_name{$i}.' '.$second_name{$i};
    $pib=~s/\s+/ /g; $pib=~s/^\s//; $pib=~s/\s$//;
    my $fpib='';
    if ($f != 0) 
    {
     $fpib=$family_name{$f}.' '.$first_name{$f}.' '.$second_name{$f};
     $fpib=~s/\s+/ /g; $fpib=~s/^(\d+\.)\s/\1 /; $fpib=~s/\s$//;$fpib=~s/^\s+//;
    }
    my $mpib='';
    if ($m != 0) 
    {
     $mpib=$family_name{$m}.' '.$first_name{$m}.' '.$second_name{$m};
     $mpib=~s/\s+/ /g; $mpib=~s/^(\d+\.)\s/\1 /; $mpib=~s/\s$//;$mpib=~s/^\s+//;
    }
    if ($pdf_opt6==1)
    {
     $cur_pic=$cury;
     if (($foto{$i} ne 'man') && ($foto{$i} ne 'woman')) 
     {
      my $icon=Image::Magick->new;
      $icon->Read(fn($projects.$projectname."/icons/".$foto{$i}));
      $icon->Write(fn("$tmpdir".'tmppdf.png'));undef $icon;
      image2pdf(420,$cury-120,$tmpdir.'tmppdf.png');
     }
     else
     {
      $gfx->linewidth(1);
      $gfx->rect(420,$cury-120,102,102);
      $gfx->stroke;
     }
    }
    pdf_font($name_font);
    hline2pdf(25,$pdf_maxx-25,2,'black');
    downfeed2(2);
    $nd=$pdf->named_destination('Dests','#indi'.$i);
    if (($pdf_loops==2) && ($loop==1)) {$pdf_person_page[$i]=$pdf_page;$pdf_person_page_by_pib{$pib}=$pdf_page}
    $nd->link($page);
    text2pdf(50,$cury,350,$name_fontsize,$list_n{$pib}.'. '.$pib,0);#Name
    if ($pdf_opt1==1)
    {
     pdf_font($about_font);
     downfeed(0.5);
     if ($sex{$i} eq 'man') {print2pdf(70,$messages[264].': '.$messages[265],$about_fontsize);} #sex if man
     if ($sex{$i} eq 'woman') {print2pdf(70,$messages[264].': '.$messages[266],$about_fontsize);} # sex if woman
     if ($birth_date{$i} ne '') {downfeed(1);text2pdf(70,$cury,350,$about_fontsize,$messages[271].': '.$birth_date{$i},0);} # birthday date
     if ($birth_place{$i} ne '') {downfeed(1);text2pdf(70,$cury,350,$about_fontsize,$messages[260].': '.$birth_place{$i},0);} # birthday place
     if ($death_date{$i} ne '') {downfeed(1);text2pdf(70,$cury,350,$about_fontsize,$messages[272].': '.$death_date{$i},0);} # death date
     if ($death_place{$i} ne '') {downfeed(1);text2pdf(70,$cury,350,$about_fontsize,$messages[261].': '.$death_place{$i},0);} # death place
     downfeed(0.5);
     if (($f != 0) || ($m !=0)) 
     {
      if ($pdf_opt6==1) {hline2pdf(50,400,1,'black')} else {hline2pdf(25,$pdf_maxx-25,1,'black')}
      downfeed2(0.25)
     }
    }
    if ($pdf_opt2==1)
    {
     pdf_font($parents_font);
     if ($f != 0) 
     {
      if ($pdf_opt7==1) {downfeed(1);link2pdf(70,$messages[102].': ',$fpib,$parents_fontsize,$f)} 
      else {print2pdf(70,$messages[102].': '.$fpib.' ('.$pdf_person_page_by_pib{$fpib}.' стор.'.')',$parents_fontsize)}
     } # father
     if ($m != 0) 
     {
      if ($pdf_opt7==1) {downfeed(1);link2pdf(70,$messages[103].': ',$mpib,$parents_fontsize,$m)} 
      else {print2pdf(70,$messages[103].': '.$mpib.' ('.$pdf_person_page_by_pib{$mpib}.' стор.'.')',$parents_fontsize)}
     } # mother
     downfeed(0.5);
    }
    if ($pdf_opt3==1)
    {
     my @spouses=();my %spousekey=();
     my $sp=0;
     my $j;
     my $f;
     foreach $f (keys %spouse)
     {
      $j=$spouse{$f};
      if (number1($j) == $i) {$spouses[$sp]=number2($j);$spousekey{$spouses[$sp]}=$f;$sp+=1}
      if (number2($j) == $i) {$spouses[$sp]=number1($j);$spousekey{$spouses[$sp]}=$f;$sp+=1}
     }
     if ($spouses[0] ne '') #if spouse present show title
     {
      if ($pdf_opt6==1) {hline2pdf(50,400,1,'black')} else {hline2pdf(25,$pdf_maxx-25,1,'black')}
      if ($sex{$i} eq 'man') {$sp=$messages[267]}
      if ($sex{$i} eq 'woman') {$sp=$messages[268]}
      pdf_font($childs_title_font);
      downfeed(0.25);
      print2pdf(50,$sp.'/'.$messages[104],$childs_title_fontsize);
      downfeed(0.75);
      if ($pdf_opt6==1) {hline2pdf(50,400,1,'black')} else {hline2pdf(25,$pdf_maxx-25,1,'black')}
      downfeed(0.25);
      my $k;
      foreach $k (@spouses)
      {
       my $spib='';
       $spib=$family_name{$k}.' '.$first_name{$k}.' '.$second_name{$k};
       $spib=~s/\s+/ /g; $spib=~s/^(\d+\.)\s/\1 /; $spib=~s/\s+$//; $spib=~s/^\s+//;
       pdf_font($spouse_font);
       downfeed(0.25);
       if ($pdf_opt7==1) {downfeed(1);link2pdf(70,'',$spib,$spouse_fontsize,$k)} 
       else {print2pdf(70,$spib.' ('.$pdf_person_page_by_pib{$spib}.' стор.'.')',$spouse_fontsize)}
       downfeed(0.25);
       if ($pdf_opt10==1)
       { 
        pdf_font($spouse_about_font);
        if ($marr_date{$spousekey{$k}} ne '')
        {
         downfeed(1);text2pdf(70,$cury,350,$spouse_about_fontsize,$messages[269].': '.$marr_date{$spousekey{$k}},0);
         downfeed(0.25);
        }
        if ($marr_place{$spousekey{$k}} ne '')
        {
         downfeed(1);text2pdf(70,$cury,350,$spouse_about_fontsize,$messages[270].': '.$marr_place{$spousekey{$k}},0);
         downfeed(0.25);
        }
       }
       if ($pdf_opt11==1)
       {
        my @skids=();
        my @skids2=();
        my $l;
        my $z;
        my $sk=0;
        if ($sex{$i} eq 'man') 
        {
         foreach $l (values %mother)
         {
          if (number2($l)==$k) {$skids[$sk]=number1($l);$sk+=1}
         }
         @skids2=();
         $sk=0;
         foreach $z (@skids)
         {
          foreach $l (values %father)
          {
           if ((number1($l)==$z) && (number2($l)==$i)) {$skids2[$sk]=number1($l);$sk+=1}
          }
         }
        }
        @skids=();
        $sk=0;
        if ($sex{$i} eq 'woman') 
        {
         foreach $l (values %father)
         {
          if (number2($l)==$k) {$skids[$sk]=number1($l);$sk+=1}
         }
         @skids2=();
         $sk=0;
         foreach $z (@skids)
         {
          foreach $l (values %mother)
          {
           if ((number1($l)==$z) && (number2($l)==$i)) {$skids2[$sk]=number1($l);$sk+=1}
          }
         }
        }
        if ($skids2[0] ne '')
        {
         pdf_font($childs_title_font);
         print2pdf(85,$messages[104],$childs_title_fontsize);
        }
        foreach $l (@skids2)
        {
         $z='';
         $z=$family_name{$l}.' '.$first_name{$l}.' '.$second_name{$l};
         $z=~s/\s+/ /g; $z=~s/^(\d+\.)\s/\1 /; $z=~s/\s+$//; $z=~s/^\s+//;
         pdf_font($childs_font);
         downfeed(0.5);
         if ($pdf_opt7==1) {downfeed(1);link2pdf(100,'',$z,$childs_fontsize,$l)} 
         else {downfeed(1);text2pdf(100,$cury,350,$childs_fontsize,$z.' ('.$pdf_person_page_by_pib{$z}.' стор.'.')',0)}
         if ($pdf_opt4==1)
         {
          pdf_font($about_childs_font);
          if ($birth_date{$l} ne '') {downfeed(1);text2pdf(100,$cury,350,$about_childs_fontsize,$messages[271].': '.$birth_date{$l},0);} # birthday date
          if ($death_date{$l} ne '') {downfeed(1);text2pdf(100,$cury,350,$about_childs_fontsize,$messages[272].': '.$death_date{$l},0);} # death date
         }
        }
        downfeed(0.5);
       }
      }
      downfeed2(1);
     }
    }
    if ($pdf_opt5==1)
    {
     if ($text{$i} ne '')
     {
      feedforpic;
      hline2pdf(50,$pdf_maxx-50,1,'black');
      pdf_font($text_title_font);
      downfeed(0.25);
      print2pdf(50,$messages[36],$text_title_fontsize);
      downfeed(0.5);
      hline2pdf(50,$pdf_maxx-50,1,'black');
      downfeed(1.5);
      pdf_font($text_font);
      text2pdf(70,$cury,490,$text_fontsize,$text{$i},1);
      downfeed(1);
     }
    }
    #end of person
    feedforpic;
    if ($pdf_opt9==1) # 
    {
     if ($gallery{$i}==1)
     {
      pdf_font($text_font);
      $txt->font($font_now,14);
      downfeed(1);
      if ($pdf_opt7==1)
      {
       $txt->fillcolor($pdf_url);
      }
      $txt->translate(50,$cury);
      $tmp='';
      if (($pdf_loops==2) && ($loop==2)) {$tmp=' ('.$pdf_gal_page[$i].$messages[311].')'}
      $x=$txt->text($messages[121].$tmp);# text of url to gallery
      if ($pdf_opt7==1)
      {
       my $an=$page->annotation; # url to gallery
       $an->rect(50,$cury+14,50+$x,$cury);
       $an->link('#gal'.$i);
       $gfx->strokecolor($pdf_url);
       $gfx->rectxy(50,$cury-2,50+$x,$cury-2); # url's underline
       $gfx->stroke;
      }
      downfeed(0.5);
     }
    }
    downfeed2(1);
    hline2pdf(25,$pdf_maxx-25,2,'black'); # end of person part
    if ($maxi>$ni) #if not last person the add new page
    {
     $pdf_page+=1;$ni+=1;
     page($pdf_page);
    }
   }
   if ($pdf_opt9==1) # if galleries enabled
   {
    my $sx;my $sy;
    my $pdf_photo_size=1000;
    my $coef=500/$pdf_photo_size;
    my $imgpdf;
    my $next_page_for_gal;
    foreach $i (sort { $a <=> $b } (keys %gallery)) #for all galleries
    {
     if ($gallery{$i} == 1) #if gallery present
     {
      open(F,'<:raw',fn($projects.$projectname.'/gallery/'.$i.'.gal'));
      my $k=1;
      my $image_file;
      $cury=$pdf_maxy-75;##
      $next_page_for_gal=1;
      while (<F>)
      {
       chomp($_);decode('utf8',$_);$image_file=$_;
       $pdf_page+=1;
 #      # if first page of gallery for this person then add destination of gallery reference
       my $pib=$family_name{$i}.' '.$first_name{$i}.' '.$second_name{$i};
       drawmessage($messages[69].' '.$loop.':'.$i.'-'.$k);
       my $annot=<F>;chomp($annot);$annot=decode('utf8',$annot);;
       my $icon=Image::Magick->new;
       $icon->Read(fn($image_file)); # open image file
       (my $x, my $y, my $dpi)=$icon->Get('columns','rows','density');$dpi=~/^(\d+)x/;$dpi=$1;
       my $resize=0;$sx=$x;$sy=$y;
       if ($y>=$x) # if Y size greateer then X
       {
        if (($y>500) && ($y<$pdf_photo_size)) {$resize=1;$sy=500;$sx=int(($sy/$y)*$x);} # if Y size between 500, $pdf_photo_size
        if ($y>=$pdf_photo_size) {$resize=1;$sy=$pdf_photo_size;$sx=int(($sy/$y)*$x);} # If greater than $pdf_photo_size
       }
       else        # if X size greateer or equal then Y
       {
        if (($x>500) && ($y<$pdf_photo_size)) {$resize=1;$sx=500;$sy=int(($sx/$x)*$y);} # if X size between 500, $pdf_photo_size
        if ($x>=$pdf_photo_size) {$resize=1;$sx=$pdf_photo_size;$sy=int(($sx/$x)*$y);} # If greater than $pdf_photo_size
       }
       if ($cury-int($sy*$coef)<100) {$next_page_for_gal=1}
       if ($next_page_for_gal==1)
       {
        page($pdf_page); # new page
        $cury=$pdf_maxy-75;##
        if ($k==1)
        {
         my $nd=$pdf->named_destination('Dests','#gal'.$i);
         $nd->link($page); $pdf_gal_page[$i]=$pdf_page;
        }
        $pib=~s/\s+/ /g; $pib=~s/^\s//; $pib=~s/\s$//;
        pdf_font($gallery_font);
        $tmp='';
        if (($pdf_loops==2) && ($loop==1)) {$tmp=$pdf_person_page[$i].$messages[311]}
        if ($pdf_opt7==1) {downfeed(1);link2pdf(50,$messages[23].' ',$pib,$gallery_fontsize,$i)}  # link to person's page
        else {print2pdf(50,$messages[23].' '.$pib.'('.$i.')',$gallery_fontsize)}
        $next_page_for_gal=0;
        downfeed(0.5);
       } 
       $icon->Set(Quality=>"75%");
       if ($resize==1) {$icon->Resize(width=>$sx,height=>$sy);} #resize picture
       $icon->Write(filename=>'png:'.fn("$tmpdir".'tmppdf.png')); #save as PNG
       undef $icon;
       $imgpdf=$pdf->image_png(fn("$tmpdir".'tmppdf.png')); #prepare picture to PDF
       if ($resize==1) # if picture resized
       {
        $cury-=int($sy*$coef)+10;##
        if ($y>=$x) 
        {
         $gfx->image($imgpdf,105,$cury,$coef); #print to pdf
        }
        else
        {
         $gfx->image($imgpdf,52,$cury,$coef); #print to pdf
        }
       }
       else # if picture not resized
       {
        $cury-=int($y*$coef)+10;##
        if ($y>=$x) 
        {
         $gfx->image($imgpdf,105,$cury,$coef);
        }
        else
        {
         $gfx->image($imgpdf,52,$cury,$coef);
        }
       }
       if ($debug==1) {print "$pib($i): $dpi ($x,$y) $resize ($sx,$sy) $coef\n";}
       $cury-=10;
       $gfx->stroke;
       pdf_font($annot_font);
       downfeed(1);text2pdf(50,$cury,520,$annot_fontsize,$annot,0);
       $k+=1;
       if ($number_of_photos>0) # if number of pictures is limited
       {
        if ($k>$number_of_photos) {last}
       }
       unlink(fn("$tmpdir".'tmppdf.png')); # delete tmp file
      } 
      close(F);
     }
    }
   }
   if (-f fn($file)) {unlink(fn($file))} # delete tmp file
   my @t=gmtime;$t[5]+=1900;$t[4]++;
   if ($t[4]<10) {$t[4]='0'.$t[4];}
   if ($t[3]<10) {$t[3]='0'.$t[3];}
   if ($t[2]<10) {$t[2]='0'.$t[2];}
   if ($t[1]<10) {$t[1]='0'.$t[1];}
   if ($t[0]<10) {$t[0]='0'.$t[0];}
   my $av2=$av;$av2=~s/\n/ /g;
   my $op2;
   if ($op ne '') 
   {
    $op2=$op;$op2=~s/\n/ /g;
   }
   else
   {
    $op2=$document_title
   }
   $pdf->info(
         'Author'       => $av2,
         'CreationDate' => "D:$t[5]$t[4]$t[3]$t[2]$t[1]$t[0]+00'$t[1]'",
         'ModDate'      => "D:$t[5]$t[4]$t[3]$t[2]$t[1]$t[0]+00'$t[1]'",
         'Creator'      => "rodovid (http://sourceforge.net/projects/rodovid/)",
         'Producer'     => "PDF::API2",
         'Title'        => $op2,
         'Subject'      => "Rodovid",
         'Keywords'     => "rodovid genealogy"
     );  $pdf->saveas(fn($file));
   $pdf->end;

  } 
  undef $pdf;
  undef $page;
  undef $txt;
  undef $gfx;
  undef $font_now;
  undef $fontu;
  undef $fontub;
  undef $fontui;
  undef $fontubi;
  undef $fontf;
  undef $fontfb;
  initfonts2pdf;
  deletemessage();
 }
 }
 menustateon;
}
our $filterwait;
sub filterselect
{
 my $s;
 my %id=%people;
 foreach my $v (keys %id) {$id{$v}=~s/people//}
 my @id=values %id;
 my $i=0;
 my $k;
 foreach my $v (@id)
 {
  my $s="$family_name{$v} $first_name{$v} $second_name{$v} $birth_place{$v} $birth_date{$v} $death_place{$v} $death_date{$v} $k $tags{$v}";
  if ($s=~/$filter/i) {$id_filtered[$i]=$v;$i+=1;}
 }
 $filterwait=1;
}
sub filter #filter person by regexp
{
 @id_filtered=();
 menustateoff;
 my $tln2=createmw($messages[315]);
 $mw{$tln2}->bind('<Destroy>'=>sub
 {
  menustateon;
 });
 $sel='';
 getscreensize;
 my $x=$screenx;
 my $y=$screeny;
 my $k;
 my $find='';
 my $finded=0;
 $filterwait=0;
 $no_persons=1;
 setgeometry3(550,250,$tln2);
 $mw{$tln2}->resizable(1,1);
 $mw{$tln2}->deiconify();
 $mw{$tln2}->raise();
 $mw{$tln2}->bind('<KeyPress-Escape>',sub
 {
  $mw{$tln2}->destroy;
 });
 my $ftln=$mw{$tln2}->Frame(-borderwidth=>"0",-relief=>"solid", -height=>'40',-padx=>0,-pady=>0)->pack(-side=>'top',-fill=>'x',-expand=>'no',-anchor=>'s');
 my $ftln2=$mw{$tln2}->Frame(-borderwidth=>"0",-relief=>"solid",-padx=>0,-pady=>0)->pack(-side=>'top',-fill=>'both',-expand=>'yes',-anchor=>'s');
 my $ftln3=$mw{$tln2}->Frame(-borderwidth=>"0",-relief=>"solid", -height=>'40',-padx=>0,-pady=>0)->pack(-side=>'top',-fill=>'x',-expand=>'no',-anchor=>'s');
 $ftln->Label(-font=>$fontbold{$tln2},-relief=>'flat',-text=>$messages[316])->pack(-side=>"left",-expand=>"0",-anchor=>"nw");
 my $ent=$ftln->Entry(-relief=>'sunken',-background=>'white',-borderwidth=>2,-font=>$font{$tln2},-textvariable=>\$find,-width=>"37")->pack(-side=>"left",-expand=>'0',-anchor=>"nw");
 sub list
 {
  $finded=0;
  $lbf->delete(0,'end');
  foreach $k (keys %people)
  {
   my $s="$family_name{$k} $first_name{$k} $second_name{$k} $birth_place{$k} $birth_date{$k} $death_place{$k} $death_date{$k} $k $tags{$k}";
   my $s2="$family_name{$k} $first_name{$k} $second_name{$k} (ID:$k)";
   if ($s=~/$find/i) 
   {
    $lbf->insert('end',$s2);
    $finded=1;
   }
  }
  if ($finded==0) {$lbf->insert('end',$messages[79]);}
 }
 $ftln->Button(-relief=>'raised',-borderwidth=>2, -image => sizePhoto($tln2,fn($workfolder.'graphics/find.png')), -command => sub
 {
  list;
 })->pack(-side=>"left",-expand=>'0',-anchor=>"nw");
 $ent->bind('<KeyPress-Return>'=>sub
 {
  list;
 });
 $ent->focus;
 $lbf=$ftln2->Scrolled("Listbox", -font=>$font{$tln2},-scrollbars => 'oe',-selectmode => "single",-background=>'white')->pack(-fill=>'both',-expand=>'yes');
 $lbf->delete(0,'end');
 foreach $k (keys %people)
 {
  my $s2="$family_name{$k} $first_name{$k} $second_name{$k} (ID:$k)";
  $lbf->insert('end',$s2);
 }
 $ftln3->Button(-borderwidth=>2,-relief=>'raised',-font=>$font{$tln2}, -text => $messages[18], -command => sub
 {
  $filter=$find;
  filterselect;
  $finded=0;
  $mw{$tln2}->destroy;
  my $nof=@id_filtered;
  $no_persons=0;
  if ($nof<1) {MyMessageBox($messages[317],'ok','info');$no_persons=1};
 })->pack(-side=>'top',-expand=>'1',-anchor=>'e');
 $mw{$tln2}->waitVariable(\$filterwait);
}
