## font-base.pkg
#
# The basic definitions for fonts.
#
# "Fonts and their related character metrics
# follow the standard X model. However in
# [x-kit] font information is viewed as logically
# part of the font; there is no separate font
# information data structure."
# -- p18, http://mythryl.org/pub/exene/1993-lib.ps
# (John Reppy's 1993 eXene library manual.)
#
#
# See also: some possibly useful code here,
# although it does not currently compile: XXX BUGGO FIXME
#
# src/lib/x-kit/widget/old/fancy/2d-graphics/scalable-font.pkg#
# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib### "A good stack of examples, as large as possible,
### is indispensable for a thorough understanding
### of any concept, and when I want to learn something
### new, I make it my first job to build one."
###
### Paul Halmos
stipulate
#
package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkg package sok = socket__premicrothread; # socket__premicrothread is from src/lib/std/socket--premicrothread.pkg package dy = display; # display is from src/lib/x-kit/xclient/src/wire/display.pkgherein
package font_base {
#
exception NO_CHAR_INFO; # Raised by the char_info functions.
exception FONT_PROPERTY_NOT_FOUND;
Font_Info # For background here see p38 in http://mythryl.org/pub/exene/X-protocol-R7.pdf
=
FINFO8
{
min_bounds: xt::Char_Info,
max_bounds: xt::Char_Info,
#
min_char: Int,
max_char: Int,
#
default_char: Int,
#
draw_dir: xt::Font_Drawing_Direction,
all_chars_exist: Bool,
#
font_ascent: Int,
font_descent: Int,
#
properties: List( xt::Font_Prop ),
char_info: Int -> xt::Char_Info
}
| FINFO16
{
min_bounds: xt::Char_Info,
max_bounds: xt::Char_Info,
#
min_char: Int,
max_char: Int,
#
default_char: Int,
#
draw_dir: xt::Font_Drawing_Direction,
all_chars_exist: Bool,
#
min_byte1: Int,
max_byte1: Int,
#
font_ascent: Int,
font_descent: Int,
#
properties: List( xt::Font_Prop ),
char_info: Int -> xt::Char_Info
};
Font = { id: xt::Font_Id,
xdpy: dy::Xdisplay, # Display to which this font belongs.
info: Font_Info
};
# Identity test:
#
fun same_font (
{ id=>id1, xdpy=> { socket => c1, ... }: dy::Xdisplay, ... }: Font,
{ id=>id2, xdpy=> { socket => c2, ... }: dy::Xdisplay, ... }: Font
)
=
xt::same_xid (id1, id2)
and
# xok::same_xsocket (c1, c2);
c1 == c2;
# Find a given property of a font:
#
fun font_property_of ({ info, ... }: Font) atom
=
get properties
where
#
properties
=
case info
#
FINFO8 { properties, ... } => properties;
FINFO16 { properties, ... } => properties;
esac;
fun get [] => raise exception FONT_PROPERTY_NOT_FOUND;
#
get ((xt::FONT_PROP { name, value } ) ! r)
=>
name == atom ?? value
:: get r;
end;
end;
# Return the non-character specific info for the font
#
fun font_info_of ({ info=>(FINFO8 x), ... }: Font)
=>
{ min_bounds => x.min_bounds,
max_bounds => x.max_bounds,
min_char => x.min_char,
max_char => x.max_char
};
font_info_of ({ info=>(FINFO16 x), ... }: Font)
=>
{ min_bounds => x.min_bounds,
max_bounds => x.max_bounds,
min_char => x.min_char,
max_char => x.max_char
};
end;
# Return the character info about
# a given character in a given font.
#
# The character is specified as an ordinal.
# We raise the exception NO_CHAR_INFO if
# the given ordinal does not correspond
# to a character in the font.
#
fun char_info_of ({ info, ... }: Font)
=
case info
#
FINFO8 { char_info, ... } => char_info;
FINFO16 { char_info, ... } => char_info;
esac;
# Return the width in pixels of
# a given character in a given font.
#
fun char_width font
=
width_fn
where
info_of = char_info_of font;
#
fun width_fn c
=
{ (info_of (char::to_int c))
->
xt::CHAR_INFO { char_width, ... };
char_width;
}
except _ = 0;
end;
# Return the width in pixels of
# a string in the given font.
#
fun text_width font
=
width_fn
where
char_width_fn = char_width font;
#
fun width_fn s
=
width_fn' (0, 0)
where
len = string::length_in_bytes s;
#
fun width_fn' (width, i)
=
if (i < len) width_fn' (width + char_width_fn (string::get_byte_as_char (s, i)), i+1);
else width;
fi;
end;
end;
# Return the width of the substring s[i..i+n - 1] in the given font
#
fun substr_width font
=
width_fn
where
char_width_fn = char_width font;
#
fun width_fn (s, i, n)
=
width_fn' (0, i)
where
len = int::min (size s, i+n);
#
fun width_fn' (width, i)
=
if (i < len) width_fn' (width + char_width_fn (string::get_byte_as_char (s, i)), i+1);
else width;
fi;
end;
end;
# Return a list containing the pixel position
# of each character in given string, in given font.
#
# In other words, return a list containing the
# width in pixels of each non-empty prefix of
# the string, in the given font.
#
# For a string of length n, this returns a list of length n+1.
#
fun char_positions font
=
{ char_width_fn = char_width font;
#
fun positions s
=
width_fn ([0], 0, 0)
where
len = string::length_in_bytes s;
#
fun width_fn (l, width, i)
=
if (i < len)
#
wide = width + char_width_fn (string::get_byte_as_char (s, i));
width_fn (wide ! l, wide, i + 1);
else
reverse l;
fi;
end;
positions;
};
# Return the extents of the given string in the given font, which is a record
# with the fields
# dir: font_draw_dir,
# font_ascent: Int,
# font_descent: Int,
# overall_info: char_info
# The dir, font_ascent and font_descent fields give the font properties. The
# overall_info field describes the bounding box of the string if written at
# the origin. The upper left corner of the bounding box is at
# (left_bearing, -ascent)
# the dimensions of the bounding box are
# (right_bearing - left_bearing, ascent + descent).
# The width is the sum of the widths of all the characters in the string.
#
fun text_extents ({ info, ... }: Font) s
=
{
my (info_of, dir, font_ascent, font_descent)
=
case info
#
FINFO8 { char_info, draw_dir, font_ascent, font_descent, ... }
=>
(char_info, draw_dir, font_ascent, font_descent);
FINFO16 { char_info, draw_dir, font_ascent, font_descent, ... }
=>
(char_info, draw_dir, font_ascent, font_descent);
esac;
len = string::length_in_bytes s;
fun min (a: Int, b) = (a < b) ?? a :: b;
fun max (a: Int, b) = (a > b) ?? a :: b;
fun ord_of i = string::get_byte (s, i);
fun get_info i = (THE (info_of (ord_of i))) except _ = NULL;
fun accum_none i
=
if (i < len)
#
case (get_info i)
#
NULL => accum_none (i+1);
THE (xt::CHAR_INFO info)
=>
accum (
{ ascent => info.ascent,
descent => info.descent,
lbear => info.left_bearing,
rbear => info.right_bearing,
width => info.char_width
},
i + 1
);
esac;
else
{ ascent => 0,
descent => 0,
lbear => 0,
rbear => 0,
width => 0
};
fi
also
fun accum (arg as { ascent, descent, lbear, rbear, width }, i)
=
if (i < len)
#
case (get_info i)
#
NULL => accum (arg, i+1);
THE (xt::CHAR_INFO info)
=>
accum(
{ ascent => max (ascent, info.ascent),
descent => max (descent, info.descent),
lbear => min (lbear, width + info.left_bearing),
rbear => max (rbear, width + info.right_bearing),
width => width + info.char_width
},
i + 1
);
esac;
else
arg;
fi;
(accum_none 0)
->
{ ascent, descent, lbear, rbear, width };
{ dir,
font_ascent,
font_descent,
#
overall_info
=>
xt::CHAR_INFO
{
ascent,
descent,
char_width => width,
left_bearing => lbear,
right_bearing => rbear,
attributes => 0u0
}
};
};
fun font_high ({ info=>FINFO8 { font_ascent, font_descent, ... }, ... }: Font)
=>
{ ascent => font_ascent,
descent => font_descent
};
font_high ({ info=>FINFO16 { font_ascent, font_descent, ... }, ... }: Font)
=>
{ ascent => font_ascent,
descent => font_descent
};
end;
}; # package font_base
end; # stipulate