diff options
Diffstat (limited to 'Master')
73 files changed, 8835 insertions, 5 deletions
diff --git a/Master/bin/alpha-linux/pedigree b/Master/bin/alpha-linux/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/alpha-linux/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/amd64-freebsd/pedigree b/Master/bin/amd64-freebsd/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/amd64-freebsd/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/amd64-kfreebsd/pedigree b/Master/bin/amd64-kfreebsd/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/amd64-kfreebsd/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/i386-cygwin/pedigree b/Master/bin/i386-cygwin/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/i386-cygwin/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/i386-freebsd/pedigree b/Master/bin/i386-freebsd/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/i386-freebsd/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/i386-kfreebsd/pedigree b/Master/bin/i386-kfreebsd/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/i386-kfreebsd/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/i386-linux/pedigree b/Master/bin/i386-linux/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/i386-linux/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/i386-netbsd/pedigree b/Master/bin/i386-netbsd/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/i386-netbsd/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/i386-solaris/pedigree b/Master/bin/i386-solaris/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/i386-solaris/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/mips-irix/pedigree b/Master/bin/mips-irix/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/mips-irix/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/powerpc-aix/pedigree b/Master/bin/powerpc-aix/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/powerpc-aix/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/powerpc-linux/pedigree b/Master/bin/powerpc-linux/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/powerpc-linux/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/sparc-linux/pedigree b/Master/bin/sparc-linux/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/sparc-linux/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/sparc-solaris/pedigree b/Master/bin/sparc-solaris/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/sparc-solaris/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/universal-darwin/pedigree b/Master/bin/universal-darwin/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/universal-darwin/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/win32/pedigree.exe b/Master/bin/win32/pedigree.exe Binary files differnew file mode 100755 index 00000000000..5777d90a17a --- /dev/null +++ b/Master/bin/win32/pedigree.exe diff --git a/Master/bin/x86_64-darwin/pedigree b/Master/bin/x86_64-darwin/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/x86_64-darwin/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/x86_64-linux/pedigree b/Master/bin/x86_64-linux/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/x86_64-linux/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/bin/x86_64-solaris/pedigree b/Master/bin/x86_64-solaris/pedigree new file mode 120000 index 00000000000..984abe00ccf --- /dev/null +++ b/Master/bin/x86_64-solaris/pedigree @@ -0,0 +1 @@ +../../texmf-dist/scripts/pedigree-perl/pedigree.pl
\ No newline at end of file diff --git a/Master/texmf-dist/doc/support/pedigree-perl/LICENSE b/Master/texmf-dist/doc/support/pedigree-perl/LICENSE new file mode 100644 index 00000000000..f90922eea38 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/LICENSE @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + <signature of Ty Coon>, 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. diff --git a/Master/texmf-dist/doc/support/pedigree-perl/Makefile b/Master/texmf-dist/doc/support/pedigree-perl/Makefile new file mode 100644 index 00000000000..446d533238e --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/Makefile @@ -0,0 +1,57 @@ +# +# Makefile for pedigree +# $Id: Makefile,v 2.2 2007-07-29 19:52:51 boris Exp $ +# +# This file is in public domain +# + +PREFIX = /usr/local + +PERLSCRIPTS=pedigree.pl + +PERLLIBS = \ + Pedigree.pm + +MANPAGES1=${PERLSCRIPTS:%.pl=%.1} +MANPAGES3=${PERLLIBS:%.pm=%.3} + + +all: man + cd Pedigree; ${MAKE} $@ + +man: ${MANPAGES1} ${MANPAGES3} + +docs: + cd doc; ${MAKE} all + +install: all + install pedigree.pl $(PREFIX)/bin/pedigree + mkdir -p $(PREFIX)/lib/site_perl + install -m 644 ${PERLLIBS} $(PREFIX)/lib/site_perl + cd Pedigree; ${MAKE} $@ + +installman: + install -m 644 pedigree.1 $(PREFIX)/man/man1 + for x in ${MANPAGES3}; do install -m 644 $$x $(PREFIX)/man/man3/$$x; done + cd Pedigree; ${MAKE} $@ + +%.1: %.pl + pod2man --section=1 -n $* -s 1 $< $@ + +%.3: %.pm + pod2man --section=3 -n $* -s 3 $< $@ + +clean: + cd doc; ${MAKE} $@ + cd Pedigree; ${MAKE} $@ + +distclean: clean + $(RM) ${MANPAGES1} ${MANPAGES3} + cd doc; ${MAKE} $@ + cd Pedigree; ${MAKE} $@ + +# +# Archive for the distribution. Includes typeset documentation and man pages +# +archive: all docs clean + tar -czvf pedigree.tgz --exclude '*~' --exclude '*.tgz' --exclude CVS . diff --git a/Master/texmf-dist/doc/support/pedigree-perl/NEWS b/Master/texmf-dist/doc/support/pedigree-perl/NEWS new file mode 100644 index 00000000000..3e8d5ad7b22 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/NEWS @@ -0,0 +1,21 @@ +pedigree NEWS: History of user interface changes + +Changes in v0.4, 2012/03/15 + +* Added TeXLive compatibility + +Changes in v0.3, 2007/07/31 + +* Added support for twins, infertility, abortions + +* Added support for multiple probands + +* Added (limited) support for consanguinic unions + +* Automatic scaling and rotation of large charts + +* Added support for additional node information on the chart + +* INCOMPATIBLE CHANGE: requires pst-pdgr v0.3 or later. + +This file is in public domain
\ No newline at end of file diff --git a/Master/texmf-dist/doc/support/pedigree-perl/Pedigree.3 b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree.3 new file mode 100644 index 00000000000..bde96a049a1 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree.3 @@ -0,0 +1,166 @@ +.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32 +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Pedigree 3" +.TH Pedigree 3 "2007-07-09" "perl v5.8.8" "User Contributed Perl Documentation" +.SH "NAME" +Pedigree \- the main library for Pedigree. +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +use Pedigree; +.PP +$node = Pedigree\->MakeNode($params); +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +This is the main package for pedigree construction. It calls other +libraries in the Pedigree:: family +.IP "\fBMakeNode\fR(\fI$params\fR);" 4 +.IX Item "MakeNode($params);" +Construct a new node from the given parameters. Check what kind of node +should we construct. +.SH "ENVIRONMENT" +.IX Header "ENVIRONMENT" +The calling program should define \fB$main::DEBUG\fR and set it to 0 +or 1. +.SH "SEE ALSO" +.IX Header "SEE ALSO" +\&\fIpedigree\fR\|(1), +\&\fIPedigree::AbortionNode\fR\|(3), +\&\fIPedigree::Area\fR\|(3), +\&\fIPedigree::ChildlessNode\fR\|(3), +\&\fIPedigree::Language\fR\|(3), +\&\fIPedigree::MarriageNode\fR\|(3), +\&\fIPedigree::Node\fR\|(3), +\&\fIPedigree::Parser\fR\|(3), +\&\fIPedigree::PersonNode\fR\|(3), +\&\fIPedigree::TwinsNode\fR\|(3), +.SH "AUTHOR" +.IX Header "AUTHOR" +Boris Veytsman, Leila Akhmadeeva, 2007 diff --git a/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/AbortionNode.3 b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/AbortionNode.3 new file mode 100644 index 00000000000..3ae47c203b9 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/AbortionNode.3 @@ -0,0 +1,167 @@ +.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32 +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Pedigree::AbortionNode 3" +.TH Pedigree::AbortionNode 3 "2007-07-22" "perl v5.8.8" "User Contributed Perl Documentation" +.SH "NAME" +Pedigree::AbortionNode \- an abortion in a pedigree +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +use Pedigree::AbortionNode; +.PP +$node = new Pedigree::AbortionNode(\fI%params\fR); +.PP +$node\->DrawNode(\fI$xidst\fR, \fI$ydist\fR, \fI$belowtextfont\fR, \fI$abovetextfont\fR, +\&\fI@fieldsfornode\fR); +.PP +$node\->PrintLegend(\fI$land\fR, \fI@fields\fR); +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +This package contains data about an abortion. Abortion is like a person, +but it cannot have kids, and it is drawn differently +.IP "\fBDrawNode\fR(\fI$xdist\fR, \fI$ydist\fR, \fI$belowtextfont\fR, \fI$abovetextfont\fR, \fI@fieldsfornode\fR);" 4 +.IX Item "DrawNode($xdist, $ydist, $belowtextfont, $abovetextfont, @fieldsfornode);" +Output the command to draw this node. The parameters are +distances between the nodes (in cm) and fields for abovetext. +.IP "\fBPrintLegend\fR(\fI$lang\fR, \fI@fields\fR);" 4 +.IX Item "PrintLegend($lang, @fields);" +Print the legend for the given node, including \fI@fields\fR in the given +language \fI$lang\fR, and excluding the fields, that have no meaning for +this node. +.SH "ENVIRONMENT" +.IX Header "ENVIRONMENT" +The calling program should define \fB$main::DEBUG\fR and set it to 0 +or 1. +.SH "SEE ALSO" +.IX Header "SEE ALSO" +\&\fIpedigree\fR\|(1), \fIPedigree\fR\|(3) +.SH "AUTHOR" +.IX Header "AUTHOR" +Boris Veytsman, Leila Akhmadeeva, 2007 diff --git a/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Area.3 b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Area.3 new file mode 100644 index 00000000000..9e58f6b46c9 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Area.3 @@ -0,0 +1,233 @@ +.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32 +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Pedigree::Area 3" +.TH Pedigree::Area 3 "2007-07-08" "perl v5.8.8" "User Contributed Perl Documentation" +.SH "NAME" +Pedigree::Area \- Calculate the area taken by a tree or a clump +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +use Pedigree::Area; +.PP +$area = new Pedigree::Area($node); +.PP +$Ymin=$area\->\fIGetYmin()\fR; +.PP +$area\->SetYmin($Ymin); +.PP +$Ymax=$area\->\fIGetYmax()\fR; +.PP +$area\->SetYmax($Ymax); +.PP +$Xmin=$area\->GetXmin($y); +.PP +$area\->SetXmin($y,$x); +.PP +$Xmax=$area\->GetXmax($y); +.PP +$area\->SetXmax($y,$x); +.PP +$area\->AddRight($otherarea); +.PP +$area\->AddLeft($otherarea); +.PP +$rootnode=$area\->\fIGetRootNode()\fR; +.PP +$area\->MoveLowerLayers($x); +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +The algorithm of \fIpedigree\fR\|(1) uses the notion of area: a part of +a picture taken by a tree or a clump. This package implements this +notion. +.PP +Each Area has \fBrootnode\fR \- the reference node for all calculations. +All distances are calculated as relative to the coordinates of the +\&\fBrootnode\fR. +.PP +The units are distances between the nodes in X and Y direction. The +Y axis is \fIdownward\fR: the earlier generations have smaller Y +coordinates. +.IP "\fBnew\fR(\fI$rootnode\fR);" 4 +.IX Item "new($rootnode);" +Construct a new area around the given rootnode +.IP "\fBGetYmin\fR();" 4 +.IX Item "GetYmin();" +Get the lower bound of the area. +.IP "\fBSetYmin\fR(\fI$y\fR);" 4 +.IX Item "SetYmin($y);" +Set the lower bound of the area. +.IP "\fBGetYmax\fR();" 4 +.IX Item "GetYmax();" +Get the upper bound of the area. +.IP "\fBSetYmax\fR(\fI$y\fR);" 4 +.IX Item "SetYmax($y);" +Set the upper bound of the area. +.IP "\fBGetXmin\fR(\fI$y\fR);" 4 +.IX Item "GetXmin($y);" +Get the minimal X coordinate of the area on the level Y. +.ie n .IP "\fBSetXmin\fR(\fI$y, \fI$x\fI\fR);" 4 +.el .IP "\fBSetXmin\fR(\fI$y, \f(CI$x\fI\fR);" 4 +.IX Item "SetXmin($y, $x);" +Set the minimal X coordinate of the area on the level Y. +.IP "\fBGetXmax\fR(\fI$y\fR);" 4 +.IX Item "GetXmax($y);" +Get the maximal X coordinate of the area the the level Y. +.ie n .IP "\fBSetXmax\fR(\fI$y, \fI$x\fI\fR);" 4 +.el .IP "\fBSetXmax\fR(\fI$y, \f(CI$x\fI\fR);" 4 +.IX Item "SetXmax($y, $x);" +Set the maximal X coordinate of the area the the level Y. +.IP "\fBAddRight\fR(\fI$otherarea\fR);" 4 +.IX Item "AddRight($otherarea);" +Add the new area \fI$otherarea\fR to the given area at the right. The +\&\*(L"other area\*(R" should have a root node that is relative to our root +node. The relative Y of the other root node is used, the relative +X is set. +.IP "\fBAddLeft\fR(\fI$otherarea\fR);" 4 +.IX Item "AddLeft($otherarea);" +Add the new area \fI$otherarea\fR to the given area at the left. The +\&\*(L"other area\*(R" should have a root node that is relative to our root +node. The relative Y of the other root node is used, the relative +X is set. +.IP "\fBGetRootNode\fR();" 4 +.IX Item "GetRootNode();" +Return the root node of the area. +.IP "\fBMoveLowerLayers\fR(\fI$x\fR);" 4 +.IX Item "MoveLowerLayers($x);" +Shift the lower layers (>0) of the area in the X direction by \fI$x\fR +.SH "ENVIRONMENT" +.IX Header "ENVIRONMENT" +The calling program should define \fB$main::DEBUG\fR and set it to 0 +or 1. +.SH "SEE ALSO" +.IX Header "SEE ALSO" +\&\fIpedigree\fR\|(1), \fIPedigree\fR\|(3) +.SH "AUTHOR" +.IX Header "AUTHOR" +Boris Veytsman, Leila Akhmadeeva, 2006, 2007 diff --git a/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/ChildlessNode.3 b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/ChildlessNode.3 new file mode 100644 index 00000000000..08930658c49 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/ChildlessNode.3 @@ -0,0 +1,170 @@ +.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32 +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Pedigree::ChildlessNode 3" +.TH Pedigree::ChildlessNode 3 "2007-07-22" "perl v5.8.8" "User Contributed Perl Documentation" +.SH "NAME" +Pedigree::ChildlessNode \- an abortion in a pedigree +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +use Pedigree::ChildlessNode; +.PP +$node = new Pedigree::ChildlessNode(\fI%params\fR); +.PP +$node\->DrawNode(\fI$xidst\fR, \fI$ydist\fR, \fI$belowtextfont\fR, \fI$abovetextfont\fR, +\&\fI@fieldsfornode\fR); +.PP +$node\->PrintLegend(\fI$land\fR, \fI@fields\fR); +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +This package contains data about a \*(L"childlessness\*(R" node. This node +is not numbered in pedigree. +.IP "\fBnew\fR(\fI%params\fR);" 4 +.IX Item "new(%params);" +Construct a new node from the given parameters. +.IP "\fBDrawNode\fR(\fI$xdist\fR, \fI$ydist\fR, \fI$belowtextfont\fR, \fI$abovetextfont\fR, \fI@fieldsfornode\fR);" 4 +.IX Item "DrawNode($xdist, $ydist, $belowtextfont, $abovetextfont, @fieldsfornode);" +Output the command to draw this node. The parameters are +distances between the nodes (in cm) and fields for abovetext (not used +here). We only print the Comment field below the node, and draw this +node higher than other nodes. +.IP "\fBPrintLegend\fR(\fI$lang\fR, \fI@fields\fR);" 4 +.IX Item "PrintLegend($lang, @fields);" +This subroutine does nothing since childlessness has no legend. +.SH "ENVIRONMENT" +.IX Header "ENVIRONMENT" +The calling program should define \fB$main::DEBUG\fR and set it to 0 +or 1. +.SH "SEE ALSO" +.IX Header "SEE ALSO" +\&\fIpedigree\fR\|(1), \fIPedigree\fR\|(3) +.SH "AUTHOR" +.IX Header "AUTHOR" +Boris Veytsman, Leila Akhmadeeva, 2007 diff --git a/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Language.3 b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Language.3 new file mode 100644 index 00000000000..1838308c460 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Language.3 @@ -0,0 +1,197 @@ +.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32 +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Pedigree::Language 3" +.TH Pedigree::Language 3 "2007-10-21" "perl v5.8.8" "User Contributed Perl Documentation" +.SH "NAME" +Pedigree::Language \- encapsulating language issues for pedigree library +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +use Pedigree::Language; +.PP +$lang = new Pedigree::Language(\fI$language\fR[, \fI$encoding\fR]); +.PP +$lang\->\fIHeader()\fR; +.PP +$lang\->\fILanguage()\fR; +.PP +$lang\->\fIEncoding()\fR; +.PP +$lang\->\fIGetFieldNames()\fR; +.PP +$lang\->\fIGetValues()\fR; +.PP +$lang\->\fIGetSpecialNames()\fR; +.PP +$lang\->PrintField(\fI$field\fR, $<$value>); +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +This package defines the language-dependent parts of the pedigree +library. The idea is to gather everything about language here, so adding +a new language should be (presumably) be easy. +.IP "\fBnew\fR(\fI$language\fR[, \fI$encoding\fR]);" 4 +.IX Item "new($language[, $encoding]);" +Construct the new interpreter from the given language and encoding names. +.IP "\fBHeader\fR ()" 4 +.IX Item "Header ()" +Print the language-related lines of the document preamble +.IP "\fBLanguage\fR ()" 4 +.IX Item "Language ()" +Print the current language +.IP "\fBEncoding\fR ()" 4 +.IX Item "Encoding ()" +Print the current encoding +.IP "\fBGetFieldNames\fR();" 4 +.IX Item "GetFieldNames();" +Outputs a reference to a hash +\&\*(L"field_name_in_this_language\*(R"=>\*(L"field_name_in_English\*(R" +.IP "\fBGetValues\fR();" 4 +.IX Item "GetValues();" +Outputs a reference to a hash +\&\*(L"field_value_in_this_language\*(R"=>\*(L"field_value_in_English\*(R" +.IP "\fBGetSpecialNames\fR();" 4 +.IX Item "GetSpecialNames();" +Some values for the 'Name' field start with \f(CW\*(C`#\*(C'\fR. They are special. +This subroutine outputs a reference to a hash +\&\*(L"special_name_in_this_language\*(R"=>\*(L"special_name\*(R" +.IP "\fBPrintField\fR(\fI$field\fR, \fI$value\fR);" 4 +.IX Item "PrintField($field, $value);" +Formats the value \fI$value\fR of the given field \fI$field\fR according +to the rules of the given language. +.SH "ENVIRONMENT" +.IX Header "ENVIRONMENT" +The calling program should define \fB$main::DEBUG\fR and set it to 0 +or 1. +.SH "SEE ALSO" +.IX Header "SEE ALSO" +\&\fIpedigree\fR\|(1), \fIPedigree\fR\|(3) +.SH "AUTHOR" +.IX Header "AUTHOR" +Boris Veytsman, Leila Akhmadeeva, 2006, 2007 diff --git a/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Makefile b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Makefile new file mode 100644 index 00000000000..5afbb317dd3 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Makefile @@ -0,0 +1,42 @@ +# +# Makefile for pedigree +# $Id: Makefile,v 2.4 2007-07-09 22:49:33 boris Exp $ +# +# This file is in public domain +# + +PREFIX = /usr/local + + +PERLLIBS = \ + AbortionNode.pm \ + Area.pm \ + ChildlessNode.pm \ + Language.pm \ + MarriageNode.pm \ + Node.pm \ + Parser.pm \ + PersonNode.pm \ + TwinsNode.pm + +MANPAGES3=${PERLLIBS:%.pm=%.3} + +all: man + +man: ${MANPAGES3} + +install: all + mkdir -p $(PREFIX)/lib/site_perl/Pedigree + install -m 644 ${PERLLIBS} $(PREFIX)/lib/site_perl/Pedigree + +installman: all + for x in ${MANPAGES3}; do install -m 644 $$x $(PREFIX)/man/man3/Pedigree::$$x; done + + +%.3: %.pm + pod2man --section=3 -n Pedigree::$* -s 3 $< $@ + +clean: + +distclean: clean + $(RM) *.3 diff --git a/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/MarriageNode.3 b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/MarriageNode.3 new file mode 100644 index 00000000000..d36edd4a56c --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/MarriageNode.3 @@ -0,0 +1,199 @@ +.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32 +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Pedigree::MarriageNode 3" +.TH Pedigree::MarriageNode 3 "2007-07-15" "perl v5.8.8" "User Contributed Perl Documentation" +.SH "NAME" +Pedigree::MarriageNode \- a marriage in a pedigree +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +use Pedigree::MarriageNode; +.PP +$node = new Pedigree::MarriageNode(\fI%params\fR); +.PP +$FSpouse = \f(CW$node\fR\->\fIFSpouse()\fR; +.PP +$MSpouse = \f(CW$node\fR\->\fIMSpouse()\fR; +.PP +$consang = \f(CW$self\fR\->\fIisConsanguinic()\fR; +.PP +$area = \f(CW$node\fR\->\fISetArea()\fR; +.PP +$node\->CalcAbsCoord(\fI$x\fR, \fI$y\fR); +.PP +$node\->DrawNode(\fI$xidst\fR, \fI$ydist\fR, \fI$belowtextfont\fR, \fI$abovetextfont\fR, +\&\fI@fieldsfornode\fR); +.PP +$node\->\fIDrawConnections()\fR; +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +This package contains data about a marriage. +.IP "\fBnew\fR(\fI%params\fR);" 4 +.IX Item "new(%params);" +Construct a new node from the given parameters. +.IP "\fBFSpouse\fR();" 4 +.IX Item "FSpouse();" +Get female spouse of a node. +.IP "\fBMSpouse\fR();" 4 +.IX Item "MSpouse();" +Get female spouse of a node. +.IP "\fBisConsanguinic\fR();" 4 +.IX Item "isConsanguinic();" +Check whether the node is consanguinic +.IP "\fBSetArea\fR();" 4 +.IX Item "SetArea();" +Calculate relative coordinates for all nodes, that are descendants of +the given node \fIand\fR the spouses that form the marriage. We create a +\&\fIPedigree::Area\fR\|(3) around the given node and recursively apply the +function to all descendants. The subroutine +returns the reference to the created area. +.IP "\fBCalcAbsCoor\fR(\fI$x\fR, $<y>);" 4 +.IX Item "CalcAbsCoor($x, $<y>);" +Set the absolute coordinates of the given node, if the absolute +coordinates of the parent node are (\fI$x\fR, \fI$y\fR), and recursively +do this for all descendants of this node, and right and left clumps. +.IP "\fBDrawNode\fR(\fI$xdist\fR, \fI$ydist\fR, \fI$belowtextfont\fR, \fI$abovetextfont\fR, \fI@fieldsfornode\fR);" 4 +.IX Item "DrawNode($xdist, $ydist, $belowtextfont, $abovetextfont, @fieldsfornode);" +Output the command to draw this node. The parameters are +distances between the nodes (in cm). +.IP "\fBDrawConnections\fR();" 4 +.IX Item "DrawConnections();" +Draw the connections from the given node to its descendants and +the spouses +.SH "ENVIRONMENT" +.IX Header "ENVIRONMENT" +The calling program should define \fB$main::DEBUG\fR and set it to 0 +or 1. +.SH "SEE ALSO" +.IX Header "SEE ALSO" +\&\fIpedigree\fR\|(1), \fIPedigree\fR\|(3) +.SH "AUTHOR" +.IX Header "AUTHOR" +Boris Veytsman, Leila Akhmadeeva, 2006, 2007 diff --git a/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Node.3 b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Node.3 new file mode 100644 index 00000000000..481b37ed9e8 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Node.3 @@ -0,0 +1,341 @@ +.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32 +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Pedigree::Node 3" +.TH Pedigree::Node 3 "2009-01-05" "perl v5.8.8" "User Contributed Perl Documentation" +.SH "NAME" +Pedigree::Node \- the base package for nodes in pedigree charts +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +use Pedigree::Node; +.PP +$node = new Pedigree::Node(\fI%params\fR); +.PP +$node\->\fICheckAllParents()\fR; +.PP +$Id = \f(CW$node\fR\->\fIId()\fR; +.PP +$node\->SetSortOrder(\-1|0|1); +.PP +$result = \f(CW$node\fR\->\fISortOrder()\fR; +.PP +$is_numbered=$node\->\fIisNumbered()\fR; +.PP +$type = \f(CW$node\fR\->\fIType()\fR; +.PP +$Kids = \f(CW$node\fR\->\fIKids()\fR; +.PP +$node\->\fIGetAndSortKids()\fR; +.PP +($root, \f(CW$newgen\fR) = \f(CW$node\fR\->FindRoot(\fI$generation\fR, [\fI$sort_order\fR]); +.PP +$x = \f(CW$node\fR\->\fIGetRelX()\fR; +.PP +$y = \f(CW$node\fR\->\fIGetRelY()\fR; +.PP +$node\->SetRelX(\fI$x\fR); +.PP +$node\->SetRelX(\fI$y\fR); +.PP +$x = \f(CW$node\fR\->\fIGetAbsX()\fR; +.PP +$y = \f(CW$node\fR\->\fIGetAbsY()\fR; +.PP +$node\->SetIndexX(\fI$n\fR); +.PP +$node\->SetAbsX(\fI$x\fR); +.PP +$node\->SetAbsY(\fI$y\fR); +.PP +$n = \f(CW$node\fR\->\fIGetIndexX()\fR; +.PP +$area = \f(CW$node\fR\->\fISetArea()\fR; +.PP +$delta = \f(CW$node\fR\->\fICenterKids()\fR; +.PP +$node\->CalcAbsCoord(\fI$x\fR, \fI$y\fR); +.PP +$node\->\fIAddConsanguinicMarriages()\fR; +.PP +$node\->AddTwins($ydist); +.PP +$frame = \f(CW$node\fR\->SetFrame(\fI$xdist\fR, \fI$ydist\fR); +.PP +$node\->DrawAll(\fI$xdist\fR, \fI$ydist\fR, \fI$belowtextfont\fR, \fI$abovetextfont\fR, + \fI@fieldsfornode\fR); +.PP +$node\->\fIDrawConnections()\fR; +.PP +$node\->PrintAllLegends(\fI$land\fR, \fI@fields\fR); +.PP +$node\->PrintLegend(\fI$land\fR, \fI@fields\fR); +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +This is the basic package that defines nodes for pedigrees. +\&\fIPedigree::PersonNode\fR\|(3) and \fIPedigree::MarriageNode\fR\|(3) inherit from +this package. +.IP "\fBnew\fR(\fI%params\fR);" 4 +.IX Item "new(%params);" +Construct a new node from the given parameters. If a node with +the give Id exists, add new information to the node. +.IP "\fBCheckAllParents\fR();" 4 +.IX Item "CheckAllParents();" +Check whether mothers and fathers of all nodes exist +.IP "\fBId\fR();" 4 +.IX Item "Id();" +Get Id of a node. Note that there is no way to set an Id of a node +that was already created. +.IP "\fBSetSortOrder\fR(\fI\-1|0|1\fR);" 4 +.IX Item "SetSortOrder(-1|0|1);" +Normally the sibs nodes are sorted by age. However, if the nodes or +their descendants are connected by a marriage line, we must sort them +in the special way: all way to the left or all way to the right. The +procedure \fBSetSortOrder\fR sets this flag for the node or deletes it +depending on the argument. +.IP "\fBSortOrder\fR();" 4 +.IX Item "SortOrder();" +Normally the sibs nodes are sorted by age. However, if the nodes or +their descendants are connected by a marriage line, we must sort them +in the special way: all way to the left or all way to the right. The +procedure \fBSortOrder\fR checks this flag. +.IP "\fBisNumbered\fR();" 4 +.IX Item "isNumbered();" +Check whether the node should be numbered in pedigree +.IP "\fBType\fR()" 4 +.IX Item "Type()" +Return node type. +.IP "\fBKids\fR();" 4 +.IX Item "Kids();" +Get the reference to the array of kids +.IP "\fBGetAndSortKids\fR();" 4 +.IX Item "GetAndSortKids();" +Apply sort the array of kids for the given node +.IP "\fBFindRoot\fR(\fI$generation\fR, [\fI$sort_order\fR]);" 4 +.IX Item "FindRoot($generation, [$sort_order]);" +Finds the root of the tree to which the current node belongs. +Takes the current generation number and returns the root and its +generation number. Here generation numbers go \*(L"backwards\*(R": the older +generations have higher numbers. The found node is assigned sort order +\&\fI$sort_order\fR. +.IP "\fBGetRelX\fR();" 4 +.IX Item "GetRelX();" +Find the relative x coordinate of the node. The coordinate is +relative to the precedessor or to the marriage node, which connects +this node to the proband +.IP "\fBGetRelY\fR();" 4 +.IX Item "GetRelY();" +Find the relative Y coordinate of the node. The coordinate is +relative to the precedessor or to the marriage node, which connects +this node to the proband. Note that the Y axis is down. +.IP "\fBSetRelX\fR(\fI$x\fR);" 4 +.IX Item "SetRelX($x);" +Set the relative x coordinate of the node. The coordinate is +relative to the precedessor or to the marriage node, which connects +this node to the proband. +.IP "\fBSetRelY\fR(\fI$y\fR);" 4 +.IX Item "SetRelY($y);" +Set the relative y coordinate of the node. The coordinate is +relative to the precedessor or to the marriage node, which connects +this node to the proband. Note that the Y axis is down. +.IP "\fBGetAbsX\fR();" 4 +.IX Item "GetAbsX();" +Find the absolute x coordinate of the node. +.IP "\fBGetAbsY\fR();" 4 +.IX Item "GetAbsY();" +Find the absolute Y coordinate of the node. +.IP "\fBGetIndexX\fR();" 4 +.IX Item "GetIndexX();" +Find the number of the node in the given generation. +.IP "\fBSetAbsX\fR(\fI$x\fR);" 4 +.IX Item "SetAbsX($x);" +Set the absolute x coordinate of the node. +.IP "\fBSetAbsY\fR(\fI$y\fR);" 4 +.IX Item "SetAbsY($y);" +Set the absolute y coordinate of the node. +.IP "\fBSetIndexX\fR(\fI$n\fR);" 4 +.IX Item "SetIndexX($n);" +Set the number of the node in the given generation. +.IP "\fBSetArea\fR();" 4 +.IX Item "SetArea();" +Calculate relative coordinates for all nodes, that are descendants of +the given node. We create a \fIPedigree::Area\fR\|(3) around the given node +and recursively apply the function to all descendants. The subroutine +returns the reference to the created area. +.IP "\fBCenterKids\fR();" 4 +.IX Item "CenterKids();" +Move the relative coordinates of all the kids of the given node +so the given node is centered in relation to the kids. Returns +the shift to be applied to the \fIPedigree::Area\fR\|(3). +.IP "\fBCalcAbsCoor\fR(\fI$x\fR, $<y>);" 4 +.IX Item "CalcAbsCoor($x, $<y>);" +Set the absolute coordinates of the given node, if the absolute +coordinates of the parent node are (\fI$x\fR, \fI$y\fR), and recursively +do this for all descendants of this node. Additionally set up +\&\fB%node_by_gen\fR. +.IP "\fBAddConsanguinicMarriages\fR();" 4 +.IX Item "AddConsanguinicMarriages();" +Check the pedigree and add consanguinic marriages to it. Note +that this procedure must be called \fBafter\fR SetAbsCoor, so +the coordinates of all nodes are set. +.IP "\fBAddTwins\fR(\fI$ydist\fR);" 4 +.IX Item "AddTwins($ydist);" +Check the pedigree and add twin nodes. Note +that this procedure must be called \fBafter\fR SetAbsCoor and +AddConsanguinicMarriages. +.IP "\fBSetFrame\fR(\fI$xidst\fR, \fI$ydist\fR);" 4 +.IX Item "SetFrame($xidst, $ydist);" +Calculate the frame: coordinates of the lower left and upper right +corners of the picture (in ps units). As a side effect, add generation +numbers to each person node and calculate the X index of each node. +.IP "\fBDrawConnections\fR();" 4 +.IX Item "DrawConnections();" +Draw the connections from the given node to its descendants +.IP "\fBDrawAll\fR(\fI$xdist\fR, \fI$ydist\fR, \fI$belowtextfont\fR, \fI$abovetextfont\fR, \fI@fieldsfornode\fR);" 4 +.IX Item "DrawAll($xdist, $ydist, $belowtextfont, $abovetextfont, @fieldsfornode);" +Draw all nodes and connections in the form suitable for +pspicture +.IP "\fBPrintAllLegends\fR(\fI$lang\fR, \fI@fields\fR);" 4 +.IX Item "PrintAllLegends($lang, @fields);" +Print legend for all the nodes. The first parameter is the +language, the other is the fields to be included in the legend. +.IP "\fBPrintLegend\fR(\fI$lang\fR, \fI@fields\fR);" 4 +.IX Item "PrintLegend($lang, @fields);" +This subroutine does nothing: a generic node has no legend. It +is overriden by \fIPedigree::PersonNode\fR\|(3) and \fIPedigree::AbortionNode\fR\|(3). +.SH "ENVIRONMENT" +.IX Header "ENVIRONMENT" +The calling program should define \fB$main::DEBUG\fR and set it to 0 +or 1. +.SH "SEE ALSO" +.IX Header "SEE ALSO" +\&\fIpedigree\fR\|(1), \fIPedigree\fR\|(3) +.SH "AUTHOR" +.IX Header "AUTHOR" +Boris Veytsman, Leila Akhmadeeva, 2006, 2007 diff --git a/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Parser.3 b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Parser.3 new file mode 100644 index 00000000000..44165db384e --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/Parser.3 @@ -0,0 +1,162 @@ +.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32 +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Pedigree::Parser 3" +.TH Pedigree::Parser 3 "2007-07-16" "perl v5.8.8" "User Contributed Perl Documentation" +.SH "NAME" +Pedigree::Parser \- parser for the input file +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +use Pedigree::Parser; +.PP +$parser = new Pedigree::Parser(I{$inputline>, \fI$lang\fR) +.PP +$parser\->Parse($inputline); +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +This package parses input for the pedigree library and is used to +define nodes. +.IP "\fBnew\fR(\fI$inputline\fR, \fI$lang\fR);" 4 +.IX Item "new($inputline, $lang);" +Construct a new parser from the pipe-separated line at input +.IP "\fBParse\fR(\fI$inputline\fR);" 4 +.IX Item "Parse($inputline);" +Take a line of comma-separated values; return a reference to a +hash of parsed values +.SH "ENVIRONMENT" +.IX Header "ENVIRONMENT" +The calling program should define \fB$main::DEBUG\fR and set it to 0 +or 1. +.SH "SEE ALSO" +.IX Header "SEE ALSO" +\&\fIpedigree\fR\|(1), \fIPedigree\fR\|(3) +.SH "AUTHOR" +.IX Header "AUTHOR" +Boris Veytsman, Leila Akhmadeeva, 2006, 2007 diff --git a/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/PersonNode.3 b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/PersonNode.3 new file mode 100644 index 00000000000..af03e1c7c89 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/PersonNode.3 @@ -0,0 +1,212 @@ +.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32 +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Pedigree::PersonNode 3" +.TH Pedigree::PersonNode 3 "2007-07-22" "perl v5.8.8" "User Contributed Perl Documentation" +.SH "NAME" +Pedigree::PersonNode \- a person in a pedigree +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +use Pedigree::PersonNode; +.PP +$node = new Pedigree::PersonNode(\fI%params\fR); +.PP +$Id = \f(CW$node\fR\->\fIMotherId()\fR; +\&\f(CW$Id\fR = \f(CW$node\fR\->\fIFatherId()\fR; +.PP +$isProband = \f(CW$node\fR\->\fIisProband()\fR; +.PP +$sex = \f(CW$node\fR\->\fISex()\fR; +.PP +$DoB = \f(CW$node\fR\->\fIDoB()\fR; +.PP +$DoD = \f(CW$node\fR\->\fIDoD()\fR; +.PP +$cond = \f(CW$node\fR\->\fICondition()\fR; +.PP +$GenName = \f(CW$node\fR\->\fIGetGenName()\fR; +.PP +$node\->SetGenName(\fI$name\fR); +.PP +$node\->DrawNode(\fI$xidst\fR, \fI$ydist\fR, \fI$belowtextfont\fR, \fI$abovetextfont\fR, +\&\fI@fieldsfornode\fR); +.PP +$node\->PrintLegend(\fI$land\fR, \fI@fields\fR); +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +This package contains data about a person. +.IP "\fBnew\fR(\fI%params\fR);" 4 +.IX Item "new(%params);" +Construct a new node from the given parameters. +.IP "\fBMotherId\fR();" 4 +.IX Item "MotherId();" +Return Mother Id. +.IP "\fBFatherId\fR();" 4 +.IX Item "FatherId();" +Return Father Id. +.IP "\fBisProband\fR();" 4 +.IX Item "isProband();" +Return 1 if the pesron is a Proband and zero otherwise +.IP "\fBSex\fR();" 4 +.IX Item "Sex();" +Get the sex of the node +.IP "\fBDoB\fR();" 4 +.IX Item "DoB();" +Get the DoB of the node +.IP "\fBDoD\fR();" 4 +.IX Item "DoD();" +Get the DoB of the node +.IP "\fBCondition\fR();" 4 +.IX Item "Condition();" +Returns node conditon. +.IP "\fBGetGenName\fR();" 4 +.IX Item "GetGenName();" +Find the generation name for the node +.IP "\fBSetGenName\fR(\fI$name\fR);" 4 +.IX Item "SetGenName($name);" +Set the generation name of the node +.IP "\fBDrawNode\fR(\fI$xdist\fR, \fI$ydist\fR, \fI$belowtextfont\fR, \fI$abovetextfont\fR, \fI@fieldsfornode\fR);" 4 +.IX Item "DrawNode($xdist, $ydist, $belowtextfont, $abovetextfont, @fieldsfornode);" +Output the command to draw this node. The parameters are +distances between the nodes (in cm) and fields for abovetext. +.IP "\fBPrintLegend\fR(\fI$lang\fR, \fI@fields\fR);" 4 +.IX Item "PrintLegend($lang, @fields);" +Print the legend for the given node, including \fI@fields\fR in the given +language \fI$lang\fR. +.SH "ENVIRONMENT" +.IX Header "ENVIRONMENT" +The calling program should define \fB$main::DEBUG\fR and set it to 0 +or 1. +.SH "SEE ALSO" +.IX Header "SEE ALSO" +\&\fIpedigree\fR\|(1), \fIPedigree\fR\|(3) +.SH "AUTHOR" +.IX Header "AUTHOR" +Boris Veytsman, Leila Akhmadeeva, 2006, 2007 diff --git a/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/TwinsNode.3 b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/TwinsNode.3 new file mode 100644 index 00000000000..79f11db2c35 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/Pedigree/TwinsNode.3 @@ -0,0 +1,169 @@ +.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32 +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Pedigree::TwinsNode 3" +.TH Pedigree::TwinsNode 3 "2007-07-15" "perl v5.8.8" "User Contributed Perl Documentation" +.SH "NAME" +Pedigree::TwinsNode \- an auxillary twins node in a pedigree +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +use Pedigree::TwinsNode; +.PP +$node = new Pedigree::TwinsNode(\fI%params\fR); +.PP +$node\->DrawNode(\fI$xidst\fR, \fI$ydist\fR, \fI$belowtextfont\fR, \fI$abovetextfont\fR, +\&\fI@fieldsfornode\fR); +.PP +$node\->\fIDrawConnections()\fR; +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +This package contains data about a twins node. Twins node is +a special node between the parent and the twins. +.IP "\fBnew\fR(\fI%params\fR);" 4 +.IX Item "new(%params);" +Construct a new node from the given parameters. +.IP "\fBDrawNode\fR(\fI$xdist\fR, \fI$ydist\fR, \fI$belowtextfont\fR, \fI$abovetextfont\fR, \fI@fieldsfornode\fR);" 4 +.IX Item "DrawNode($xdist, $ydist, $belowtextfont, $abovetextfont, @fieldsfornode);" +Output the command to draw this node. The parameters are +distances between the nodes (in psunits). +.IP "\fBDrawConnections\fR();" 4 +.IX Item "DrawConnections();" +Draw the connections from the given node to its descendants and +the parent +.SH "ENVIRONMENT" +.IX Header "ENVIRONMENT" +The calling program should define \fB$main::DEBUG\fR and set it to 0 +or 1. +.SH "SEE ALSO" +.IX Header "SEE ALSO" +\&\fIpedigree\fR\|(1), \fIPedigree\fR\|(3) +.SH "AUTHOR" +.IX Header "AUTHOR" +Boris Veytsman, Leila Akhmadeeva, 2007 diff --git a/Master/texmf-dist/doc/support/pedigree-perl/README b/Master/texmf-dist/doc/support/pedigree-perl/README new file mode 100644 index 00000000000..edc6821f949 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/README @@ -0,0 +1,31 @@ + A Program for Generation TeX Pedigrees From CSV Files + Boris Veytsman & Leila Akhmadeeva + Version 0.4, March 2012 + +This program generates TeX commands to typeset pedigrees - either TeX +fragments of full LaTeX files. It has support for multilanguage +pedigrees (at the present moment English and Russian languages are +supported). + +To create manual pages for this program, issue make in the main +directory. To install the program and the library files issue make +install (this command assumes location /usr/local/bin/ for the +binaries and /usr/local/lib/site_perl for Perl libraries). Optionally +you can install manual pages to the proper location on your system. +The typeset manual in in the doc subdirectory. + +For manual installation: + +1. Install pedigree.pl as /usr/local/bin/pedigree + +2. Install Pedigree subdirectory as /usr/local/lib/site_perl/Pedigree + and move there all .pm modules. + +3. Optionally install man pages & documentation. + +Copyright 2006-2012, Boris Veytsman <borisv@lk.net>, Leila Akhmadeeva + +This work may be distributed and/or modified under the conditions of +the GNU Public License, either version 2 of this license or (at your +option) any later version. + diff --git a/Master/texmf-dist/doc/support/pedigree-perl/doc/Makefile b/Master/texmf-dist/doc/support/pedigree-perl/doc/Makefile new file mode 100644 index 00000000000..864566de3b7 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/doc/Makefile @@ -0,0 +1,75 @@ +# +# Makefile for pedigree program +# +# This file is in public domain +# +# $Id: Makefile,v 2.10 2007-07-29 19:52:53 boris Exp $ +# + +TEXFILES = pedigree.tex + +INCLUDES = \ + english.tex \ + english1.tex \ + russian.tex \ + twins.tex \ + abortions.tex \ + childlessness.tex \ + sort1.tex \ + sort2.tex \ + sort3.tex \ + badsort.tex \ + consanguinic.tex + + +PDFS = ${TEXFILES:%.tex=%.pdf} + +all: $(PDFS) + + +%.pdf: %.ps + ps2pdf -sAutoRotatePages=None $< + +%.ps: %.dvi + dvips -Ppdf -o $@ $< + + +# +# We need to cancel the implicit rule +# +%.dvi: %.tex + +%.dvi: %.tex $(INCLUDES) + latex $< + - bibtex $* + latex $< + latex $< + while ( grep -q '^LaTeX Warning: Label(s) may have changed' $*.log) \ + do latex $<; done + + +%.tex: ../examples/english_short.cfg ../examples/%.csv + cd ..; perl -I. pedigree.pl -c examples/english_short.cfg -o doc/$*.tex examples/$*.csv + + +english1.tex: ../examples/english1.cfg ../examples/english.csv + cd ..; perl -I. pedigree.pl -c examples/english1.cfg -o doc/$@ examples/english.csv + +abortions.tex: ../examples/english.cfg ../examples/abortions.csv + cd ..; perl -I. pedigree.pl -c examples/english.cfg -o doc/$@ examples/abortions.csv + + +english.tex: ../examples/english.cfg ../examples/english.csv + cd ..; perl -I. pedigree.pl -c examples/english.cfg -o doc/$@ examples/english.csv + +russian.tex: ../examples/russian.cfg ../examples/russian.csv + cd ..; perl -I. pedigree.pl -c examples/russian.cfg -o doc/$@ examples/russian.csv + + + +clean: + $(RM) *.aux *.bbl *.dvi *.log *.out *.toc *.blg *.lof *.lot *.lol pst-pdgr.tex pst-pdgr.sty + +distclean: clean + rm -f ${PDFS} $(INCLUDES) + diff --git a/Master/texmf-dist/doc/support/pedigree-perl/doc/abortions.tex b/Master/texmf-dist/doc/support/pedigree-perl/doc/abortions.tex new file mode 100644 index 00000000000..c6d33951c25 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/doc/abortions.tex @@ -0,0 +1,19 @@ +{% +\psset{descarmA=0.8}% +\begin{pspicture}(-4,-4)(4,2) +\rput(0, 0){\pstPerson[female, affected, belowtext={\small I:1}, abovetext={\scriptsize Ann}]{A0}} +\rput(2, -2){\pstPerson[male, affected, belowtext={\small II:3}, proband, abovetext={\scriptsize John}]{B3}} +\rput(-2, -2){\pstAbortion[affected, belowtext={\small II:1}, abovetext={\scriptsize female}]{B1}} +\rput(0, -2){\pstAbortion[normal, belowtext={\small II:2}, sab, abovetext={\scriptsize male}]{B2}} +\pstDescent{A0}{B1} +\pstDescent{A0}{B2} +\pstDescent{A0}{B3} +\end{pspicture}% +} + +\begin{description} +\item[I:1] Ann; born: 1970.06.15. +\item[II:1] abortion; born: 1990.03.01. +\item[II:2] abortion; born: 2000.10.10. +\item[II:3] John; born: 2002.12.01. +\end{description} diff --git a/Master/texmf-dist/doc/support/pedigree-perl/doc/english.tex b/Master/texmf-dist/doc/support/pedigree-perl/doc/english.tex new file mode 100644 index 00000000000..5d812a19c27 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/doc/english.tex @@ -0,0 +1,46 @@ +{% +\psset{descarmA=0.8}% +\begin{pspicture}(-8,-4)(6,4) +\rput(-6, 2){\pstPerson[male, normal, belowtext={\small I:1}, deceased, abovetext={\scriptsize Joseph Smith}]{GF1}} +\rput(0, 2){\pstPerson[male, normal, belowtext={\small I:3}, abovetext={\scriptsize Jim Brown}]{GF2}} +\rput(4, 2){\pstPerson[female, normal, belowtext={\small I:4}, abovetext={\scriptsize Lisa Brown}]{GM2}} +\rput(2, 2){\pnode{GF2_m_GM2}} +\rput(-4, 2){\pnode{GF1_m_GM1}} +\rput(-2, 2){\pstPerson[female, asymptomatic, belowtext={\small I:2}, deceased, abovetext={\scriptsize Joan Smith}]{GM1}} +\rput(0, 0){\pnode{F1_m_M1}} +\rput(-5, 0){\pstPerson[female, obligatory, belowtext={\small II:1}, abovetext={\scriptsize Ann Gold}]{A1}} +\rput(2, 0){\pstPerson[female, normal, belowtext={\small II:3}, abovetext={\scriptsize Mary Smith}]{M1}} +\rput(-3, 0){\pstPerson[male, affected, belowtext={\small II:2}, abovetext={\scriptsize Bill Smith}]{F1}} +\rput(0, -2){\pstPerson[female, affected, belowtext={\small III:3}, abovetext={\scriptsize Rebecca Smith}]{S1}} +\rput(2, -2){\pstPerson[male, normal, belowtext={\small III:4}, abovetext={\scriptsize Alexander Smith}]{S2}} +\rput(-2, -2){\pstPerson[male, affected, belowtext={\small III:2}, proband, abovetext={\scriptsize John Smith}]{P}} +\rput(-5, -2){\pstPerson[female, affected, belowtext={\small III:1}, abovetext={\scriptsize Jenny Smith}]{C1}} +\pstDescent{GF2_m_GM2}{M1} +\ncline[]{GF2_m_GM2}{GM2} +\ncline[]{GF2_m_GM2}{GF2} +\pstDescent{GF1_m_GM1}{A1} +\pstDescent{GF1_m_GM1}{F1} +\ncline[]{GF1_m_GM1}{GM1} +\ncline[]{GF1_m_GM1}{GF1} +\pstDescent{F1_m_M1}{P} +\pstDescent{F1_m_M1}{S1} +\pstDescent{F1_m_M1}{S2} +\ncline[]{F1_m_M1}{M1} +\ncline[]{F1_m_M1}{F1} +\pstDescent{A1}{C1} +\end{pspicture}% +} + +\begin{description} +\item[I:1] Joseph Smith; born: unknown; age at death: unknown. +\item[I:2] Joan Smith; born: 1902/07/01; age at death: 73. +\item[I:3] Jim Brown; born: 1905/11/01. +\item[I:4] Lisa Brown; born: 1910/03/03. +\item[II:1] Ann Gold; born: 1941/09/02; Aunt of the proband. +\item[II:2] Bill Smith; born: 1938/04/03. +\item[II:3] Mary Smith; born: 1940/02/05. +\item[III:1] Jenny Smith; born: 1969/12/03; Cousin of the proband. +\item[III:2] John Smith; born: 1970/02/05; Evaluated 2005/12/01. +\item[III:3] Rebecca Smith; born: 1972/12/25. +\item[III:4] Alexander Smith; born: 1975/11/12. +\end{description} diff --git a/Master/texmf-dist/doc/support/pedigree-perl/doc/english1.tex b/Master/texmf-dist/doc/support/pedigree-perl/doc/english1.tex new file mode 100644 index 00000000000..a652cdbb048 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/doc/english1.tex @@ -0,0 +1,32 @@ +{% +\psset{descarmA=0.9}% +\begin{pspicture}(-6,-3.6)(4.5,3.6) +\rput(-4.5, 1.8){\pstPerson[male, normal, belowtext={\small I:1}, deceased]{GF1}} +\rput(0, 1.8){\pstPerson[male, normal, belowtext={\small I:3}]{GF2}} +\rput(3, 1.8){\pstPerson[female, normal, belowtext={\small I:4}]{GM2}} +\rput(1.5, 1.8){\pnode{GF2_m_GM2}} +\rput(-3, 1.8){\pnode{GF1_m_GM1}} +\rput(-1.5, 1.8){\pstPerson[female, asymptomatic, belowtext={\small I:2}, deceased]{GM1}} +\rput(0, 0){\pnode{F1_m_M1}} +\rput(-3.75, 0){\pstPerson[female, obligatory, belowtext={\small II:1}]{A1}} +\rput(1.5, 0){\pstPerson[female, normal, belowtext={\small II:3}]{M1}} +\rput(-2.25, 0){\pstPerson[male, affected, belowtext={\small II:2}]{F1}} +\rput(0, -1.8){\pstPerson[female, affected, belowtext={\small III:3}]{S1}} +\rput(1.5, -1.8){\pstPerson[male, normal, belowtext={\small III:4}]{S2}} +\rput(-1.5, -1.8){\pstPerson[male, affected, belowtext={\small III:2}, proband]{P}} +\rput(-3.75, -1.8){\pstPerson[female, affected, belowtext={\small III:1}]{C1}} +\pstDescent{GF2_m_GM2}{M1} +\ncline[]{GF2_m_GM2}{GM2} +\ncline[]{GF2_m_GM2}{GF2} +\pstDescent{GF1_m_GM1}{A1} +\pstDescent{GF1_m_GM1}{F1} +\ncline[]{GF1_m_GM1}{GM1} +\ncline[]{GF1_m_GM1}{GF1} +\pstDescent{F1_m_M1}{P} +\pstDescent{F1_m_M1}{S1} +\pstDescent{F1_m_M1}{S2} +\ncline[]{F1_m_M1}{M1} +\ncline[]{F1_m_M1}{F1} +\pstDescent{A1}{C1} +\end{pspicture}% +} diff --git a/Master/texmf-dist/doc/support/pedigree-perl/doc/pedigree.bib b/Master/texmf-dist/doc/support/pedigree-perl/doc/pedigree.bib new file mode 100644 index 00000000000..a705bc192c7 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/doc/pedigree.bib @@ -0,0 +1,49 @@ +,-------------------. +| BIBTEX ENTRIES | +`-------------------' + +@article{PedigreeNomenclature95, + author = {Robin L. Bennett and Kathryn A. Steinhaus and + Stefanie B. Uhrich and Corrine K. O'Sullivan and + Robert G. Resta and Debra Lochner-Doyle and + Dorene S. Markei and Victoria Vincent and + Jan Hamanishi}, + journal = {Am. J. Hum. Genet.}, + number = {3}, + pages = {745--752}, + title = {Recommendations for Standardized Human Pedigree + Nomenclature}, + volume = {56}, + year = {1995}, +} + +@Manual{pst-pdgr06, + title = {Creating Medical Pedigrees with PSTricks and \LaTeX}, + author = {Boris Veytsman and Leila Akhmadeeva}, + month = {July}, + year = 2007, + note = {\url{http://ctan.tug.org/tex-archive/graphics/pstricks/contrib/pedigree/pst-pdgr}} +} + +@Manual{PSTricks93, + title = {PSTricks: PostScript Macros for Generic \TeX}, + author = {Van Zandt, Timothy}, + editor = {Denis Girou}, + month = {July}, + year = 2007, + note = {\url{http://ctan.tug.org/tex-archive/graphics/pstricks/base/doc}} +} + + +@book{GraphDrawing99, + address = {New Jersey}, + author = {Di Battista, Giuseppe and Peter Eades and + Roberto Tamassia and Ioannis G. Tollis}, + publisher = {Prentice Hall}, + series = {An Alan R.~Apt Book}, + title = {Graph Drawing: Algortihms for the Visualization of + Graphs}, + year = {1999}, +} + +This file is in public domain
\ No newline at end of file diff --git a/Master/texmf-dist/doc/support/pedigree-perl/doc/pedigree.pdf b/Master/texmf-dist/doc/support/pedigree-perl/doc/pedigree.pdf Binary files differnew file mode 100644 index 00000000000..d31d1565a50 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/doc/pedigree.pdf diff --git a/Master/texmf-dist/doc/support/pedigree-perl/doc/pedigree.tex b/Master/texmf-dist/doc/support/pedigree-perl/doc/pedigree.tex new file mode 100644 index 00000000000..51fb4361011 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/doc/pedigree.tex @@ -0,0 +1,1153 @@ +\documentclass{article} +\usepackage[koi8-r]{inputenc} +\usepackage[russian, english]{babel} +\usepackage{pst-pdgr} +\usepackage{pstricks-add} +\usepackage{url} +\usepackage{fancyvrb} +\usepackage{listings} +\lstset{language=Perl, captionpos=b, basicstyle=\ttfamily, +abovecaptionskip=\abovedisplayskip, +belowcaptionskip=\belowdisplayskip} +\renewcommand{\lstlistlistingname}{List of Listings} +\usepackage{graphicx} +\usepackage{paralist} +\psset{descarmA=1} +\newcommand{\program}[1]{\textsf{#1}} +\usepackage[breaklinks,colorlinks,linkcolor=black,citecolor=black, + pagecolor=black,urlcolor=black]{hyperref} +\DefineShortVerb{\|} +\begin{document} +\selectlanguage{english} +\title{A Program For Automatic Pedigree Construction With \path{pst-pdgr}\\ + User Manual and Algorithm Description} +\author{Boris Veytsman, \path{borisv@lk.net} \and Leila Akhmadeeva} +\date{March 2012} +\maketitle +\begin{abstract} + The set of macros in \path{pst-pdgr} package allows to typeset + complex pedigrees. However, a manual placement of pedigree symbols + on a canvas is a time-consuming task. This program produces \TeX{} + files from spreadsheets with the data on inheritance for a large + class of pedigrees. It has a simple interface and can be used for + quite complex pedigrees. +\end{abstract} + +\begin{center} + \input{english1.tex} +\end{center} + +\clearpage + +\tableofcontents +\listoffigures +\listoftables +\lstlistoflistings +\clearpage + + +\part{User Manual} +\label{part:manual} + + +\section{Introduction} +\label{sec:intro} + +Medical pedigree is a very important tool for clinicians, genetic +researchers and educators. As stated +in~\cite{PedigreeNomenclature95}, ``The construction of an accurate +family pedigree is a fundamental component of a clinical genetic +evaluation and of human genetic research.'' The package +\path{pst-pdgr}~\cite{pst-pdgr06} provides a set of PSTricks macros +(see~\cite{PSTricks93}) to typeset pedigrees. In the framework of +\path{pst-pdgr} the user manually chooses coordinates for each +pedigree node on the diagram. While this is relatively easy for small +pedigrees, this task becomes increasingly time-consuming for larger +ones. There may be several approaches to automate it. For example, +one may have data about the patients and their families in a +spreadsheet or database. Then it would be useful to generate +pedigrees from such data. This is the aim of the program +\path{pedigree} described in this manual. + +Spreadsheets and databases can export the data as separated +values files (``csv'' files for Comma Separated Values). Our program +reads these files and outputs LaTeX{} code with \path{pst-pdgr} +macros. We tried to make this code readable, so a user might tweak it +if necessary. + +Of course, manually produced \LaTeX{} code is more versatile than the +automatically generated one. There are certain limitations for the +program: +\begin{inparaenum} +\item only persons having common genes with the proband or the + ``starting person'' are included in the + pedigree; +\item no adopted children, sperm donors or surrogate + mothers are shown on the pedigree; +\item only one disease is shown on the chart; +\item the support for consanguinic unions and inbreeding is rather + experimental (see Section~\ref{sec:consanguinic}). +\end{inparaenum} +Subsequent versions of the program may ease some of these +limitations. + +\section{Installation} +\label{sec:install} + +\subsection{System Requirements} +\label{sec:reqs} + +The program requires \program{Perl} version~5 or newer (it was tested +with \program{Perl} v5.8.8, but should work with any +\program{Perl-5}). The \LaTeX{} macros require \path{pst-pdgr} +version~0.3 (July 2007) or newer. + +\subsection{Unix/Linux Installation} +\label{sec:install_unix} + +If your system has a working \program{make} program, which is the +usual case for Unix-like environments, the supplied \path{Makefile} +installs the executable \path{pedigree} in \path{/usr/local/bin}, the +libraries in \path{/usr/local/lib/site_perl} and the manual pages in +\path{/usr/local/man}. This is done by the usual command +|make install|. Optionally you can install files in the +\path{doc} and \path{examples} subdirectories in the proper places in +your system. + +\subsection{Installation in Other Systems} +\label{sec:other} + +If your system does not have \program{make}, you need to manually +perform the following: +\begin{enumerate} +\item Install the executable \path{pedigree.pl} to the place your + system can find it. +\item Install the libraries: \path{Pedigree.pm}, directory + \path{Pedigree} and all files in it to the \program{Perl} search + path. The latter is listed in the array \path{@INC}, which can be + checked by the command |perl -V| or its equivalent. +\end{enumerate} + +\section{Configuration} +\label{sec:config} + + +\subsection{Configuration Variables and Location of Configuration File} +\label{sec:conf_file} + +The program defaults are sufficient for most cases. However, if you +want to draw pedigrees in a language other than English, or to tweak +the layout of the pedigrees, you need to change the program +configuration. + +The behavior of the program \program{pedigree} is determined by +\emph{configuration variables.} There are several sources of +configuration variables. They are (in the order of increasing +priority): +\begin{enumerate} +\item Program defaults. +\item The system configuration file\footnote{On Unix-like systems, + where \path{/etc} exists} \path{/etc/pedigree.cfg}. On \TeX Live + the system coniguration files are + \path{$TEXMFHOME/texmf-config/pedigree/pedigree.cfg} and + \path{$TEXMFLOCAL/pedigree/pedigree.cfg}. +\item User configuration file\footnote{On Unix-like systems, where + \path{$HOME} exists} \path{$HOME/.pedigreerc}. +\item The file specified by the |-c| option (see + Section~\ref{sec:invocation}). +\end{enumerate} +If a file mentioned in this list does not exists, the program +silently\footnote{Unless \path{-d} option is selected, see + Section~\ref{sec:invocation}} continues. + +Note that even if a configuration file with higher priority exists, +the program reads the files with lower priority first. The former +\emph{overrides} the latter, but not precludes it from reading. In +other words, if \path{/etc/pedigree.cfg} defines variables +\lstinline|$foo| and \lstinline|$bar|, and \path{$HOME/.pedigreerc} +defines \lstinline|$bar| and \lstinline|$baz|, the program takes +\lstinline|$foo| from the first file, and \lstinline|$bar| and +\lstinline|$baz| from the second one. + + +\subsection{Configuration File Format} +\label{sec:conf_file_format} + +All configuration files mentioned in Section~\ref{sec:conf_file}, have +the same format. They are actually snippets of \program{Perl} code, +executed by the program \program{pedigree}. This means, by the way, +that all precautions usually taken with respect to programs and +scripts, are relevant for configuration files as well. In particular, +it is a bad idea to have world-writable system-wide configuration +file \path{/etc/pedigree.cfg}. + +The code in configuration files is very simple, and one does not need +to know \program{Perl} to edit configuration files. There are several +simple rules which are enough to understand these files: +\begin{enumerate} +\item All text after \lstinline|#| to the end of the line is a + comments. In particular, the lines starting with \lstinline|#|, are + comment lines. +\item \program{Perl} commands must end by semicolon \lstinline|;|. +\item The commands like + \begin{lstlisting} + $xdist=1.5; + \end{lstlisting} + or + \begin{lstlisting} + @fieldsforprint=qw(Name DoB); + \end{lstlisting} + assign values to the variables. +\item Variables starting with \lstinline|$| are scalars and + take numerical or string values. Variables starting with + \lstinline|@| are arrays and take list of values. +\item A backslash in single quotes stands for itself, A backslash in + double quotes or inside \lstinline|<<END|\dots\lstinline|END| + construction must be doubled. Compare the commands + \begin{lstlisting} + $foo='\documentclass'; + $bar="\\documentclass"; + \end{lstlisting} +\item The last command in the file must be + \begin{lstlisting} + 1; + \end{lstlisting} +\end{enumerate} + +A number of commented configuration files can be found in the +\path{examples} subdirectory of the distribution. + +In the remaining parts of this section we describe the configuration +variables in detail. + +\subsection{\TeX{} Output Setup} +\label{sec:conf_tex} + +A number of variables determine what kind of \TeX{} file is produced. +An example of their usage is shown on Listing~\ref{lst:tex}. + +The variable \lstinline|$fulldoc| determines whether the program +produces a full \LaTeX{} file with header and preamble (when +\lstinline|$fulldoc=1|), or just a snippet to be included in a larger +document (when \lstinline|$fulldoc=0|). The default is 1. + +The variable \lstinline|$documentheader| is used when +\lstinline|$fulldoc| is 1. It determines the document class of the +resulting \LaTeX{} file. The default is |article| class, set by +|\documentclass{article}|. + +By default the preamble of the \LaTeX{} file created when +\lstinline|$fulldoc| is 1, contains only the line +|\usepackage{pst-pdgr}| and, if the language chosen is not English +(see Section~\ref{sec:conf_lang}), the calls of \program{babel} and +\program{inputenc} packages. The variable \lstinline|$addtopreamble|, +if set, may contain any other \LaTeX{} code you might wish to add to +the preamble. + +The variable \lstinline|$printlegend| determines whether to add legend +to the pedigree. The default value is 1, and the legend is printed. + +\begin{lstlisting}[float, caption={Configuration File: Setting \TeX{} Output}, + label=lst:tex] +# Do we want to have a full LaTeX +# file or just a fragment? +# +$fulldoc=1; + +# What kind of document do we want +# +$documentheader='\documentclass{article}'; + +# Define additional packages here +# +$addtopreamble=<<END; +\\usepackage{pst-pdgr} +END + +# Do we want to print a legend? +# +$printlegend=1; +\end{lstlisting} + + +\subsection{What to Print} +\label{sec:what_to_print} + +The next groups of configuration variables sets the information to be +printed in the legend and on the pedigree. It consists of two arrays: +array \lstinline|@fieldsforlegend| is the list of fields (see +Section~\ref{sec:data_file}) which are included in the legend, and +array \lstinline|@fieldsforchart| is the list of fields to print near +each node in the pedigree (Listing~\ref{lst:what_to_print}). Setting +\lstinline|@fieldsforchart| to empty array: +\begin{lstlisting} +@fieldsforchart = (); +\end{lstlisting} +prevents putting additional information on the pedigrees. + +The field names are described in Section~\ref{sec:data_file}. Note +that |AgeAtDeath| is a special field: it is the age at death (or +empty) calculated as the difference between the death date and the +birth date. + +\begin{lstlisting}[float, caption={Configuration File: Choosing +Fields to Print}, label=lst:what_to_print] +# Fields to include in the legend. +# Delete Name for privacy protection. +# +@fieldsforlegend = qw(Name DoB DoD Comment); + +# +# Fields to put at the node. +# Delete Name for privacy protection. +# +@fieldsforchart = qw(Name); +\end{lstlisting} + +\subsection{Language and Encoding} +\label{sec:conf_lang} + +The next group of variables describes the language and encoding of +the data file input and the \LaTeX{} output. They are shown in +Listing~\ref{lst:lang_enc}. The variable \lstinline|$language| at +present can have one of two values: |english| (the default) or +|russian|. If the value is |russian|, the output document preamble +includes the line +\begin{lstlisting}[language=tex] +\usepackage[russian]{babel} +\end{lstlisting} +The variable \lstinline|$encoding| sets the encoding of the \LaTeX{} +file if the language is not English. By default it is |cp1251|, if +the language is Russian. Set it to |koi8-r| to choose KOI8 encoding. +It is worth to note that the data file and the output \LaTeX{} file +are assumed to have the same language and encoding. + + +\begin{lstlisting}[float, caption={Configuration File: Choosing +Language and Encoding}, label=lst:lang_enc] +# +# Language +# +# $language="russian"; +$language="english"; + +# +# Override the encoding +# +# $encoding="koi8-r"; +\end{lstlisting} + +If |$language| is not |english|, the program recognizes both English +and native names of the fields in the data file (see +Section~\ref{sec:data_file}). + +\subsection{Fonts} +\label{sec:fonts} + +There are two kinds of text on the chart: the text above a node +and the text below a node\footnote{The \TeX{} + package~\cite{pst-pdgr06} also allows to place text at both sides of +the node, but the program \program{pedigree} currently does not use +this feature.}. The fonts for them are set by the variables +\lstinline|$belowtextfont| (by default |\small|) and +\lstinline|$abovetextfont| (by default |\scriptsize|). Any \LaTeX{} +font declaration like |\sffamily| or |\itshape| is allowed here. See +Listing~\ref{lst:fonts} for an example of usage. + +\begin{lstlisting}[float, caption={Configuration File: Choosing +Fonts}, label=lst:fonts] +# +# Fonts for the chart +# +$belowtextfont='\small'; +$abovetextfont='\scriptsize'; +\end{lstlisting} + +\subsection{Lengths} +\label{sec:conf_dist} + +The next group of variables (Listing~\ref{lst:dist}) sets the +distances between the key elements of the chart. All lengths are in +centimeters (actually, in |unit|s, are defined in +PSTricks~\cite{PSTricks93}). + +\begin{lstlisting}[float, caption={Configuration File: Choosing +Lengths}, label=lst:dist] +# +# descarmA in cm +# +$descarmA = 0.8; + +# +# Distances between nodes (in cm) +# +$xdist=2; +$ydist=2; +\end{lstlisting} + +The variable \lstinline|$descarmA| sets the length of the first +segment of the descent line: from the parent node to the sibs line, +as measured from the center of the parent (see~\cite{pst-pdgr06} for +more details). By default it is 0.8. + +The variables \lstinline|$xdist| and \lstinline|$ydist| set the +distances between the nodes along horizontal and vertical axes +correspondingly. The default for both is 2. + +\subsection{Scaling and Rotation} +\label{sec:scaling_rotation} + +Complex pedigrees might be too large to fit on a page. In this case a +scaling and (or) rotation might be necessary to print the chart. Of +course, changing the lengths described in Section~\ref{sec:conf_dist} +might also help, but the scaling described here also changed the size +of the pedigree symbols. + +There are three variables controlling the scaling and rotation of +pedigrees: \lstinline|$maxW|, \lstinline|$maxH| and +\lstinline|$rotate| (see Listing~\ref{lst:scaling_rotation}). The +variables \lstinline|$maxW| and \lstinline|$maxH| are the maximal +width and height of the chart in centimeters. Setting any of them to +zero disables scaling. + +The scaling works as follows. If both height and width of the +pedigree are smaller than the limits, no scaling is done. In the other +case the chart is scaled while preserving the aspect ratio (by +changing the value of |unit|, see~\cite{PSTricks93}) to fit into the +limits. + +The variable |$rotate| sets the orientation of the chart. If it is +|no|, the pedigree is never rotated, while if it |yes|, it is always +rotated ninety degrees counterclockwise. If this variable is set to +|maybe| (the default), the program compares the scaling for +the non-rotated and rotated pedigrees, and chooses the orientation for +which the scaling is closer to one. + +\begin{lstlisting}[float, caption={Configuration File: Choosing +Scaling and Rotation}, label=lst:scaling_rotation] +# +# Maximal width and height of the pedigree in cm. +# Set this to 0 to switch off scaling +# +$maxW = 15; +$maxH = 19; + +# +# Whether to rotate the page. The values are +# 'yes', 'no' and 'maybe' +# If 'maybe' is chosen, the pedigree is rotated +# if this provides better scaling +# +$rotate = 'maybe'; +\end{lstlisting} + +\section{Running the Program} +\label{sec:runnning} + + + +\subsection{Program Invocation And Options} +\label{sec:invocation} + +The program \path{pedigree} is a command line program. It reads the +data from a text file \path{input_file} and produces an output file +with \LaTeX{} macros. The format of the input file is described in +Section~\ref{sec:data_file}. The program invocation is: +\begin{verbatim} +pedigree [-c configuration_file] [-d] [-o output_file] + [-s start] input_file +\end{verbatim} +(the square brackets show optional arguments). + +All arguments but |input_file| are optional. They are described +below. + +The option |-c| selects a \emph{configuration file.} The format +of the configuration file is described in +Section~\ref{sec:conf_file}. If this option is absent, the program +uses its own default parameters, or system-wide or user's defaults, as +explained in Section~\ref{sec:conf_file}. + + +The option \path{-d} selects debugging mode. In this mode a lot of +debugging messages are dumped to \path{stderr}. + +The parameter |-o| provides the name of the output file. Both +\path{input_file} and \path{output_file} can be ``-'', which means +\path{stdin} for the input and \path{stdout} for the output. If the +parameter |-o| is absent, the program tries to guess the name of +the output file from the name of the input file. If the input file is +|foo.csv|, the output file will be |foo.tex|. On the other +hand, if the input file is \path{stdin}, the output file is +\path{stdout}. + +Usually pedigrees are built starting from the proband\footnote{The + proband is the first person among the relatives who came to a + geneticist; he or she is the primary patient.}. Only the people +that share genes with the proband, are shown on the pedigree. +However, in some cases, for example when there is no proband, or +where there are several probands, it is neccessary to override this +default and tell the program from which person to start. This is done +using the option |-s|. If it is present, it must be followed by the +Id of a person in the data file (see Section~\ref{sec:data_file} for +the discussion of Id). + +The option |-v| is special. The invocation |pedigree -v| +outputs the version and license information. + + +\subsection{Data File} +\label{sec:data_file} + +The input for the program is a separated values file. Usually such +files are called CSV for ``comma separated values''. However, this +program uses the vertical bar (``pipe'') \verb+|+ as a separator. +Each line of this file is a \emph{record}. The lines are separated by +pipes into \emph{fields.} Most SQL programs produce such files by +default. Spreadsheet programs will make them if you choose ``Save +As\dots'' option, and select \verb+|+ as the field separator, and +empty text delimiter. We sometimes will call the records ``rows'' and +the fields ``columns'' to use the familiar spreadsheet metaphor. +Normally each row corresponds to a person in a pedigree. We will call +this person \emph{the current person} when describing the fields. + +The width of the fields may not be the same in all rows (or, in other +words, the pipes \verb+|+ may be disaligned). We make them aligned in +the examples included in this manual just to make the text more +readable. + +The first line of the data file contains the names of the fields +(``column headers''). The fields in the subsequent lines must match +the order of the headers. An empty field must be still included (as +\verb+||+ or \verb+| |+). Otherwise the order of columns is arbitrary +as long as it is the same for all rows (i.e. matches the order of +``column headers'' in the first line). + +All fields but |Id| are optional. If the value is empty for all rows, +the corresponding column can be dropped. If applicable, the default +values for this field will be substituted by the program. + +On the other hand the data file can include any additional columns as +long as their names do not clash with the names listed below and the +special name |AgeAtDeath|. These additional columns can be included +in the chart or legend as described in +Section~\ref{sec:what_to_print}. + +Here is the list of columns and explanation of their meaning: +\begin{description} +\item[Id:] Each line (including the special lines described below) + must have a unique |Id|. The |Id| may contain only Latin letters + and numbers, and start with a letter. +\item[Name:] The name of the person described in the current row. + There are also \emph{special names} when the current row describes + abortions or infertility. They are described below. The names + should not contain ``special symbols'' like \#, \$, \%, \_, + \textasciicircum, etc. +\item[Sex:] The gender of a person. This column may have one of two + values: |male| or |female|. The empty value corresponds to a person + with unknown gender. +\item[DoB:] The date of birth for the current person. The format is + |YYYY.MM.DD|. If the date of birth is not known, the field may be + empty or the keyword |unknown| may be used. +\item[DoD:] The date of death for current person. The format is the + same as for |DoB|: |YYYY.MM.DD|. If this field is empty, the + corresponding person is alive. For deceased persons with an unknown + date of death use the keyword |unknown|. Note the subtle difference + between the fields |DoB| and |DoD|: an empty value for |DoB| is + means ``unknown birth date'' while for |DoD| it means that there is + no date of death at all. +\item[Mother:] The |Id| of the mother of the person (or empty). +\item[Father:] The |Id| of the father of the person (or empty). +\item[Proband] This field can be either |yes| for the probands, or + empty (or |no|) for other persons. Note that if a pedigree has no + probands or several probands, the program does not know, from which + node to start the pedigree. Therefore in this case the option |-s| + must be used to explicitly set the |Id| of the starting chart node + (see Section~\ref{sec:invocation}). +\item[Condition:] This column can have the values |normal|, + |obligatory|, |asymptomatic| or |affected|. If it is empty, the + default value |normal| is assumed. +\item[Comment:] A comment about the person. +\item[Twins:] If the current person has twins, they are listed in this + column separated by spaces and (or) commas. See + Section~\ref{sec:twins} for more details. +\item[Type:] This column is used in certain special cases. For + abortions it shows the type of the abortion + (Section~\ref{sec:abortions}), for childless people and marriages it + shows the type of childnessness (Section~\ref{sec:childless}), and + for twins it shows the type of twins (Section~\ref{sec:twins}). +\item[SortOrder:] This column is used when the algorithm for sorting + siblings and unions gives a wrong result, and a manual correction is + needed. See Section~\ref{sec:sorting} for the explanation and + examples. +\end{description} + +Examples of data files (in English and Russian) are shown in +Listing~\ref{lst:data_examples} (the Russian keywords are discussed in +Section~\ref{sec:language}). + +\begin{lstlisting}[float, caption={Examples of Data Files (English and +Russian)}, label=lst:data_examples, escapeinside={`'}] +` +\rotatebox{90}{% + \begin{minipage}{1.5\linewidth} + \small + \VerbatimInput{../examples/english.csv} + \bigskip + \selectlanguage{russian} + \VerbatimInput{../examples/russian.csv} + \end{minipage}} +' +\end{lstlisting} + +\begin{figure} + \centering + \input{english.tex} + \caption{Example of the Typeset Pedigree in English (Data File from + Listing~\ref{lst:data_examples})} + \label{fig:example-english-typeset} +\end{figure} + +\begin{figure} + \centering + {\selectlanguage{russian} + \input{russian.tex}} + \caption{Example of the Typeset Pedigree in Russian (Data File from + Listing~\ref{lst:data_examples})} + \label{fig:example-russian-typeset} +\end{figure} + + +\subsection{Twins} +\label{sec:twins} + +The column |Twins| (see Section~\ref{sec:twins}) lists all |Id|s of +all twins of the given person. The column |Type| can be used to show +the type of the twins. The empty value means polyzygotic twins, +|monozygotic| means monozygotic twins, and |qzygotic| is used in the +case when the type of twins is under doubt. An example of a data file +with twins is shown on Listing~\ref{lst:twins}, and the corresponding +pedigree on Figure~\ref{fig:twins}. + + +\begin{lstlisting}[float, caption={Example of Data File with Twins}, +label=lst:twins, escapeinside={`'}] +` + \small + \VerbatimInput{../examples/twins.csv} +' +\end{lstlisting} + +\begin{figure} + \centering + \input{twins.tex} + \caption{Example of a Pedigree with Twins (Data File from + Listing~\ref{lst:twins})} + \label{fig:twins} +\end{figure} + +\subsection{Abortions} +\label{sec:abortions} + +Aborted pregnancies are described by a special entry in the data file. +The field |Name| has the value |#abortion|; the symbol |#| is used to +show that this is a special value. The columns |Sex|, |DoB|, +|Mother|, |Father| and |Condition| have the usual meaning. The +special column |Type| is either empty or be equal to |sab| for +self-abortions. + +\begin{lstlisting}[float, caption={Example of Data File with Abortions}, +label=lst:abortions, escapeinside={`'}] +` + \small + \VerbatimInput{../examples/abortions.csv} +' +\end{lstlisting} + +\begin{figure} + \centering + \input{abortions.tex} + \caption{Example of a Pedigree with Abortions (Data File from + Listing~\ref{lst:abortions})} + \label{fig:abortions} +\end{figure} + +\subsection{Childlessness and Infertility} +\label{sec:childless} + +Childlessness is can be a property of a person or a union between two +persons. Therefore in this implementation we use a special row rather +than a column to report it. As other rows, this one has a unique +|Id|. The |Name| column should have a special entry |#childless|. +Like |#abortion| (Section~\ref{sec:abortions}), this special name +starts with |#| to distinguish it from ``real'' names. There are four +other columns that have meaning for this row: +\begin{description} +\item[Mother:] The |Id| of the childless female. +\item[Father:] The |Id| of the childless male. If both |Mother| and + |Father| columns are not empty, the entry describes the union + between the |Father| and |Mother|. Of only |Mother| or |Father| is + not empty, the entry describes the state of the corresponding + person. +\item[Type:] This column might be either empty or have a keyword + |infertile|. In the latter case the childlessness of the person or + union is caused by a proven infertility. +\item[Comment:] The vaule of this column is shown under the + childlessness symbol on the chart. Put there a short description of + the cause of childlessness, like |anospermia| or |vasectomy|. +\end{description} +An example of a pedigree with childlessness is shown on +Listing~\ref{lst:childless} and Figure~\ref{fig:childless}. + +\begin{lstlisting}[float, caption={Example of Data File with +Childlessness}, label=lst:childless, escapeinside={`'}] +` + \small + \VerbatimInput{../examples/childlessness.csv} +' +\end{lstlisting} + +\begin{figure} + \centering + \input{childlessness.tex} + \caption{Example of a Pedigree with Childlessness (Data File from + Listing~\ref{lst:childless})} + \label{fig:childless} +\end{figure} + +\subsection{Ordering Siblings and Marriage Partners} +\label{sec:sorting} + +The generations in pedigrees are ordered in vertical direction, from +up do down. How should we order the people on the same generation, +i.e. siblings and marriage partners? + +Usually two rules are used: +\begin{enumerate} +\item The siblings are ordered from the oldest on the left to the + youngest to the right.\label{item:sibling_order} +\item In marriage or other union the male is to the left, and the + female is to the right. +\end{enumerate} +However, the combination of these rules might lead to the situation +when marriage lines intersect the parental lines. Therefore the +rule~\ref{item:sibling_order} is usually implicitly modified: +\begin{enumerate} +\item[\ref{item:sibling_order}a.] The are ordered from the oldest on + the left to the youngest to the right. However, if a sibling's + marriage is shown on a pedigree, this sibling is always the + rightmost (male) or the leftmost (female). +\end{enumerate} +The program follows these rules. It is enough to draw pedigrees in +most cases. In particular, they always produce correct pedigrees if +there is only one marriage shown. However, in complex cases these +rules fail, as shown on Listing~\ref{lst:sort1} and +Figure~\ref{fig:sort1}. It is possible to extend the rules +above to account for these cases, however we chose another solution: +to provide a facility for the manual intervention in the sorting and +ordering algorithm. For this purpose a special column |SortOrder| is +used. It can have positive numbers greater than 1 or negative numbers +smaller than -1. If the value of this column is positive, the +corresponding person is moved to the left when sorting siblings and +to the right when sorting marriage partners. If it is negative, the +opposite sorting rule is applied (see Section~\ref{sec:alg_sorting} +for more detailed discussion). Note that sibling sorting and marriage +partners sorting must work in opposite directions, otherwise marriage +lines intersect paternal lines. + +\begin{lstlisting}[float, caption={A Data File with a Sorting +Problem}, label=lst:sort1, escapeinside={`'}] +` + \small + \VerbatimInput{../examples/sort1.csv} +' +\end{lstlisting} + +\begin{figure} + \centering + \input{sort1.tex} + \caption{Pedigree from Listing~\ref{lst:sort2}} + \label{fig:sort1} +\end{figure} + +Let us return to the pedigree on Listing~\ref{lst:sort1}. To improve +Figure~\ref{fig:sort1} we can either move Peter to the right or Lucy to +the left. The first solution is shown on Listing~\ref{lst:sort2} and +Figure~\ref{fig:sort2}. The second is shown on Listing~\ref{lst:sort3} and +Figure~\ref{fig:sort3}. + +\begin{lstlisting}[float, caption={First Solution to the Problem in +Listing~\ref{lst:sort1} }, label=lst:sort2, escapeinside={`'}] +` + \small + \VerbatimInput{../examples/sort2.csv} +' +\end{lstlisting} + +\begin{figure} + \centering + \input{sort2.tex} + \caption{Pedigree from Listing~\ref{lst:sort2}} + \label{fig:sort2} +\end{figure} + +\begin{lstlisting}[float, caption={Second Solution to the Problem in +Listing~\ref{lst:sort1} }, label=lst:sort3, escapeinside={`'}] +` + \small + \VerbatimInput{../examples/sort3.csv} +' +\end{lstlisting} + +\begin{figure} + \centering + \input{sort3.tex} + \caption{Pedigree from Listing~\ref{lst:sort3}} + \label{fig:sort3} +\end{figure} + + +Of course sometimes a pedigree cannot be drawn without +self-intersections with any sorting of siblings. An example of such +pedigree is shown on Listing~\ref{lst:badsort} and +Figure~\ref{fig:badsort}. Obviously no amount of shuffling the +siblngs can help in his case. + +\begin{lstlisting}[float, caption={A Pedigree with Unavoidable +Self-Intersections}, label=lst:badsort, escapeinside={`'}] +` + \small + \VerbatimInput{../examples/badsort.csv} +' +\end{lstlisting} + +\begin{figure} + \centering + \input{badsort.tex} + \caption{Pedigree from Listing~\ref{lst:badsort}} + \label{fig:badsort} +\end{figure} + + +If the program cannot avoid self-intersection of marriage lines and +parental lines despite automatics sorting and manual intervention, as +the last resort it creates a multi-segment marriage line, as shown on +Figures~\ref{fig:sort1} and~\ref{fig:badsort}. + + +\subsection{Consanguinic Unions} +\label{sec:consanguinic} + +Consanguinic unions present a technical problem for the program (see +the discussion in Section~\ref{sec:alg_consanguinic}). Therefore the +support of consanguinicity is experimental for this release. + +There is a number of limitations for consanguinic unions in the data +file at present. First, the consanguinic unions should not in the +direct lineage of the proband or the person from which the pedigree +starts. In many cases this limitation can eliminated by using |-s| +option (see Section~\ref{sec:invocation}) to choose a different +starting point for the pedigree. Second, the children of consanguinic +unions might appear not centerd on the charts. An example of a +pedigree with consanguinic marriages is shown on +Listing~\ref{lst:consanguinic}, and the corresponding chart is shown +on Figure~\ref{fig:consanguinic}. The drawbacks of the program are +evident from the positions of Laura nad Jack on these charts. + +\begin{lstlisting}[float, caption={A Pedigree with Consanguinic +Unions}, label=lst:consanguinic, escapeinside={`'}] +` + \small + \VerbatimInput{../examples/consanguinic.csv} +' +\end{lstlisting} + +\begin{figure} + \centering + \input{consanguinic.tex} + \caption{Pedigree from Listing~\ref{lst:consanguinic}} + \label{fig:consanguinic} +\end{figure} + + + +\subsection{Language-Dependent Keywords} +\label{sec:language} + +At present the program \program{pedigree} can work with English and +Russian languages. As discussed in Section~\ref{sec:conf_lang}, the +language options chooses \emph{both} the languages of input and output +files. It is easy to add new languages to the scheme by expanding the +library |Pedigree::Language.pm| in the distribution. + +The English language is the default. Moreover, if the Russian option +is chosen, English keywords are still recognized in the input file. + +The English and Russian keywords are listed in +Table~\ref{tab:keywords}. Note that some keywords have variants; +they are listed in the table as well. + +\begin{table} + \centering + \begin{tabular}{lll} + \hline + English keyword & English variants & Russian keywords \\ + \hline + \multicolumn{3}{l}{\textbf{Field Names}}\\ + Id & & \foreignlanguage{russian}{éÄÅÎÔ}\\ + Name & & \foreignlanguage{russian}{æéï}\\ + Sex & & \foreignlanguage{russian}{ðÏÌ}\\ + DoB & & \foreignlanguage{russian}{òÏÖÄ}\\ + DoD & & \foreignlanguage{russian}{õÍÅÒ}\\ + Mother & & \foreignlanguage{russian}{íÁÔØ}\\ + Father & & \foreignlanguage{russian}{ïÔÅÃ}\\ + Proband & & \foreignlanguage{russian}{ðÒÏÂÁÎÄ}\\ + Condition & & \foreignlanguage{russian}{óÏÓÔÏÑÎÉÅ}\\ + Comment & & \foreignlanguage{russian}{ëÏÍÍÅÎÔÁÒÉÊ}\\ + Type & & \foreignlanguage{russian}{ôÉÐ}\\ + Twins & & \foreignlanguage{russian}{âÌÉÚÎÅÃÙ}\\ + SortOrder & Sort & \foreignlanguage{russian}{ðÏÒÑÄÏËóÏÒÔÉÒÏ×ËÉ, + óÏÒÔ}\\ + \multicolumn{3}{l}{\textbf{Field Values}}\\ + male & & \foreignlanguage{russian}{ÍÕÖ, Í}\\ + female & & \foreignlanguage{russian}{ÖÅÎ, Ö}\\ + unknown & & \foreignlanguage{russian}{ÎÅÉÚ×, ÎÅÉÚ×ÅÓÔÎÏ}\\ + yes & & \foreignlanguage{russian}{ÄÁ}\\ + no & & \foreignlanguage{russian}{ÎÅÔ}\\ + normal & & \foreignlanguage{russian}{ÎÏÒÍ, ÚÄÏÒÏ×}\\ + obligatory & obligat & \foreignlanguage{russian}{ÏÂÌÉÇÁÔ}\\ + asymptomatic & asymp & \foreignlanguage{russian}{ÁÓÉÍÐ}\\ + affected & affect & \foreignlanguage{russian}{ÂÏÌØÎ, ÂÏÌÅÎ}\\ + infertile & & \foreignlanguage{russian}{ÂÅÓÐÌÏÄÎ}\\ + sab & & \foreignlanguage{russian}{×ÙËÉÄÙÛ}\\ + monozygotic & monzygot & \foreignlanguage{russian}{ÍÏÎÏÚÉÇÏÔÎ, + ÍÏÎÏÚÉÇ, ÏÄÎÏÑÊÃÅ×}\\ + qzygotic & qzygot, ? & \foreignlanguage{russian}{?}\\ + \multicolumn{3}{l}{\textbf{Special Names}}\\ + |#|abortion & & |#|\foreignlanguage{russian}{ÁÂÏÒÔ}\\ + |#|childless & & |#|\foreignlanguage{russian}{ÂÅÚÄÅÔÎ}\\ + \hline + \end{tabular} + \caption{Keywords in Different Languages} + \label{tab:keywords} +\end{table} + + + + + +\clearpage + +\part{Algorithm Description} +\label{part:algortihm} + + +\section{Introduction} +\label{sec:alg_intro} + +This part is intended for advanced users and is not neccessary for +runnuing the program. + +The problem of nicely typesetting graphs is one of the classical +problems in the Computer Science~\cite{GraphDrawing99}. One of the +earliest algorithms here is the classical algorithm for layered rooted +trees by Reingold and Tilford~\cite[\S~3.1]{GraphDrawing99}. This +algorithm was implemented by |PSTricks|~\cite{PSTricks93}. However, +many pedigrees are not trees~\cite{pst-pdgr06}. If we consider a +subset of pedigrees where inbreeding is absent, the pedigrees become +trees. However, even in this case the the tree is not necessary +layered, as can be seen from +Figure~\ref{fig:example-english-typeset}. Therefore a new approach +generalizing Reingold-Tilford algorithm is necessary. This approach +is based on the analysis of the structure of pedigrees and is +sketched in the remainder of this manual. + +\section{Main Algorithm} +\label{sec:alg} + + +A pedigree consists of nodes (vertices), connected by lines (edges). +If there is no inbreeding, the graph is acyclic. There are two kinds +of nodes in the graph: person nodes (squares and circles on +Figures~\ref{fig:example-english-typeset} +and~\ref{fig:example-russian-typeset}) and \emph{marriage nodes}, +which are nameless on the figures. We will use the notation ``male +spouse-female spouse'' for such nodes, so the marriage nodes on +Figure~\ref{fig:example-english-typeset} are I:1-I:2, I:3-I:4 and +II:2-II:3. A node has a \emph{precedessor} and \emph{children}. A +marriage node does not have a precedessor, but has \emph{male spouse} +and \emph{female spouse} (it is customary to put male spouses to the +left and female spouses to the right on pedigrees). Any node has a +\emph{downward tree} of its children, grandchildren etc. The downward +tree may be empty. + +Any node in an acyclic graph can be a root. However, in layered +trees there is a special root: the one that has no precedessor. +Similarly we will call a \emph{local root} a node that has no +predecessor. All marriage nodes are local roots. Some person nodes +can be local roots as well. + +Let us first discuss the case where cobnsanguinic marriages are +absent. In this case a pedigree is a tree. + +The proposed algorithm is recursive and starts from a local root. +Strictly speaking, it can start from any local root, but medical +pedigrees have a special person: \emph{proband,} the person who was +the first to be examined by genetic specialists (the proband is shown by an +arrow drawn near the node on +Figures~\ref{fig:example-english-typeset} +and~\ref{fig:example-russian-typeset}). Therefore it makes sense to +start from the local root which has proband in its downward tree. + +If this local root is a person node, the pedigree is the layered tree, +and Reingold-Tilford algorithm is sufficient. Therefore we should +consider only the case when the local root is a marriage node. In +this case we can typeset the downward tree using Reingold-Tilford +algorithm. The spouses do not belong to this tree. However, each of +them belongs to each own subpedigree. We will call them \emph{left + subpedigree} and \emph{right subpedigree}. We recursively apply our +algorithm to typeset left and right subpedigrees. Then we move the +left subpedigree to the right and right subpedigree to the left as far +as we can without intersection between them and the downward tree. + +This process is shown on Figure~\ref{fig:subpedigrees}. Obviously +this algorithm converges and leads to typesetting the pedigree without +intersections between the subtrees and subpedigrees. + +\begin{figure} + \centering + \begin{pspicture}(-7,-4)(5.5,4) +% \psgrid(-8,-4)(6,4) + \rput(-6, 2){\pstPerson[male, normal, belowtext=I:1, deceased]{GF1}} + \rput(-4, 2){\pnode{GF1_m_GM1}} + \rput(-2, 2){\pstPerson[female, asymptomatic, belowtext=I:2, deceased]{GM1}} + \rput(0, 2){\pstPerson[male, normal, belowtext=I:3]{GF2}} + \rput(2, 2){\pnode{GF2_m_GM2}} + \rput(4, 2){\pstPerson[female, normal, belowtext=I:4]{GM2}} + \rput(-5, 0){\pstPerson[female, obligatory, belowtext=II:1]{A1}} + \rput(-3, 0){\pstPerson[male, affected, belowtext=II:2]{F1}} + \rput(0, 0){\pnode{F1_m_M1}} + \rput(2, 0){\pstPerson[female, normal, belowtext=II:3]{M1}} + \rput(-5, -2){\pstPerson[female, affected, belowtext=III:1]{C1}} + \rput(-2, -2){\pstPerson[male, affected, belowtext=III:2, proband]{P}} + \rput(0, -2){\pstPerson[female, affected, belowtext=III:3]{S1}} + \rput(2, -2){\pstPerson[male, normal, belowtext=III:4]{S2}} + \pstDescent{GF1_m_GM1}{A1} + \pstDescent{GF1_m_GM1}{F1} + \ncline{GF1_m_GM1}{GM1} + \ncline{GF1_m_GM1}{GF1} + \pstDescent{GF2_m_GM2}{M1} + \ncline{GF2_m_GM2}{GM2} + \ncline{GF2_m_GM2}{GF2} + \pstDescent{A1}{C1} + \pstDescent{F1_m_M1}{P} + \pstDescent{F1_m_M1}{S1} + \pstDescent{F1_m_M1}{S2} + \ncline{F1_m_M1}{M1} + \ncline{F1_m_M1}{F1} + \ncbox[linestyle=none, boxsize=1, nodesepA=0.7, nodesepB=0.7, + boxdepth=0.7, style=TBlue]{GF1}{GM1} + \ncbox[linestyle=none, boxsize=1.3, nodesepA=0.7, nodesepB=0.7, + boxdepth=0.7, style=TBlue]{A1}{F1} + \ncbox[linestyle=none, boxsize=1.3, nodesepA=0.7, nodesepB=0.7, + boxdepth=0.7, style=TBlue]{C1}{C1} + \rput(-4,3.2){\textcolor{blue}{Left subpedigree}} + \ncbox[linestyle=none, boxsize=1, nodesepA=0.7, nodesepB=0.7, + boxdepth=0.7, style=TRed]{GF2}{GM2} + \ncbox[linestyle=none, boxsize=1.3, nodesepA=0.7, nodesepB=0.7, + boxdepth=0.7, style=TRed]{M1}{M1} + \rput(2,3.2){\textcolor{red}{Right subpedigree}} + \ncbox[linestyle=none, boxsize=1.3, nodesepA=0.7, nodesepB=0.7, + boxdepth=0.7, style=TGreen]{P}{S2} + \rput(0,-3){\textcolor{green}{Downward tree}} + \rput(0,0){\psdot} + \rput(0,0.2){Local root} + \end{pspicture} + \caption{Subpedigrees and Downward Tree} + \label{fig:subpedigrees} +\end{figure} + + +\section{Algorithm for Sorting Siblings and Marriage Partners} +\label{sec:alg_sorting} + +When we create a marriage node, we want to put the male to the left +and the female to the right. When we then sort siblings, we want this +male to be the rightmost, and the female to be the leftmost. To do +so, we assign to each node the special quantity |SortOrder|. +Initially all nodes have |SortOrder| equal to zero, unless +specifically set by the user in the input file (see +Section~\ref{sec:sorting}). Then we use the following rules: +\begin{enumerate} +\item When creating the the marriage node: + \begin{enumerate} + \item If both spouses have equal |SortOrder| field, the male goes to + the left, the female goes to the right. + \item Otherwise, the spouse with greater |SortOrder| goes to the left. + \item If |SortOrder| of a spouse is 0, we set it to 1 (the + spouse on the left) or -1 (the spouse on the right). + \end{enumerate} +\item When sorting siblings: + \begin{enumerate} + \item The sibling with smaller |SortOrder| goes to the left. + \item If both siblings have the same |SortOrder|, the oldest one + goes to the left. + \end{enumerate} +\end{enumerate} + +\section{Modifications for Consangunic Unions} +\label{sec:alg_consanguinic} + +Consanguinic unions present a problem for the described algorithm, +because pedigrees with them are no longer trees (see +Figure~\ref{fig:consanguinic}). + +In this release of the program we use the following hack. The direct +lineage of the proband (or, more generally, the starting node) may have +both mothers and fathers in the pedigree because they share genes from +the starting node. If any other person has both mother and father in +the chart, his or her parents both shared their genes with the +starting node. Therefore they formed a consanguinic union. In this +case the children of this node appear in two subtrees: their mother's +and their father's. + +We delete them from one of the subtrees (the one with lower generation +number), connect their parents with a double line (consanguinic union) +and put the descent line from the middle of the union to them. + +There are two problems with this hack (see +Section~\ref{sec:consanguinic}): the children of consanguinic unions +are not centered on the diagaram, and the hack fails if the starting +node itself is a descendant of a consanguinic union. + +Probably the next releases will employ better algorithms for +consanguinic unions. + +\section{Conclusion} +\label{sec:concl} + +The algorithm seems to be efficient and producing nicely typeset +pedigrees. Since the input file format is simple, it may be used by +the people without special skills in \LaTeX. On the other hand, the +\TeX{} files produces are easy to understand and edit manually if the +need arises. + +\clearpage + +\section{Acknowledgements} +\label{sec:ack} + +The authors are grateful to Herbert Vo\ss{} for help with +|PSTricks| code. The support of \TeX{} User Group is gratefully +acknowledged. One of the authors (LA) was supported by Russian +Foundation for Fundamental Research (travel grant 06-04-58811), +Russian Federation President Council for Grants Supporting Young +Scientists and Flagship Science Schools (grant MD-4245.2006.7) + + +\bibliographystyle{unsrt} +\bibliography{pedigree} + +\end{document} + +% $Id: pedigree.tex,v 2.18 2012-03-16 01:29:03 boris Exp $
\ No newline at end of file diff --git a/Master/texmf-dist/doc/support/pedigree-perl/doc/russian.tex b/Master/texmf-dist/doc/support/pedigree-perl/doc/russian.tex new file mode 100644 index 00000000000..70b3dad5cb4 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/doc/russian.tex @@ -0,0 +1,27 @@ +{% +\psset{descarmA=0.8}% +\begin{pspicture}(-6.6,-9.9)(6.6,3.3) +\rput(0, 0){\pnode{F1_m_M1}} +\rput(3.3, 0){\pstPerson[female, normal, belowtext={\small I:2}, deceased, abovetext={\scriptsize é×ÁÎÏ×Á ìÀÂÏ×Ø é×ÁÎÏ×ÎÁ}]{M1}} +\rput(-3.3, 0){\pstPerson[male, obligatory, belowtext={\small I:1}, deceased, abovetext={\scriptsize é×ÁÎÏ× ðÅÔÒ éÌØÉÞ}]{F1}} +\rput(0, -6.6){\pstPerson[female, normal, belowtext={\small III:2}, abovetext={\scriptsize é×ÁÎÏ×Á äÁÒØÑ óÅÒÇÅÅ×ÎÁ}]{K2}} +\rput(-3.3, -6.6){\pstPerson[male, asymptomatic, belowtext={\small III:1}, abovetext={\scriptsize é×ÁÎÏ× é×ÁÎ óÅÒÇÅÅ×ÉÞ}]{K1}} +\rput(1.65, -3.3){\pstPerson[female, normal, belowtext={\small II:2}, abovetext={\scriptsize é×ÁÎÏ×Á áÎÎÁ ðÅÔÒÏ×ÎÁ}]{S1}} +\rput(-1.65, -3.3){\pstPerson[male, affected, belowtext={\small II:1}, proband, abovetext={\scriptsize é×ÁÎÏ× óÅÒÇÅÊ ðÅÔÒÏ×ÉÞ}]{P}} +\pstDescent{F1_m_M1}{P} +\pstDescent{F1_m_M1}{S1} +\ncline[]{F1_m_M1}{M1} +\ncline[]{F1_m_M1}{F1} +\pstDescent{P}{K1} +\pstDescent{P}{K2} +\end{pspicture}% +} + +\begin{description} +\item[I:1] é×ÁÎÏ× ðÅÔÒ éÌØÉÞ; {\cyr\cyrr\cyro\cyrd.} {\cyr\cyrn\cyre\cyri\cyrz\cyrv.}; {\cyr\cyru\cyrm. \cyrv{} \cyrv\cyro\cyrz\cyrr. } {\cyr\cyrn\cyre\cyri\cyrz\cyrv.}. +\item[I:2] é×ÁÎÏ×Á ìÀÂÏ×Ø é×ÁÎÏ×ÎÁ; {\cyr\cyrr\cyro\cyrd.} 1935/12/01; {\cyr\cyru\cyrm. \cyrv{} \cyrv\cyro\cyrz\cyrr. } 70. +\item[II:1] é×ÁÎÏ× óÅÒÇÅÊ ðÅÔÒÏ×ÉÞ; {\cyr\cyrr\cyro\cyrd.} 1965/08/06. +\item[II:2] é×ÁÎÏ×Á áÎÎÁ ðÅÔÒÏ×ÎÁ; {\cyr\cyrr\cyro\cyrd.} 1968/05/05. +\item[III:1] é×ÁÎÏ× é×ÁÎ óÅÒÇÅÅ×ÉÞ; {\cyr\cyrr\cyro\cyrd.} 1990/12/01; çÅÎÅÔÉÞ. ÉÓÓÌ. 2005/12/08. +\item[III:2] é×ÁÎÏ×Á äÁÒØÑ óÅÒÇÅÅ×ÎÁ; {\cyr\cyrr\cyro\cyrd.} 1995/03/24; çÅÎÅÔÉÞ. ÉÓÓÌ. 2005/12/08. +\end{description} diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/abortions.csv b/Master/texmf-dist/doc/support/pedigree-perl/examples/abortions.csv new file mode 100644 index 00000000000..0397efb1aa0 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/abortions.csv @@ -0,0 +1,5 @@ +Id |Name |Sex |DoB |DoD |Mother|Proband|Condition|Type +A0 |Ann |female|1970.06.15| | | |affected | +B1 |#abortion|female|1990.03.01| |A0 | |affected | +B2 |#abortion|male |2000.10.10| |A0 | | |sab +B3 |John |male |2002.12.01| |A0 |yes |affected | diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/badsort.csv b/Master/texmf-dist/doc/support/pedigree-perl/examples/badsort.csv new file mode 100644 index 00000000000..26816361950 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/badsort.csv @@ -0,0 +1,14 @@ +Id |Name |Sex |DoB |Father|Mother|Proband +A0 |John |male |1915.06.15| | | +B1 |Sam |male |1935.12.04|A0 | | +B2 |Ann |female|1937.03.02|A0 | | +C1 |Paul |male |1952.10.03|B1 | | +F1 |Scott |male |1912.02.01| | | +G1 |Simon |male |1934.09.17|F1 | | +G2 |Sarah |female|1936.12.19|F1 | | +H1 |Lola |female|1960.04.13|G2 | | +K1 |Jim |male |1962.11.05|G1 |B2 | +M1 |Jane |female|1917.02.13| | | +P1 |Simon |male |1935.10.04| | M1 | +R1 |Pam |female|1964.02.05|P1 | | +X1 |James |male |1988.07.12|K1 |R1 |yes
\ No newline at end of file diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/childlessness.csv b/Master/texmf-dist/doc/support/pedigree-perl/examples/childlessness.csv new file mode 100644 index 00000000000..38b524cb457 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/childlessness.csv @@ -0,0 +1,6 @@ +Id |Name |Sex |Mother|Father|Proband|Type |Comment +A0 |John |male | | | | | +B1 |James |male | |A0 | | | +B1c|#childless |male | |B1 | |infertile |anospermia +B2 |Ann |female| |A0 |yes | | +B2c|#childless | |B2 | | | |
\ No newline at end of file diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/consanguinic.csv b/Master/texmf-dist/doc/support/pedigree-perl/examples/consanguinic.csv new file mode 100644 index 00000000000..0aba287f1a4 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/consanguinic.csv @@ -0,0 +1,11 @@ +Id |Name |Sex |Father|Mother|Proband|DoB +A0 |Jane |female| | | |1908.12.12 +B1 |John |male | |A0 | |1936.12.15 +B2 |Ann |female| |A0 | |1934.04.17 +B3 |Samantha |female| |A0 | |1932.12.03 +B4 |Nancy |female| |A0 | |1928.01.05 +C1 |Mary |female| |B2 | yes |1955.08.26 +C2 |Paul |male | |B3 | |1964.05.07 +C3 |Jane |female| |B4 | |1950.11.03 +D1 |Jack |male |B1 |C1 | |1975.07.01 +D2 |Laura |female|C2 |C3 | |1974.09.05 diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/english.cfg b/Master/texmf-dist/doc/support/pedigree-perl/examples/english.cfg new file mode 100644 index 00000000000..a8028789a77 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/english.cfg @@ -0,0 +1,76 @@ +# An example configuration file for pedigree program +# This file is used for the examples in the program manual. + +# Do we want to have a full LaTeX file or just a fragment? +# +$fulldoc=0; + +# What kind of document do we want +# +# $documentheader='\documentclass[landscape]{article}'; + +# Define additional packages here +# +# $addtopreamble=<<END; +# \\usepackage{pst-pdgr} +# END + +# Do we want to print a legend? +# +$printlegend=1; + +# Fields to include in the legend. Delete Name for privacy +# protection. +# +@fieldsforlegend = qw(Name DoB AgeAtDeath Comment); + +# +# Fields to put at the node. Delete Name for privacy +# protection. +# +@fieldsforchart = qw(Name); + +# Language +# +# $language="russian"; +$language="english"; + +# Override the encoding +# +# $encoding="koi8-r"; + +# +# Fonts for the chart +# +$belowtextfont='\small'; +$abovetextfont='\scriptsize'; + +# +# descarmA +# +$descarmA = 0.8; + +# +# Distances between nodes (in cm) +# +$xdist=2; +$ydist=2; + +# +# Maximal width and height of the pedigree in cm. +# Set this to 0 to switch off scaling +# +$maxW = 15; +$maxH = 19; + +# +# Whether to rotate the page. The values are 'yes', 'no' and 'maybe' +# If 'maybe' is chosen, the pedigree is rotated if it allows better +# scaling +# +$rotate = 'maybe'; + + +# Must be the last line +# +1; diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/english.csv b/Master/texmf-dist/doc/support/pedigree-perl/examples/english.csv new file mode 100644 index 00000000000..01a59888bd1 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/english.csv @@ -0,0 +1,12 @@ +Id |Name |Sex |DoB | DoD |Mother|Father|Proband|Condition |Comment +P |John Smith |male |1970/02/05| |M1 |F1 | yes | affected|Evaluated 2005/12/01 +M1 |Mary Smith |female|1940/02/05| |GM2 |GF2 | | normal | +F1 |Bill Smith |male |1938/04/03| |GM1 | GF1 | |affected | +GM1|Joan Smith |female|1902/07/01|1975/12/13| | | |asymptomatic +GF1|Joseph Smith |male |unknown |unknown | | | | normal +GF2|Jim Brown |male |1905/11/01| | | | | normal | +GM2|Lisa Brown |female|1910/03/03| | | | | normal | +S1 |Rebecca Smith |female|1972/12/25| |M1 |F1 | | affected +S2 |Alexander Smith |male |1975/11/12| |M1 |F1 | | normal +A1 |Ann Gold |female|1941/09/02| |GM1 | GF1 | | obligatory|Aunt of the proband +C1 | Jenny Smith |female|1969/12/03| |A1 | | | affected | Cousin of the proband diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/english1.cfg b/Master/texmf-dist/doc/support/pedigree-perl/examples/english1.cfg new file mode 100644 index 00000000000..5ce3a8d3037 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/english1.cfg @@ -0,0 +1,76 @@ +# An example configuration file for pedigree program +# This file is used for the examples in the program manual. + +# Do we want to have a full LaTeX file or just a fragment? +# +$fulldoc=0; + +# What kind of document do we want +# +# $documentheader='\documentclass[landscape]{article}'; + +# Define additional packages here +# +# $addtopreamble=<<END; +# \\usepackage{pst-pdgr} +# END + +# Do we want to print a legend? +# +$printlegend=0; + +# Fields to include in the legend. Delete Name for privacy +# protection. +# +@fieldsforlegend = qw(Name DoB AgeAtDeath Comment); + +# +# Fields to put at the node. Delete Name for privacy +# protection. +# +@fieldsforchart = qw(); + +# Language +# +# $language="russian"; +$language="english"; + +# Override the encoding +# +# $encoding="koi8-r"; + +# +# Fonts for nodes +# +$belowtextfont='\small'; +$abovetextfont='\scriptsize'; + +# +# descarmA +# +$descarmA = 0.9; + +# +# Distances between nodes (in cm) +# +$xdist=1.5; +$ydist=1.8; + +# +# Maximal width and height of the pedigree in cm. +# Set this to 0 to switch off scaling +# +$maxW = 15; +$maxH = 19; + +# +# Whether to rotate the page. The values are 'yes', 'no' and 'maybe' +# If 'maybe' is chosen, the pedigree is rotated if it allows better +# scaling +# +$rotate = 'maybe'; + + +# Must be the last line +# +1; diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/english_short.cfg b/Master/texmf-dist/doc/support/pedigree-perl/examples/english_short.cfg new file mode 100644 index 00000000000..8ee82a474c7 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/english_short.cfg @@ -0,0 +1,76 @@ +# An example configuration file for pedigree program +# This file is used for the examples in the program manual. + +# Do we want to have a full LaTeX file or just a fragment? +# +$fulldoc=0; + +# What kind of document do we want +# +# $documentheader='\documentclass[landscape]{article}'; + +# Define additional packages here +# +# $addtopreamble=<<END; +# \\usepackage{pst-pdgr} +# END + +# Do we want to print a legend? +# +$printlegend=0; + +# Fields to include in the legend. Delete Name for privacy +# protection. +# +@fieldsforlegend = qw(Name DoB AgeAtDeath Comment); + +# +# Fields to put at the node. Delete Name for privacy +# protection. +# +@fieldsforchart = qw(Name); + +# Language +# +# $language="russian"; +$language="english"; + +# Override the encoding +# +# $encoding="koi8-r"; + +# +# Fonts for the chart +# +$belowtextfont='\small'; +$abovetextfont='\scriptsize'; + +# +# descarmA +# +$descarmA = 0.8; + +# +# Distances between nodes (in cm) +# +$xdist=2; +$ydist=2; + +# +# Maximal width and height of the pedigree in cm. +# Set this to 0 to switch off scaling +# +$maxW = 15; +$maxH = 19; + +# +# Whether to rotate the page. The values are 'yes', 'no' and 'maybe' +# If 'maybe' is chosen, the pedigree is rotated if it allows better +# scaling +# +$rotate = 'maybe'; + + +# Must be the last line +# +1; diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/pedigree.cfg b/Master/texmf-dist/doc/support/pedigree-perl/examples/pedigree.cfg new file mode 100644 index 00000000000..a82689e0e39 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/pedigree.cfg @@ -0,0 +1,47 @@ +# An example configuration file for pedigree program +# + +# Do we want to have a full LaTeX file or just a fragment? +# +$fulldoc=1; + +# What kind of document do we want +# +# $documentheader='\documentclass[landscape]{article}'; +$documentheader='\documentclass{article}'; + +# Define additional packages here +# +# $addtopreamble=<<END; +# \\usepackage{graphics} +# END +$addtopreamble=<<END; +\\psset{armB=1} +END + +# Do we want to print a legend? +# +$printlegend=1; + +# Fields to include in the legend. Delete Name for privacy +# protection. +# +@fieldstoprint = qw(Name DoB AgeAtDeath Comment); + +# Language +# +# $language="russian"; +$language="english"; + +# Override the encoding, if neccessary +# +# $encoding="koi8-r"; + +# Distances between nodes (in cm) +# +$xdist=2; +$ydist=2; + +# Must be the last line +# +1;
\ No newline at end of file diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/russian.cfg b/Master/texmf-dist/doc/support/pedigree-perl/examples/russian.cfg new file mode 100644 index 00000000000..13f16b5974d --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/russian.cfg @@ -0,0 +1,78 @@ +# An example configuration file for pedigree program +# This file is used for the examples in the program manual. + +# Do we want to have a full LaTeX file or just a fragment? +# +$fulldoc=0; + +# What kind of document do we want +# +# $documentheader='\documentclass[landscape]{article}'; + +# Define additional packages here +# +# $addtopreamble=<<END; +# \\usepackage{pst-pdgr} +# END + +# Do we want to print a legend? +# +$printlegend=1; + +# Fields to include in the legend. Delete Name for privacy +# protection. +# +@fieldsforlegend = qw(Name DoB AgeAtDeath Comment); + +# +# Fields to put at the node. Delete Name for privacy +# protection. +# +@fieldsforchart = qw(Name); + +# Language +# +# $language="english"; + $language="russian"; + + +# Override the encoding +# +$encoding="koi8-r"; + +# +# Fonts for nodes +# +$belowtextfont='\small'; +$abovetextfont='\scriptsize'; + +# +# descarmA +# +$descarmA = 0.8; + +# +# Distances between nodes (in cm) +# +$xdist=3.3; +$ydist=3.3; + +# +# Maximal width and height of the pedigree in cm. +# Set this to 0 to switch off scaling +# +$maxW = 15; +$maxH = 19; + +# +# Whether to rotate the page. The values are 'yes', 'no' and 'maybe' +# If 'maybe' is chosen, the pedigree is rotated if it allows better +# scaling +# +$rotate = 'maybe'; + + + +# Must be the last line +# +1; diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/russian.csv b/Master/texmf-dist/doc/support/pedigree-perl/examples/russian.csv new file mode 100644 index 00000000000..d702582b964 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/russian.csv @@ -0,0 +1,7 @@ +éÄÅÎÔ|æéï |ðÏÌ|òÏÖÄ |õÍÅÒ |íÁÔØ|ïÔÅÃ|ðÒÏÂÁÎÄ|óÏÓÔÏÑÎÉÅ | ëÏÍÍÅÎÔÁÒÉÊ +P |é×ÁÎÏ× óÅÒÇÅÊ ðÅÔÒÏ×ÉÞ |ÍÕÖ|1965/08/06| |M1 |F1 |ÄÁ |ÂÏÌØÎ | +M1 |é×ÁÎÏ×Á ìÀÂÏ×Ø é×ÁÎÏ×ÎÁ|ÖÅÎ|1935/12/01|2005/10/01| | | |ÎÏÒÍ +F1 |é×ÁÎÏ× ðÅÔÒ éÌØÉÞ |ÍÕÖ|ÎÅÉÚ× |2003/01/25| | | |ÏÂÌÉÇÁÔ +S1 |é×ÁÎÏ×Á áÎÎÁ ðÅÔÒÏ×ÎÁ |ÖÅÎ|1968/05/05| |M1 |F1 | |ÎÏÒÍ +K1 |é×ÁÎÏ× é×ÁÎ óÅÒÇÅÅ×ÉÞ |ÍÕÖ|1990/12/01| | |P | |ÁÓÉÍÐ |çÅÎÅÔÉÞ. ÉÓÓÌ. 2005/12/08 +K2 |é×ÁÎÏ×Á äÁÒØÑ óÅÒÇÅÅ×ÎÁ|ÖÅÎ|1995/03/24| | |P | |ÎÏÒÍ |çÅÎÅÔÉÞ. ÉÓÓÌ. 2005/12/08 diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/sort1.csv b/Master/texmf-dist/doc/support/pedigree-perl/examples/sort1.csv new file mode 100644 index 00000000000..315721ebe8a --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/sort1.csv @@ -0,0 +1,12 @@ +Id |Name |Sex |DoB |Father|Mother|Proband +A0 |John |male |1915.06.15| | | +B1 |Joan |female|1940.03.02|A0 | | +B2 |Jane |female|1942.07.07|A0 | | +B3 |Bill |male |1944.12.01|A0 | | +B4 |Peter |male |1941.05.01| | | +C1 |Jack |male |1963.12.01|B4 |B2 | +C2 |Sam |male |1961.08.26| |B1 | +C3 |Ann |female|1965.11.12| |B3 | +C4 |Lucy |female|1965.12.11| | | +D1 |Mark |male |1989.06.21|C1 |C4 |yes +D2 |Dina |female|1991.12.02|C1 |C4 | diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/sort2.csv b/Master/texmf-dist/doc/support/pedigree-perl/examples/sort2.csv new file mode 100644 index 00000000000..f38830ee3eb --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/sort2.csv @@ -0,0 +1,12 @@ +Id |Name |Sex |DoB |Father|Mother|Proband|SortOrder +A0 |John |male |1915.06.15| | | | +B1 |Joan |female|1940.03.02|A0 | | | +B2 |Jane |female|1942.07.07|A0 | | | +B3 |Bill |male |1944.12.01|A0 | | | +B4 |Peter |male |1941.05.01| | | | 3 +C1 |Jack |male |1963.12.01|B4 |B2 | | +C2 |Sam |male |1961.08.26| |B1 | | +C3 |Ann |female|1965.11.12| |B3 | | +C4 |Lucy |female|1965.12.11| | | | +D1 |Mark |male |1989.06.21|C1 |C4 |yes | +D2 |Dina |female|1991.12.02|C1 |C4 | | diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/sort3.csv b/Master/texmf-dist/doc/support/pedigree-perl/examples/sort3.csv new file mode 100644 index 00000000000..44b60b2dc06 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/sort3.csv @@ -0,0 +1,12 @@ +Id |Name |Sex |DoB |Father|Mother|Proband|SortOrder +A0 |John |male |1915.06.15| | | | +B1 |Joan |female|1940.03.02|A0 | | | +B2 |Jane |female|1942.07.07|A0 | | | +B3 |Bill |male |1944.12.01|A0 | | | +B4 |Peter |male |1941.05.01| | | | +C1 |Jack |male |1963.12.01|B4 |B2 | | +C2 |Sam |male |1961.08.26| |B1 | | +C3 |Ann |female|1965.11.12| |B3 | | +C4 |Lucy |female|1965.12.11| | | | -3 +D1 |Mark |male |1989.06.21|C1 |C4 |yes | +D2 |Dina |female|1991.12.02|C1 |C4 | | diff --git a/Master/texmf-dist/doc/support/pedigree-perl/examples/twins.csv b/Master/texmf-dist/doc/support/pedigree-perl/examples/twins.csv new file mode 100644 index 00000000000..a07333accc1 --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/examples/twins.csv @@ -0,0 +1,12 @@ +Id |Name |Sex |DoB |DoD |Mother|Father|Proband|Twins|Type +F0 |Adam |male |unknown |unknown | | | | | +A0 |Sam |male |1950.01.03|unknown | |F0 | | A1 |qzygotic +A1 |John |male |1950.01.03|2005.04.12| |F0 | | A0 |qzygotic +A2 |Jane |female|1951.14.15| | | | | | +B1 |Jack |male |1975.05.06| |A2 |A1 | |B2 |monozygotic +B2 |Mike |male |1975.05.06| |A2 |A1 | |B1 |monozygotic +B3 |Pam |female|1973.11.01| |A2 |A1 | | | +C1 |Jane |female|1998.12.04| | |B1 | |C2,C3| +C2 |John |male |1998.12.04| | |B1 | |C1,C3| +C3 |George|male |1998.12.04| | |B1 | yes |C1,C2| +C4 |Ann |female|2003.02.04| | |B1 | | |
\ No newline at end of file diff --git a/Master/texmf-dist/doc/support/pedigree-perl/pedigree.1 b/Master/texmf-dist/doc/support/pedigree-perl/pedigree.1 new file mode 100644 index 00000000000..d377a34dfbd --- /dev/null +++ b/Master/texmf-dist/doc/support/pedigree-perl/pedigree.1 @@ -0,0 +1,185 @@ +.\" Automatically generated by Pod::Man 2.1801 (Pod::Simple 3.05) +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" Escape single quotes in literal strings from groff's Unicode transform. +.ie \n(.g .ds Aq \(aq +.el .ds Aq ' +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.ie \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.el \{\ +. de IX +.. +.\} +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "pedigree 1" +.TH pedigree 1 "2012-03-15" "perl v5.10.0" "User Contributed Perl Documentation" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.if n .ad l +.nh +.SH "NAME" +pedigree \- create a TeX file for pedigree from a csv file +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +\&\fBpedigree\fR [\-c \fIconfiguration_file\fR] [\-d] [\-o \fIoutput_file\fR] [\-s \fIstart_id\fR] \fIinput_file\fR +.PP +\&\fBpedigree\fR \-v +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +The program converts a comma separated \fIinput_file\fR into a TeX file +with pst-pdgr macros. +.SH "OPTIONS" +.IX Header "OPTIONS" +.IP "\fB\-c\fR \fIconfiguration_file\fR" 4 +.IX Item "-c configuration_file" +The configuration file to read along with the system-wide and user's +configuration files +.IP "\fB\-d\fR" 4 +.IX Item "-d" +Debug mode on +.IP "\fB\-o\fR \-\fIoutput_file\fR" 4 +.IX Item "-o -output_file" +The ouput file instead of \fIinput_file.tex\fR +.IP "\fB\-s\fR \-\fIstart_id\fR" 4 +.IX Item "-s -start_id" +If this option is selected, the pedigree is constructed starting from +the node with the Id i<start_id>. Otherwise it is started from the +proband node. +.Sp +This option allows to create pedigrees with multiple probands or absent +probands, or show people who are not proband's relatives. +.IP "\fB\-v\fR" 4 +.IX Item "-v" +Print version information +.SH "FILES" +.IX Header "FILES" +.IP "\fB/etc/pedigree.cfg\fR" 4 +.IX Item "/etc/pedigree.cfg" +Global configuration file +.ie n .IP "\fB\fB$HOME\fB/.pedigreerc\fR" 4 +.el .IP "\fB\f(CB$HOME\fB/.pedigreerc\fR" 4 +.IX Item "$HOME/.pedigreerc" +User configuration file +.SH "SEE ALSO" +.IX Header "SEE ALSO" +The manual distributed with this program describes the format of the +configuration file and the input file. +.PP +The library functions are described in \fIPedigree::Language\fR\|(3), +\&\fIPedigree::Parser\fR\|(3), \fIPedigree::Node\fR\|(3), \fIPedigree::PersonNode\fR\|(3), +\&\fIPedigree::MarriageNode\fR\|(3), \fIPedigree::Area\fR\|(3). +.SH "AUTHOR" +.IX Header "AUTHOR" +Boris Veytsman, Leila Akhmadeeva, 2006, 2007 diff --git a/Master/texmf-dist/scripts/pedigree-perl/Pedigree.pm b/Master/texmf-dist/scripts/pedigree-perl/Pedigree.pm new file mode 100644 index 00000000000..c92a027b865 --- /dev/null +++ b/Master/texmf-dist/scripts/pedigree-perl/Pedigree.pm @@ -0,0 +1,112 @@ +=pod + +=head1 NAME + +Pedigree - the main library for Pedigree. + +=head1 SYNOPSIS + +use Pedigree; + +$node = Pedigree->MakeNode($params); + +=head1 DESCRIPTION + +This is the main package for pedigree construction. It calls other +libraries in the Pedigree:: family + +=over 4 + +=cut + + + +#################################################################### +# Define the package # +#################################################################### + +package Pedigree; +use Pedigree::AbortionNode; +use Pedigree::Area; +use Pedigree::ChildlessNode; +use Pedigree::Language; +use Pedigree::MarriageNode; +use Pedigree::Node; +use Pedigree::Parser; +use Pedigree::PersonNode; +use Pedigree::TwinsNode; +use strict; + +#################################################################### +# MakeNode # +#################################################################### + +=pod + +=item B<MakeNode>(I<$params>); + +Construct a new node from the given parameters. Check what kind of node +should we construct. + +=cut + +sub MakeNode { + my ($class,$params)=@_; + + my $self; + + if ($params->{'Name'} =~ s/^\#//) { + if ($params->{'Name'} eq 'abortion') { + $self=new Pedigree::AbortionNode(%{$params}); + } elsif ($params->{'Name'} eq 'childless') { + $self=new Pedigree::ChildlessNode(%{$params}); + } else { + print STDERR "Unknown special name: ", $params->{'Name'}, + "\n"; + } + } else { + $self=new Pedigree::PersonNode(%{$params}); + } + return $self; + +} + + + + +#################################################################### +# THE END # +#################################################################### + +=pod + +=back + +=head1 ENVIRONMENT + +The calling program should define B<$main::DEBUG> and set it to 0 +or 1. + +=head1 SEE ALSO + +pedigree(1), +Pedigree::AbortionNode(3), +Pedigree::Area(3), +Pedigree::ChildlessNode(3), +Pedigree::Language(3), +Pedigree::MarriageNode(3), +Pedigree::Node(3), +Pedigree::Parser(3), +Pedigree::PersonNode(3), +Pedigree::TwinsNode(3), + + +=head1 AUTHOR + +Boris Veytsman, Leila Akhmadeeva, 2007 + + + +=cut + +1; diff --git a/Master/texmf-dist/scripts/pedigree-perl/Pedigree/AbortionNode.pm b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/AbortionNode.pm new file mode 100644 index 00000000000..df56988c16d --- /dev/null +++ b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/AbortionNode.pm @@ -0,0 +1,148 @@ +=pod + +=head1 NAME + +Pedigree::AbortionNode - an abortion in a pedigree + +=head1 SYNOPSIS + +use Pedigree::AbortionNode; + +$node = new Pedigree::AbortionNode(I<%params>); + +$node->DrawNode(I<$xidst>, I<$ydist>, I<$belowtextfont>, I<$abovetextfont>, +I<@fieldsfornode>); + +$node->PrintLegend(I<$land>, I<@fields>); + +=head1 DESCRIPTION + +This package contains data about an abortion. Abortion is like a person, +but it cannot have kids, and it is drawn differently + +=over 4 + +=cut + + + +#################################################################### +# Define the package # +#################################################################### + +package Pedigree::AbortionNode; +use Pedigree; +use strict; +our @ISA=('Pedigree::PersonNode'); + + + +#################################################################### +# DrawNode # +#################################################################### + +=pod + +=item B<DrawNode>(I<$xdist>, I<$ydist>, I<$belowtextfont>, I<$abovetextfont>, +I<@fieldsfornode>); + +Output the command to draw this node. The parameters are +distances between the nodes (in cm) and fields for abovetext. + +=cut + +sub DrawNode { + my $self=shift; + my ($xdist, $ydist, $belowtextfont, $abovetextfont, @fieldsfornode) = @_; + my $result = '\rput('.($xdist*$self->GetAbsX()).", ". + ($ydist*$self->GetAbsY()).'){\pstAbortion['; + my @opts=($self->Condition(), + 'belowtext={'."$belowtextfont ".$self->GetGenName().'}'); + if ($self->Type() eq 'sab') { + push @opts, 'sab'; + } + my @abovetext; + if ($self->Sex() ne 'unknown') { + push @abovetext, $self->Sex(); + } + foreach my $field (@fieldsfornode) { + if (($field ne 'Sex') && ($field ne 'Name')) { + push @abovetext, $self->{$field}; + } + } + if (scalar @abovetext) { + push @opts,'abovetext={'."$abovetextfont ".join('; ',@abovetext).'}'; + } + $result .= join(', ',@opts); + $result .= ']{'.$self->Id()."}}\n"; + return $result; +} + +#################################################################### +# PrintLegend # +#################################################################### + +=pod + +=item B<PrintLegend>(I<$lang>, I<@fields>); + +Print the legend for the given node, including I<@fields> in the given +language I<$lang>, and excluding the fields, that have no meaning for +this node. + + +=cut + +sub PrintLegend { + my ($self, $lang, @fields) = @_; + my $result = '\item['.$self->GetGenName().'] '; + my @desc; + foreach my $field (@fields) { + if (exists $self->{$field} && ($field ne 'DoD') && + ($field ne 'AgeAtDeath')) { + my $res = $lang->PrintField($field, $self->{$field}); + if (length($res)>0) { + push @desc, $res; + } + } + } + $result .= join ("; ",@desc); + $result .= ".\n"; + # + # We print only the nodes, for which there is an information + # + if (scalar @desc) { + return $result; + } + return; +} + + + +#################################################################### +# THE END # +#################################################################### + +=pod + +=back + +=head1 ENVIRONMENT + +The calling program should define B<$main::DEBUG> and set it to 0 +or 1. + +=head1 SEE ALSO + +pedigree(1), Pedigree(3) + + +=head1 AUTHOR + +Boris Veytsman, Leila Akhmadeeva, 2007 + + + +=cut + +1; diff --git a/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Area.pm b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Area.pm new file mode 100644 index 00000000000..12cda99deb9 --- /dev/null +++ b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Area.pm @@ -0,0 +1,452 @@ +=pod + +=head1 NAME + +Pedigree::Area - Calculate the area taken by a tree or a clump + +=head1 SYNOPSIS + +use Pedigree::Area; + +$area = new Pedigree::Area($node); + +$Ymin=$area->GetYmin(); + +$area->SetYmin($Ymin); + +$Ymax=$area->GetYmax(); + +$area->SetYmax($Ymax); + +$Xmin=$area->GetXmin($y); + +$area->SetXmin($y,$x); + +$Xmax=$area->GetXmax($y); + +$area->SetXmax($y,$x); + +$area->AddRight($otherarea); + +$area->AddLeft($otherarea); + +$rootnode=$area->GetRootNode(); + +$area->MoveLowerLayers($x); + +=head1 DESCRIPTION + +The algorithm of pedigree(1) uses the notion of area: a part of +a picture taken by a tree or a clump. This package implements this +notion. + +Each Area has B<rootnode> - the reference node for all calculations. +All distances are calculated as relative to the coordinates of the +B<rootnode>. + +The units are distances between the nodes in X and Y direction. The +Y axis is I<downward>: the earlier generations have smaller Y +coordinates. + +=over 4 + +=cut + +#################################################################### +# Define the package # +#################################################################### + +package Pedigree::Area; +use strict; + + +#################################################################### +# new # +#################################################################### + +=pod + +=item B<new>(I<$rootnode>); + +Construct a new area around the given rootnode + +=cut + +sub new { + my ($class, $node) = @_; + my $self={}; + # + # Top and bottom in the Y direction + # + $self->{'Ymin'}=0; + $self->{'Ymax'}=0; + # + # Hashes of Xmin and Xmax + # + $self->{'Xmin'}->{0}=0; + $self->{'Xmax'}->{0}=0; + $self->{'RootNode'}=$node; + bless ($self, $class); + return $self; + +} + +#################################################################### +# GetYmin # +#################################################################### + +=pod + +=item B<GetYmin>(); + +Get the lower bound of the area. + +=cut + +sub GetYmin { + my $self = shift; + return $self->{'Ymin'}; +} + +#################################################################### +# SetYmin # +#################################################################### + +=pod + +=item B<SetYmin>(I<$y>); + +Set the lower bound of the area. + +=cut + +sub SetYmin { + my $self = shift; + my $y=shift; + $self->{'Ymin'}=$y; + return $y; +} + +#################################################################### +# GetYmax # +#################################################################### + +=pod + +=item B<GetYmax>(); + +Get the upper bound of the area. + +=cut + +sub GetYmax { + my $self = shift; + return $self->{'Ymax'}; +} + +#################################################################### +# SetYmax # +#################################################################### + +=pod + +=item B<SetYmax>(I<$y>); + +Set the upper bound of the area. + +=cut + +sub SetYmax { + my $self = shift; + my $y=shift; + $self->{'Ymax'}=$y; + return $y; +} + +#################################################################### +# GetXmin # +#################################################################### + +=pod + +=item B<GetXmin>(I<$y>); + +Get the minimal X coordinate of the area on the level Y. + +=cut + +sub GetXmin { + my $self = shift; + my $y=shift; + return $self->{'Xmin'}->{$y}; +} + +#################################################################### +# SetXmin # +#################################################################### + +=pod + +=item B<SetXmin>(I<$y, $x>); + +Set the minimal X coordinate of the area on the level Y. + +=cut + +sub SetXmin { + my $self = shift; + my $y=shift; + my $x=shift; + $self->{'Xmin'}->{$y}=$x; + return $x; +} + +#################################################################### +# GetXmax # +#################################################################### + +=pod + +=item B<GetXmax>(I<$y>); + +Get the maximal X coordinate of the area the the level Y. + +=cut + +sub GetXmax { + my $self = shift; + my $y=shift; + return $self->{'Xmax'}->{$y}; +} + +#################################################################### +# SetXmax # +#################################################################### + +=pod + +=item B<SetXmax>(I<$y, $x>); + +Set the maximal X coordinate of the area the the level Y. + +=cut + +sub SetXmax { + my $self = shift; + my $y=shift; + my $x=shift; + $self->{'Xmax'}->{$y}=$x; + return $x; +} + + +#################################################################### +# AddRight # +#################################################################### + +=pod + +=item B<AddRight>(I<$otherarea>); + +Add the new area I<$otherarea> to the given area at the right. The +"other area" should have a root node that is relative to our root +node. The relative Y of the other root node is used, the relative +X is set. + +=cut + +sub AddRight { + my ($self, $other) = @_; + my $deltaY = $other->GetRootNode()->GetRelY(); + + # + # First, we calculate the intersection of two areas + # It is between max(Y_{min,1}, Y_{min,2}+deltaY) + # and min(Y_{max,1}, Y_{max,2}+deltaY) + # + my $intMin=$self->GetYmin(); + if ($other->GetYmin()+$deltaY > $intMin) { + $intMin = $other->GetYmin()+$deltaY; + } + my $intMax = $self->GetYmax(); + if ($other->GetYmax()+$deltaY < $intMax) { + $intMax=$other->GetYmax()+$deltaY; + } + + # + # Now we are ready to calculate relative X shift + # + my $deltaX=0; + for (my $y=$intMin; $y<=$intMax; $y++) { + my $x0 = $self->GetXmax($y); + my $x1 = $other->GetXmin($y-$deltaY); + if ($x1 + $deltaX - $x0 <1) { + $deltaX = 1 + $x0 - $x1; + } + } + # + # And set the relative X + # + $other->GetRootNode()->SetRelX($deltaX); + + # + # Now we recalculate our area + # + for (my $y=$intMin; $y<=$intMax; $y++) { + $self->SetXmax($y, $other->GetXmax($y-$deltaY) + $deltaX); + } + if ($other->GetYmin()+$deltaY < $self->GetYmin()) { + for (my $y=$other->GetYmin()+$deltaY; $y<$self->GetYmin(); $y++) { + $self->SetXmin($y, $other->GetXmin($y-$deltaY)+$deltaX); + $self->SetXmax($y, $other->GetXmax($y-$deltaY)+$deltaX); + } + $self->SetYmin($other->GetYmin()+$deltaY); + } + if ($other->GetYmax()+$deltaY > $self->GetYmax()) { + for (my $y=$self->GetYmax()+1; $y<=$other->GetYmax()+$deltaY; $y++) { + $self->SetXmin($y, $other->GetXmin($y-$deltaY)+$deltaX); + $self->SetXmax($y, $other->GetXmax($y-$deltaY)+$deltaX); + } + $self->SetYmax($other->GetYmax()+$deltaY); + } +} + +#################################################################### +# AddLeft # +#################################################################### + +=pod + +=item B<AddLeft>(I<$otherarea>); + +Add the new area I<$otherarea> to the given area at the left. The +"other area" should have a root node that is relative to our root +node. The relative Y of the other root node is used, the relative +X is set. + +=cut + +sub AddLeft { + my ($self, $other) = @_; + my $deltaY = $other->GetRootNode()->GetRelY(); + + # + # First, we calculate the intersection of two areas + # It is between max(Y_{min,1}, Y_{min,2}+deltaY) + # and min(Y_{max,1}, Y_{max,2}+deltaY) + # + my $intMin=$self->GetYmin(); + if ($other->GetYmin()+$deltaY > $intMin) { + $intMin = $other->GetYmin()+$deltaY; + } + my $intMax = $self->GetYmax(); + if ($other->GetYmax()+$deltaY < $intMax) { + $intMax=$other->GetYmax()+$deltaY; + } + + # + # Now we are ready to calculate relative X shift + # + my $deltaX=0; + for (my $y=$intMin; $y<=$intMax; $y++) { + my $x0 = $other->GetXmax($y-$deltaY); + my $x1 = $self->GetXmin($y); + if ($x1 + $deltaX - $x0 <1) { + $deltaX = 1 + $x0 - $x1; + } + } + # + # And set the relative X + # + $other->GetRootNode()->SetRelX(-$deltaX); + + # + # Now we recalculate our area + # + for (my $y=$intMin; $y<=$intMax; $y++) { + $self->SetXmin($y, $other->GetXmin($y-$deltaY) - $deltaX); + } + if ($other->GetYmin()+$deltaY < $self->GetYmin()) { + for (my $y=$other->GetYmin()+$deltaY; $y<$self->GetYmin(); $y++) { + $self->SetXmin($y, $other->GetXmin($y-$deltaY)-$deltaX); + $self->SetXmax($y, $other->GetXmax($y-$deltaY)-$deltaX); + } + $self->SetYmin($other->GetYmin()+$deltaY); + } + if ($other->GetYmax()+$deltaY > $self->GetYmax()) { + for (my $y=$self->GetYmax()+1; $y<=$other->GetYmax()+$deltaY; $y++) { + $self->SetXmin($y, $other->GetXmin($y-$deltaY)-$deltaX); + $self->SetXmax($y, $other->GetXmax($y-$deltaY)-$deltaX); + } + $self->SetYmax($other->GetYmax()+$deltaY); + } +} + +#################################################################### +# GetRootNode # +#################################################################### + +=pod + +=item B<GetRootNode>(); + +Return the root node of the area. + +=cut + +sub GetRootNode { + my $self = shift; + return $self->{'RootNode'}; +} + +#################################################################### +# MoveLowerLayers # +#################################################################### + +=pod + +=item B<MoveLowerLayers>(I<$x>); + +Shift the lower layers (>0) of the area in the X direction by I<$x> + +=cut + +sub MoveLowerLayers { + my $self = shift; + my $x=shift; + for (my $y=-1; $y>=$self->GetYmin; $y--) { + $self->SetXmin($y, $self->GetXmin($y)+$x); + $self->SetXmax($y, $self->GetXmax($y)+$x); + } + return 0; +} + + + +#################################################################### +# THE END # +#################################################################### + + +=pod + +=back + +=head1 ENVIRONMENT + +The calling program should define B<$main::DEBUG> and set it to 0 +or 1. + +=head1 SEE ALSO + +pedigree(1), Pedigree(3) + +=head1 AUTHOR + +Boris Veytsman, Leila Akhmadeeva, 2006, 2007 + + + +=cut + +1; diff --git a/Master/texmf-dist/scripts/pedigree-perl/Pedigree/ChildlessNode.pm b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/ChildlessNode.pm new file mode 100644 index 00000000000..db4b1c985b6 --- /dev/null +++ b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/ChildlessNode.pm @@ -0,0 +1,150 @@ +=pod + +=head1 NAME + +Pedigree::ChildlessNode - an abortion in a pedigree + +=head1 SYNOPSIS + +use Pedigree::ChildlessNode; + +$node = new Pedigree::ChildlessNode(I<%params>); + +$node->DrawNode(I<$xidst>, I<$ydist>, I<$belowtextfont>, I<$abovetextfont>, +I<@fieldsfornode>); + +$node->PrintLegend(I<$land>, I<@fields>); + + +=head1 DESCRIPTION + +This package contains data about a "childlessness" node. This node +is not numbered in pedigree. + +=over 4 + +=cut + + + +#################################################################### +# Define the package # +#################################################################### + +package Pedigree::ChildlessNode; +use Pedigree; +use strict; +our @ISA=('Pedigree::PersonNode'); + +#################################################################### +# new # +#################################################################### + +=pod + +=item B<new>(I<%params>); + +Construct a new node from the given parameters. + +=cut + +sub new { + my ($class,%params)=@_; + my $self=$class->SUPER::new(%params); + if (!ref($self)) { + return 0; + } + + # + # These nodes are NOT numbered in pedigrees + # + + $self->{'Numbered'}=0; + + return $self; + +} + + +#################################################################### +# DrawNode # +#################################################################### + +=pod + +=item B<DrawNode>(I<$xdist>, I<$ydist>, I<$belowtextfont>, I<$abovetextfont>, +I<@fieldsfornode>); + +Output the command to draw this node. The parameters are +distances between the nodes (in cm) and fields for abovetext (not used +here). We only print the Comment field below the node, and draw this +node higher than other nodes. + +=cut + +sub DrawNode { + my $self=shift; + my ($xdist, $ydist, $belowtextfont, $abovetextfont, @fieldsfornode) = @_; + my $result = '\rput('.($xdist*$self->GetAbsX()).", ". + ($ydist*($self->GetAbsY()+0.6)).'){\pstChildless['; + my @opts=('belowtextrp=t'); + if ($self->{'Comment'}) { + push @opts, + 'belowtext={'."$belowtextfont ".$self->{'Comment'}.'}'; + } + if ($self->Type() eq 'infertile') { + push @opts, 'infertile'; + } + if (scalar @opts) { + $result .= join(', ',@opts); + } + $result .= ']{'.$self->Id()."}}\n"; + return $result; +} + +#################################################################### +# PrintLegend # +#################################################################### + +=pod + +=item B<PrintLegend>(I<$lang>, I<@fields>); + +This subroutine does nothing since childlessness has no legend. + +=cut + +sub PrintLegend { + + return; +} + + + +#################################################################### +# THE END # +#################################################################### + +=pod + +=back + +=head1 ENVIRONMENT + +The calling program should define B<$main::DEBUG> and set it to 0 +or 1. + +=head1 SEE ALSO + +pedigree(1), Pedigree(3) + + +=head1 AUTHOR + +Boris Veytsman, Leila Akhmadeeva, 2007 + + + +=cut + +1; diff --git a/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Language.pm b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Language.pm new file mode 100644 index 00000000000..bcae95d3074 --- /dev/null +++ b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Language.pm @@ -0,0 +1,459 @@ +=pod + +=head1 NAME + +Pedigree::Language - encapsulating language issues for pedigree library + +=head1 SYNOPSIS + +use Pedigree::Language; + +$lang = new Pedigree::Language(I<$language>[, I<$encoding>]); + +$lang->Header(); + +$lang->Language(); + +$lang->Encoding(); + +$lang->GetFieldNames(); + +$lang->GetValues(); + +$lang->GetSpecialNames(); + +$lang->PrintField(I<$field>, $<$value>); + + +=head1 DESCRIPTION + +This package defines the language-dependent parts of the pedigree +library. The idea is to gather everything about language here, so adding +a new language should be (presumably) be easy. + +=over 4 + +=cut + +#################################################################### +# Define the package # +#################################################################### + +package Pedigree::Language; +use strict; + +# +# And package methods +# + + +#################################################################### +# new # +#################################################################### + +=pod + + +=item B<new>(I<$language>[, I<$encoding>]); + +Construct the new interpreter from the given language and encoding names. + +=cut + + +sub new { + my $self={}; + my ($class,$language,$encoding)=@_; + $self->{'language'}=$language; + if (!defined($encoding) && ($language eq 'russian')) { + $encoding='cp1251'; + } + if (defined($encoding)) { + $self->{encoding}=$encoding; + } + bless $self, $class; + return ($self); +} + + +#################################################################### +# Header # +#################################################################### + + +=pod + +=item B<Header> () + +Print the language-related lines of the document preamble + +=cut + +sub Header { + my $self=shift; + my $result; + if ($self->Encoding()) { + $result .= '\usepackage['.$self->Encoding().']{inputenc}'."\n"; + } + if (!($self->Language() eq 'english')) { + $result .= '\usepackage['.$self->Language().']{babel}'."\n"; + } + return $result; + +} + + +#################################################################### +# Language # +#################################################################### + + +=pod + +=item B<Language> () + +Print the current language + +=cut + +sub Language { + my $self=shift; + return $self->{'language'}; +} + +#################################################################### +# Encoding # +#################################################################### + + +=pod + +=item B<Encoding> () + +Print the current encoding + +=cut + +sub Encoding { + my $self=shift; + return $self->{'encoding'}; +} + + +#################################################################### +# GetFieldNames # +#################################################################### + + +=pod + +=item B<GetFieldNames>(); + +Outputs a reference to a hash +"field_name_in_this_language"=>"field_name_in_English" + +=cut + +sub GetFieldNames() { + my $self=shift; + my %result=(); + + # + # The English names are default + # + %result=( + 'Id'=>'Id', + 'Name'=>'Name', + 'Sex'=>'Sex', + 'DoB'=>'DoB', + 'DoD'=>'DoD', + 'Mother'=>'Mother', + 'Father'=>'Father', + 'Proband'=>'Proband', + 'Condition'=>'Condition', + 'Type'=>'Type', + 'Twins'=>'Twins', + 'Comment'=>'Comment', + 'SortOrder'=>'SortOrder', + 'Sort'=>'SortOrder'); + + # + # Russian names depend on the encoding + # + if (($self->Language() eq 'russian') && ($self->Encoding() eq 'koi8-r')) { + $result{'éÄÅÎÔ'}='Id'; + $result{'æéï'}='Name'; + $result{'ðÏÌ'}='Sex'; + $result{'òÏÖÄ'}='DoB'; + $result{'õÍÅÒ'}='DoD'; + $result{'íÁÔØ'}='Mother'; + $result{'ïÔÅÃ'}='Father'; + $result{'ðÒÏÂÁÎÄ'}='Proband'; + $result{'óÏÓÔÏÑÎÉÅ'}='Condition'; + $result{'ôÉÐ'}='Type'; + $result{'âÌÉÚÎÅÃÙ'}='Twins'; + $result{'ëÏÍÍÅÎÔÁÒÉÊ'}='Comment'; + $result{'ðÏÒÑÄÏËóÏÒÔÉÒÏ×ËÉ'}='SortOrder'; + $result{'óÏÒÔ'}='SortOrder'; + } + if (($self->Language() eq 'russian') && ($self->Encoding() eq 'cp1251')) { + $result{'Èäåíò'}='Id'; + $result{'ÔÈÎ'}='Name'; + $result{'Ïîë'}='Sex'; + $result{'Ðîæä'}='DoB'; + $result{'Óìåð'}='DoD'; + $result{'Ìàòü'}='Mother'; + $result{'Îòåö'}='Father'; + $result{'Ïðîáàíä'}='Proband'; + $result{'Ñîñòîÿíèå'}='Condition'; + $result{'Òèï'}='Type'; + $result{'×íêÿïåçý'}='Twins'; + $result{'Êîììåíòàðèé'}='Comment'; + $result{'ÏîðÿäîêÑîðòèðîâêè'}='SortOrder'; + $result{'Ñîðò'}='SortOrder'; + } + + + return \%result; +} + +#################################################################### +# GetValues # +#################################################################### + + +=pod + +=item B<GetValues>(); + +Outputs a reference to a hash +"field_value_in_this_language"=>"field_value_in_English" + +=cut + +sub GetValues { + my $self=shift; + my %result=(); + + # + # The English values are default + # + %result=( + 'male'=>'male', + 'female'=>'female', + 'unknown'=>'unknown', + 'yes'=>1, + 'no'=>0, + 'normal'=>'normal', + 'obligatory'=>'obligatory', + 'oblig'=>'obligatory', + 'asymptomatic'=>'asymptomatic', + 'asymp'=>'asymptomatic', + 'affected'=>'affected', + 'affect'=>'affected', + 'infertile'=>'infertile', + 'Infertile'=>'infertile', + 'sab'=>'sab', + 'Sab'=>'sab', + 'monozygotic'=>'monozygotic', + 'monozygot'=>'monozygotic', + 'qzygotic'=>'qzygotic', + 'qzygot'=>'qzygotic', + '?'=>'qzygotic', + ); + + # + # Russian names depend on the encoding + # + if (($self->Language() eq 'russian') && ($self->Encoding() eq 'koi8-r')) { + $result{'ÍÕÖ'} = 'male'; + $result{'ÖÅÎ'} = 'female'; + $result{'Í'} = 'male'; + $result{'Ö'} = 'female'; + $result{'ÎÅÉÚ×'} = 'unknown'; + $result{'ÎÅÉÚ×ÅÓÔÎÏ'} = 'unknown'; + $result{'ÄÁ'} = 1; + $result{'ÎÅÔ'} = 0; + $result{'äÁ'} = 1; + $result{'îÅÔ'} = 0; + $result{'ÎÏÒÍ'} = 'normal'; + $result{'ÚÄÏÒÏ×'} = 'normal'; + $result{'ÏÂÌÉÇÁÔ'} = 'obligatory'; + $result{'ÁÓÉÍÐ'} = 'asymptomatic'; + $result{'ÂÏÌØÎ'} = 'affected'; + $result{'ÂÏÌÅÎ'} = 'affected'; + $result{'ÂÅÓÐÌÏÄÎ'} = 'infertile'; + $result{'×ÙËÉÄÙÛ'} = 'sab'; + $result{'ÏÄÎÏÑÊÃÅ×'} = 'monozygotic'; + $result{'ÍÏÎÏÚÉÇÏÔÎ'} = 'monozygotic'; + $result{'ÍÏÎÏÚÉÇ'} = 'monozygotic'; + $result{'ÄÉÚÉÇ'} = ''; + } + + if (($self->Language() eq 'russian') && ($self->Encoding() eq 'cp1251')) { + $result{'ìóæ'} = 'male'; + $result{'æåí'} = 'female'; + $result{'ì'} = 'male'; + $result{'æ'} = 'female'; + $result{'íåèçâ'} = 'unknown'; + $result{'íåèçâåñòíî'} = 'unknown'; + $result{'äà'} = 1; + $result{'íåò'} = 0; + $result{'Äà'} = 1; + $result{'Íåò'} = 0; + $result{'íîðì'} = 'normal'; + $result{'ÿäðôðþ'} = 'normal'; + $result{'îáëèãàò'} = 'obligatory'; + $result{'àñèìï'} = 'asymptomatic'; + $result{'áîëüí'} = 'affected'; + $result{'÷ðíåï'} = 'affected'; + $result{'÷åõòíðäï'} = 'infertile'; + $result{'þýìêäýù'} = 'sab'; + $result{'ðäïðóëçåþ'} = 'monozygotic'; + $result{'îðïðÿêúðæï'} = 'monozygotic'; + $result{'îðïðÿêú'} = 'monozygotic'; + $result{'äêÿêú'} = ''; + } + + return \%result; +} + +#################################################################### +# GetSpecialNames # +#################################################################### + + +=pod + +=item B<GetSpecialNames>(); + +Some values for the 'Name' field start with C<#>. They are special. +This subroutine outputs a reference to a hash +"special_name_in_this_language"=>"special_name" + +=cut + +sub GetSpecialNames { + my $self=shift; + my %result=(); + + # + # The English values are default + # + %result=( + 'abort'=>'abortion', + 'childless'=>'childless', + ); + + # + # Russian names depend on the encoding + # + if (($self->Language() eq 'russian') && ($self->Encoding() eq 'koi8-r')) { + $result{'ÁÂÏÒÔ'} = 'abortion'; + $result{'ÂÅÚÄÅÔÎ'} = 'childless'; + } + + if (($self->Language() eq 'russian') && ($self->Encoding() eq 'cp1251')) { + $result{'â÷ðôæ'} = 'abortion'; + $result{'÷åÿäåæï'} = 'childless'; + } + + return \%result; +} + + + +#################################################################### +# PrintField # +#################################################################### + + +=pod + +=item B<PrintField>(I<$field>, I<$value>); + +Formats the value I<$value> of the given field I<$field> according +to the rules of the given language. + +=cut + +sub PrintField { + my $self=shift; + my ($field, $value) = @_; + + + # + # The English values are default + # + + if ($self->Language() eq 'english') { + if ($field eq 'DoB' ) { + return "born: $value"; + } + if ($field eq 'DoD' ) { + return "died: $value"; + } + if ($field eq 'AgeAtDeath') { + return "age at death: $value"; + } + } + + if ($self->Language() eq 'russian') { + if ($value eq 'unknown') { + $value = '{\cyr\cyrn\cyre\cyri\cyrz\cyrv.}'; + } + if ($field eq 'DoB' ) { + return '{\cyr\cyrr\cyro\cyrd.}'." $value"; + } + if ($field eq 'DoD') { + return '{\cyr\cyru\cyrm.}'." $value"; + } + if ($field eq 'AgeAtDeath') { + return '{\cyr\cyru\cyrm. \cyrv{} \cyrv\cyro\cyrz\cyrr. }'." $value"; + } + # + # Special name + # + if ($field eq 'Name' && $value eq 'abortion') { + return '{\cyr\cyra\cyrb\cyro\cyrr\cyrt}'; + } + } + + + # + # The last resort + # + return $value; + + +} + + + +#################################################################### +# THE END # +#################################################################### + + +=pod + +=back + +=head1 ENVIRONMENT + +The calling program should define B<$main::DEBUG> and set it to 0 +or 1. + +=head1 SEE ALSO + +pedigree(1), Pedigree(3) + +=head1 AUTHOR + +Boris Veytsman, Leila Akhmadeeva, 2006, 2007 + + + +=cut + +1; diff --git a/Master/texmf-dist/scripts/pedigree-perl/Pedigree/MarriageNode.pm b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/MarriageNode.pm new file mode 100644 index 00000000000..39e20bf58f9 --- /dev/null +++ b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/MarriageNode.pm @@ -0,0 +1,346 @@ +=pod + +=head1 NAME + +Pedigree::MarriageNode - a marriage in a pedigree + +=head1 SYNOPSIS + +use Pedigree::MarriageNode; + +$node = new Pedigree::MarriageNode(I<%params>); + +$FSpouse = $node->FSpouse(); + +$MSpouse = $node->MSpouse(); + +$consang = $self->isConsanguinic(); + +$area = $node->SetArea(); + +$node->CalcAbsCoord(I<$x>, I<$y>); + +$node->DrawNode(I<$xidst>, I<$ydist>, I<$belowtextfont>, I<$abovetextfont>, +I<@fieldsfornode>); + +$node->DrawConnections(); + + +=head1 DESCRIPTION + +This package contains data about a marriage. + +=over 4 + +=cut + + + +#################################################################### +# Define the package # +#################################################################### + +package Pedigree::MarriageNode; +use Pedigree; +use strict; +our @ISA=('Pedigree::Node'); + + +#################################################################### +# new # +#################################################################### + +=pod + +=item B<new>(I<%params>); + +Construct a new node from the given parameters. + +=cut + +sub new { + my ($class,%params)=@_; + my $self=$class->SUPER::new(%params); + if (!ref($self)) { # Bad node + return 0; + } + + bless ($self,$class); + + # + # Normally marriage nodes are not consanguinic + # + if (!exists($self->{'Consanguinic'})) { + $self->{'Consanguinic'} = 0; + } + + # After we constructed the node, we want to move the kids + # from the parent nodes to the marriage node + + my $selfId = $self->{'Id'}; + if (exists($self->{'FSpouse'}) && exists($self->{'MSpouse'})) { + my $fspouse = $self->{'FSpouse'}; + my $fspouseId = $fspouse->Id(); + my $mspouse = $self->{'MSpouse'}; + my $mspouseId = $mspouse->Id(); + + + foreach my $kidId (keys %{$self->{'kids_by_parent_id'}->{$fspouseId}}) { + if ($main::DEBUG) { + print STDERR "Checking kid $kidId for $selfId\n"; + } + if (exists ($self->{'kids_by_parent_id'}->{$mspouseId}->{$kidId})) { + if ($main::DEBUG) { + print STDERR + "Moving $kidId from $fspouseId and $mspouseId to ". + "$selfId\n"; + } + delete $self->{'kids_by_parent_id'}->{$mspouseId}->{$kidId}; + delete $self->{'kids_by_parent_id'}->{$fspouseId}->{$kidId}; + $self->{'kids_by_parent_id'}->{$selfId}->{$kidId}=1; + } + } + } + + return $self; +} + + +#################################################################### +# FSpouse # +#################################################################### + +=pod + +=item B<FSpouse>(); + +Get female spouse of a node. + +=cut + +sub FSpouse { + my $self = shift; + return $self->{'FSpouse'}; +} + + +#################################################################### +# MSpouse # +#################################################################### + +=pod + +=item B<MSpouse>(); + +Get female spouse of a node. + +=cut + +sub MSpouse { + my $self = shift; + return $self->{'MSpouse'}; +} + +#################################################################### +# isConsanguinic # +#################################################################### + +=pod + +=item B<isConsanguinic>(); + +Check whether the node is consanguinic + +=cut + +sub isConsanguinic { + my $self = shift; + return $self->{'Consanguinic'}; +} + + +#################################################################### +# SetArea # +#################################################################### + +=pod + +=item B<SetArea>(); + +Calculate relative coordinates for all nodes, that are descendants of +the given node I<and> the spouses that form the marriage. We create a +Pedigree::Area(3) around the given node and recursively apply the +function to all descendants. The subroutine +returns the reference to the created area. + +=cut + +sub SetArea { + my $self = shift; + my $area = $self->SUPER::SetArea(); + + # + # Female is to the right, male is to the left unless we have + # Sort Order set for anybody. If it is set, the order + # is OPPOSITE to the SortOrder + # + my ($left,$right) = ($self->MSpouse(), $self->FSpouse()); + if ($left->SortOrder() <=> $right->SortOrder()) { + ($left,$right) = + sort {$a->SortOrder() <=> $b->SortOrder()} ($left,$right); + } + my ($rightRoot,$gen) = @{$right->FindRoot(0,-1)}; + $rightRoot->SetRelY($gen); + my $rightArea=$rightRoot->SetArea(); + $area->AddRight($rightArea); + + my ($leftRoot,$gen) = @{$left->FindRoot(0,1)}; + $leftRoot->SetRelY($gen); + my $leftArea=$leftRoot->SetArea(); + $area->AddLeft($leftArea); + + $self->{'Area'}=$area; + + if ($main::DEBUG) { + print STDERR "Setting area for marriage node ",$self->Id(),"\n"; + for (my $y=$area->GetYmin(); $y<=$area->GetYmax(); $y++) { + print STDERR "\t$y: ", $area->GetXmin($y), ", ", + $area->GetXmax($y), "\n"; + } + } + + + return $area; +} + + +#################################################################### +# CalcAbsCoor # +#################################################################### + +=pod + +=item B<CalcAbsCoor>(I<$x>, $<y>); + +Set the absolute coordinates of the given node, if the absolute +coordinates of the parent node are (I<$x>, I<$y>), and recursively +do this for all descendants of this node, and right and left clumps. + +=cut + +sub CalcAbsCoor { + my $self=shift; + my ($x,$y) = @_; + $self->SUPER::CalcAbsCoor($x, $y); + $x += $self->GetRelX(); + $y += $self->GetRelY(); + + my ($FRoot,undef) = @{$self->FSpouse()->FindRoot(0)}; + $FRoot->CalcAbsCoor($x, $y); + + my ($MRoot,undef) = @{$self->MSpouse()->FindRoot(0)}; + $MRoot->CalcAbsCoor($x, $y); + + return 0; +} + + +#################################################################### +# DrawNode # +#################################################################### + +=pod + +=item B<DrawNode>(I<$xdist>, I<$ydist>, I<$belowtextfont>, I<$abovetextfont>, +I<@fieldsfornode>); + +Output the command to draw this node. The parameters are +distances between the nodes (in cm). + +=cut + +sub DrawNode { + my $self=shift; + my ($xdist, $ydist, $belowtextfont, $abovetextfont, @fieldsfornode) = @_; + my $result = '\rput('.($xdist*$self->GetAbsX()).", ". + ($ydist*$self->GetAbsY()).'){\pnode{'. + $self->Id()."}}\n"; + return $result; +} + +#################################################################### +# DrawConnections # +#################################################################### + +=pod + +=item B<DrawConnections>(); + +Draw the connections from the given node to its descendants and +the spouses + +=cut + +sub DrawConnections { + my $self = shift; + my $xdist = shift; + my $ydist = shift; + my $result = $self->SUPER::DrawConnections($xdist, $ydist); + my $Id=$self->Id(); + my $style=""; + if ($self->isConsanguinic()) { + $style='doubleline=true, '; + } + foreach my $spouse ($self->FSpouse(), $self->MSpouse()) { + if (!ref($spouse)) { + next; + } + my $sId=$spouse->Id(); + # Check whether spouse nodes are adjacent to the marriage node. + # We do this check only for non-consanguinic unions + if (!($self->isConsanguinic()) && + (abs($self->GetIndexX() - $spouse->GetIndexX()) > 1)) { + my ($nodeA,$nodeB) = sort + {$a->GetIndexX() <=> $b->GetIndexX()} ($spouse, $self); + my $IdA=$nodeA->Id(); + my $IdB=$nodeB->Id(); + $result .= + "\\ncloop[$style angleA=0, angleB=180, loopsize=". + 0.4*$ydist . ', arm=' . 0.4*$xdist . + ']{'.$IdA.'}{'.$IdB.'}'."\n"; + } else { + $result .= "\\ncline[$style]{".$Id.'}{'.$sId.'}'."\n"; + } + } + return $result; +} + + + + +#################################################################### +# THE END # +#################################################################### + +=pod + +=back + +=head1 ENVIRONMENT + +The calling program should define B<$main::DEBUG> and set it to 0 +or 1. + +=head1 SEE ALSO + +pedigree(1), Pedigree(3) + +=head1 AUTHOR + +Boris Veytsman, Leila Akhmadeeva, 2006, 2007 + + + +=cut + +1; diff --git a/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Node.pm b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Node.pm new file mode 100644 index 00000000000..445f92abafb --- /dev/null +++ b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Node.pm @@ -0,0 +1,1240 @@ +=pod + +=head1 NAME + +Pedigree::Node - the base package for nodes in pedigree charts + +=head1 SYNOPSIS + +use Pedigree::Node; + +$node = new Pedigree::Node(I<%params>); + +$node->CheckAllParents(); + +$Id = $node->Id(); + +$node->SetSortOrder(-1|0|1); + +$result = $node->SortOrder(); + +$is_numbered=$node->isNumbered(); + +$type = $node->Type(); + +$Kids = $node->Kids(); + +$node->GetAndSortKids(); + +($root, $newgen) = $node->FindRoot(I<$generation>, [I<$sort_order>]); + +$x = $node->GetRelX(); + +$y = $node->GetRelY(); + +$node->SetRelX(I<$x>); + +$node->SetRelX(I<$y>); + +$x = $node->GetAbsX(); + +$y = $node->GetAbsY(); + +$node->SetIndexX(I<$n>); + +$node->SetAbsX(I<$x>); + +$node->SetAbsY(I<$y>); + +$n = $node->GetIndexX(); + +$area = $node->SetArea(); + +$delta = $node->CenterKids(); + + +$node->CalcAbsCoord(I<$x>, I<$y>); + +$node->AddConsanguinicMarriages(); + +$node->AddTwins($ydist); + +$frame = $node->SetFrame(I<$xdist>, I<$ydist>); + + +$node->DrawAll(I<$xdist>, I<$ydist>, I<$belowtextfont>, I<$abovetextfont>, + I<@fieldsfornode>); + +$node->DrawConnections(); + +$node->PrintAllLegends(I<$land>, I<@fields>); + +$node->PrintLegend(I<$land>, I<@fields>); + +=head1 DESCRIPTION + +This is the basic package that defines nodes for pedigrees. +Pedigree::PersonNode(3) and Pedigree::MarriageNode(3) inherit from +this package. + +=over 4 + +=cut + +#################################################################### +# Define the package # +#################################################################### + +package Pedigree::Node; +use strict; +use Pedigree; + +#################################################################### +# package variables # +#################################################################### + +# +# The pool: %node_by_id keeps the relation between +# nodes and references +# + +our %node_by_id; + +# +# The hash %node_by_gen is a hash of hasehs. The keys +# are generation numbers (with zero being the root of pedigree), +# and the values are the hashes Id->node +# +our %node_by_gen; + +# +# The hash %kids_by_parent_id is a hash of hashes. The keys are +# Ids of parents. The hashes are $kid->1, where $kid is the kid id +# (NOT the kid node due to limitations of Perl) +# +our %kids_by_parent_id; + +# +# The array @twin_sets lists all twin nodes. Each twin node is +# a has with entries 'Type' and 'KidIds'. They store +# twins type (monozygotic, qzygotic or empty) and Ids of the +# kid nodes correspondingly (KidIds is actually a hash of +# node Ids). +# +our @twin_sets; + +#################################################################### +# And package methods # +#################################################################### + +#################################################################### +# new # +#################################################################### + +=pod + +=item B<new>(I<%params>); + +Construct a new node from the given parameters. If a node with +the give Id exists, add new information to the node. + +=cut + +sub new { + my ($class,%params)=@_; + + if (!exists($params{'Id'})) { + print STDERR "Warning: cannot create node from %params\n"; + return 0; + } + + my $Id=$params{'Id'}; + my $self; + if (exists($node_by_id{$Id})) { + $self=$node_by_id{$Id}; + } else { + $self={}; + bless ($self,$class); + $node_by_id{$Id}=$self; + } + + foreach my $key (keys %params) { + $self->{$key} = $params{$key}; + } + + # + # Calculate age at death + # + if (exists($self->{'DoB'}) && exists($self->{'DoD'})) { + $self->{'AgeAtDeath'} = 'unknown'; + if (($self->{'DoB'} ne 'unknown') && + ($self->{'DoD'} ne 'unknown')) { + my ($y1, $m1, $d1) = split /\./, $self->{'DoB'}; + my ($y2, $m2, $d2) = split /\./, $self->{'DoD'}; + $self->{'AgeAtDeath'} = int(($y2-$y1) + ($m2-$m1)/12 + + ($d2-$d1)/12/30); + } + } + + + # + # Only Person Nodes are numbered in pedigrees + # + $self->{'Numbered'}=0; + + # + # The field 'Kids' is special. This is a reference + # to an array filled by GetAndSortKids() + # + if (!exists($self->{'Kids'})) { + $self->{'Kids'}=[]; + } + + # + # Hashes %kids_by_parent_id + # + if (exists($self->{'Mother'})) { + my $parent = $self->{'Mother'}; + $kids_by_parent_id{$parent}->{$self->Id()}=1; + } + if (exists($self->{'Father'})) { + my $parent = $self->{'Father'}; + $kids_by_parent_id{$parent}->{$self->Id()}=1; + } + + # + # Add references to the hashes + # + + $self->{'node_by_id'} = \%node_by_id; + $self->{'node_by_gen'} = \%node_by_gen; + $self->{'kids_by_parent_id'} = \%kids_by_parent_id; + $self->{'twin_sets'} = \@twin_sets; + + # + # Initially the nodes are sorted by age only + # + if (!($self->{'SortOrder'})) { + $self->{'SortOrder'} = 0; + } + + + return $self; + +} + +#################################################################### +# CheckAllParents # +#################################################################### + +=pod + +=item B<CheckAllParents>(); + +Check whether mothers and fathers of all nodes exist + +=cut + +sub CheckAllParents { + my $self = shift; + + foreach my $parentId (keys %kids_by_parent_id) { + if (!exists($node_by_id{$parentId}) ) { + print STDERR + "Node $parentId does not exist and is listed as parent for nodes"; + foreach my $kidId (keys %{$kids_by_parent_id{$parentId}}) { + print STDERR " ", $kidId; + my $kid = $node_by_id{$kidId}; + if ($kid->{'Mother'} eq $parentId) { + delete $kid->{'Mother'}; + } + if ($kid->{'Father'} eq $parentId) { + delete $kid->{'Father'}; + } + } + print STDERR ". Deleting\n"; + delete $kids_by_parent_id{$parentId}; + } elsif ($main::DEBUG) { + print STDERR "Node $parentId is OK\n"; + } + } + + return 0; +} + + +#################################################################### +# Id # +#################################################################### + +=pod + +=item B<Id>(); + +Get Id of a node. Note that there is no way to set an Id of a node +that was already created. + +=cut + +sub Id { + my $self = shift; + return $self->{'Id'}; +} + +#################################################################### +# SetSortOrder # +#################################################################### + +=pod + +=item B<SetSortOrder>(I<-1|0|1>); + +Normally the sibs nodes are sorted by age. However, if the nodes or +their descendants are connected by a marriage line, we must sort them +in the special way: all way to the left or all way to the right. The +procedure B<SetSortOrder> sets this flag for the node or deletes it +depending on the argument. + +=cut + +sub SetSortOrder { + my $self = shift; + my $order = shift; + $self->{'SortOrder'}=$order; + return $order; +} + +#################################################################### +# SortOrder # +#################################################################### + +=pod + +=item B<SortOrder>(); + +Normally the sibs nodes are sorted by age. However, if the nodes or +their descendants are connected by a marriage line, we must sort them +in the special way: all way to the left or all way to the right. The +procedure B<SortOrder> checks this flag. + +=cut + +sub SortOrder { + my $self = shift; + return $self->{'SortOrder'}; +} + +#################################################################### +# isNumbered # +#################################################################### + +=pod + +=item B<isNumbered>(); + +Check whether the node should be numbered in pedigree + +=cut + +sub isNumbered { + my $self = shift; + return $self->{'Numbered'}; +} + +#################################################################### +# Type # +#################################################################### + +=pod + +=item B<Type>() + +Return node type. + +=cut + +sub Type { + my $self=shift; + return $self->{'Type'}; +} + + + +#################################################################### +# Kids # +#################################################################### + +=pod + +=item B<Kids>(); + +Get the reference to the array of kids + +=cut + +sub Kids { + my $self = shift; + return $self->{'Kids'}; +} + + +#################################################################### +# GetAndSortKids # +#################################################################### + +=pod + +=item B<GetAndSortKids>(); + +Apply sort the array of kids for the given node + +=cut + +sub GetAndSortKids { + my $self=shift; + my @kids; + my $Id = $self->Id(); + foreach my $kidId (keys %{$self->{'kids_by_parent_id'}->{$Id}}) { + push @kids, $self->{'node_by_id'}->{$kidId}; + } + @kids = sort by_sibs_order @kids; + $self->{'Kids'}=\@kids; + if ($main::DEBUG) { + print STDERR "Node ",$self->Id(),", Kids: "; + foreach my $kid (@{$self->Kids()}) { + print STDERR $kid->Id(), " "; + } + print STDERR "\n"; + } + return 0; +} + +#################################################################### +# FindRoot # +#################################################################### + +=pod + +=item B<FindRoot>(I<$generation>, [I<$sort_order>]); + +Finds the root of the tree to which the current node belongs. +Takes the current generation number and returns the root and its +generation number. Here generation numbers go "backwards": the older +generations have higher numbers. The found node is assigned sort order +I<$sort_order>. + +=cut + +sub FindRoot { + my ($self,$gen,$sort)=@_; + + if (defined $sort && !($self->SortOrder())) { + $self->SetSortOrder($sort); + } + + # If there are no parents, I am the root + if (!exists($self->{'Mother'}) && !exists($self->{'Father'})) { + my @result=($self,$gen); + return \@result; + } + + # If there are both parents, their union is the root + if (exists($self->{'Mother'}) && exists($self->{'Father'})) { + my $motherId=$self->{'Mother'}; + my $mother=$node_by_id{$motherId}; + my $fatherId=$self->{'Father'}; + my $father=$node_by_id{$fatherId}; + + + my $marriageId = $fatherId."_m_".$motherId; + my $marriage = + new Pedigree::MarriageNode ( + 'Id'=>$marriageId, + 'MSpouse'=>$father, + 'FSpouse'=>$mother + ); + if (defined $sort) { + $marriage->SetSortOrder($sort); + } + my @result = ($marriage,$gen+1); + return \@result; + } + + # Ok, only one parent is there. The search goes further + + my $parentId; + if (exists($self->{'Mother'})) { + $parentId=$self->{'Mother'}; + } else { + $parentId=$self->{'Father'}; + } + my $parent=$node_by_id{$parentId}; + return $parent->FindRoot($gen+1,$sort); +} + +#################################################################### +# GetRelX # +#################################################################### + +=pod + +=item B<GetRelX>(); + +Find the relative x coordinate of the node. The coordinate is +relative to the precedessor or to the marriage node, which connects +this node to the proband + +=cut + +sub GetRelX { + my $self = shift; + return $self->{'RelX'}; +} + +#################################################################### +# GetRelY # +#################################################################### + +=pod + +=item B<GetRelY>(); + +Find the relative Y coordinate of the node. The coordinate is +relative to the precedessor or to the marriage node, which connects +this node to the proband. Note that the Y axis is down. + +=cut + +sub GetRelY { + my $self = shift; + return $self->{'RelY'}; +} + + +#################################################################### +# SetRelX # +#################################################################### + +=pod + +=item B<SetRelX>(I<$x>); + +Set the relative x coordinate of the node. The coordinate is +relative to the precedessor or to the marriage node, which connects +this node to the proband. + +=cut + +sub SetRelX { + my ($self, $x) = @_; + $self->{'RelX'} = $x; + return 0; +} + +#################################################################### +# SetRelY # +#################################################################### + +=pod + +=item B<SetRelY>(I<$y>); + +Set the relative y coordinate of the node. The coordinate is +relative to the precedessor or to the marriage node, which connects +this node to the proband. Note that the Y axis is down. + +=cut + +sub SetRelY { + my ($self, $y) = @_; + $self->{'RelY'} = $y; + return 0; +} + +#################################################################### +# GetAbsX # +#################################################################### + +=pod + +=item B<GetAbsX>(); + +Find the absolute x coordinate of the node. + +=cut + +sub GetAbsX { + my $self = shift; + return $self->{'AbsX'}; +} + +#################################################################### +# GetAbsY # +#################################################################### + +=pod + +=item B<GetAbsY>(); + +Find the absolute Y coordinate of the node. + +=cut + +sub GetAbsY { + my $self = shift; + return $self->{'AbsY'}; +} + +#################################################################### +# GetIndexX # +#################################################################### + +=pod + +=item B<GetIndexX>(); + +Find the number of the node in the given generation. + +=cut + +sub GetIndexX { + my $self = shift; + return $self->{'IndexX'}; +} + + + +#################################################################### +# SetAbsX # +#################################################################### + +=pod + +=item B<SetAbsX>(I<$x>); + +Set the absolute x coordinate of the node. + +=cut + +sub SetAbsX { + my ($self, $x) = @_; + $self->{'AbsX'} = $x; + return 0; +} + +#################################################################### +# SetAbsY # +#################################################################### + +=pod + +=item B<SetAbsY>(I<$y>); + +Set the absolute y coordinate of the node. + +=cut + +sub SetAbsY { + my ($self, $y) = @_; + $self->{'AbsY'} = $y; + return 0; +} + + +#################################################################### +# SetIndexX # +#################################################################### + +=pod + +=item B<SetIndexX>(I<$n>); + +Set the number of the node in the given generation. + +=cut + +sub SetIndexX { + my ($self, $n) = @_; + $self->{'IndexX'} = $n; + return 0; +} + + + +#################################################################### +# SetArea # +#################################################################### + +=pod + +=item B<SetArea>(); + +Calculate relative coordinates for all nodes, that are descendants of +the given node. We create a Pedigree::Area(3) around the given node +and recursively apply the function to all descendants. The subroutine +returns the reference to the created area. + +=cut + +sub SetArea { + my $self = shift; + $self->GetAndSortKids(); + my $area = new Pedigree::Area ($self); + foreach my $kid (@{$self->Kids()}) { + my $kidarea = $kid->SetArea(); + $kid->SetRelY(-1); + $area->AddRight($kidarea); + } + # + # We want the node to be the center of siblings + # subtrees + # + my $deltaX=$self->CenterKids(); + $area->MoveLowerLayers($deltaX); + if ($main::DEBUG) { + print STDERR "Setting area for ",$self->Id(),"\n"; + for (my $y=$area->GetYmin(); $y<=$area->GetYmax(); $y++) { + print STDERR "\t$y: ", $area->GetXmin($y), ", ", + $area->GetXmax($y), "\n"; + } + } + $self->{'Area'} = $area; + return $area; +} + +#################################################################### +# CenterKids # +#################################################################### + +=pod + +=item B<CenterKids>(); + +Move the relative coordinates of all the kids of the given node +so the given node is centered in relation to the kids. Returns +the shift to be applied to the Pedigree::Area(3). + +=cut + +sub CenterKids { + my $self=shift; + my $nKids=scalar @{$self->Kids()}; + if ($nKids < 2) { # One or no kids - no need to center + return 0; + } + my $x0 = $self->Kids()->[0]->GetRelX(); + my $x1 = $self->Kids()->[$nKids-1]->GetRelX(); + my $delta = -($x0+$x1)/2; + foreach my $kid (@{$self->Kids()}) { + $kid->SetRelX($kid->GetRelX()+$delta); + } + return $delta; +} + + +#################################################################### +# CalcAbsCoor # +#################################################################### + +=pod + +=item B<CalcAbsCoor>(I<$x>, $<y>); + +Set the absolute coordinates of the given node, if the absolute +coordinates of the parent node are (I<$x>, I<$y>), and recursively +do this for all descendants of this node. Additionally set up +B<%node_by_gen>. + +=cut + +sub CalcAbsCoor { + my $self=shift; + my ($x,$y) = @_; + $x += $self->GetRelX(); + $y += $self->GetRelY(); + # + # Consanguinic kids may be already set + # + if (!exists($self->{'AbsY'}) || $self->{'AbsY'} > $y) { + $self->SetAbsX($x); + $self->SetAbsY($y); + foreach my $kid (@{$self->Kids()}) { + $kid->CalcAbsCoor($x,$y); + } + $node_by_gen{$y}->{$self->Id()}= $self; + if ($main::DEBUG) { + print STDERR "Abs Coords for ", $self->Id(), ": $x, $y\n"; + } + } else { + if ($main::DEBUG) { + print STDERR "Not setting abs coords for ",$self->Id(),"\n"; + } + } + + return 0; +} + + +#################################################################### +# AddConsanguinicMarriages # +#################################################################### + +=pod + +=item B<AddConsanguinicMarriages>(); + +Check the pedigree and add consanguinic marriages to it. Note +that this procedure must be called B<after> L<SetAbsCoor>, so +the coordinates of all nodes are set. + +=cut + +# +# This is rather a hack. Basically we think that a union is +# consanguinic if the spouses are already set in the pedigree. +# We check all kids which are in the pedigree and add those +# who have both mother and father that list them as kids. +# + +sub AddConsanguinicMarriages { + my $self = shift; + foreach my $gen (keys %node_by_gen) { + foreach my $kid (values %{$node_by_gen{$gen}}) { + if (!exists($kid->{'Mother'}) || + !exists($kid->{'Father'})) { + next; # kid + } + my $motherId=$kid->MotherId(); + my $fatherId=$kid->FatherId(); + my $mother=$node_by_id{$motherId}; + my $father=$node_by_id{$fatherId}; + if (!exists($mother->{'AbsX'}) || + !exists($father->{'AbsX'})) { + next; # kid + } + if (exists($node_by_id{$fatherId."_m_".$motherId})) { + next; # kid + } + # + # If we are here, we found a consangunic marriage! + # + if ($main::DEBUG) { + print STDERR "Found a consanguinic marriage between ", + "$fatherId and $motherId. The kid is ", + $kid->Id(), "\n"; + } + my $marriageId=$fatherId."_m_".$motherId; + my $marriage= + new Pedigree::MarriageNode ( + Id=>$marriageId, + 'Consanguinic'=>1, + 'FSpouse'=>$mother, + 'MSpouse'=>$father + ); + # + # We set up this node in the middle between father + # and mother + # + $marriage->SetAbsX(($father->GetAbsX()+$mother->GetAbsX())/2); + $marriage->SetAbsY(($father->GetAbsY()+$mother->GetAbsY())/2); + $node_by_gen{$marriage->GetAbsY()}->{$marriageId}= $marriage; + + # + # Repopulate parents' kids + # + $mother->GetAndSortKids(); + $father->GetAndSortKids(); + + # + # We would like to make the kids to belong to this marriage, + # but it might be wrong: it might be in the wrong generation! + # Let is check it + if (($marriage->GetAbsY() - $kid->GetAbsY()) == 1) { + $marriage->GetAndSortKids(); + } else { + # + # Ok, we need an additional node. It has the same + # abscissa as $marriage, but is one generation above kids + # + my $marriage1Id=$fatherId."_m1_".$motherId; + my $marriage1 = + new Pedigree::MarriageNode ( + Id=>$marriage1Id, + 'Consanguinic'=>1, + ); + $marriage1->SetAbsX($marriage->GetAbsX()); + $marriage1->SetAbsY(1+$kid->GetAbsY()); + $node_by_gen{$marriage1->GetAbsY()}->{$marriage1Id}= + $marriage1; + # + # Now we transfer kids + # + $kids_by_parent_id{$marriage1Id} = + $kids_by_parent_id{$marriageId}; + delete $kids_by_parent_id{$marriageId}; + $kids_by_parent_id{$marriageId}->{$marriage1Id}=1; + $marriage->GetAndSortKids(); + $marriage1->GetAndSortKids(); + } + } + } +} + + +#################################################################### +# AddTwins # +#################################################################### + +=pod + +=item B<AddTwins>(I<$ydist>); + +Check the pedigree and add twin nodes. Note +that this procedure must be called B<after> L<SetAbsCoor> and +L<AddConsanguinicMarriages>. + +=cut + +sub AddTwins { + my $self = shift; + my $ydist= shift; + # + # First, delete all kids from $twin_sets, for which there + # are no nodes + # + foreach my $set (@twin_sets) { + foreach my $kidId (keys %{$set->{'KidIds'}}) { + if (!exists($node_by_id{$kidId})) { + delete $set->{'KidIds'}->{$kidId}; + if ($main::DEBUG) { + print STDERR "Bad node \"$kidId\" in twin sets\n"; + } + } + } + } + + # + # Now we are ready to check for twins + # + foreach my $gen (keys %node_by_gen) { + foreach my $parentId (keys %{$node_by_gen{$gen}}) { + foreach my $kidId (keys %{$kids_by_parent_id{$parentId}}) { + for (my $i=0; $i<scalar @twin_sets; $i++) { + if (exists $twin_sets[$i]->{'KidIds'}->{$kidId}) { + my @kidIds = keys %{$twin_sets[$i]->{'KidIds'}}; + my $type = $twin_sets[$i]->{'Type'}; + my $twinsId = 't_'.join('_',@kidIds); + my $twinsNode = + Pedigree::TwinsNode->new ( + 'Id'=>$twinsId, + 'Type'=>$type, + 'ParentId'=>$parentId, + 'KidIds'=> + $twin_sets[$i]->{'KidIds'} + ); + # + # Change kids + # + my $parent = $node_by_id{$parentId}; + $parent->GetAndSortKids(); + $twinsNode->GetAndSortKids(); + + # + # Now the coordinates of the node. + # It is centered over kids nodes and 0.24 $ydist above + # + my @kids = sort {$a->GetAbsX() <=> + $b->GetAbsX()} + @{$twinsNode->Kids()}; + my $leftKid=$kids[0]; + my $rightKid=$kids[scalar(@kids)-1]; + $twinsNode->SetAbsX(($leftKid->GetAbsX() + + $rightKid->GetAbsX())/2.0); + $twinsNode->SetAbsY($leftKid->GetAbsY() + + 0.2*$ydist); + $node_by_gen{$twinsNode->GetAbsY()}-> + {$twinsId}= $twinsNode; + + # + # There is no need to keep this in the twins set + # + splice @twin_sets, $i,1; + last; # twin_sets + } + } + } + } + } + return 0; +} + + + + + +#################################################################### +# SetFrame # +#################################################################### + +=pod + +=item B<SetFrame>(I<$xidst>, I<$ydist>); + +Calculate the frame: coordinates of the lower left and upper right +corners of the picture (in ps units). As a side effect, add generation +numbers to each person node and calculate the X index of each node. + +=cut + +sub SetFrame { + my $self=shift; + my ($xdist, $ydist) = @_; + + my $xmin=0; + my $xmax=0; + + my @sorted_gens = sort {$b <=> $a} keys %node_by_gen; + my $ymin=$sorted_gens[(scalar @sorted_gens) -1]; + my $ymax=$sorted_gens[0]; + # + # The names of the nodes look like I:1, V:5. Let the + # first number be $i, and the second one be $j. + # IndexX is different from $j by the fact that marriage nodes + # are not skipped. + # + my $i=1; + foreach my $gen (@sorted_gens) { + my $roman=roman_num($i); + my @sorted_nodes = + sort {$a->GetAbsX() <=> $b->GetAbsX()} values %{$node_by_gen{$gen}}; + my $num_nodes= scalar @sorted_nodes; + if ($sorted_nodes[0]->GetAbsX()<$xmin) { + $xmin=$sorted_nodes[0]->GetAbsX(); + } + if ($sorted_nodes[$num_nodes-1]->GetAbsX()>$xmax) { + $xmax=$sorted_nodes[$num_nodes-1]->GetAbsX(); + } + my $j=1; + my $indexX=1; + foreach my $node (@sorted_nodes) { + $node->SetIndexX($indexX); + if ($main::DEBUG) { + print STDERR "Node ", $node->Id(), ", index ", + $node->GetIndexX(), "\n"; + } + $indexX++; + if ($node->isNumbered()) { + $node->SetGenName("$roman:$j"); + if ($main::DEBUG) { + print STDERR $node->Id(), ": ", $node->GetGenName(), + "\n"; + } + $j++; + } + } + # + # The fractional "generations" are for twin nodes + # and consanguinic marriage nodes. + # + if ($gen == int($gen)) { + $i++; + } + } + my @result = ($xdist*($xmin-1), $ydist*($ymin-1), + $xdist*($xmax+1), $ydist*($ymax+1)); + return \@result; +} + + + +#################################################################### +# DrawConnections # +#################################################################### + +=pod + +=item B<DrawConnections>(); + +Draw the connections from the given node to its descendants + +=cut + +sub DrawConnections { + my $self = shift; + my $xdist = shift; + my $ydist = shift; + my $result; + my $Id=$self->Id; + foreach my $kid (@{$self->Kids()}) { + my $kidId = $kid->Id(); + $result .= '\pstDescent{'.$Id.'}{'.$kidId.'}'."\n"; + } + return $result; +} + + + + + +#################################################################### +# DrawAll # +#################################################################### + +=pod + +=item B<DrawAll>(I<$xdist>, I<$ydist>, I<$belowtextfont>, + I<$abovetextfont>, I<@fieldsfornode>); + +Draw all nodes and connections in the form suitable for +pspicture + +=cut + +sub DrawAll { + my ($self, $xdist, $ydist, $belowtextfont, + $abovetextfont, @fieldsfornode) = @_; + + # + # Commands to draw nodes + # + my $nodes; + + # + # Commands to draw connections + # + my $connections; + + + foreach my $gen (keys %node_by_gen) { + foreach my $node (values %{$node_by_gen{$gen}}) { + # + # We draw only the nodes, who belong to the right + # generation (consanguinity may lead to duplicate nodes + # + # + if ($node->GetAbsY() <=> $gen) { + delete $node_by_gen{$gen}->{$node->Id()}; + next; + } + + $nodes .= $node->DrawNode($xdist, $ydist, + $belowtextfont, $abovetextfont, + @fieldsfornode); + $connections .=$node->DrawConnections($xdist, $ydist); + } + } + return $nodes.$connections; +} + +#################################################################### +# PrintAllLegends # +#################################################################### + +=pod + +=item B<PrintAllLegends>(I<$lang>, I<@fields>); + +Print legend for all the nodes. The first parameter is the +language, the other is the fields to be included in the legend. + +=cut + +sub PrintAllLegends { + my ($self, $lang, @fields) = @_; + + my $result="\n\\begin{description}\n"; + + foreach my $gen (sort {$b <=> $a} keys(%node_by_gen)) { + foreach my $node + (sort {$a->GetIndexX() <=> $b->GetIndexX()} + values(%{$node_by_gen{$gen}})) { + $result .= $node->PrintLegend($lang,@fields); + } + } + + $result .= "\\end{description}\n"; + + return $result; +} + + +#################################################################### +# PrintLegend # +#################################################################### + +=pod + +=item B<PrintLegend>(I<$lang>, I<@fields>); + +This subroutine does nothing: a generic node has no legend. It +is overriden by Pedigree::PersonNode(3) and Pedigree::AbortionNode(3). + +=cut + +sub PrintLegend { + + return; +} + + + + +#################################################################### +# by_sibs_order # +#################################################################### + +# +# Internal procedure for sorting kids +# + +sub by_sibs_order { + # + # We compare sort order, and if it is the same, DoB + # + return ($a->SortOrder() <=> $b->SortOrder()) || + ($a->DoB() cmp $b->DoB()); +} + +#################################################################### +# roman_num # +#################################################################### + +# +# Internal procedure for roman numerals +# + +sub roman_num { + my $i=shift; + my @nums=qw(0 I II III IV V VI VII VIII IX X XI XII XIII XIV XV + XVI XVII XVIII XIX XX XXI XXII XXIII XXIV); + return $nums[$i]; +} + + +#################################################################### +# THE END # +#################################################################### + + +=pod + +=back + +=head1 ENVIRONMENT + +The calling program should define B<$main::DEBUG> and set it to 0 +or 1. + +=head1 SEE ALSO + +pedigree(1), Pedigree(3) + +=head1 AUTHOR + +Boris Veytsman, Leila Akhmadeeva, 2006, 2007 + + + +=cut + +1; diff --git a/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Parser.pm b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Parser.pm new file mode 100644 index 00000000000..7978064f473 --- /dev/null +++ b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Parser.pm @@ -0,0 +1,237 @@ +=pod + +=head1 NAME + +Pedigree::Parser - parser for the input file + +=head1 SYNOPSIS + +use Pedigree::Parser; + +$parser = new Pedigree::Parser(I{$inputline>, I<$lang>) + +$parser->Parse($inputline); + + +=head1 DESCRIPTION + +This package parses input for the pedigree library and is used to +define nodes. + +=over 4 + +=cut + +#################################################################### +# Define the package # +#################################################################### + +package Pedigree::Parser; +use strict; + +#################################################################### +# package variables # +#################################################################### + +# +# %fields_to_convert: the hash of fields that contain limited +# number of values and the default value for such field +# + +my %fields_to_convert = ( + 'Sex'=>'unknown', + 'Proband'=>0, + 'Condition'=>'normal', + 'Type' => '' +); + + +#################################################################### +# And package methods # +#################################################################### + +#################################################################### +# new # +#################################################################### + +=pod + +=item B<new>(I<$inputline>, I<$lang>); + +Construct a new parser from the pipe-separated line at input + +=cut + +sub new { + my ($class,$inputline,$lang)=@_; + my $self={}; + + # + # The hash $self->{fields} is the main stored data structure. + # The key is the field, the value is the number of the field + # in the input lines. + # + my %fieldnames=%{$lang->GetFieldNames()}; + chomp $inputline; + $inputline =~ s/^\s+//; + $inputline =~ s/\s+$//; + my @input = split /\s*\|\s*/, $inputline; + for (my $i=0; $i<scalar @input; $i++) { + my $name=$input[$i]; + if (exists $fieldnames{$name}) { + my $field=$fieldnames{$name}; + $self->{fields}->{$field}=$i; + } else { + print STDERR "Warning: unknown field $name\n"; + } + } + + if ($main::DEBUG) { + print STDERR "Field names:\n"; + foreach my $key (keys %fieldnames) { + my $field=$fieldnames{$key}; + my $pos=$self->{fields}->{$field}; + print STDERR "\t$key\t$field\t$pos\n"; + } + } + + # + # The hash $self->{values} contains values for fields + # with closed sets of values. + # + my %values=%{$lang->GetValues()}; + $self->{values}=\%values; + + if ($main::DEBUG) { + print STDERR "Field values:\n"; + foreach my $key (keys %values) { + my $value=$values{$key}; + print STDERR "\t$key\t$value\n"; + } + } + + + # + # The hash $self->{special_names} contains special values + # for the 'Name' field + # + my %special=%{$lang->GetSpecialNames()}; + $self->{'special_names'}=\%special; + + if ($main::DEBUG) { + print STDERR "Special names:\n"; + foreach my $key (keys %special) { + my $value=$special{$key}; + print STDERR "\t$key\t$value\n"; + } + } + + if ($main::DEBUG) { + print STDERR "Special fields:\n"; + foreach my $key (keys %fields_to_convert) { + my $value=$fields_to_convert{$key}; + print STDERR "\t$key\t$value\n"; + } + } + + bless ($self,$class); + return $self; +} + + +#################################################################### +# Parse # +#################################################################### + +=pod + +=item B<Parse>(I<$inputline>); + +Take a line of comma-separated values; return a reference to a +hash of parsed values + +=cut + +sub Parse { + my ($self,$inputline)=@_; + chomp $inputline; + $inputline =~ s/^\s+//; + $inputline =~ s/\s+$//; + my @input = split /\s*\|\s*/, $inputline; + if ($main::DEBUG) { + print STDERR "Parsing line:$inputline\n"; + } + + my %result; + + foreach my $field (keys %{$self->{fields}}) { + my $i=$self->{fields}->{$field}; + my $value=$input[$i]; + # + # Special fields... + # + if (exists $self->{values}->{$value}) { + $value=$self->{values}->{$value}; + } + if (exists $fields_to_convert{$field}) { + if (length($value) == 0 ) { + $value=$fields_to_convert{$field}; + } + } + # + # Dropping empty fields + # + if (length($value) == 0 ) { + next; + } + + # + # Converting Name field + # + if (($field eq 'Name') && ($value =~ /^\#/)) { + foreach my $regexp (keys %{$self->{'special_names'}}) { + my $name=$self->{'special_names'}->{$regexp}; + $value =~ s/^(\#$regexp.*)/\#$name/i; + } + } + + # + # And finishing + # + $result{$field}=$value; + if ($main::DEBUG) { + print STDERR "\t$field\t$value\n"; + } + } + + return \%result; + +} + +#################################################################### +# THE END # +#################################################################### + +=pod + +=back + +=head1 ENVIRONMENT + +The calling program should define B<$main::DEBUG> and set it to 0 +or 1. + +=head1 SEE ALSO + +pedigree(1), Pedigree(3) + +=head1 AUTHOR + +Boris Veytsman, Leila Akhmadeeva, 2006, 2007 + + + +=cut + +1; + diff --git a/Master/texmf-dist/scripts/pedigree-perl/Pedigree/PersonNode.pm b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/PersonNode.pm new file mode 100644 index 00000000000..6d341cb7157 --- /dev/null +++ b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/PersonNode.pm @@ -0,0 +1,389 @@ +=pod + +=head1 NAME + +Pedigree::PersonNode - a person in a pedigree + +=head1 SYNOPSIS + +use Pedigree::PersonNode; + +$node = new Pedigree::PersonNode(I<%params>); + +$Id = $node->MotherId(); +$Id = $node->FatherId(); + +$isProband = $node->isProband(); + +$sex = $node->Sex(); + +$DoB = $node->DoB(); + +$DoD = $node->DoD(); + +$cond = $node->Condition(); + +$GenName = $node->GetGenName(); + +$node->SetGenName(I<$name>); + +$node->DrawNode(I<$xidst>, I<$ydist>, I<$belowtextfont>, I<$abovetextfont>, +I<@fieldsfornode>); + +$node->PrintLegend(I<$land>, I<@fields>); + +=head1 DESCRIPTION + +This package contains data about a person. + +=over 4 + +=cut + +#################################################################### +# Define the package # +#################################################################### + +package Pedigree::PersonNode; +use Pedigree; +use strict; +our @ISA=('Pedigree::Node'); + +#################################################################### +# new # +#################################################################### + +=pod + +=item B<new>(I<%params>); + +Construct a new node from the given parameters. + +=cut + +sub new { + my ($class,%params)=@_; + my $self=$class->SUPER::new(%params); + + if (!ref($self)) { + return 0; + } + + # + # Only Person Nodes are numbered in pedigrees + # + + $self->{'Numbered'}=1; + + # + # Now Twins... + # + + if (exists $self->{'Twins'}) { + my $Id=$self->{'Id'}; + my $string = $self->{'Twins'}; + $string =~ s/^\s*//; + $string =~ s/\s*$//; + my @twinIds=($Id, split (/[\s,;]+/, $string)); + if ($main::DEBUG) { + print STDERR "Found twins: ", join(', ',@twinIds), "\n"; + } + my $found=0; + for (my $i=0; $i<scalar @{$self->{'twin_sets'}}; $i++) { + if (exists $self->{'twin_sets'}->[$i]->{'KidIds'}->{$Id}) { + $found=1; + foreach my $kidId (@twinIds) { + $self->{'twin_sets'}->[$i]->{'KidIds'}->{$kidId}=1; + } + if ($main::DEBUG) { + print STDERR "Added to twin set number $i\n"; + } + last; # twin_set + } + } + if (!$found) { # Add twin set + my $set; + $set->{'Type'} = $self->{'Type'}; + foreach my $kidId (@twinIds) { + $set->{'KidIds'}->{$kidId}=1; + } + push @{$self->{'twin_sets'}}, $set; + if ($main::DEBUG) { + print STDERR "Started a new twin set number ", + scalar(@{$self->{'twin_sets'}})-1, "\n"; + } + } + } + + return $self; + +} + + +#################################################################### +# MotherId # +#################################################################### + +=pod + +=item B<MotherId>(); + +Return Mother Id. + +=cut + +sub MotherId { + my $self=shift; + return $self->{'Mother'}; +} + +#################################################################### +# FatherId # +#################################################################### + +=pod + +=item B<FatherId>(); + +Return Father Id. + +=cut + +sub FatherId { + my $self=shift; + return $self->{'Father'}; +} + + +#################################################################### +# isProband # +#################################################################### + +=pod + +=item B<isProband>(); + +Return 1 if the pesron is a Proband and zero otherwise + +=cut + +sub isProband { + my $self=shift; + if ($self->{Proband} == 1) { + return 1; + } else { + return 0; + } +} + +#################################################################### +# Sex # +#################################################################### + +=pod + +=item B<Sex>(); + +Get the sex of the node + +=cut + +sub Sex { + my $self = shift; + return $self->{'Sex'}; +} + +#################################################################### +# DoB # +#################################################################### + +=pod + +=item B<DoB>(); + +Get the DoB of the node + +=cut + +sub DoB { + my $self = shift; + return $self->{'DoB'}; +} + +#################################################################### +# DoB # +#################################################################### + +=pod + +=item B<DoD>(); + +Get the DoB of the node + +=cut + +sub DoD { + my $self = shift; + return $self->{'DoD'}; +} + +#################################################################### +# Condition # +#################################################################### + +=pod + +=item B<Condition>(); + +Returns node conditon. + +=cut + +sub Condition { + my $self=shift; + return $self->{'Condition'}; +} + + +#################################################################### +# GetGenName # +#################################################################### + +=pod + +=item B<GetGenName>(); + +Find the generation name for the node + +=cut + +sub GetGenName { + my $self = shift; + return $self->{'GenName'}; +} + + +#################################################################### +# SetGenName # +#################################################################### + +=pod + +=item B<SetGenName>(I<$name>); + +Set the generation name of the node + +=cut + +sub SetGenName { + my ($self, $name) = @_; + $self->{'GenName'} = $name; + return 0; +} + + +#################################################################### +# DrawNode # +#################################################################### + +=pod + +=item B<DrawNode>(I<$xdist>, I<$ydist>, I<$belowtextfont>, I<$abovetextfont>, +I<@fieldsfornode>); + +Output the command to draw this node. The parameters are +distances between the nodes (in cm) and fields for abovetext. + +=cut + +sub DrawNode { + my $self=shift; + my ($xdist, $ydist, $belowtextfont, $abovetextfont, @fieldsfornode) = @_; + my $result = '\rput('.($xdist*$self->GetAbsX()).", ". + ($ydist*$self->GetAbsY()).'){\pstPerson['; + my @opts=($self->Sex(), $self->Condition(), + 'belowtext={'."$belowtextfont ".$self->GetGenName().'}'); + if (length($self->DoD())>0) { + push @opts, 'deceased'; + } + if ($self->isProband()) { + push @opts, 'proband'; + } + if (scalar @fieldsfornode) { + my @abovetext; + foreach my $field (@fieldsfornode) { + push @abovetext, $self->{$field}; + } + push @opts,'abovetext={'."$abovetextfont ".join('; ',@abovetext).'}'; + } + $result .= join(', ',@opts); + $result .= ']{'.$self->Id()."}}\n"; + return $result; +} + +#################################################################### +# PrintLegend # +#################################################################### + +=pod + +=item B<PrintLegend>(I<$lang>, I<@fields>); + +Print the legend for the given node, including I<@fields> in the given +language I<$lang>. + +=cut + +sub PrintLegend { + my ($self, $lang, @fields) = @_; + my $result = '\item['.$self->GetGenName().'] '; + my @desc; + foreach my $field (@fields) { + if (exists $self->{$field}) { + my $res = $lang->PrintField($field, $self->{$field}); + if (length($res)>0) { + push @desc, $res; + } + } + } + $result .= join ("; ",@desc); + $result .= ".\n"; + # + # We print only the nodes, for which there is an information + # + if (scalar @desc) { + return $result; + } + return; +} + + + +#################################################################### +# THE END # +#################################################################### + + +=pod + +=back + +=head1 ENVIRONMENT + +The calling program should define B<$main::DEBUG> and set it to 0 +or 1. + + +=head1 SEE ALSO + +pedigree(1), Pedigree(3) + +=head1 AUTHOR + +Boris Veytsman, Leila Akhmadeeva, 2006, 2007 + + + +=cut + +1; diff --git a/Master/texmf-dist/scripts/pedigree-perl/Pedigree/TwinsNode.pm b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/TwinsNode.pm new file mode 100644 index 00000000000..c8557230bd7 --- /dev/null +++ b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/TwinsNode.pm @@ -0,0 +1,172 @@ +=pod + +=head1 NAME + +Pedigree::TwinsNode - an auxillary twins node in a pedigree + +=head1 SYNOPSIS + +use Pedigree::TwinsNode; + +$node = new Pedigree::TwinsNode(I<%params>); + + +$node->DrawNode(I<$xidst>, I<$ydist>, I<$belowtextfont>, I<$abovetextfont>, +I<@fieldsfornode>); + +$node->DrawConnections(); + + +=head1 DESCRIPTION + +This package contains data about a twins node. Twins node is +a special node between the parent and the twins. + +=over 4 + +=cut + + + +#################################################################### +# Define the package # +#################################################################### + +package Pedigree::TwinsNode; +use Pedigree; +use strict; +our @ISA=('Pedigree::Node'); + + +#################################################################### +# new # +#################################################################### + +=pod + +=item B<new>(I<%params>); + +Construct a new node from the given parameters. + +=cut + +sub new { + my ($class,%params)=@_; + my $self=$class->SUPER::new(%params); + if (!ref($self)) { # Bad node + return 0; + } + + bless ($self,$class); + + # After we constructed the node, we want to move the kids + # from the parent node to the twins node + + my $selfId = $self->{'Id'}; + my $parentId = $self->{'ParentId'}; + foreach my $kidId (keys %{$self->{'KidIds'}}) { + if ($main::DEBUG) { + print STDERR + "Moving $kidId from $parentId and to $selfId\n"; + } + delete $self->{'kids_by_parent_id'}->{$parentId}->{$kidId}; + $self->{'kids_by_parent_id'}->{$selfId}->{$kidId}=1; + } + + return $self; +} + + + +#################################################################### +# DrawNode # +#################################################################### + +=pod + +=item B<DrawNode>(I<$xdist>, I<$ydist>, I<$belowtextfont>, I<$abovetextfont>, +I<@fieldsfornode>); + +Output the command to draw this node. The parameters are +distances between the nodes (in psunits). + +=cut + +sub DrawNode { + my $self=shift; + my ($xdist, $ydist, $belowtextfont, $abovetextfont, @fieldsfornode) = @_; + my $result = '\rput('.($xdist*$self->GetAbsX()).", ". + ($ydist*$self->GetAbsY()).'){\pnode{'. + $self->Id()."}}\n"; + return $result; +} + +#################################################################### +# DrawConnections # +#################################################################### + +=pod + +=item B<DrawConnections>(); + +Draw the connections from the given node to its descendants and +the parent + +=cut + +sub DrawConnections { + my $self = shift; + my $xdist = shift; + my $ydist = shift; + my $Id=$self->Id(); + my $parentId = $self->{'ParentId'}; + my @kids = @{$self->Kids()}; + my $leftKid=shift @kids; + my $leftKidId=$leftKid->Id(); + my $rightKid= pop @kids; + my $rightKidId=$rightKid->Id(); + my @opts; + if ($self->Type()) { + push @opts, $self->Type(); + } + foreach my $kid (@kids) { + push @opts, "addtwin=".$kid->Id(); + } + my $result = '\pstTwins['; + if (scalar @opts) { + $result .= join (", ",@opts); + } + $result .= ']{'.$parentId.'}{'. + $Id.'}{'.$leftKidId.'}{'.$rightKidId.'}'."\n"; + return $result; +} + + + + +#################################################################### +# THE END # +#################################################################### + +=pod + +=back + +=head1 ENVIRONMENT + +The calling program should define B<$main::DEBUG> and set it to 0 +or 1. + +=head1 SEE ALSO + +pedigree(1), Pedigree(3) + +=head1 AUTHOR + +Boris Veytsman, Leila Akhmadeeva, 2007 + + + +=cut + +1; diff --git a/Master/texmf-dist/scripts/pedigree-perl/pedigree.pl b/Master/texmf-dist/scripts/pedigree-perl/pedigree.pl new file mode 100755 index 00000000000..d8ace2ce125 --- /dev/null +++ b/Master/texmf-dist/scripts/pedigree-perl/pedigree.pl @@ -0,0 +1,544 @@ +#!/usr/bin/env perl +# +# Copyright (C) 2006 Boris Veytsman & Leila Akhmadeeva +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. +# +# +=pod + +=head1 NAME + +pedigree - create a TeX file for pedigree from a csv file + +=head1 SYNOPSIS + +B<pedigree> [-c I<configuration_file>] [-d] [-o I<output_file>] [-s I<start_id>] I<input_file> + +B<pedigree> -v + +=head1 DESCRIPTION + +The program converts a comma separated I<input_file> into a TeX file +with pst-pdgr macros. + +=head1 OPTIONS + +=over 4 + +=item B<-c> I<configuration_file> + +The configuration file to read along with the system-wide and user's +configuration files + +=item B<-d> + +Debug mode on + +=item B<-o> -I<output_file> + +The ouput file instead of I<input_file.tex> + +=item B<-s> -I<start_id> + +If this option is selected, the pedigree is constructed starting from +the node with the Id i<start_id>. Otherwise it is started from the +proband node. + +This option allows to create pedigrees with multiple probands or absent +probands, or show people who are not proband's relatives. + +=item B<-v> + +Print version information + +=back + +=head1 FILES + +=over 4 + +=item B</etc/pedigree.cfg> + +Global configuration file + +=item B<$HOME/.pedigreerc> + +User configuration file + +=back + +=head1 SEE ALSO + +The manual distributed with this program describes the format of the +configuration file and the input file. + +The library functions are described in Pedigree::Language(3), +Pedigree::Parser(3), Pedigree::Node(3), Pedigree::PersonNode(3), +Pedigree::MarriageNode(3), Pedigree::Area(3). + +=head1 AUTHOR + +Boris Veytsman, Leila Akhmadeeva, 2006, 2007 + + +=cut + + +######################################################### +# Packages and Options # +######################################################### + +use strict; +use vars qw($opt_c $opt_d $opt_o $opt_s $opt_v); + +############################## +# TeXLive compatibility stuff +############################## +my $TLMaster; # Where TeXlive is +my $TLCONF; # TL config file +my $TLCONFLOCAL; # TL local config file +chomp($TLMaster = `kpsewhich -var-value=SELFAUTOPARENT`); +if (length($TLMaster)) { + unshift @INC, "$TLMaster/texmf-dist/scripts/pedigree-perl"; + $TLCONF = "$TLMaster/texmf-config/pedigree/pedigree.cfg"; + chomp($TLCONFLOCAL = `kpsewhich -var-value=TEXMFLOCAL`); + $TLCONFLOCAL .= "/pedigree/pedigree.cfg"; +} + +use Getopt::Std; +use FileHandle; +use Pedigree; + +######################################################### +# Options Reading and Global Variables # +######################################################### + +my $USAGE="Usage: $0 [-c configuration_file] [-d] [-o output_file] [-s start_id] input_file\n"; +my $COPYRIGHT=<<END; +$0 Version 0.4, July 2012 + +Copyright (C) 2006, 2007, 2012 Boris Veytsman & Leila Akhmadeeva + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, +END + +my $GLOBALCONF="/etc/pedigree.cfg"; + +my $USERCONF="$ENV{HOME}/.pedigreerc"; + + +our $IN = new FileHandle; +our $OUT = new FileHandle; + +getopts('c:do:s:v') or die $USAGE; + +if ($opt_v) { + die $COPYRIGHT; +} + +our $DEBUG = $opt_d ||0; + +if (scalar @ARGV != 1) { + die $USAGE; +} + +our $start_id = $opt_s; + +######################################################### +# Opening Files # +######################################################### + + +if ($ARGV[0] eq '-') { + $IN->fdopen(fileno(STDIN),"r"); +} else { + $IN->open($ARGV[0], "r") or die "Cannot read from $ARGV[0]\n"; +} + +my $outfile=$ARGV[0]; +if ($opt_o) { + $outfile = $opt_o; +} else { + $outfile =~ s/\.[^\.]*$/.tex/; +} +if ($outfile eq '-') { + $OUT->fdopen(fileno(STDOUT),"w"); +} else { + $OUT->open($outfile, "w") or die "Cannot write to $outfile\n"; +} + +######################################################### +# Configuration # +######################################################### + +# +# First, the defaults. Even if we do not find any +# configuration file, these will work. +# + + +# +# Do we want to have a full LaTeX file or just a fragment? +# +our $fulldoc=1; + +# +# What kind of document do we want +# +# our $documentheader='\documentclass[landscape]{article}'; +our $documentheader='\documentclass{article}'; + +# +# Define additional packages here +# +# our $addtopreamble=<<END; +# \\usepackage{graphics} +# END +our $addtopreamble=<<END; +\\psset{descarmA=1} +END + + + +# +# Do we want to print a legend? +# +our $printlegend=1; + +# +# Fields to include in the legend. Delete Name for privacy +# protection. +# +our @fieldsforlegend = qw(Name DoB AgeAtDeath Comment); + +# +# Fields to put at the node. Delete Name for privacy +# protection. +# +our @fieldsforchart = qw(Name); + +# +# Language +# +# our $language="russian"; +our $language="english"; + +# +# Override the encoding +# +# our $encoding="koi8-r"; + +our $encoding; + +# +# descarmA +# +our $descarmA = 0.8; + +# +# Fonts for nodes +# +our $belowtextfont='\small'; +our $abovetextfont='\scriptsize'; + +# +# Distances between nodes (in cm) +# +our $xdist=2; +our $ydist=2; + +# +# Maximal width and height of the pedigree in cm. +# Set this to 0 to switch off scaling +# +our $maxW = 15; +our $maxH = 19; + +# +# Whether to rotate the page. The values are 'yes', 'no' and 'maybe' +# If 'maybe' is chosen, the pedigree is rotated if it allows better +# scaling +# +our $rotate = 'maybe'; + +# +# Read the global configuration file(s) +# +foreach my $conffile ($GLOBALCONF, $TLCONF, $TLCONFLOCAL) { + if (-r $conffile) { + if ($DEBUG) { + print STDERR "Reading global configuration file $conffile\n"; + } + require "$conffile"; + } else { + if ($DEBUG) { + print STDERR "Cannot find global configuration file $conffile; going without it\n"; + } + } +} + +# +# Read the user configuration file +# +if (-r $USERCONF) { + if ($DEBUG) { + print STDERR "Reading user configuration file $USERCONF\n"; + } + require "$USERCONF"; +} else { + if ($DEBUG) { + print STDERR "Cannot find user configuration file $USERCONF; going without it\n"; + } +} + +# +# Read the option configuration file +# +if ($opt_c) { + if (-r $opt_c) { + if ($DEBUG) { + print STDERR "Reading optional configuration file $opt_c\n"; + } + require "$opt_c"; + } else { + die "Cannot find $opt_c\n"; + } +} + +######################################################### +# Setting up # +######################################################### + +my $lang = new Pedigree::Language($language, $encoding); +$_=<$IN>; +my $parser = new Pedigree::Parser($_,$lang); +my $start; + +######################################################### +# Reading input # +######################################################### + +while (<$IN>) { + my $node = Pedigree->MakeNode($parser->Parse($_)); + if (ref($node)) { + if ($start_id) { + if ($start_id eq $node->Id()) { + $start = $node; + if ($DEBUG) { + print STDERR "Found start: ", $start->Id(), "\n"; + } + } + } else { + if ($node->isProband()) { + if (ref($start)) { + print STDERR "Two probands? I got ", $start->Id(), + " and ", $node->Id(), "\n"; + } + $start=$node; + if ($DEBUG) { + print STDERR "Found proband: ", $start->Id(), "\n"; + } + } + } + } +} + +if (!ref($start)) { + die "Cannot find the start!\n"; +} + +######################################################### +# Process Pedigree # +######################################################### + +# +# Check all parents +# +$start->CheckAllParents(); + + +# +# The root is the root of the tree to which the proband +# belongs +# + +my ($root, undef)=@{$start->FindRoot(0)}; +if ($DEBUG) { + print STDERR "Root: ", $root->Id(), "\n"; +} + +# +# Calculate relative coordinates +# +$root->SetRelX(0); +$root->SetRelY(0); +$root->SetArea(); + +# +# Calculate the absolute coordinates +# +$root->CalcAbsCoor(0,0); + +# +# Check for consanguinic marriages +# +$root->AddConsanguinicMarriages(); + +# +# And twins +# +$root->AddTwins($ydist); + +# +# Get the frame +# +my ($xmin, $ymin, $xmax, $ymax) = @{$root->SetFrame($xdist, $ydist)}; + + + +######################################################### +# Printing headers # +######################################################### + +if ($fulldoc) { + printheader($OUT,$lang,$addtopreamble); +} + +######################################################### +# Calculate scale and check whether to rotate # +######################################################### + +my $scale=1; +my $scaleRotated = 1; + +if ($maxH && $maxW) { + if ($maxH/($ymax-$ymin) < $scale) { + $scale = $maxH/($ymax-$ymin); + } + if ($maxW/($xmax-$xmin) < $scale) { + $scale = $maxW/($xmax-$xmin); + } + if ($maxW/($ymax-$ymin) < $scaleRotated) { + $scaleRotated = $maxW/($ymax-$ymin); + } + if ($maxH/($xmax-$xmin) < $scaleRotated) { + $scaleRotated = $maxH/($xmax-$xmin); + } +} + +my $doRotate = ($rotate =~ /yes/i) || (($rotate =~ /maybe/i) && + ($scaleRotated > $scale)); + +######################################################### +# Printing pspicture # +######################################################### + +my $pre; +my $post ='}'."\n"; + +if ($doRotate) { + $descarmA *= $scaleRotated; + $pre="\\rotatebox{90}{%\n\\psset{descarmA=$descarmA}%\n"; + if ($scaleRotated<1) { + $pre .= '\psset{unit='.$scaleRotated.'}%'."\n"; + } +} else { + $descarmA *= $scale; + $pre="{%\n\\psset{descarmA=$descarmA}%\n"; + if ($scale<1) { + $pre .= '{\psset{unit='.$scale.'}%'."\n"; + } +} + +print $OUT $pre; + +print $OUT '\begin{pspicture}',"($xmin,$ymin)($xmax,$ymax)\n"; + +print $OUT $root->DrawAll($xdist, $ydist, $belowtextfont, + $abovetextfont, @fieldsforchart); + +print $OUT '\end{pspicture}%',"\n"; + +print $OUT $post; + +######################################################### +# Printing legend # +######################################################### + + +if ($printlegend) { + print $OUT $root->PrintAllLegends($lang, @fieldsforlegend); +} + +######################################################### +# Printing end # +######################################################### + + +if ($fulldoc) { + printend($OUT); +} + +######################################################### +# Exiting # +######################################################### + +exit 0; + +######################################################### +# Subroutines # +######################################################### + +# +# Printing headers & footers +# + +sub printheader { + my ($OUT,$lang,$addtopreamble)=@_; + print $OUT <<END; +$documentheader +\\usepackage{pst-pdgr} +END + + print $OUT $lang->Header; + print $OUT <<END; +$addtopreamble +\\begin{document} +END + return 0; +} + + +sub printend { + my $OUT=shift; + print $OUT "\\end{document}\n"; + return 0; +} + + diff --git a/Master/tlpkg/bin/tlpkg-ctan-check b/Master/tlpkg/bin/tlpkg-ctan-check index 231a2bd527f..8981b21e894 100755 --- a/Master/tlpkg/bin/tlpkg-ctan-check +++ b/Master/tlpkg/bin/tlpkg-ctan-check @@ -300,7 +300,7 @@ my @TLP_working = qw( pdf14 pdf-trans pdfcomment pdfcprot pdfcrop pdfjam pdfmarginpar pdfpages pdfscreen pdfslide pdfsync pdftex-def pdftricks pdfx - pecha perception perltex + pecha pedigree-perl perception perltex permute persian-bib persian-modern petiteannonce petri-nets pgf pgf-soroban pgf-umlsd pgfgantt pgfmolbio pgfopts pgfplots phaistos philex philokalia philosophersimprint diff --git a/Master/tlpkg/libexec/ctan2tds b/Master/tlpkg/libexec/ctan2tds index 66f5bf7e839..bc8c994b4b8 100755 --- a/Master/tlpkg/libexec/ctan2tds +++ b/Master/tlpkg/libexec/ctan2tds @@ -645,6 +645,7 @@ chomp ($Build = `cd $Master/../Build/source && pwd`); 'pdfmarginpar',"&MAKEflatten", 'pdfrack', "die 'skipping, until someone asks for it'", 'pdfx', "&MAKEflatten", + 'pedigree', "die 'skipping, use pedigree-perl'", 'persian-modern',"&MAKEflatten", 'pgf', "&MAKEcopy", 'pgfplots', "&MAKEcopy", @@ -1007,6 +1008,7 @@ chomp ($Build = `cd $Master/../Build/source && pwd`); 'lithuanian' => '&POSTlithuanian', 'montex' => '&POSTmontex', 'niceframe' => '&POSTrmsymlink', + 'pedigree-perl' => '&POSTpedigreeperl', 'pgf' => '&POSTpgf', 'prerex' => '&POSTprerex', 'pst-cox' => '&POSTpstcox', @@ -1530,6 +1532,7 @@ $standardtex='\.(.bx|cfg|sty|clo|ldf|cls|def|fd|cmap|4ht)$'; 'pdcmac', 'plain', 'pdf-trans', 'generic', 'pdfcrop', 'support', + 'pedigree-perl', 'support', 'persian-bib', 'xelatex', 'phaistos', 'fonts', 'philokalia', 'xelatex', @@ -2088,6 +2091,7 @@ $standardxmt='\.xmt'; 'luaindex' => '\.lua$', 'lualatex-math' => '\.lua$', 'luasseq' => '\.lua$', +# 'pedigree-perl' => 'Pedigree/*.pm', ); # scripts that should end up in $bindir too. @@ -2124,6 +2128,7 @@ $standardxmt='\.xmt'; 'musixtex' => '\.lua$', 'pdfcrop' => '\.pl$', 'pdfjam' => 'pdf[^.]*$', + 'pedigree-perl' => '\.pl$', 'perltex' => '\.pl$', 'pkfix' => '\.pl$', 'pkfix-helper' => 'pkfix-helper$', @@ -2680,15 +2685,13 @@ sub domp { } # BibTeX bibliography files: -sub dobib -{ +sub dobib { $bibpatt = $specialbib{$package} || $standardbib; &install("$DEST/bibtex/bib/$package", $bibpatt); } # source files: -sub dosource -{ +sub dosource { $sourceformat = $specialsourcefmt{$package} || $standardsourcefmt; # default to using specialdocfmt, as we do in setup? $sourcepatt = $specialsource{$package} || $standardsource; @@ -4750,6 +4753,14 @@ sub POSTmontex { &SYSTEM ("$MV 00readme 00readme.mfinput.km"); } +sub POSTpedigreeperl { + print "POST$package - mv *.pm Pedigree/*.pm\n"; + my $scriptdir = "$DEST/scripts/$package"; + &xmkdir ("$scriptdir/Pedigree"); + &SYSTEM ("$MV *.pm $scriptdir/"); + &SYSTEM ("$MV Pedigree/*.pm $scriptdir/Pedigree/"); +} + sub POSTpgf { print "POST$package - mv generic,latex,... directories\n"; &SYSTEM ("cd $DEST && mkdir tex && mv context generic latex plain tex"); diff --git a/Master/tlpkg/tlpsrc/collection-pstricks.tlpsrc b/Master/tlpkg/tlpsrc/collection-pstricks.tlpsrc index 67b50112d69..6bfc05e5cb9 100644 --- a/Master/tlpkg/tlpsrc/collection-pstricks.tlpsrc +++ b/Master/tlpkg/tlpsrc/collection-pstricks.tlpsrc @@ -8,6 +8,7 @@ depend auto-pst-pdf depend bclogo depend makeplot depend pdftricks +depend pedigree-perl depend psbao depend pst-2dplot depend pst-3d diff --git a/Master/tlpkg/tlpsrc/pedigree-perl.tlpsrc b/Master/tlpkg/tlpsrc/pedigree-perl.tlpsrc new file mode 100644 index 00000000000..49994731de4 --- /dev/null +++ b/Master/tlpkg/tlpsrc/pedigree-perl.tlpsrc @@ -0,0 +1,2 @@ +runpattern d texmf-dist/scripts/pedigree-perl +binpattern f bin/${ARCH}/pedigree |