home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Misc / FTREE0.3.LHA / ftree / ps / RCS / ftinit.ps,v
Encoding:
Text File  |  1994-04-30  |  3.3 KB  |  180 lines
  1. head    1.2;
  2. access;
  3. symbols;
  4. locks; strict;
  5. comment    @# @;
  6.  
  7.  
  8. 1.2
  9. date    94.04.30.12.38.46;    author peteric;    state Exp;
  10. branches;
  11. next    1.1;
  12.  
  13. 1.1
  14. date    94.03.09.21.52.24;    author peteric;    state Exp;
  15. branches;
  16. next    ;
  17.  
  18.  
  19. desc
  20. @PostScript procedures for use in FTree.
  21. @
  22.  
  23.  
  24. 1.2
  25. log
  26. @Corrections for multiple-marriage code; Ftree v0.3
  27. @
  28. text
  29. @%
  30. %
  31. % procset file for ftree family history program.
  32. % A default version of this also exists in ftree.
  33. %
  34. % (c) Copyright P. Ivimey-Cook 1994.
  35. %
  36. % Procedure printmultiple extracted from PostScript
  37. % Language Cokbook by Adobe.
  38. %
  39. % $Id$
  40. %
  41.  
  42. /showcentred {            % str =>
  43.     dup stringwidth pop 2 div neg 0 rmoveto show
  44. } def
  45. /show2centred {            % fdict str1 fdict str2 =>
  46.     4 dict begin /s2 exch def /f2 exch def /s1 exch def /f1 exch def
  47.     f1 setfont s1 stringwidth pop
  48.     f2 setfont s2 stringwidth pop
  49.     add 2 div neg 0 rmoveto
  50.     f1 setfont s1 show f2 setfont s2 show
  51. end } def
  52. /showright {                % str => 
  53.     dup stringwidth pop neg 0 rmoveto show
  54. } def
  55. /yrln {                % dy x y =>
  56.     moveto 0 exch rlineto
  57. } bind def
  58. /xrln {                % dx x y =>
  59.     moveto 0 rlineto
  60. } bind def
  61. /fsf {                    % name size font-id =>
  62.     findfont exch scalefont def
  63. } bind def
  64. /printtitle {            % grlev ptsiz ttl =>
  65.     /ttl exch def /yd exch 10 add def /grlev exch def
  66.     0 5 rmoveto currentpoint
  67.     /xd ttl stringwidth pop 2 div 10 add def
  68.     xd neg 0 rlineto 0 yd neg rlineto xd 2 mul 0 rlineto 0 yd rlineto
  69.     closepath gsave grlev setgray fill grestore stroke
  70.     moveto 0 yd 10 sub neg rmoveto ttl showcentred
  71. } def
  72. /printmarriage    {    % wdt wdt-y wife wf-y { mdt } show2? mdt-y bool hdt hdt-y husb-nm husb-y xpos =>
  73.     /xpos exch def
  74.     personfont setfont
  75.     xpos exch moveto showcentred
  76.     datefont setfont
  77.     xpos exch moveto showcentred
  78.     xpos exch moveto
  79.     { symfont (x) datefont 4 -1 roll show2centred }
  80.     { symfont setfont (x) showcentred } ifelse
  81.     personfont setfont
  82.     xpos exch moveto showcentred
  83.     datefont setfont
  84.     xpos exch moveto showcentred
  85. } def
  86. /printperson {        % dt-str dt-y nm-str nm-y { id-str id-y } pr-id xpos =>
  87.     /xpos exch def
  88.     printids { identfont setfont
  89.         xpos exch moveto showcentred
  90.     } if
  91.     personfont setfont
  92.     xpos exch moveto showcentred
  93.     datefont setfont
  94.     xpos exch moveto showcentred
  95. } def
  96. /cross {            % dxby2 dyby2 =>
  97.     /dby2 exch def
  98.     dby2 0 rmoveto dby2 neg 2 mul 0 rlineto
  99.     dby2 dy rmoveto 0 dby2 2 mul rlineto
  100.     0 dby2 neg rmoveto 
  101. } def
  102. /cross {            % dby2 =>
  103.     /dby2 exch def
  104.     dby2 0 rmoveto dby2 -2 mul 0 rlineto
  105.     dby2 dby2 rmoveto 0 dby2 -2 mul rlineto
  106.     0 dby2 rmoveto 
  107. } def
  108. /pmargins {
  109.     0 setlinewidth
  110.     newpath
  111.     0 0 moveto 5 cross
  112.     0 pageheight rmoveto 5 cross
  113.     pagewidth 0 rmoveto 5 cross
  114.     0 pageheight neg rmoveto 5 cross
  115.     stroke
  116. } def
  117. /printmultiple {    % x-pages y-pages =>
  118.     /rows exch def
  119.     /cols exch def
  120.     /pictproc exch def
  121.     newpath
  122.     leftmargin botmargin moveto
  123.     0 pageheight rlineto
  124.     pagewidth 0 rlineto
  125.     0 pageheight neg rlineto
  126.     closepath clip
  127.     newpath % clip doesn't do this
  128.     leftmargin botmargin translate
  129.     0 1 rows 1 sub {
  130.         /rowcount exch def
  131.         0 1 cols 1 sub {
  132.             /colcount exch def
  133.             gsave initclip pmargins grestore
  134.             gsave
  135.             pagewidth colcount mul neg
  136.             pageheight rowcount mul neg
  137.             translate
  138.             pictproc
  139.             gsave showpage grestore
  140.             grestore
  141.         } for
  142.     } for
  143. } def
  144. %%End
  145. @
  146.  
  147.  
  148. 1.1
  149. log
  150. @Initial revision
  151. @
  152. text
  153. @a16 1
  154.  
  155. a23 1
  156.  
  157. a26 1
  158.  
  159. a29 1
  160.  
  161. a32 1
  162.  
  163. d36 8
  164. a43 1
  165.  
  166. a57 1
  167.  
  168. d68 22
  169. a89 2
  170.  
  171. /printmultiple {
  172. d98 2
  173. a99 1
  174.     closepath clip newpath
  175. d105 1
  176. d116 1
  177. a116 1
  178.  
  179. @
  180.