15.4.1385  src/lib/x-kit/tut/widget/test-font.pkg

## test-font.pkg

# Compiled by:
#     src/lib/x-kit/tut/widget/widgets.lib


stipulate
    include package   threadkit;                        # threadkit             is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    #
    package rx =  run_in_x_window_old;                  # run_in_x_window_old   is from   src/lib/x-kit/widget/old/lib/run-in-x-window-old.pkg
    package xc =  xclient;                              # xclient               is from   src/lib/x-kit/xclient/xclient.pkg
    #
    package wg =  widget;                               # widget                is from   src/lib/x-kit/widget/old/basic/widget.pkg
herein

    package test_font:  api {
                            do_it':  (List(String), String) -> Void;
                            do_it:    Void -> Void;
                            main:    (List(String), X) -> Void;
                        }
    {

        fun print_info (msg, xc::CHAR_INFO info)
            =
            {   file::print msg;

                file::print
                    (sprintf ": lb %d rb %d wd %d\n"
                        info.left_bearing
                        info.right_bearing
                        info.char_width
                    );
            };

        fun font_info font
            =
            {   (xc::font_info_of  font)
                    ->
                    { min_bounds, max_bounds, min_char, max_char };

                char_info
                    =
                    xc::char_info_of  font;

                fun loop c
                    = 
                    if (c != max_char)

                        info = char_info c;

                        print_info (int::to_string c, info);
                        loop (c+1);
                    fi
                    except
                        xc::NO_CHAR_INFO
                            =
                            loop (c+1);

                file::print
                    (sprintf "min_char = %d max_char = %d\n"
                       min_char
                       max_char
                    ); 

                print_info ("min_bounds", min_bounds);
                print_info ("max_bounds", max_bounds);

                loop min_char;
            };

        fname = "-Adobe-Helvetica-Bold-R-Normal--*-120-*";

        fun goodbye root
            =
            {   fun quit ()
                    =
                    {   wg::delete_root_window root;
                        shut_down_thread_scheduler 0;
                    };

                font = wg::open_font root fname;

                font_info font;
                quit ();
            };

        fun do_it' (debug_flags, server)
            =
            {   xlogger::init  debug_flags;
                #
                rx::run_in_x_window_old'  goodbye  [ rx::DISPLAY server ];
            };

        fun do_it ()
            =
            rx::run_in_x_window_old  goodbye;

        fun main (program ! server ! _, _) =>  do_it'([], server);
            main _                         =>  do_it ();
        end;

    };                          # package test_font
end;

## COPYRIGHT (c) 1991, 1995 by AT&T Bell Laboratories.  See SMLNJ-COPYRIGHT file for details.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.