🚀 go-pugleaf

In article <567@ssp15.idca.tds.philips.nl> jos@idca.tds.PHILIPS.nl (Jos Vos) writes:
>After receiving my Apple LaserWriter IINTX, I was wondered about the fact
>that Apple didn't include the names to be used in PostScript of all the
>35 fonts (e.g. Courier-Bold).
>
>So, I wrote a small PostScript program, that returns all font names on
>its output (not on paper!):
>
>	FontDirectory { /FontName get == } forall
>
>Maybe this program might also be interesting for others, dealing with
>the same lack of information in the printer documentation.

I have written/stolen/modifyed a program from the net that produced the
same result. The result is presented on a paper from the printer.
The difference is that the fontnames are sorted in alphabetic order together
with some, maybe useful, information from the LaserWriter. The program
uses Bubblesort to sort the names of the fonts. Please dont't flame me
for a bad algorithm in the sorting, it's just a happy hack...
NOTE: that it's assumed that no more then 50 fonts exists in the LaserWriter.
Use the program, and have a Happy Smile!

-------Cut Here------8<-----8<-----8<-----8<-----8<-----8<-----8<-----8<-----
%!
/MaxNrOfFonts 50 def 	% Maximum numbers of fonts...
/Xpos 136 def
/Ypos 690 def
/num 0 def 		% local counter
/incr {
  /num num 1 add def
} def

/s40 { 40 string } def	% Proper length of the fontname

/showline {		% Show and newlines
  show
  newline
} def

/newline {		% Spacing between lines
  /Ypos Ypos 12 sub def
  Xpos Ypos moveto
} def

/CountFonts {		% Count the fonts and put the names into array
  FontDirectory 
  {
    pop
    s40
    cvs
    incr
  }
  forall
  /FontArray num array def
  FontArray astore
  pop
} def

/ListFonts {		% Sort the fonts and show them on paper
  Bubbelsort
  FontArray
  {
    showline
  }
  forall
} def

/Bubbelsort {		% Here is the sorting routine
  1 1 num 1 sub
  {
    /localcount exch def
    num 1 sub -1 localcount
    {
      /innercount exch def
      /firststring FontArray innercount 1 sub get def
      /secondstring FontArray innercount get def
      firststring secondstring gt
      {
         FontArray innercount 1 sub secondstring put
         FontArray innercount firststring put
      } if
    } for
  } for
} def

/prettyline
{  /YPOSition exch def
   newpath 
     Xpos Ypos YPOSition add moveto
     Xpos 100 add Ypos YPOSition add lineto
   stroke
} def

/Times-Roman findfont 12 scalefont setfont
14 prettyline

Xpos Ypos 18 add moveto
CountFonts
(Number of fonts: ) show
num s40 cvs show

30 prettyline
Xpos Ypos moveto
ListFonts
newline

/Times-Bold findfont 12 scalefont setfont
(Total memory: ) show
vmstatus s40 cvs show newline
(Memory used: ) show
s40 cvs show newline
pop
(Free memory: ) show
vmstatus exch sub s40 cvs show newline newline
pop
/Times-Roman findfont 12 scalefont setfont
(From ulfis@nada.kth.se, 88-10-05) show
showpage
-------Cut Here------8<-----8<-----8<-----8<-----8<-----8<-----8<-----8<-----