%!
% Folio font pie menus
% Don Hopkins

/TheFont /Times-Roman findfont 12 scalefont def
/TheFontName TheFont 100 string cvs def

/select-font { % font => -
  /TheFont exch store
  /TheFontName TheFont 100 string cvs store
  /PaintClient win send
} def

/point-sizes [
  1 6 8 10 12 14 16 18 20 22 24 26 28 30 32
] def

/def-font-menu { % /name [fonts...] /init => -
  10 dict begin % localdict
    /init exch def
    /fonts exch def
    [ fonts {
        FontDirectory 1 index known {
	  /name exch def
	  /font name findfont def
	  [ point-sizes {
	      [ exch dup (% Point) sprintf
	        exch font exch scalefont
	      ]
	    } forall
	  ]
	} { pop } ifelse
      } forall
    ] [
      fonts {
	FontDirectory 1 index known {
	  [ exch dup findfont 16 scalefont ]
	  { getmenuarg 1 get select-font }
	} { pop } ifelse
      } forall
    ] /new PulloutPieMenu send
    /init load 1 index send
  end % localdict
  def
} def

% ITC

/AvantGardeMenu [
  (AvantGarde-Book)
  (AvantGarde-BookOblique)
  (AvantGarde-DemiOblique)
  (AvantGarde-Demi)
] {
  /LabelMinRadius 50 def
  /PieInitialAngle 135 def
  /ArgBorder 3 def
} def-font-menu

/BookmanMenu [
  (Bookman-Light)
  (Bookman-LightItalic)
  (Bookman-DemiItalic)
  (Bookman-Demi)
] {
  /LabelMinRadius 40 def
  /PieInitialAngle 135 def
} def-font-menu

/ZapfMenu [
  (ZapfChancery-MediumItalic)
  (ZapfDingbats)
] {
  /LabelMinRadius 40 def
  /ArgBorder 3 def
} def-font-menu

% Linotype

/HelveticaMenu [
  (Helvetica)
  (Helvetica-Oblique)
  (Helvetica-BoldOblique)
  (Helvetica-Bold)
] {
  /LabelMinRadius 40 def
  /PieInitialAngle 135 def
} def-font-menu

/NewCenturySchlbkMenu [
  (NewCenturySchlbk-Roman)
  (NewCenturySchlbk-Italic)
  (NewCenturySchlbk-BoldItalic)
  (NewCenturySchlbk-Bold)
] {
  /LabelMinRadius 40 def
  /PieInitialAngle 135 def
} def-font-menu

/PalatinoMenu [
  (Palatino-Roman)
  (Palatino-Italic)
  (Palatino-BoldItalic)
  (Palatino-Bold)
] {
  /LabelMinRadius 50 def
  /PieInitialAngle 135 def
  /ArgBorder 3 def
} def-font-menu

/TimesMenu [
  (Times-Roman)
  (Times-Italic)
  (Times-BoldItalic)
  (Times-Bold)
] {
  /LabelMinRadius 40 def
  /PieInitialAngle 135 def
} def-font-menu

% Monotype

/BemboMenu [
  (Bembo)
  (Bembo-Italic)
  (Bembo-BoldItalic)
  (Bembo-Bold)
] {
  /LabelMinRadius 40 def
  /PieInitialAngle 135 def
} def-font-menu

/GillSansMenu [
  (GillSans)
  (GillSans-Italic)
  (GillSans-BoldItalic)
  (GillSans-Bold)
] {
  /LabelMinRadius 40 def
  /PieInitialAngle 135 def
} def-font-menu

/RockwellMenu [
  (Rockwell)
  (Rockwell-Italic)
  (Rockwell-BoldItalic)
  (Rockwell-Bold)
] {
  /LabelMinRadius 40 def
  /PieInitialAngle 135 def
} def-font-menu

% Bigelow & Holmes

/Lucida-BrightMenu [
  (Lucida-Bright)
  (Lucida-BrightItalic)
  (Lucida-BrightDemiBoldItalic)
  (Lucida-BrightDemiBold)
] {
  /LabelMinRadius 40 def
  /PieInitialAngle 135 def
} def-font-menu

/LucidaSansMenu [
  (LucidaSans)
  (LucidaSans-Italic)
  (LucidaSans-BoldItalic)
  (LucidaSans-Bold)
] {
  /LabelMinRadius 40 def
  /PieInitialAngle 135 def
} def-font-menu

/LucidaSansTypewriterMenu [
  (LucidaSansTypewriter)
  (LucidaSansTypewriter-Bold)
] {
  /LabelMinRadius 40 def
} def-font-menu

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/ITCMenu [
  [(AvantGarde) /AvantGarde-Book findfont 16 scalefont ] 
  AvantGardeMenu
  [(Bookman) /Bookman-Light findfont 16 scalefont ] 
  BookmanMenu
  [(Zapf) /ZapfChancery-MediumItalic findfont 16 scalefont ] 
  ZapfMenu
] /new PieMenu send def

/LinotypeMenu [
  [ (Times) /Times-Roman findfont 16 scalefont ]
  TimesMenu
  [(Helvetica) /Helvetica findfont 16 scalefont ]
  HelveticaMenu
  [ (NewCenturySchlbk) /NewCenturySchlbk-Roman findfont 16 scalefont ] 
  NewCenturySchlbkMenu
  [ (Palatino) /Palatino-Roman findfont 16 scalefont ]
  PalatinoMenu
] /new PieMenu send def

/MonotypeMenu [
  [ (Bembo) /Bembo findfont 16 scalefont ]
  BemboMenu
  [ (GillSans) /GillSans findfont 16 scalefont ]
  GillSansMenu
  [ (Rockwell) /Rockwell findfont 16 scalefont ]
  RockwellMenu
] /new PieMenu send def

/Bigelow&HolmesMenu [
  [ (LucidaSansTypewriter) /LucidaSansTypewriter findfont 16 scalefont ]
  LucidaSansTypewriterMenu
  [ (Lucida-Bright) /Lucida-Bright findfont 16 scalefont ]
  Lucida-BrightMenu
  [ (LucidaSans) /LucidaSans findfont 16 scalefont ]
  LucidaSansMenu
] /new PieMenu send def
Bigelow&HolmesMenu /PieInitialAngle 270 put

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/FontMenu [
  [ (ITC) /Bookman-Light findfont 16 scalefont ]
  ITCMenu
  [ (Linotype) /Palatino-Roman findfont 16 scalefont ]
  LinotypeMenu
  [ (Bigelow & Holmes) /Lucida-Bright findfont 16 scalefont ]
  Bigelow&HolmesMenu
  [ (Monotype) /Bembo findfont 16 scalefont ]
  MonotypeMenu
] /new PieMenu send def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/win framebuffer /new DefaultWindow send def
{ /ClientMenu FontMenu def
  /PaintClient {
    gsave
      ClientCanvas setcanvas
      erasepage
      0 setgray
      TheFont setfont
      ClientWidth 2 div ClientHeight 2 div moveto
      TheFontName cshow
    grestore
  } def
} win send

/reshapefromuser win send
/map win send