mirror of
https://github.com/kennethreitz/context.git
synced 2026-06-05 23:00:17 +00:00
1110 lines
46 KiB
LLVM
1110 lines
46 KiB
LLVM
/*
|
|
* @progname ps-circle.ll
|
|
* @version 2.6.2 of 2003-12-10
|
|
* @author Jim Eggert (eggertj@ll.mit.edu), Henry Sikkema (hasikkema@yahoo.ca)
|
|
* @category
|
|
* @output PostScript
|
|
* @description
|
|
|
|
Print a five to ten-generation ancestry circle chart in PostScript.
|
|
|
|
Version 2.5, December 2002 by Henry Sikkema (hasikkema@yahoo.ca)
|
|
Version 1.1, September 2002
|
|
Version 1, 15 September 1993 by Jim Eggert (eggertj@ll.mit.edu)
|
|
|
|
This program generates a basic five to ten-generation ancestry circle chart.
|
|
Its output is a Postscript file specifying the chart. This program
|
|
uses a modified version of the CIRC.PS program written by
|
|
David Campbell and John Dunn.
|
|
|
|
You must choose the number of generations to print (5 - 10 generations).
|
|
For a larger number of generations the print may get VERY small but may
|
|
be enlarged using a program such as Corel Draw or other programs and printed
|
|
onto a larger paper or printed in parts.
|
|
|
|
You have the option of creating a colour gradient background or an
|
|
alternating colour scheme for males and females. The gradient does take a while to
|
|
process since all I do is to draw and fill circles with decreasing radius. Please
|
|
email (see above) me if you know how to make a better gradient. To change the colours
|
|
you need to modify the resulting Postscript file. The colours are given
|
|
in RGB format. The default colors are RED for female text and BLUE for male text,
|
|
the backgrounds are opposite: light blue to female box fillin and light red for
|
|
male box fill in. The default colour gradient is a light brown on the inside
|
|
to a darker brown on the outside for an attempted antique look.
|
|
|
|
http://sikkema.netfirms.com/family/tree/ps-circle/ps-circle.html
|
|
|
|
The data currently printed depends on the level number and on the length
|
|
of the names. When there are more than one given name (i.e. second and
|
|
third names), if they are too long they are eliminated.
|
|
|
|
The full birth date is printed if there is no known death date. In this
|
|
case, the date is preceeded by 'b:' to indicate that the date is a birth,
|
|
for example (b: 12 Sep 1901); the only exception is on level one where
|
|
the 'b:' is dropped for the sake of space. When only a death date is known,
|
|
it will be preceeded by a dash, for example (-1978). In every other case, only
|
|
the birth and death years are printed, for example (1901-1978).
|
|
|
|
The case (capitalization) of the names are not changed at all from the GEDCOM file.
|
|
|
|
This data is currently printed:
|
|
First line Second Line Third line
|
|
-----------------------------------------------------------------
|
|
Level 1: Given Names Surname Dates
|
|
Level 2: Full Name Dates ---
|
|
Level 3: Full Name Dates ---
|
|
Level 4: First Name Surname Dates
|
|
Level 5: First Name Surname Dates
|
|
Level 6: First Name Surname Dates
|
|
Level 7: Full Name Dates ---
|
|
Level 8: Full Name Dates ---
|
|
Level 9: Full Name, Dates --- ---
|
|
Level 10: Full Name, Dates --- ---
|
|
|
|
Future: - color coding based on country of origin. (Robert Simms)
|
|
- marriage date estimate
|
|
- proper zooming in Ghostview
|
|
- eliminate blank pages with small radius
|
|
*/
|
|
|
|
global(indicentre)
|
|
global(marrest)
|
|
global(version)
|
|
global(printmarr)
|
|
global(gradient)
|
|
global(maxlevel)
|
|
global(printdate)
|
|
global(numindilines)
|
|
global(nummarr)
|
|
global(enc_choice) /* int, specifies character encoding to use */
|
|
global(x_pages)
|
|
global(y_pages)
|
|
global(radius)
|
|
global(font_name)
|
|
|
|
proc removeparentheses(n){
|
|
set(b,index(n,"(",1))
|
|
if(gt(b,0)){/*remove ( if it exists*/
|
|
set(cb,index(n,")",1))
|
|
if(gt(cb,b)){ /*remove upto the ) */
|
|
set(startpt,add(cb,1))
|
|
}else{
|
|
set(startpt,add(b,1))
|
|
}
|
|
set(endpt,strlen(n))
|
|
if(gt(endpt,startpt)){
|
|
set(n,concat(trim(n,sub(b,1)),substring(n,startpt,endpt)))
|
|
}else{
|
|
set(n,trim(n,sub(b,1)))
|
|
}
|
|
}
|
|
set(b,index(n,")",1))
|
|
if(gt(b,0)){/*remove ) if it exists*/
|
|
set(startpt,add(b,1))set(endpt,strlen(n))
|
|
if(gt(endpt,startpt)){
|
|
set(n,concat(trim(n,sub(b,1)),substring(n,startpt,endpt)))
|
|
}else{
|
|
set(n,trim(n,sub(b,1)))
|
|
}
|
|
}
|
|
set(b,substring(n,strlen(n),strlen(n)))
|
|
if(eq(b," ")){ /*remove final space if it exists*/
|
|
set(n,trim(n,sub(strlen(n),1)))
|
|
}
|
|
set(b,index(n," ",1))
|
|
if(gt(b,0)){/*remove double space if it exists*/
|
|
set(startpt,add(b,1))set(endpt,strlen(n))
|
|
if(gt(endpt,startpt)){
|
|
set(n,concat(trim(n,sub(b,1)),substring(n,startpt,endpt)))
|
|
}else{
|
|
set(n,trim(n,sub(b,1)))
|
|
}
|
|
}
|
|
n
|
|
}
|
|
proc put_given_name(person,length){
|
|
if (ne(trimname(person,add(length,strlen(surname(person)),1)),"")){set(l,trimname(person,add(length,strlen(surname(person)),1)))}else{set(l,givens(person))}
|
|
if(ne(trim(l,sub(index(l,surname(person),1),2)),"")){set(n,trim(l,sub(index(l,surname(person),1),2)))}
|
|
call removeparentheses(n)
|
|
}
|
|
|
|
proc put_full_name(person,sur_upper,n_order,length){
|
|
set(n,fullname(person,sur_upper,n_order,length))
|
|
call removeparentheses(n)
|
|
|
|
}
|
|
proc endline(ahnen,offset,info,max){") " d(ahnen) " " d(offset) " " d(info) " " d(max) "} addind\n"}
|
|
|
|
proc putperson(family, person, level, ahnen, info,dateformat) {
|
|
list(levellength)
|
|
setel(levellength,1,25)
|
|
setel(levellength,2,26)
|
|
setel(levellength,3,23)
|
|
setel(levellength,4,16)
|
|
setel(levellength,5,15)
|
|
setel(levellength,6,15)
|
|
setel(levellength,7,21)
|
|
setel(levellength,8,21)
|
|
setel(levellength,9,21)
|
|
setel(levellength,10,21)
|
|
setel(levellength,11,21)
|
|
|
|
set(max,0)
|
|
set(offset,0)
|
|
|
|
if(eq(dateformat,1)){
|
|
if (eq(level,1)) {
|
|
if (givens(person)){set(max,add(max,1))}
|
|
if (surname(person)){set(max,add(max,1))}
|
|
if (or(year(death(person)),year(birth(person)))){set(max,add(max,1))}
|
|
|
|
if (givens(person)){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "(" call put_given_name(person,getel(levellength,level)) call endline(ahnen,offset,info,max)}
|
|
if (surname(person)){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "(" surname(person) call endline(ahnen,offset,info,max)}
|
|
if (or(year(death(person)),year(birth(person)))){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "(" if (year(death(person))){year(birth(person))"-" year(death(person))}else{if(eq(indicentre,0)){"b:"}date(birth(person))}call endline(ahnen,offset,info,max)}
|
|
|
|
}elsif(and(ge(level,2),le(level,6))){
|
|
if (givens(person)){set(max,add(max,1))}
|
|
if (surname(person)){set(max,add(max,1))}
|
|
if (or(year(death(person)),year(birth(person)))){set(max,add(max,1))}
|
|
|
|
if (givens(person)){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "(" call put_given_name(person,getel(levellength,level)) call endline(ahnen,offset,info,max)}
|
|
if (surname(person)){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "(" surname(person) call endline(ahnen,offset,info,max)}
|
|
if (or(year(death(person)),year(birth(person)))){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "(" if (year(death(person))){"("year(birth(person))"-" year(death(person))")"}else{if (year(birth(person))){"b:"date(birth(person))}}call endline(ahnen,offset,info,max)}
|
|
|
|
}elsif(or(eq(level,7),eq(level,8))){
|
|
if (or(givens(person),surname(person))){set(max,add(max,1))}
|
|
if (or(year(death(person)),year(birth(person)))){set(max,add(max,1))}
|
|
|
|
if (or(givens(person),surname(person))){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "(" call put_full_name(person,0,1,getel(levellength,level)) call endline(ahnen,offset,info,max)}
|
|
if (or(year(death(person)),year(birth(person)))){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "(" if (year(death(person))){"("year(birth(person))"-" year(death(person))")"}else{if (year(birth(person))){"b:"date(birth(person))}}call endline(ahnen,offset,info,max)}
|
|
}elsif(ge(level,9)){set(offset,add(offset,1))set(max,add(max,1))
|
|
set(numindilines,add(numindilines,1))d(numindilines)" {""(" call put_full_name(person,0,1,getel(levellength,level)) " " if (year(death(person))){"("year(birth(person))"-" year(death(person))")"}else{if (year(birth(person))){"b:"date(birth(person))}} call endline(ahnen,offset,info,max)
|
|
}
|
|
}elsif(ge(dateformat,2)){ /* (yyyy-yyyy) date format ------------------------------------- */
|
|
if (eq(level,1)) {
|
|
if (givens(person)){set(max,add(max,1))}
|
|
if (surname(person)){set(max,add(max,1))}
|
|
if (or(eq(dateformat,3),or(year(death(person)),year(birth(person))))){set(max,add(max,1))}
|
|
|
|
if (givens(person)){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "(" call put_given_name(person,getel(levellength,level)) call endline(ahnen,offset,info,max)}
|
|
if (surname(person)){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "(" surname(person) call endline(ahnen,offset,info,max)}
|
|
if (or(eq(dateformat,3),or(year(death(person)),year(birth(person))))){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "(" if (year(birth(person))){year(birth(person))}else{if(eq(dateformat,3)){" "}} "-" if (year(death(person))){year(death(person))}else{if(eq(dateformat,3)){" "}}call endline(ahnen,offset,info,max)}
|
|
|
|
}elsif(and(ge(level,2),le(level,6))){
|
|
if (givens(person)){set(max,add(max,1))}
|
|
if (surname(person)){set(max,add(max,1))}
|
|
if (or(eq(dateformat,3),or(year(death(person)),year(birth(person))))){set(max,add(max,1))}
|
|
|
|
if (givens(person)){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "(" call put_given_name(person,getel(levellength,level)) call endline(ahnen,offset,info,max)}
|
|
if (surname(person)){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "(" surname(person) call endline(ahnen,offset,info,max)}
|
|
if (or(eq(dateformat,3),or(year(death(person)),year(birth(person))))){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "((" if (year(birth(person))){year(birth(person))}else{if(eq(dateformat,3)){" "}} "-" if (year(death(person))){year(death(person))}else{if(eq(dateformat,3)){" "}} ")"call endline(ahnen,offset,info,max)}
|
|
}elsif(or(eq(level,7),eq(level,8))){
|
|
if (or(givens(person),surname(person))){set(max,add(max,1))}
|
|
if (or(eq(dateformat,3),or(year(death(person)),year(birth(person))))){set(max,add(max,1))}
|
|
|
|
if (or(givens(person),surname(person))){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "(" call put_full_name(person,0,1,getel(levellength,level)) call endline(ahnen,offset,info,max)}
|
|
if (or(eq(dateformat,3),or(year(death(person)),year(birth(person))))){set(numindilines,add(numindilines,1))d(numindilines)" {"set(offset,add(offset,1)) "((" if (year(birth(person))){year(birth(person))}else{if(eq(dateformat,3)){" "}} "-" if (year(death(person))){year(death(person))}else{if(eq(dateformat,3)){" "}} ")"call endline(ahnen,offset,info,max)}
|
|
}elsif(ge(level,9)){set(offset,add(offset,1))set(max,add(max,1))
|
|
set(numindilines,add(numindilines,1))d(numindilines)" {""(" call put_full_name(person,0,1,getel(levellength,level))
|
|
if (or(eq(dateformat,3),or(year(death(person)),year(birth(person))))){" (" if (year(birth(person))){year(birth(person))}else{if(eq(dateformat,3)){" "}} "-" if (year(death(person))){year(death(person))}else{if(eq(dateformat,3)){" "}}")"}
|
|
call endline(ahnen,offset,info,max)
|
|
}
|
|
}
|
|
|
|
if (eq(printmarr,1)){
|
|
if (eq(marrest,1)){ /*marriage date estimation does not yet work!*/
|
|
if (ne(date(marriage(family)),"")){if (eq("M",sex(person))){set(nummarr,add(nummarr,1))d(nummarr)" {(" stddate(marriage(family)) ") " d(ahnen) " " d(info)"} addmarr\n"}}
|
|
}else{
|
|
if (ne(date(marriage(family)),"")){if (eq("M",sex(person))){set(nummarr,add(nummarr,1))d(nummarr)" {(" stddate(marriage(family)) ") " d(ahnen) " " d(info)"} addmarr\n"}}
|
|
}
|
|
}
|
|
}
|
|
|
|
proc semicirc(family, person, level, ahnen, info, maxlevel,dateformat) {
|
|
|
|
if (and(person,le(level,maxlevel))) {
|
|
call putperson(family,person,level,ahnen,info,dateformat)
|
|
set(nextlevel, add(level,1))
|
|
set(nextahnen, mul(ahnen,2))
|
|
call semicirc(parents(person), father(person), nextlevel, nextahnen, info,maxlevel,dateformat)
|
|
call semicirc(parents(person), mother(person), nextlevel, add(nextahnen,1), info,maxlevel,dateformat)
|
|
}
|
|
}
|
|
|
|
proc putpageprintouts(xn,yn){
|
|
set(page_num, 0)
|
|
set(yi, sub(yn, 1))
|
|
while(ge(yi, 0)) {
|
|
set(yi_ord, sub(sub(yn, 1), yi))
|
|
set(xi, sub(xn, 1))
|
|
while(ge(xi, 0)) {
|
|
set(page_num, add(page_num, 1))
|
|
"%%Page: " d(page_num) " " d(page_num) "\n"
|
|
"cleartomark mark\n"
|
|
d(xi) " " d(yi) " print-a-page\n"
|
|
"showpage\n"
|
|
set(xi, sub(xi, 1))
|
|
}
|
|
set(yi, sub(yi, 1))
|
|
}
|
|
}
|
|
|
|
proc printfile(){
|
|
"%!PS-Adobe-3.0\n"
|
|
"%%Title: (PS-CIRCLE.PS - Circular Genealogical Pedigree Chart in Postscript format)\n"
|
|
"%%Creator: " version " - a Lifelines circle ancestry chart report generator\n"
|
|
"%%CreationDate: " stddate(gettoday()) "\n"
|
|
"%%Pages: "d(mul(x_pages,y_pages))"\n"
|
|
"%%PageOrder: Ascend\n"
|
|
"%%Orientation: Portrait\n"
|
|
"%%EndComments\n\n"
|
|
|
|
"%%BeginDefaults\n"
|
|
"%%ViewingOrientation: 1 0 0 1\n"
|
|
"%%EndDefaults\n\n"
|
|
|
|
"%%BeginProlog\n\n"
|
|
"% much of the code involved with font encoding and with multipaging\n"
|
|
"% is borrowed from Robert Simms <rsimms@ces.clemson.edu>\n\n"
|
|
|
|
"%page margins\n"
|
|
"/margin_top 20 def\n"
|
|
"/margin_bottom 20 def\n"
|
|
"/margin_left 20 def\n"
|
|
"/margin_right 20 def\n\n"
|
|
|
|
"%number of pages in each direction\n"
|
|
|
|
"/xpages "d(x_pages)" def\n"
|
|
"/ypages "d(y_pages)" def\n\n"
|
|
|
|
"/fontname /"font_name" def\n\n"
|
|
|
|
"/portrait true def\n\n"
|
|
|
|
"/inch {72 mul} def\n\n"
|
|
|
|
"/*SF { % Complete selectfont emulation\n" /**/
|
|
" exch findfont exch\n"
|
|
" dup type /arraytype eq {makefont}{scalefont} ifelse setfont\n"
|
|
"} bind def\n\n"
|
|
|
|
"/BuildRectPath{\n"
|
|
" dup type dup /integertype eq exch /realtype eq or{\n"
|
|
" 4 -2 roll moveto %Operands are: x y width height\n"
|
|
" dup 0 exch rlineto\n"
|
|
" exch 0 rlineto\n"
|
|
" neg 0 exch rlineto\n"
|
|
" closepath\n"
|
|
" }{\n"
|
|
" dup length 4 sub 0 exch 4 exch{\n"
|
|
" 1 index exch 4 getinterval aload pop\n"
|
|
" BuildRectPath\n"
|
|
" }for\n"
|
|
" pop\n"
|
|
" }ifelse\n"
|
|
"} bind def\n\n"
|
|
|
|
"/*RC { gsave newpath BuildRectPath fill grestore } bind def\n\n" /**/
|
|
|
|
"% install Level 2 emulations, or substitute built-in Level 2 operators\n"
|
|
"/languagelevel where\n"
|
|
" {pop languagelevel}{1} ifelse\n"
|
|
"2 lt {\n"
|
|
" /RC /*RC load def\n" /**/
|
|
" /SF /*SF load def\n" /**/
|
|
"}{\n"
|
|
" /RC /rectclip load def % use RC instead of rectclip\n"
|
|
" /SF /selectfont load def % use SF instead of selectfont\n"
|
|
"} ifelse\n\n"
|
|
|
|
"%Coordinate conversion utilities\n"
|
|
"/polar { %(ang rad) -> (x y)\n"
|
|
" /rad exch def /ang exch def\n"
|
|
" /x rad ang cos mul def /y rad ang sin mul def\n"
|
|
" x y\n"
|
|
"} def\n\n"
|
|
|
|
"/midang {\n"
|
|
" /inf exch def\n"
|
|
" inf 1 eq {360 2 maxlevel exp div mul -90.0 add} %for first level male, go counter clockwise from bottom\n"
|
|
" {360 2 maxlevel exp div mul 90.0 add} ifelse %for first level female, go clockwise from bottom\n"
|
|
"} def\n\n"
|
|
|
|
"%Shortcut macros\n"
|
|
"/m {moveto} def /l {lineto} def\n\n"
|
|
|
|
"%Constants\n"
|
|
"/pi 3.14159265358979 def\n"
|
|
"/ptsize 10 def\n"
|
|
"/offset ptsize 1.25 mul neg def\n\n"
|
|
|
|
"/radius {4.0 7.0 div exch indicentre add mul inch} def\n"
|
|
|
|
"%begin font encoding borrowed from Robert Simms\n"
|
|
if(ne(enc_choice, 0)) {
|
|
"/encvecmod* { % on stack should be /Encoding and an encoding array\n"
|
|
" % make an array copy so we don't try to modify the original via pointer\n"
|
|
" dup length array copy\n"
|
|
" encvecmod aload length dup 2 idiv exch 2 add -1 roll exch\n"
|
|
" {dup 4 2 roll put}\n"
|
|
" repeat\n"
|
|
"} def\n"
|
|
"/reenc {\n"
|
|
" findfont\n"
|
|
" dup length dict begin\n"
|
|
" {1 index /FID eq {pop pop} {\n"
|
|
" 1 index /Encoding eq {\n"
|
|
" encvecmod* def\n"
|
|
" }{def} ifelse\n"
|
|
" } ifelse\n"
|
|
" } forall\n"
|
|
" currentdict\n"
|
|
" end\n"
|
|
" definefont pop\n"
|
|
"} def\n"
|
|
}
|
|
if(eq(enc_choice, 1)) {
|
|
"% Adjust the font so that it is iso-8859-1 compatible\n"
|
|
"/languagelevel where {pop languagelevel}{1} ifelse 2 ge {\n"
|
|
" /encvecmod* {pop ISOLatin1Encoding} def % Use built-in ISOLatin1Encoding if PS interpreter is Level 2\n"
|
|
"}{\n"
|
|
/* This array indicates changes to go from the Standard Encoding Vector
|
|
to the ISOLatin1 Encoding Vector for ISO-8859-1 compatibility,
|
|
according to the PostScript Language Reference Manual, 2nd ed.
|
|
The characters from A0 to FF are essential for 8859-1 conformance.
|
|
*/
|
|
" /encvecmod [\n"
|
|
" 16#90 /dotlessi 16#91 /grave 16#92 /acute 16#93 /circumflex\n"
|
|
" 16#94 /tilde 16#95 /macron 16#96 /breve 16#97 /dotaccent\n"
|
|
" 16#98 /dieresis 16#99 /.notdef 16#9a /ring 16#9b /cedilla\n"
|
|
" 16#9c /.notdef 16#9d /hungarumlaut 16#9e /ogonek 16#9f /caron\n"
|
|
" 16#a0 /space 16#a1 /exclamdown 16#a2 /cent 16#a3 /sterling\n"
|
|
" 16#a4 /currency 16#a5 /yen 16#a6 /brokenbar 16#a7 /section\n"
|
|
" 16#a8 /dieresis 16#a9 /copyright 16#aa /ordfeminine 16#ab /guillemotleft\n"
|
|
" 16#ac /logicalnot 16#ad /hyphen 16#ae /registered 16#af /macron\n"
|
|
" 16#b0 /degree 16#b1 /plusminus 16#b2 /twosuperior 16#b3 /threesuperior\n"
|
|
" 16#b4 /acute 16#b5 /mu 16#b6 /paragraph 16#b7 /periodcentered\n"
|
|
" 16#b8 /cedilla 16#b9 /onesuperior 16#ba /ordmasculine 16#bb /guillemotright\n"
|
|
" 16#bc /onequarter 16#bd /onehalf 16#be /threequarters 16#bf /questiondown\n"
|
|
" 16#c0 /Agrave 16#c1 /Aacute 16#c2 /Acircumflex 16#c3 /Atilde\n"
|
|
" 16#c4 /Adieresis 16#c5 /Aring 16#c6 /AE 16#c7 /Ccedilla\n"
|
|
" 16#c8 /Egrave 16#c9 /Eacute 16#ca /Ecircumflex 16#cb /Edieresis\n"
|
|
" 16#cc /Igrave 16#cd /Iacute 16#ce /Icircumflex 16#cf /Idieresis\n"
|
|
" 16#d0 /Eth 16#d1 /Ntilde 16#d2 /Ograve 16#d3 /Oacute\n"
|
|
" 16#d4 /Ocircumflex 16#d5 /Otilde 16#d6 /Odieresis 16#d7 /multiply\n"
|
|
" 16#d8 /Oslash 16#d9 /Ugrave 16#da /Uacute 16#db /Ucircumflex\n"
|
|
" 16#dc /Udieresis 16#dd /Yacute 16#de /Thorn 16#df /germandbls\n"
|
|
" 16#e0 /agrave 16#e1 /aacute 16#e2 /acircumflex 16#e3 /atilde\n"
|
|
" 16#e4 /adieresis 16#e5 /aring 16#e6 /ae 16#e7 /ccedilla\n"
|
|
" 16#e8 /egrave 16#e9 /eacute 16#ea /ecircumflex 16#eb /edieresis\n"
|
|
" 16#ec /igrave 16#ed /iacute 16#ee /icircumflex 16#ef /idieresis\n"
|
|
" 16#f0 /eth 16#f1 /ntilde 16#f2 /ograve 16#f3 /oacute\n"
|
|
" 16#f4 /ocircumflex 16#f5 /otilde 16#f6 /odieresis 16#f7 /divide\n"
|
|
" 16#f8 /oslash 16#f9 /ugrave 16#fa /uacute 16#fb /ucircumflex\n"
|
|
" 16#fc /udieresis 16#fd /yacute 16#fe /thorn 16#ff /ydieresis\n"
|
|
" ] def\n"
|
|
"} ifelse\n\n"
|
|
} elsif(eq(enc_choice, 2)) {
|
|
/* The following array specifies changes to make to a font encoding
|
|
to make characters A0 through FF match the ISO Latin alphabet no. 2
|
|
This will work as long as there are instructions in the font for
|
|
drawing the glyphs named here. Missing glyphs would be
|
|
substituted with /.notdef from the font by the PostScript interpreter.
|
|
*/
|
|
"/encvecmod [\n"
|
|
" 16#a0 /space 16#a1 /Aogonek 16#a2 /breve 16#a3 /Lslash\n"
|
|
" 16#a4 /currency 16#a5 /Lcaron 16#a6 /Sacute 16#a7 /section\n"
|
|
" 16#a8 /dieresis 16#a9 /Scaron 16#aa /Scedilla 16#ab /Tcaron\n"
|
|
" 16#ac /Zacute 16#ad /hyphen 16#ae /Zcaron 16#af /Zdotaccent\n"
|
|
" 16#b0 /degree 16#b1 /aogonek 16#b2 /ogonek 16#b3 /lslash\n"
|
|
" 16#b4 /acute 16#b5 /lcaron 16#b6 /sacute 16#b7 /caron\n"
|
|
" 16#b8 /cedilla 16#b9 /scaron 16#ba /scedilla 16#bb /tcaron\n"
|
|
" 16#bc /zacute 16#bd /hungarumlaut 16#be /zcaron 16#bf /zdotaccent\n"
|
|
" 16#c0 /Racute 16#c1 /Aacute 16#c2 /Acircumflex 16#c3 /Abreve\n"
|
|
" 16#c4 /Adieresis 16#c5 /Lacute 16#c6 /Cacute 16#c7 /Ccedilla\n"
|
|
" 16#c8 /Ccaron 16#c9 /Eacute 16#ca /Eogonek 16#cb /Edieresis\n"
|
|
" 16#cc /Ecaron 16#cd /Iacute 16#ce /Icircumflex 16#cf /Dcaron\n"
|
|
" 16#d0 /Dcroat 16#d1 /Nacute 16#d2 /Ncaron 16#d3 /Oacute\n"
|
|
" 16#d4 /Ocircumflex 16#d5 /Ohungarumlaut 16#d6 /Odieresis 16#d7 /multiply\n"
|
|
" 16#d8 /Rcaron 16#d9 /Uring 16#da /Uacute 16#db /Uhungarumlaut\n"
|
|
" 16#dc /Udieresis 16#dd /Yacute 16#de /Tcommaaccent 16#df /germandbls\n"
|
|
" 16#e0 /racute 16#e1 /aacute 16#e2 /acircumflex 16#e3 /abreve\n"
|
|
" 16#e4 /adieresis 16#e5 /lacute 16#e6 /cacute 16#e7 /ccedilla\n"
|
|
" 16#e8 /ccaron 16#e9 /eacute 16#ea /eogonek 16#eb /edieresis\n"
|
|
" 16#ec /ecaron 16#ed /iacute 16#ee /icircumflex 16#ef /dcaron\n"
|
|
" 16#f0 /dcroat 16#f1 /nacute 16#f2 /ncaron 16#f3 /oacute\n"
|
|
" 16#f4 /ocircumflex 16#f5 /ohungarumlaut 16#f6 /odieresis 16#f7 /divide\n"
|
|
" 16#f8 /rcaron 16#f9 /uring 16#fa /uacute 16#fb /uhungarumlaut\n"
|
|
" 16#fc /udieresis 16#fd /yacute 16#fe /tcommaaccent 16#ff /dotaccent\n"
|
|
"] def\n\n"
|
|
} elsif(eq(enc_choice, 3)) {
|
|
/* This array indicates changes necessary to go from the Standard Encoding
|
|
Vector to one matching the int'l characters and some others in the
|
|
IBM Extended Character Set
|
|
*/
|
|
"/encvecmod [\n"
|
|
" 16#80 /Ccedilla 16#81 /udieresis 16#82 /eacute 16#83 /acircumflex\n"
|
|
" 16#84 /adieresis 16#85 /agrave 16#86 /aring 16#87 /ccedilla\n"
|
|
" 16#88 /ecircumflex 16#89 /edieresis 16#8a /egrave 16#8b /idieresis\n"
|
|
" 16#8c /icircumflex 16#8d /igrave 16#8e /Adieresis 16#8f /Aring\n"
|
|
" 16#90 /Eacute 16#91 /ae 16#92 /AE 16#93 /ocircumflex\n"
|
|
" 16#94 /odieresis 16#95 /ograve 16#96 /ucircumflex 16#97 /ugrave\n"
|
|
" 16#98 /ydieresis 16#99 /Odieresis 16#9a /Udieresis 16#9b /cent\n"
|
|
" 16#9c /sterling 16#9d /yen 16#9e /.notdef 16#9f /florin\n"
|
|
" 16#a0 /aacute 16#a1 /iacute 16#a2 /oacute 16#a3 /uacute\n"
|
|
" 16#a4 /ntilde 16#a5 /Ntilde 16#a6 /ordfeminine 16#a7 /ordmasculine\n"
|
|
" 16#a8 /questiondown 16#a9 /.notdef 16#aa /.notdef 16#ab /onehalf\n"
|
|
" 16#ac /onequarter 16#ad /exclamdown 16#ae /guillemotleft 16#af /guillemotright\n"
|
|
" 16#e1 /germandbls 16#ed /oslash 16#f1 /plusminus 16#f6 /divide\n"
|
|
" 16#f8 /degree 16#f9 /bullet\n"
|
|
"] def\n\n"
|
|
}
|
|
if(ne(enc_choice, 0)) {
|
|
"/gedfont fontname reenc\n"
|
|
"/fontname /gedfont def\n\n"
|
|
}
|
|
"%end font encoding end of section borrowed from Robert Simms\n"
|
|
|
|
if (eq(gradient,1)){
|
|
"/gradient{ %draw and fill 256 circles with a decreasing radius and slightly diffent colour\n"
|
|
" /blue2 exch def /green2 exch def /red2 exch def\n"
|
|
" /blue1 exch def /green1 exch def /red1 exch def\n\n"
|
|
|
|
" /maxrad maxlevel radius def\n"
|
|
" /delta_r maxrad neg 256 div def %find radius step to use\n\n"
|
|
|
|
" gsave\n"
|
|
" maxrad delta_r 0.0 { %step through the circles from large to small\n"
|
|
" /r exch def\n"
|
|
" /ratio r maxrad div def\n"
|
|
" /red red1 red2 sub ratio mul red2 add def % work out the new colour\n"
|
|
" /blue blue1 blue2 sub ratio mul blue2 add def\n"
|
|
" /green green1 green2 sub ratio mul green2 add def\n\n"
|
|
|
|
" red green blue setrgbcolor\n"
|
|
" newpath 0.0 0.0 r 0 360 arc fill %draw and fill circles\n"
|
|
" } for\n"
|
|
" grestore\n"
|
|
"} def\n\n"
|
|
}
|
|
"/fan{ %Fan Template\n"
|
|
" gsave\n"
|
|
if(or(ne(printmarr,1),ne(transparent,1))){
|
|
" %begin gender specific shading of boxes\n"
|
|
" /c 1 def %flag for the alternating colours\n"
|
|
" 1 indicentre sub 1 maxlevel {%shade the boxes if necessary\n"
|
|
" /i exch def\n"
|
|
" /delta_ang 360.0 2 i exp div def %set the angle stepsize\n"
|
|
" /r1 i radius def /r2 i 1 sub radius def %find the inner and outer radius for the box\n"
|
|
if (ge(maxlevel,8)){
|
|
" i 8 ge {0}{0.7 radfactor div} ifelse"
|
|
}else{
|
|
" .7 radfactor div"
|
|
}
|
|
" setlinewidth %if level is beyond 7 make lines thinnest possible\n\n"
|
|
" 90.0 delta_ang 449.99 { %step through all angles from 90� to 90�+360� (450�)\n"
|
|
" /ang1 exch def /ang2 ang1 delta_ang add def %find the beginning and ending angle for each box\n"
|
|
" newpath\n"
|
|
" i 0 gt{%draw the box\n"
|
|
" ang1 r1 polar m 0 0 r1 ang1 ang2 arc ang2 r2 polar l 0 0 r2 ang2 ang1 arcn\n"
|
|
" }{\n"
|
|
" 0 0 1 radius 0 0 1 radius 0 360 arc\n"
|
|
" }ifelse\n"
|
|
" closepath\n"
|
|
if(eq(transparent,0)){
|
|
" i 0 gt { %fill in box if necessary\n"
|
|
" c 1 eq {/c1 0 def rf gf bf setrgbcolor} {/c1 1 def rm gm bm setrgbcolor} ifelse\n"
|
|
" }{\n"
|
|
" centrepersonsex 0 eq {rm gm bm setrgbcolor} {rf gf bf setrgbcolor} ifelse\n"
|
|
" }ifelse\n"
|
|
" gsave fill grestore\n"
|
|
" i 0 gt{/c c1 def}if %exchange color for next box\n"
|
|
" rl gl bl setrgbcolor\n\n"
|
|
}
|
|
if(eq(printmarr,0)){
|
|
if(eq(transparent,0)){
|
|
" i 9 le {stroke} if %draw outline of box if level is less than 10\n"
|
|
}else{
|
|
" stroke\n"
|
|
}
|
|
}
|
|
" }for\n"
|
|
" }for %end gender specific shading of boxes\n"
|
|
}
|
|
if (eq(printmarr,1)){
|
|
" %begin draw boxes around husband and wife\n"
|
|
" rl gl bl setrgbcolor\n"
|
|
" 2 indicentre sub 1 maxlevel { %step through the levels\n"
|
|
" /i exch def\n"
|
|
if (ge(maxlevel,8)){
|
|
" i 8 ge {0}{0.7 radfactor div} ifelse"
|
|
}else{
|
|
" .7 radfactor div"
|
|
}
|
|
" setlinewidth\n\n"
|
|
" /delta_ang 360.0 2 i 1 sub exp div def %set the angle stepsize\n"
|
|
" 90.0 delta_ang 449.99 {\n"
|
|
" /ang1 exch def /ang2 ang1 delta_ang add def\n"
|
|
" /r1 i radius def /r2 i 1 sub radius def\n\n"
|
|
|
|
" %draw tic marks around marriage date\n"
|
|
" /delta_r r1 r2 sub 15 div def\n"
|
|
" /angave ang1 delta_ang 2 div add def\n"
|
|
" /r_inner r2 delta_r add def\n"
|
|
" /r_outer r1 delta_r sub def\n\n"
|
|
|
|
" newpath angave r_outer polar m angave r1 polar l stroke\n"
|
|
" r2 0 gt{\n"
|
|
" newpath angave r2 polar m angave r_inner polar l stroke\n"
|
|
" }if\n\n"
|
|
|
|
if(eq(transparent,0)){
|
|
" rm gm bm setrgbcolor %erase small gap between male and female\n"
|
|
" .5 setlinewidth\n"
|
|
" newpath angave r_outer polar m angave r_inner polar l stroke\n"
|
|
" rl gl bl setrgbcolor\n"
|
|
if (ge(maxlevel,8)){
|
|
" i 8 ge {0}{0.7 radfactor div} ifelse"
|
|
}else{
|
|
" .7 radfactor div"
|
|
}
|
|
" setlinewidth\n"
|
|
}
|
|
|
|
" %finish tic marks\n\n"
|
|
|
|
" newpath %draw box around parents\n"
|
|
" ang1 r1 polar m 0 0 r1 ang1 ang2 arc\n"
|
|
" ang2 r2 polar l 0 0 r2 ang2 ang1 arcn closepath\n"
|
|
" stroke\n"
|
|
" }for\n"
|
|
" }for %end draw boxes around husband and wife\n\n"
|
|
}
|
|
|
|
|
|
if (eq(printdate,1)){
|
|
" 0 0 0 setrgbcolor\n"
|
|
" fontname 5 SF\n"
|
|
" /radiusprint maxlevel radius 1.01 mul def\n"
|
|
" datetoday radiusprint 300 circtext\n"
|
|
}
|
|
" grestore\n"
|
|
"} def\n\n"
|
|
|
|
"/angtext{ %Angled Line Printing Procedure for outer lines than do not curve\n"
|
|
" /inf exch def /offst exch def /ang exch def /levelnum exch def /str exch def\n\n"
|
|
|
|
" gsave\n"
|
|
" ang rotate %rotate coordinate system for printing\n\n"
|
|
|
|
" /r1 levelnum 1 sub radius def /r2 levelnum radius def\n"
|
|
if(eq(printmarr,1)){
|
|
" levelnum 1 eq indicentre 0 eq and{/r1 0 def /r2 0 def}if\n\n"
|
|
}
|
|
" /y r1 r2 add 2 div def\n\n"
|
|
|
|
" inf 0 eq{0 offst -10 mul 15 add translate}{y 0.0 translate}ifelse\n\n"
|
|
|
|
" str stringwidth pop 2 div neg offst moveto\n"
|
|
" str show\n"
|
|
" grestore\n"
|
|
"} def\n\n"
|
|
|
|
"/circtext{ %Circular Line Printing Procedure for inner lines than do curve\n\n"
|
|
|
|
" /angle exch def /textradius exch def /str exch def\n\n"
|
|
|
|
" /xradius textradius ptsize 4 div add def\n"
|
|
" gsave\n"
|
|
" angle str findhalfangle add rotate\n"
|
|
" str {/charcode exch def ( ) dup 0 charcode put circchar} forall\n"
|
|
" grestore\n"
|
|
"} def\n\n"
|
|
|
|
"/findhalfangle {stringwidth pop 2 div 2 xradius mul pi mul div 360 mul} def\n\n"
|
|
|
|
"/circchar{ %print each character at a different angle around the circle\n"
|
|
" /char exch def\n\n"
|
|
|
|
" /halfangle char findhalfangle def\n"
|
|
" gsave\n"
|
|
" halfangle neg rotate\n"
|
|
" textradius 0 translate\n"
|
|
" -90 rotate\n"
|
|
" char stringwidth pop 2 div neg 0 moveto\n"
|
|
" char show\n"
|
|
" grestore\n"
|
|
" halfangle 2 mul neg rotate\n"
|
|
"} def\n\n"
|
|
|
|
"/setprintcolor{\n"
|
|
" /ahnen exch def /inf exch def\n"
|
|
" ahnen 2 div dup cvi eq {redmale greenmale bluemale setrgbcolor}{redfemale greenfemale bluefemale setrgbcolor} ifelse\n"
|
|
" ahnen inf mul 1 eq {redmale greenmale bluemale setrgbcolor} if\n"
|
|
"} def\n\n"
|
|
|
|
"/position{ %compute position from ahnentafel number\n"
|
|
" /ahnenn exch def\n"
|
|
" ahnenn 2 maxlevel -1 add exp lt {\n"
|
|
" /a 2 ahnenn log 1.9999 log div floor exp def\n"
|
|
" /numerator 2 a mul -1 add -2 ahnenn a neg add mul add def\n"
|
|
" /fact 2 maxlevel -2 add exp def\n"
|
|
" numerator a div fact mul\n"
|
|
" }{2 maxlevel exp ahnenn neg add} ifelse\n"
|
|
"} def\n\n"
|
|
|
|
"/level {1 add log 2 log div ceiling cvi} def %compute generation level from ahnentafel number\n\n"
|
|
|
|
"/info{\n"
|
|
" /max exch def /inf exch def /noffset exch def /ahnen exch def\n"
|
|
" /fntfactor {[0 0.85 0.85 0.8 0.7 0.5 0.4 0.3 0.3 0.25 0.25 0.25 0.25] exch get} def %set different font sizes for each level\n\n"
|
|
|
|
" ahnen 2 maxlevel exp lt {\n"
|
|
" /place ahnen position def\n"
|
|
" /levelnum ahnen level def %get the level number of the current person\n"
|
|
" /radtab levelnum radius def %get the radius of the current level\n"
|
|
" /ftsize ptsize levelnum fntfactor mul def %find the new fontsize depending on the current level number\n"
|
|
" /offset ftsize 1.25 mul neg def %find the distance that the text should be printed from the ring\n"
|
|
" inf ahnen setprintcolor %print the names and information in alternating colors as defined below in line #350\n"
|
|
" fontname ftsize SF %set the font to use\n\n"
|
|
|
|
" levelnum 5 lt {levelnum radtab place noffset inf max inner} % the inner four rings\n"
|
|
" {levelnum place noffset inf 0 max outer} ifelse % all outer rings\n"
|
|
" } if\n"
|
|
"} def\n\n"
|
|
|
|
if(eq(indicentre,1)){
|
|
"/indiinfo{\n"
|
|
" /inf exch def /noffset exch def /ahnen exch def\n"
|
|
" /ftsize ptsize 0.9 mul def %find the new fontsize depending on the current level number\n"
|
|
" /offset ftsize 1.25 mul neg def %find the distance that the text should be printed from the ring\n"
|
|
" inf ahnen setprintcolor %print the names and information in alternating colors as defined below in line #350\n"
|
|
" fontname ftsize SF %set the font to use\n\n"
|
|
|
|
" 0 0 noffset 0 angtext\n"
|
|
"} def\n\n"
|
|
}
|
|
|
|
"/nstr 7 string def\n"
|
|
"/prtn {-0.5 inch 5.5 inch m nstr cvs show} def\n"
|
|
"/prt {-0.5 inch 5.5 inch m show} def\n\n"
|
|
|
|
if (eq(printmarr,1)){
|
|
"/minfo{\n"
|
|
" /inf exch def /ahnen exch def\n"
|
|
" /fntfactor {[0 0.7 0.7 0.6 0.6 0.5 0.4 0.3 0.3 0.25 0.25 0.25 0.25] exch get} def %set different font sizes for each level\n\n"
|
|
|
|
" ahnen 2 maxlevel exp lt {\n"
|
|
" /place ahnen 1 eq {0}{ahnen 2 div position}ifelse def %get the position of the text counting on the outer ring from bottom upwards\n"
|
|
" /levelnum ahnen level def %get the level number of the current person\n"
|
|
" /ftsize ptsize levelnum fntfactor mul 0.80 mul def %find the new fontsize depending on the current level number\n"
|
|
" /offset ftsize 0.35 mul neg def %find the distance that the text should be printed from the ring\n"
|
|
" rl gl bl setrgbcolor\n"
|
|
" dup\n"
|
|
" /namelength exch length def\n"
|
|
" /f namelength 11 lt {1}{11 namelength div}ifelse def\n"
|
|
" fontname ftsize f mul SF %set the font to use\n\n"
|
|
|
|
" levelnum place 0 inf 1 1 outer\n"
|
|
" } if\n"
|
|
"} def\n\n"
|
|
}
|
|
|
|
"/inner{\n"
|
|
" /max exch def /inf exch def /noffset exch def /place exch def /radtab exch def /levelnum exch def\n"
|
|
" % slight modifications for each level for line spacing\n"
|
|
if(eq(indicentre,0)){
|
|
" max 3 eq {/factor {[0.0 0.98 0.97 0.97 0.975] exch get} def}if\n"
|
|
" max 2 eq {/factor {[0.0 0.80 0.885 0.935 0.94] exch get} def}if\n"
|
|
" max 1 eq {/factor {[0.0 0.70 0.835 0.905 0.91] exch get} def}if\n\n"
|
|
}
|
|
if(eq(indicentre,1)){
|
|
" max 3 eq {/factor {[0.0 0.96 0.98 0.98 0.975] exch get} def}if\n"
|
|
" max 2 eq {/factor {[0.0 0.96 0.935 0.945 0.94] exch get} def}if\n"
|
|
" max 1 eq {/factor {[0.0 0.96 0.905 0.915 0.91] exch get} def}if\n\n"
|
|
}
|
|
|
|
" levelnum 1 eq indicentre 0 eq and{/offset offset 0.75 mul def} if %max the offset a bit smaller for the first level\n"
|
|
" radtab levelnum factor mul noffset offset mul add place inf midang circtext\n"
|
|
"} def\n\n"
|
|
|
|
"/outer{\n"
|
|
" /max exch def /marr exch def /inf exch def /noffset exch def /place exch def /levelnum exch def\n\n"
|
|
|
|
" % in the following:\n"
|
|
" % f1 spreads the text out apart from eachother when more positive (larger)\n"
|
|
" % f2 shifts the set of text counter clockwise when more positive (larger)\n"
|
|
if(eq(maxlevel,5)){
|
|
" max 3 eq {levelnum 5 eq {/f1 -2.5 def /f2 1.35 def} if}if\n"
|
|
" max 2 eq {levelnum 5 eq {/f1 -2.5 def /f2 0.25 def} if}if\n\n"
|
|
}
|
|
if(eq(maxlevel,6)){
|
|
" max 3 eq {levelnum 5 eq {/f1 -2.5 def /f2 6.50 def} if\n"
|
|
" levelnum 6 eq {/f1 -1.7 def /f2 1.50 def} if}if\n"
|
|
" max 2 eq {\n"
|
|
" levelnum 5 eq {/f1 -2.5 def /f2 4.85 def} if\n"
|
|
" levelnum 6 eq {/f1 -1.7 def /f2 1.50 def} if}if\n\n"
|
|
}
|
|
if(eq(maxlevel,7)){
|
|
" max 3 eq {levelnum 5 eq {/f1 -2.5 def /f2 6.50 def} if\n"
|
|
" levelnum 6 eq {/f1 -1.6 def /f2 4.30 def} if}if\n"
|
|
" max 2 eq {\n"
|
|
" levelnum 5 eq {/f1 -2.5 def /f2 4.85 def} if\n"
|
|
" levelnum 6 eq {/f1 -1.6 def /f2 3.30 def} if\n"
|
|
" levelnum 7 eq {/f1 -1.0 def /f2 0.70 def} if}if\n"
|
|
" max 1 eq {\n"
|
|
" levelnum 5 eq {/f1 -2.5 def /f2 4.85 def} if\n"
|
|
" levelnum 6 eq {/f1 -1.6 def /f2 4.30 def} if\n"
|
|
" levelnum 7 eq {/f1 -2.0 def /f2 1.20 def} if}if\n\n"
|
|
}
|
|
if(eq(maxlevel,8)){
|
|
" max 3 eq {levelnum 5 eq {/f1 -2.5 def /f2 6.50 def} if\n"
|
|
" levelnum 6 eq {/f1 -1.6 def /f2 4.30 def} if}if\n"
|
|
" max 2 eq {\n"
|
|
" levelnum 5 eq {/f1 -2.5 def /f2 4.85 def} if\n"
|
|
" levelnum 6 eq {/f1 -1.6 def /f2 3.30 def} if\n"
|
|
" levelnum 7 eq {/f1 -1.0 def /f2 2.20 def} if\n"
|
|
" levelnum 8 eq {/f1 -0.7 def /f2 0.80 def} if}if\n"
|
|
" max 1 eq {\n"
|
|
" levelnum 5 eq {/f1 -2.5 def /f2 4.85 def} if\n"
|
|
" levelnum 6 eq {/f1 -1.6 def /f2 3.30 def} if\n"
|
|
" levelnum 7 eq {/f1 -1.0 def /f2 1.50 def} if\n"
|
|
" levelnum 8 eq {/f1 -0.7 def /f2 0.50 def} if}if\n\n"
|
|
}
|
|
if(eq(maxlevel,9)){
|
|
" max 3 eq {levelnum 5 eq {/f1 -2.5 def /f2 6.50 def} if\n"
|
|
" levelnum 6 eq {/f1 -1.6 def /f2 4.30 def} if}if\n"
|
|
" max 2 eq {\n"
|
|
" levelnum 5 eq {/f1 -2.5 def /f2 4.85 def} if\n"
|
|
" levelnum 6 eq {/f1 -1.6 def /f2 4.00 def} if\n"
|
|
" levelnum 7 eq {/f1 -1.0 def /f2 2.00 def} if\n"
|
|
" levelnum 8 eq {/f1 -0.6 def /f2 1.40 def} if}if\n"
|
|
" max 1 eq {\n"
|
|
" levelnum 5 eq {/f1 -2.5 def /f2 4.85 def} if\n"
|
|
" levelnum 6 eq {/f1 -1.6 def /f2 4.00 def} if\n"
|
|
" levelnum 7 eq {/f1 -1.0 def /f2 2.00 def} if\n"
|
|
" levelnum 8 eq {/f1 -0.6 def /f2 1.40 def} if\n"
|
|
" levelnum 9 eq {/f1 0.0 def /f2 0.00 def} if}if\n\n"
|
|
}
|
|
if(eq(maxlevel,10)){
|
|
" max 3 eq {levelnum 5 eq {/f1 -2.5 def /f2 6.50 def} if\n"
|
|
" levelnum 6 eq {/f1 -1.6 def /f2 4.30 def} if}if\n"
|
|
" max 2 eq {\n"
|
|
" levelnum 5 eq {/f1 -2.5 def /f2 4.85 def} if\n"
|
|
" levelnum 6 eq {/f1 -1.6 def /f2 4.00 def} if\n"
|
|
" levelnum 7 eq {/f1 -1.0 def /f2 2.00 def} if\n"
|
|
" levelnum 8 eq {/f1 -0.6 def /f2 1.40 def} if}if\n"
|
|
" max 1 eq {\n"
|
|
" levelnum 5 eq {/f1 -2.5 def /f2 4.85 def} if\n"
|
|
" levelnum 6 eq {/f1 -1.6 def /f2 4.00 def} if\n"
|
|
" levelnum 7 eq {/f1 -1.0 def /f2 1.70 def} if\n"
|
|
" levelnum 8 eq {/f1 -0.6 def /f2 1.20 def} if\n"
|
|
" levelnum 9 eq {/f1 0.0 def /f2 0.40 def} if\n"
|
|
" levelnum 10 ge{/f1 0.0 def /f2 0.225 def}if}if\n\n"
|
|
}
|
|
|
|
" marr 1 eq {/f1 0.0 def /f2 0.0 def} if\n\n"
|
|
|
|
" /ang place inf midang f1 noffset mul f2 add add def\n"
|
|
" levelnum ang offset inf angtext\n"
|
|
"} def\n\n"
|
|
|
|
"% borrowed from Robert Simms\n"
|
|
if(eq(indicentre,1)){
|
|
"/addcenterindi {centerperson_array 3 1 roll put} def\n"
|
|
}
|
|
if(eq(printmarr,1)){
|
|
"/addmarr {marriage_array 3 1 roll put} def\n"
|
|
}
|
|
"/addind {person_array 3 1 roll put} def\n\n"
|
|
}
|
|
|
|
proc main() {
|
|
monthformat(4)
|
|
stddate(0)
|
|
dayformat(2)
|
|
|
|
set(version, "ps-circle.ll version 2.6.2, 10 December 2003 - code by Henry Sikkema")
|
|
|
|
set(numindilines,-1)
|
|
set(nummarr,-1)
|
|
|
|
set(mc, -1)
|
|
|
|
while (lt(mc,0)){
|
|
list(options)
|
|
setel(options,1,"Family in centre (husband/wife).")
|
|
setel(options,2,"Individual in centre")
|
|
set(mc,menuchoose(options, "Select the number of generations you want printed:"))
|
|
if(eq(mc,0)){break()}
|
|
if(eq(mc,1)){set(indicentre,0) getfam(fam)}
|
|
if(eq(mc,2)){set(indicentre,1) getindi(person)}
|
|
}
|
|
|
|
list(options)
|
|
setel(options,1,"5 generations.")
|
|
setel(options,2,"6 generations.")
|
|
setel(options,3,"7 generations.")
|
|
setel(options,4,"8 generations.")
|
|
setel(options,5,"9 generations.")
|
|
setel(options,6,"10 generations.")
|
|
set(maxlevel,menuchoose(options, "Select the numbers of generation you want printed:"))
|
|
if(eq(maxlevel,0)){break()}
|
|
set(maxlevel,add(maxlevel,4))
|
|
|
|
list(options)
|
|
setel(options,1,"Full birth date info if no date is given: ex b:11 Oct 1758")
|
|
setel(options,2,"Year only format: example (1758-1823)")
|
|
setel(options,3,"Year only format (spaces for unknown date) ex: ( -1823)")
|
|
set(mc, menuchoose(options, "Select date format:"))
|
|
if(eq(mc,0)){break()}
|
|
if(eq(mc,1)){set(dateformat,1)}
|
|
if(eq(mc,2)){set(dateformat,2)}
|
|
if(eq(mc,3)){set(dateformat,3)}
|
|
|
|
list(options)
|
|
setel(options,1,"Yes, print marriage dates only if exact date is known.")
|
|
setel(options,2,"Yes, print marriage date even when estimate is found in file")
|
|
setel(options,3,"No, do not print marriage dates.")
|
|
set(mc, menuchoose(options, "Print marriage dates?"))
|
|
if(eq(mc,0)){break()}
|
|
if(eq(mc,1)){set(printmarr,1)set(marrest,0)}
|
|
if(eq(mc,3)){set(printmarr,0)}
|
|
if(eq(mc,2)){set(printmarr,1)set(marrest,1)}
|
|
|
|
list(options)
|
|
setel(options,1,"Colour text (default: blue for males, red for females)")
|
|
setel(options,2,"Black Text (best for printing on non-colour printers)")
|
|
set(mc, menuchoose(options, "Select text colour option:"))
|
|
if(eq(mc,0)){break()}
|
|
if(eq(mc,1)){set(colourtext,1)}
|
|
if(eq(mc,2)){set(colourtext,0)}
|
|
|
|
list(options)
|
|
setel(options,1,"Gender Specific Colour scheme (default: pink for males, light blue for females)")
|
|
setel(options,2,"Transparent Background (best for printing on non-colour printers)")
|
|
setel(options,3,"Gradient Colour scheme")
|
|
set(mc,menuchoose(options, "Select text colour option:"))
|
|
if (eq(mc,0)){break()}
|
|
if (eq(mc,1)){set(alternating,1)set(gradient,0)}
|
|
if (eq(mc,2)){set(alternating,0)set(gradient,0)}
|
|
if (eq(mc,3)){set(alternating,0)set(gradient,1)}
|
|
|
|
list(options)
|
|
setel(options,1,"Yes, put on today's date.")
|
|
setel(options,2,"No, do not put on today's date.")
|
|
set(mc,menuchoose(options, "Do you want today's date printed on the circle?"))
|
|
if (eq(mc,0)){break()}
|
|
if (eq(mc,1)){set(printdate,1)}
|
|
if (eq(mc,2)){set(printdate,0)}
|
|
|
|
list(options)
|
|
setel(options,1,"Helvetica/Arial")
|
|
setel(options,2,"Times-Roman")
|
|
setel(options,3,"Courier")
|
|
setel(options,4,"AvantGarde-Book")
|
|
setel(options,5,"Times-Roman")
|
|
setel(options,6,"ZapfChancery")
|
|
|
|
set(mc,menuchoose(options, "Choose a font to use:"))
|
|
if (eq(mc,0)){break()}
|
|
if (eq(mc,1)){set(font_name,"Helvetica")}
|
|
if (eq(mc,2)){set(font_name,"Times-Roman")}
|
|
if (eq(mc,3)){set(font_name,"Courier")}
|
|
if (eq(mc,4)){set(font_name,"AvantGarde-Book")}
|
|
if (eq(mc,5)){set(font_name,"Palatino-Roman")}
|
|
if (eq(mc,6)){set(font_name,"ZapfChancery")}
|
|
|
|
list(options)
|
|
setel(options,1,"Single page (maximum circle size on a single page)")
|
|
setel(options,2,"Multipage according to number of pages selected")
|
|
setel(options,3,"Multipage according to radius of chart")
|
|
set(mc,menuchoose(options, "Select page type: "))
|
|
if (eq(mc,0)){break()}
|
|
if (eq(mc,1)){
|
|
set(x_pages,1)set(y_pages,1)set(radius,0)
|
|
}
|
|
if(gt(mc,1)){
|
|
print( "Radius (inches) # of pages Radius (inches) # of pages"
|
|
,nl()," 0-8 1x1=1 32-33 4x4=16"
|
|
,nl()," 8-10 2x1=2 33-42 5x4=20"
|
|
,nl()," 10-16 2x2=4 42-43 6x4=24"
|
|
,nl()," 16-21 3x2=6 43-50 6x5=30"
|
|
,nl()," 21-25 3x3=9 50-54 7x5=35"
|
|
,nl()," 25-32 4x3=12 54-59 7x6=42",nl()
|
|
)
|
|
}
|
|
if (eq(mc,2)){
|
|
getint( x_pages, "Number of horizontal portrait pages on chart")
|
|
getint( y_pages, "Number of vertical portrait pages on chart")
|
|
set(radius,0)
|
|
}
|
|
if (eq(mc,3)){
|
|
getint(radius, "Enter desired radius in inches:")
|
|
if (le(radius,8)){set(x_pages,1)set(y_pages,1)}
|
|
if (and(ge(radius,8),lt(radius,10))){set(x_pages,2)set(y_pages,1)}
|
|
if (and(ge(radius,10),lt(radius,16))){set(x_pages,2)set(y_pages,2)}
|
|
if (and(ge(radius,16),lt(radius,21))){set(x_pages,3)set(y_pages,2)}
|
|
if (and(ge(radius,21),lt(radius,25))){set(x_pages,3)set(y_pages,3)}
|
|
if (and(ge(radius,25),lt(radius,32))){set(x_pages,4)set(y_pages,3)}
|
|
if (and(ge(radius,32),lt(radius,33))){set(x_pages,4)set(y_pages,4)}
|
|
if (and(ge(radius,33),lt(radius,42))){set(x_pages,5)set(y_pages,4)}
|
|
if (and(ge(radius,42),lt(radius,43))){set(x_pages,6)set(y_pages,4)}
|
|
if (and(ge(radius,43),lt(radius,50))){set(x_pages,6)set(y_pages,5)}
|
|
if (and(ge(radius,50),lt(radius,54))){set(x_pages,7)set(y_pages,5)}
|
|
if (and(ge(radius,54),lt(radius,59))){set(x_pages,7)set(y_pages,6)}
|
|
}
|
|
print(nl())
|
|
/*
|
|
** ISO-Latin 1, or ISO 8859-1, is a world-wide standard for most languages
|
|
** of Latin origin: Albanian, Basque, Breton, Catalan, Cornish, Danish, Dutch
|
|
** English, Faroese, Finish (exc. S,s,Z,z with caron),
|
|
** French (exc. OE, oe, Y with dieresis), Frisian, Galician, German,
|
|
** Greenlandic, Icelandic, Irish Gaelic (new orthography), Italian, Latin,
|
|
** Luxemburgish, Norwegian, Portuguese, Rhaeto-Romanic, Scottish Gaelic,
|
|
** Spanish, Swedish.
|
|
**
|
|
** ISO Latin 2, or ISO 8859-2, covers these languages: Albanian, Croatian,
|
|
** Czech, English, German, Hungarian, Latin, Polish, Romanian (cedilla below
|
|
** S,s,T,t instead of comma), Slovak, Sloverian, Sorbian.
|
|
*/
|
|
list(options)
|
|
setel(options, 1, "ISO Latin 1 most West European languages")
|
|
setel(options, 2, "ISO Latin 2 Central and East European languages")
|
|
setel(options, 3, "IBM PC (covers at least the international chars)")
|
|
set(enc_choice, menuchoose(options,
|
|
"Select font reencoding, or (q) to use what's in the fonts"))
|
|
if (eq(enc_choice,0)){break()}
|
|
|
|
call printfile()
|
|
|
|
if (eq(printdate,1)){
|
|
monthformat(6) /*capitalized full word (eg, January, February) */
|
|
"/datetoday (Date: " stddate(gettoday()) ") def\n\n"
|
|
monthformat(4) /*capitalized abbreviation (eg, Jan, Feb) */
|
|
}
|
|
|
|
"/indicentre "d(indicentre)" def %1=put individual in centre,0=family at centre\n"
|
|
if(eq(indicentre,1)){if(eq(sex(person),"M")){set(psex,0)}else{set(psex,1)}
|
|
"/centrepersonsex "d(psex)" def %0=male; 1=female\n\n"}else{"\n"}
|
|
|
|
"/maxlevel " d(maxlevel) " def\n"
|
|
|
|
"% color of the text in RGB format\n"
|
|
if(eq(colourtext,1)){
|
|
"/redmale 0.0 def /greenmale 0.0 def /bluemale 1.0 def\n"
|
|
"/redfemale 1.0 def /greenfemale 0.0 def /bluefemale 0.0 def\n\n"
|
|
}else{
|
|
"/redmale 0.0 def /greenmale 0.0 def /bluemale 0.0 def\n"
|
|
"/redfemale 0.0 def /greenfemale 0.0 def /bluefemale 0.0 def\n\n"
|
|
}
|
|
|
|
if (eq(gradient,1)){
|
|
"0.6431 0.3255 0.0228 % inside centre color in RGB format\n"
|
|
"0.9922 0.7686 0.5490 % outside rim color in RGB format to form a radial gradient\n"
|
|
"gradient\n\n"
|
|
"/transparent 1 def % 1=transparent, 0=color shading\n\n"
|
|
|
|
"/rf 0.0 def /gf 0.0 def /bf 0.0 def %rgb female box fill\n"
|
|
"/rm 0.0 def /gm 0.0 def /bm 0.0 def %rgb male box fill\n\n"
|
|
|
|
}else{
|
|
if (eq(alternating,0)){
|
|
"/transparent 1 def % 1=transparent, 0=color shading\n\n"
|
|
|
|
"/rf 1.0 def /gf 1.0 def /bf 1.0 def %rgb female box fill\n"
|
|
"/rm 1.0 def /gm 1.0 def /bm 1.0 def %rgb male box fill\n\n"
|
|
}else{
|
|
"/transparent 0 def % 1=transparent, 0=color shading\n\n"
|
|
|
|
"/rf 0.8 def /gf 0.8 def /bf 1.0 def %rgb female box fill\n"
|
|
"/rm 1.0 def /gm 0.8 def /bm 0.8 def %rgb male box fill\n\n"
|
|
}
|
|
}
|
|
/* "/printmarr "d(printmarr)" def\n"*/
|
|
|
|
"/rl 0.0 def /gl 0.0 def /bl 0.0 def % rgb for lines\n"
|
|
|
|
"% partially borrowed from Robert Simms\n"
|
|
"% Find printable dimension for chart with a sequence of steps\n\n"
|
|
|
|
"% get printable area for each page\n"
|
|
"clippath pathbbox newpath\n"
|
|
"/ury exch def /urx exch def\n"
|
|
"/lly exch def /llx exch def\n\n"
|
|
|
|
"/llx llx margin_left add def /lly lly margin_bottom add def\n"
|
|
"/urx urx margin_right sub def /ury ury margin_top sub def\n\n"
|
|
|
|
"% get available width and height for printing on a sheet of paper\n"
|
|
"/wp urx llx sub def\n"
|
|
"/hp ury lly sub def\n\n"
|
|
|
|
"% get width and height of the multi-page printable area\n"
|
|
"/tw0 wp xpages mul def\n"
|
|
"/th0 hp ypages mul def\n\n"
|
|
|
|
"tw0 th0 gt {\n"
|
|
if(eq(radius,0)) {" /mindim th0 def\n"}
|
|
" th0 wp div ceiling cvi xpages lt {/xpages th0 wp div ceiling cvi def /tw0 wp xpages mul def /ypages ypages def}{/xpages xpages def /ypages ypages def}ifelse\n"
|
|
"}{\n"
|
|
if(eq(radius,0)) {" /mindim tw0 def\n"}
|
|
" tw0 hp div ceiling cvi ypages lt {/ypages tw0 hp div ceiling cvi def /th0 hp ypages mul def /xpages xpages def}{/xpages xpages def /ypages ypages def}ifelse\n"
|
|
"}ifelse\n\n"
|
|
|
|
if(gt(radius,0)) {
|
|
"/radfactor " d(radius) " inch 8 inch div def\n"
|
|
}else{
|
|
"/radfactor mindim 8 inch div def\n"
|
|
}
|
|
"/scalefactor 7.0 maxlevel indicentre add div radfactor mul def\n\n"
|
|
|
|
"/print-a-page { % page printing procedure\n"
|
|
" /ypage exch ypages 2 div 1 sub sub def %y-correction to center chart\n"
|
|
" /xpage exch xpages 2 div 1 sub sub def %x-correction to center chart\n"
|
|
" ypage ypages lt xpage xpages lt and { %only print if page is in correct range\n"
|
|
" gsave\n"
|
|
" llx lly translate\n"
|
|
" 0 0 wp hp RC % specify (rectangular) clipping path to keep the margins clean\n"
|
|
" xpage wp mul ypage hp mul translate % move origin so that desired portion of chart lands within clipping path\n"
|
|
" scalefactor dup scale %enlarge scale to fit page\n"
|
|
" fan %draw circle template\n"
|
|
if(eq(indicentre,1)){" centerperson_array {exec indiinfo} forall %put in center person\n"}
|
|
" person_array {exec info} forall %put in all people with dates\n"
|
|
if(eq(printmarr,1)) {" marriage_array {exec minfo} forall %put in marriage dates\n"}
|
|
" 1 dup scale %reset scale to normal\n"
|
|
" grestore\n"
|
|
" } if\n"
|
|
"} def % print-a-page procedure\n\n"
|
|
|
|
"%%EndProlog\n"
|
|
"%%BeginSetUp\n\n"
|
|
|
|
"/fillarray{% store vertical lines and individual records in arrays\n"
|
|
|
|
if(eq(indicentre,1)){
|
|
"0 {(" call put_given_name(person,20) ") " d(psex) " 1 0} addcenterindi\n"
|
|
"1 {(" surname(person) ") " d(psex) " 2 0} addcenterindi\n"
|
|
"2 {(" if (or(eq(dateformat,0),year(death(person)))){year(birth(person))"-" year(death(person))}else{date(birth(person))}") " d(psex) " 3 0} addcenterindi\n"
|
|
call semicirc(parents(person),father(person),1,1,1,maxlevel,dateformat)
|
|
call semicirc(parents(person),mother(person),1,1,2,maxlevel,dateformat)
|
|
}else{
|
|
call semicirc(fam,husband(fam),1,1,1,maxlevel,dateformat)
|
|
call semicirc(fam,wife(fam),1,1,2,maxlevel,dateformat)
|
|
}
|
|
"} def\n\n"
|
|
|
|
if(eq(indicentre,1)){"/centerperson_array 3 array def\n"}
|
|
if(eq(printmarr,1)){"/marriage_array "d(add(nummarr,1))" array def\n"}
|
|
"/person_array "d(add(numindilines,1))" array def\n"
|
|
|
|
"fillarray\n\n"
|
|
|
|
"mark\n\n"
|
|
"%%EndSetUp\n"
|
|
call putpageprintouts(x_pages,y_pages)
|
|
"%%EOF\n"
|
|
print("Output file full-name: ", outfile(), nl())
|
|
}
|