home *** CD-ROM | disk | FTP | other *** search
/ Adobe Illustrator 3.0 & Fonts [NeXTSTEP] / AdobeTypeLibrary_Syntax2.img / FontInstaller.app / fontdirectory.ps < prev    next >
Encoding:
Text File  |  1991-04-24  |  5.2 KB  |  257 lines
  1. %!
  2. %%Title: fontsample.ps
  3. %%CreationDate: Sat Nov 11 15:30:46 1989
  4. % Copyright (C) 1987, 1991
  5. % Adobe Systems Incorporated
  6. % All Rights Reserved
  7. % CreationDate: (4/23/91)
  8.  
  9. % use the real font in the sample, unless this boolean
  10. % has been predefined to turn this off
  11. /realfont where { pop }{
  12.     /realfont true def
  13. } ifelse
  14. realfont { %ifelse
  15.     /leading 18 def
  16.     /dumbfont /Times-Roman findfont 14 scalefont def
  17. }{ %else
  18.     /leading 14 def
  19.     /dumbfont /Times-Roman findfont 12 scalefont def
  20. } ifelse
  21. /NextStepEncoding where { pop } { /NextStepEncoding false def } ifelse
  22.  
  23. /LeftStart 48 def
  24. /MiddleStart 315 def
  25. /Top 792 48 sub def
  26. /Left LeftStart def
  27. /lineadvance { %def
  28.     currentpoint exch pop leading sub Left exch moveto
  29.     currentpoint 48 lt { %ifelse
  30.     128 gt { %ifelse
  31.         showpage
  32.         /Left LeftStart store
  33.     }{ %else
  34.         /Left MiddleStart store
  35.     } ifelse
  36.     Left Top moveto
  37.     }{ %else
  38.     pop
  39.     } ifelse
  40. } bind def
  41.  
  42. %
  43. % Define a special findfont to use for making sure that local
  44. % "on disk" fonts don't end up in memory on DPS machines
  45. systemdict /shareddict known
  46. {
  47.     /fNamBuffer 128 string def
  48.     fNamBuffer 0 (%font%) putinterval
  49.     /findfont {
  50.         dup SharedFontDirectory exch known
  51.     {
  52.         SharedFontDirectory exch get
  53.     }
  54.     {
  55.         dup FontDirectory exch known
  56.         {
  57.             FontDirectory exch get
  58.         }
  59.         {    % Run the file directly so it doesn't get put in either dir
  60.             dup
  61.         fNamBuffer 6 122 getinterval cvs length 6 add
  62.         fNamBuffer exch 0 exch getinterval
  63.         run
  64.         FontDirectory exch get
  65.         }
  66.         ifelse
  67.     } ifelse
  68.     } def
  69. } if
  70.  
  71. /namebuff 512 string def
  72. realfont { %ifelse
  73.     /PrintSample { %def
  74.     save exch
  75.         dup findfont 14 scalefont setfont
  76.         namebuff cvs
  77.         currentfont /Encoding get 
  78.             dup dup StandardEncoding ne
  79.         exch NextStepEncoding ne and
  80.         exch 101 get /.notdef eq or
  81.         currentfont /FontName get /Machine eq or
  82.         currentfont /FontName get /Stencil eq or
  83.         currentfont /FontName get /AGaramond-Titling eq or {
  84.         currentfont
  85.             dumbfont setfont exch show (: )show
  86.         setfont
  87.         (AaBbCcDdEe) show
  88.         }{ show } ifelse
  89.     restore
  90.     lineadvance
  91.     } bind def
  92. }{ %else
  93.     dumbfont setfont
  94.     /PrintSample { %def
  95.     % save exch
  96.         namebuff cvs show
  97.     % restore
  98.     lineadvance
  99.     } bind def
  100. } ifelse
  101.  
  102. /buff 512 string def
  103. /addfonttolist { %def
  104.     null def
  105. } bind def
  106.  
  107. /$sort 20 dict def
  108.  
  109. % SortInit returns the root node of an empty binary tree.
  110.  
  111. /SortInit {
  112.     1 array
  113. } def
  114.  
  115. % Insert expects a root node and string on the stack.
  116. % inserts the string into the tree. It expect /compare
  117. % to be defined, and to take two strings and return a boolian
  118. % that tells if the first is greater than the second.
  119. /compare {gt}def
  120.  
  121. /Insert
  122. {exch dup 0 get type (nulltype) eq
  123.     {exch [ exch 1 array 1 array ] 0 exch put}
  124.     {aload pop aload pop 4 2 roll 2 copy compare
  125.         {pop 3 -1 roll pop Insert}
  126.         {pop exch pop Insert}
  127.         ifelse
  128.     }ifelse
  129.  }def
  130.  
  131. %PrefixWalk expects a root node  and a proc body on the operand stack.
  132. %For each element in the array, it executes the proc body.
  133.  
  134. /PrefixWalk
  135. {$sort begin
  136.   cvx /!bt exch def bpwalk 
  137.  end}def
  138.  
  139.  
  140. /Sort {
  141.   $sort begin
  142.      % dictionary is on the stack
  143.      { % forall
  144.          pop
  145.      buff cvs dup length string copy
  146.      tree exch Insert
  147.      } forall
  148.   end
  149. } def
  150.  
  151. /Print {
  152.     $sort begin
  153.     tree { PrintSample } PrefixWalk
  154.     end
  155. } bind def
  156.  
  157. $sort begin
  158.  
  159. /bpwalk
  160. {dup 0 get type /nulltype eq
  161.     {pop}
  162.     {aload pop aload pop exch bpwalk exch !bt bpwalk}
  163.     ifelse
  164. }def
  165.  
  166. end %end of $sort
  167.  
  168. /tree SortInit def
  169. /memoryfonts 1000 dict def
  170. /diskfonts 1500 dict def
  171.  
  172. %%EndProlog
  173.  
  174. %%BeginSetup
  175. Left Top moveto
  176. %%EndSetup
  177.  
  178. /Times-Italic findfont 14 scalefont setfont
  179. (Fonts in Memory) show
  180. lineadvance lineadvance
  181. dumbfont setfont
  182.  
  183. memoryfonts begin
  184.     FontDirectory {
  185.     pop
  186.     buff cvs dup dup 0 get (|) 0 get eq { pop pop pop }{ %ifelse
  187.         dup (Screen-) anchorsearch {
  188.         pop pop pop pop
  189.         }{
  190.         pop pop addfonttolist
  191.         } ifelse
  192.     } ifelse
  193.     % addfonttolist
  194.     } bind forall
  195.     /SharedFontDirectory where {
  196.     pop
  197.     SharedFontDirectory {
  198.         pop
  199.         buff cvs dup dup 0 get (|) 0 get eq { pop pop pop }{ %ifelse
  200.         dup (Screen-) anchorsearch {
  201.             pop pop pop pop
  202.         }{
  203.             pop pop addfonttolist
  204.         } ifelse
  205.         } ifelse
  206.     } bind forall
  207.     } if
  208. end %memoryfonts
  209. memoryfonts Sort
  210. Print
  211.  
  212. /tree SortInit def
  213. diskfonts begin
  214.     % print "Fonts on Disk" at an appropriate place on the page
  215.     Left LeftStart eq { %ifelse
  216.     /Left MiddleStart store
  217.     }{ %else
  218.     currentpoint exch pop 300 le { %ifelse
  219.         showpage
  220.         /Left LeftStart store
  221.     }{ %else
  222.         lineadvance lineadvance
  223.     } ifelse
  224.     } ifelse
  225.     Left Top moveto
  226.     /Times-Italic findfont 14 scalefont setfont
  227.     (Fonts on Disk) show
  228.     lineadvance lineadvance
  229.     dumbfont setfont
  230.     
  231.     /filenameforall where {
  232.     pop
  233.     (%font%*) {
  234.         dup length 6 sub 6 exch getinterval
  235.         % OK, now cover 2.0 bug where this returns the string
  236.         % <fontname>.font/<fontname> instead of just <fontname>
  237.         (.font/) search 
  238.         {    % ifelse
  239.         pop pop
  240.         dup length string copy addfonttolist
  241.         }
  242.         { addfonttolist }
  243.         ifelse
  244.     } 128 string filenameforall
  245.     (fonts/*) {
  246.         dup length 6 sub 6 exch getinterval
  247.         dup length string copy addfonttolist
  248.     } 128 string filenameforall
  249.     } if
  250. end %diskfonts
  251. diskfonts Sort
  252. Print
  253.  
  254. showpage
  255.  
  256.  
  257.