File: ps-circle.ll

package info (click to toggle)
lifelines 3.0.50-2
  • links: PTS
  • area: main
  • in suites: etch-m68k
  • size: 11,140 kB
  • ctags: 6,517
  • sloc: ansic: 57,468; xml: 8,014; sh: 4,255; makefile: 848; yacc: 601; perl: 170; sed: 16
file content (1109 lines) | stat: -rw-r--r-- 47,543 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
/*
 * @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())
}