PreviousUpNext

15.4.1361  src/lib/x-kit/widget/fancy/2d-graphics/scalable-font.pkg

## font-size-server.sml
## COPYRIGHT (c) 1994 AT&T Bell Laboratories.



###            "I believe OS/2 is destined to be
###             the most important operating system,
###             and possibly program, of all times."
###
###                          -- Bill Gates, 1988 



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" (fn () => loop[]);
            FS { plea=plea, reply=reply }
          end

    fun findFont (FS { plea, reply } ) size = (send (plea, size); pull reply)

  end


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext