3
# Copyright (C) 2006-2012 Boris Veytsman & Leila Akhmadeeva
5
# This program is free software; you can redistribute it and/or modify
6
# it under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 2 of the License, or
8
# (at your option) any later version.
10
# This program is distributed in the hope that it will be useful,
11
# but WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
15
# You should have received a copy of the GNU General Public License
16
# along with this program; if not, write to the Free Software
17
# Foundation, Inc., 59 Temple Place - Suite 330,
18
# Boston, MA 02111-1307, USA.
25
pedigree - create a TeX file for pedigree from a csv file
29
B<pedigree> [-c I<configuration_file>] [-d] [-o I<output_file>] [-s I<start_id>] I<input_file>
35
The program converts a comma separated I<input_file> into a TeX file
42
=item B<-c> I<configuration_file>
44
The configuration file to read along with the system-wide and user's
51
=item B<-o> -I<output_file>
53
The ouput file instead of I<input_file.tex>
55
=item B<-s> -I<start_id>
57
If this option is selected, the pedigree is constructed starting from
58
the node with the Id i<start_id>. Otherwise it is started from the
61
This option allows to create pedigrees with multiple probands or absent
62
probands, or show people who are not proband's relatives.
66
Print version information
74
=item B</etc/pedigree.cfg>
76
Global configuration file
78
=item B<$HOME/.pedigreerc>
80
User configuration file
86
The manual distributed with this program describes the format of the
87
configuration file and the input file.
89
The library functions are described in Pedigree::Language(3),
90
Pedigree::Parser(3), Pedigree::Node(3), Pedigree::PersonNode(3),
91
Pedigree::MarriageNode(3), Pedigree::Area(3).
95
Boris Veytsman, Leila Akhmadeeva, 2006-2012
101
#########################################################
102
# Packages and Options #
103
#########################################################
106
use vars qw($opt_c $opt_d $opt_o $opt_s $opt_v);
108
our $TLCONF; # TL config file
109
our $TLCONFLOCAL; # TL local config file
112
# find files relative to our installed location within TeX Live
113
chomp(my $TLMaster = `kpsewhich -var-value=SELFAUTOPARENT`); # TL root
114
if (length($TLMaster)) {
115
unshift @INC, "$TLMaster/texmf-dist/scripts/pedigree-perl";
116
$TLCONF = "$TLMaster/texmf-config/pedigree/pedigree.cfg";
117
chomp($TLCONFLOCAL = `kpsewhich -var-value=TEXMFLOCAL`);
118
$TLCONFLOCAL .= "/pedigree/pedigree.cfg";
126
#########################################################
127
# Options Reading and Global Variables #
128
#########################################################
130
my $USAGE="Usage: $0 [-c configuration_file] [-d] [-o output_file] [-s start_id] input_file\n";
132
$0 Version 1.0, April 2012
134
Copyright (C) 2006-2012 Boris Veytsman & Leila Akhmadeeva
136
This program is free software; you can redistribute it and/or modify
137
it under the terms of the GNU General Public License as published by
138
the Free Software Foundation; either version 2 of the License, or
139
(at your option) any later version.
141
This program is distributed in the hope that it will be useful,
142
but WITHOUT ANY WARRANTY; without even the implied warranty of
143
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
144
GNU General Public License for more details.
146
You should have received a copy of the GNU General Public License
147
along with this program; if not, write to the Free Software
148
Foundation, Inc., 59 Temple Place - Suite 330,
151
my $GLOBALCONF="/etc/pedigree.cfg";
153
my $USERCONF="$ENV{HOME}/.pedigreerc";
156
our $IN = new FileHandle;
157
our $OUT = new FileHandle;
159
getopts('c:do:s:v') or die $USAGE;
165
our $DEBUG = $opt_d ||0;
167
if (scalar @ARGV != 1) {
171
our $start_id = $opt_s;
173
#########################################################
175
#########################################################
178
if ($ARGV[0] eq '-') {
179
$IN->fdopen(fileno(STDIN),"r");
181
$IN->open($ARGV[0], "r") or die "Cannot read from $ARGV[0]\n";
184
my $outfile=$ARGV[0];
188
$outfile =~ s/\.[^\.]*$/.tex/;
190
if ($outfile eq '-') {
191
$OUT->fdopen(fileno(STDOUT),"w");
193
$OUT->open($outfile, "w") or die "Cannot write to $outfile\n";
196
#########################################################
198
#########################################################
201
# First, the defaults. Even if we do not find any
202
# configuration file, these will work.
207
# Do we want to have a full LaTeX file or just a fragment?
212
# What kind of document do we want
214
# our $documentheader='\documentclass[landscape]{article}';
215
our $documentheader='\documentclass{article}';
218
# Define additional packages here
220
# our $addtopreamble=<<END;
221
# \\usepackage{graphics}
223
our $addtopreamble=<<END;
230
# Do we want to print a legend?
235
# Fields to include in the legend. Delete Name for privacy
238
our @fieldsforlegend = qw(Name DoB AgeAtDeath Comment);
241
# Fields to put at the node. Delete Name for privacy
244
our @fieldsforchart = qw(Name);
249
# our $language="russian";
250
our $language="english";
253
# Override the encoding
255
# our $encoding="koi8-r";
267
our $belowtextfont='\small';
268
our $abovetextfont='\scriptsize';
271
# Distances between nodes (in cm)
277
# Maximal width and height of the pedigree in cm.
278
# Set this to 0 to switch off scaling
284
# Whether to rotate the page. The values are 'yes', 'no' and 'maybe'
285
# If 'maybe' is chosen, the pedigree is rotated if it allows better
288
our $rotate = 'maybe';
291
# Read the global configuration file(s)
293
foreach my $conffile ($GLOBALCONF, $TLCONF, $TLCONFLOCAL) {
296
print STDERR "Reading global configuration file $conffile\n";
301
print STDERR "Cannot find global configuration file $conffile; going without it\n";
307
# Read the user configuration file
311
print STDERR "Reading user configuration file $USERCONF\n";
316
print STDERR "Cannot find user configuration file $USERCONF; going without it\n";
321
# Read the option configuration file
326
print STDERR "Reading optional configuration file $opt_c\n";
330
die "Cannot find $opt_c\n";
334
#########################################################
336
#########################################################
338
my $lang = new Pedigree::Language($language, $encoding);
340
my $parser = new Pedigree::Parser($_,$lang);
343
#########################################################
345
#########################################################
348
my $node = Pedigree->MakeNode($parser->Parse($_));
351
if ($start_id eq $node->Id()) {
354
print STDERR "Found start: ", $start->Id(), "\n";
358
if ($node->isProband()) {
360
print STDERR "Two probands? I got ", $start->Id(),
361
" and ", $node->Id(), "\n";
365
print STDERR "Found proband: ", $start->Id(), "\n";
373
die "Cannot find the start!\n";
376
#########################################################
378
#########################################################
383
$start->CheckAllParents();
387
# The root is the root of the tree to which the proband
391
my ($root, undef)=@{$start->FindRoot(0)};
393
print STDERR "Root: ", $root->Id(), "\n";
397
# Calculate relative coordinates
404
# Calculate the absolute coordinates
406
$root->CalcAbsCoor(0,0);
409
# Check for consanguinic marriages
411
$root->AddConsanguinicMarriages();
416
$root->AddTwins($ydist);
421
my ($xmin, $ymin, $xmax, $ymax) = @{$root->SetFrame($xdist, $ydist)};
425
#########################################################
427
#########################################################
430
printheader($OUT,$lang,$addtopreamble);
433
#########################################################
434
# Calculate scale and check whether to rotate #
435
#########################################################
438
my $scaleRotated = 1;
440
if ($maxH && $maxW) {
441
if ($maxH/($ymax-$ymin) < $scale) {
442
$scale = $maxH/($ymax-$ymin);
444
if ($maxW/($xmax-$xmin) < $scale) {
445
$scale = $maxW/($xmax-$xmin);
447
if ($maxW/($ymax-$ymin) < $scaleRotated) {
448
$scaleRotated = $maxW/($ymax-$ymin);
450
if ($maxH/($xmax-$xmin) < $scaleRotated) {
451
$scaleRotated = $maxH/($xmax-$xmin);
455
my $doRotate = ($rotate =~ /yes/i) || (($rotate =~ /maybe/i) &&
456
($scaleRotated > $scale));
458
#########################################################
459
# Printing pspicture #
460
#########################################################
466
$descarmA *= $scaleRotated;
467
$pre="\\rotatebox{90}{%\n\\psset{descarmA=$descarmA}%\n";
468
if ($scaleRotated<1) {
469
$pre .= '\psset{unit='.$scaleRotated.'}%'."\n";
473
$pre="{%\n\\psset{descarmA=$descarmA}%\n";
475
$pre .= '{\psset{unit='.$scale.'}%'."\n";
481
print $OUT '\begin{pspicture}',"($xmin,$ymin)($xmax,$ymax)\n";
483
print $OUT $root->DrawAll($xdist, $ydist, $belowtextfont,
484
$abovetextfont, @fieldsforchart);
486
print $OUT '\end{pspicture}%',"\n";
490
#########################################################
492
#########################################################
496
print $OUT $root->PrintAllLegends($lang, @fieldsforlegend);
499
#########################################################
501
#########################################################
508
#########################################################
510
#########################################################
514
#########################################################
516
#########################################################
519
# Printing headers & footers
523
my ($OUT,$lang,$addtopreamble)=@_;
526
\\usepackage{pst-pdgr}
529
print $OUT $lang->Header;
540
print $OUT "\\end{document}\n";
added
removed
texk/texlive/linked_scripts/pedigree-perl/pedigree.pl
