## scalable-font.pkg
api SCALABLE_FONT =
api
package w: WIDGET
enum font_style = Normal | Italic | Bold
my dfltFontSz: Int
type font_imp
my fontServer: (w::root * w::view * List( w::Arg ) ) -> font_imp
my findFont: font_imp -> (font_style * Int) -> Null_Or( w::XC::font )
end
package ScalableFont: SCALABLE_FONT
=
pkg
package w = widget
use threadkit
enum font_style = Normal | Italic | Bold
# Eventually, this should come from the style
dfltFontSz = 12 # points
rmFont = "-adobe-times-medium-r-normal--*-%d-*-*-p-*-iso8859-1"
itFont = "-adobe-times-medium-i-normal--*-%d-*-*-p-*-iso8859-1"
bfFont = "-adobe-times-bold-r-normal--*-%d-*-*-p-*-iso8859-1"
fmtRmFont = format::format rmFont
fmtItFont = format::format itFont
fmtBfFont = format::format bfFont
# Note that font sizes are specified in tenths of a point
fun fmtFontName (Normal, size) = fmtRmFont [format::INT (size*10)]
| fmtFontName (Italic, size) = fmtItFont [format::INT (size*10)]
| fmtFontName (Bold, size) = fmtBfFont [format::INT (size*10)]
enum font_imp = FS of {
plea: chan( font_style * Int ),
reply: chan( Null_Or( w::XC::font ) )
}
fun fontServer (root, view, args) = let
plea = channel () and reply = channel ()
openFont = w::openFont root
fun loadFont (_, 0) = NULL
| loadFont (style, size) =
(THE (openFont (fmtFontName (style, size))))
except Font::FONT_NOT_FOUND =>(
file::write (file::stderr, cat [
"Font size", int::to_string size, " : not found\n"]
);
loadFont (style, size - 1))
fun handlePlea (fonts, (style, pleasz)) = let
fun match (sty, s, _) = (sty = style) and (s = pleasz)
in
case list::find match fonts
of (THE(_, _, f)) => (send (reply, THE f); fonts)
| NULL => (case loadFont (style, pleasz)
of NULL => (send (reply, NULL); fonts)
| (THE f) => (
send (reply, THE f);
(style, pleasz, f) . fonts)
) # end case
# end case
end
fun loop flist = loop (handlePlea (flist, pull plea))
in
make_thread "scalable_font" (\\ () => loop[]);
FS { plea=plea, reply=reply }
end
fun findFont (FS { plea, reply } ) size
=
( send (plea, size);
pull reply
)
end