1# /=====================================================================\ #
2# |  LaTeXML::Common::Font                                              | #
3# | Representaion of Fonts                                              | #
4# |=====================================================================| #
5# | Part of LaTeXML:                                                    | #
6# |  Public domain software, produced as part of work done by the       | #
7# |  United States Government & not subject to copyright in the US.     | #
8# |---------------------------------------------------------------------| #
9# | Bruce Miller <bruce.miller@nist.gov>                        #_#     | #
10# | http://dlmf.nist.gov/LaTeXML/                              (o o)    | #
11# \=========================================================ooo==U==ooo=/ #
12package LaTeXML::Common::Font;
13use strict;
14use warnings;
15use LaTeXML::Global;
16use LaTeXML::Core::Token;
17use LaTeXML::Common::Error;
18use LaTeXML::Common::Object;
19use LaTeXML::Common::Dimension;
20use List::Util qw(min max sum);
21use base qw(LaTeXML::Common::Object);
22
23# Note that this has evolved way beynond just "font",
24# but covers text properties (or even display properties) in general
25# including basic font information, color & background color
26# as well as encoding and language information.
27
28DebuggableFeature('size-detailed', "Show sizing of boxes in detail");
29# NOTE: This is now in Common that it may evolve to be useful in Post processing...
30
31my $DEFFAMILY     = 'serif';      # [CONSTANT]
32my $DEFSERIES     = 'medium';     # [CONSTANT]
33my $DEFSHAPE      = 'upright';    # [CONSTANT]
34my $DEFCOLOR      = 'black';      # [CONSTANT]
35my $DEFBACKGROUND = undef;        # [CONSTANT] no color; transparent
36my $DEFOPACITY    = '1';          # [CONSTANT]
37my $DEFENCODING   = 'OT1';        # [CONSTANT]
38my $DEFLANGUAGE   = undef;
39
40sub DEFSIZE { return $STATE->lookupValue('NOMINAL_FONT_SIZE') || 10; }
41
42my $FLAG_FORCE_FAMILY = 0x1;
43my $FLAG_FORCE_SERIES = 0x2;
44my $FLAG_FORCE_SHAPE  = 0x4;
45my $FLAG_EMPH         = 0x10;
46#======================================================================
47# Mappings from various forms of names or component names in TeX
48# Given a font, we'd like to map it to the "logical" names derived from LaTeX,
49# (w/ loss of fine grained control).
50# I'd like to use Karl Berry's font naming scheme
51# (See http://www.tug.org/fontname/html/)
52# but it seems to be a one-way mapping, and moreover, doesn't even fit CM fonts!
53# We'll assume a sloppier version:
54#   family + series + variant + size
55# NOTE: This probably doesn't really belong in here...
56
57my %font_family = (
58  cmr   => { family => 'serif' },      cmss  => { family => 'sansserif' },
59  cmtt  => { family => 'typewriter' }, cmvtt => { family => 'typewriter' },
60  cmti  => { family => 'typewriter', shape => 'italic' },
61  cmfib => { family => 'serif' },      cmfr  => { family => 'serif' },
62  cmdh  => { family => 'serif' },      cm    => { family => 'serif' },
63  ptm   => { family => 'serif' },      ppl   => { family => 'serif' },
64  pnc   => { family => 'serif' },      pbk   => { family => 'serif' },
65  phv   => { family => 'sansserif' },  pag   => { family => 'serif' },
66  pcr   => { family => 'typewriter' }, pzc   => { family => 'script' },
67  put   => { family => 'serif' },      bch   => { family => 'serif' },
68  psy   => { family => 'symbol' },     pzd   => { family => 'dingbats' },
69  ccr   => { family => 'serif' },      ccy   => { family => 'symbol' },
70  cmbr  => { family => 'sansserif' },  cmtl  => { family => 'typewriter' },
71  cmbrs => { family => 'symbol' },     ul9   => { family => 'typewriter' },
72  txr   => { family => 'serif' },      txss  => { family => 'sansserif' },
73  txtt  => { family => 'typewriter' }, txms  => { family => 'symbol' },
74  txsya => { family => 'symbol' },     txsyb => { family => 'symbol' },
75  pxr   => { family => 'serif' },      pxms  => { family => 'symbol' },
76  pxsya => { family => 'symbol' },     pxsyb => { family => 'symbol' },
77  futs  => { family => 'serif' },
78  uaq   => { family => 'serif' },   ugq  => { family => 'sansserif' },
79  eur   => { family => 'serif' },   eus  => { family => 'script' },
80  euf   => { family => 'fraktur' }, euex => { family => 'symbol' },
81  # The following are actually math fonts.
82  ms    => { family => 'symbol' },
83  ccm   => { family => 'serif',      shape    => 'italic' },
84  cmm   => { family => 'italic',     encoding => 'OML' },
85  cmex  => { family => 'symbol',     encoding => 'OMX' },      # Not really symbol, but...
86  cmsy  => { family => 'symbol',     encoding => 'OMS' },
87  ccitt => { family => 'typewriter', shape    => 'italic' },
88  cmbrm => { family => 'sansserif',  shape    => 'italic' },
89  futm  => { family => 'serif',      shape    => 'italic' },
90  futmi => { family => 'serif',      shape    => 'italic' },
91  txmi  => { family => 'serif',      shape    => 'italic' },
92  pxmi  => { family => 'serif',      shape    => 'italic' },
93  bbm   => { family => 'blackboard' },
94  bbold => { family => 'blackboard' },
95  bbmss => { family => 'blackboard' },
96  # some ams fonts
97  cmmib => { family => 'italic', series   => 'bold' },
98  cmbsy => { family => 'symbol', series   => 'bold' },
99  msa   => { family => 'symbol', encoding => 'AMSa' },
100  msb   => { family => 'symbol', encoding => 'AMSb' },
101  # Are these really the same?
102  msx => { family => 'symbol', encoding => 'AMSa' },
103  msy => { family => 'symbol', encoding => 'AMSb' },
104);
105
106# Maps the "series code" to an abstract font series name
107my %font_series = (
108  '' => { series => 'medium' }, m   => { series => 'medium' }, mc => { series => 'medium' },
109  b  => { series => 'bold' },   bc  => { series => 'bold' },   bx => { series => 'bold' },
110  sb => { series => 'bold' },   sbc => { series => 'bold' },   bm => { series => 'bold' });
111
112# Maps the "shape code" to an abstract font shape name.
113my %font_shape = ('' => { shape => 'upright' }, n => { shape => 'upright' }, i => { shape => 'italic' }, it => { shape => 'italic' },
114  sl => { shape => 'slanted' }, sc => { shape => 'smallcaps' }, csc => { shape => 'smallcaps' });
115
116# These could be exported...
117sub lookupFontFamily {
118  my ($familycode) = @_;
119  return $font_family{ ToString($familycode) }; }
120
121sub lookupFontSeries {
122  my ($seriescode) = @_;
123  return $font_series{ ToString($seriescode) }; }
124
125sub lookupFontShape {
126  my ($shapecode) = @_;
127  return $font_shape{ ToString($shapecode) }; }
128
129# Symbolic font sizes, relative to the NOMINAL_FONT_SIZE (often 10)
130# extended logical font sizes, based on nominal document size of 10pts
131# Possibly should simply use absolute font point sizes, as declared in class...
132my %font_size = (
133  tiny   => 0.5,   SMALL => 0.7, Small => 0.8,  small => 0.9,
134  normal => 1.0,   large => 1.2, Large => 1.44, LARGE => 1.728,
135  huge   => 2.074, Huge  => 2.488,
136  big    => 1.2,   Big   => 1.6, bigg => 2.1, Bigg => 2.6,
137);
138
139sub rationalizeFontSize {
140  my ($size) = @_;
141  return unless defined $size;
142  if (my $symbolic = $font_size{$size}) {
143    return $symbolic * DEFSIZE(); }
144  return $size; }
145
146# convert to percent
147sub relativeFontSize {
148  my ($newsize, $oldsize) = @_;
149  return int(0.5 + 100 * $newsize / $oldsize) . '%'; }
150
151my $FONTREGEXP
152  = '(' . join('|', sort { -($a cmp $b) } keys %font_family) . ')'
153  . '(' . join('|', sort { -($a cmp $b) } keys %font_series) . ')'
154  . '(' . join('|', sort { -($a cmp $b) } keys %font_shape) . ')'
155  . '(\d*)';
156
157sub decodeFontname {
158  my ($name, $at, $scaled) = @_;
159  if ($name =~ /^$FONTREGEXP$/o) {
160    my %props;
161    my ($fam, $ser, $shp, $size) = ($1, $2, $3, $4);
162    if (my $ffam = lookupFontFamily($fam)) { map { $props{$_} = $$ffam{$_} } keys %$ffam; }
163    if (my $fser = lookupFontSeries($ser)) { map { $props{$_} = $$fser{$_} } keys %$fser; }
164    if (my $fsh  = lookupFontShape($shp))  { map { $props{$_} = $$fsh{$_} } keys %$fsh; }
165    $size = 1 unless $size;    # Yes, also if 0, "" (from regexp)
166    $size = $at if defined $at;
167    $size *= $scaled if defined $scaled;
168    $props{size} = $size;
169    # Experimental Hack !?!?!?
170    $props{encoding} = 'OT1' unless defined $props{encoding};
171    $props{at}       = $at . "pt" if defined $at;
172    return %props; }
173  else {
174    return; } }
175
176sub lookupTeXFont {
177  my ($fontname, $seriescode, $shapecode) = @_;
178  my %props;
179  if (my $ffam = lookupFontFamily($fontname)) {
180    map { $props{$_} = $$ffam{$_} } keys %$ffam; }
181  if (my $fser = lookupFontSeries($seriescode)) {
182    map { $props{$_} = $$fser{$_} } keys %$fser; }
183  if (my $fsh = lookupFontShape($shapecode)) {
184    map { $props{$_} = $$fsh{$_} } keys %$fsh; }
185  return %props; }
186
187#======================================================================
188# NOTE:  Would it make sense to allow compnents to be `inherit' ??
189
190# Note: forcefamily, forceseries, forceshape (& forcebold for compatibility)
191# are only useful for fonts in math; See the specialize method below.
192sub new {
193  my ($class, %options) = @_;
194  my $family    = $options{family};
195  my $series    = $options{series};
196  my $shape     = $options{shape};
197  my $size      = $options{size};
198  my $color     = $options{color};
199  my $bg        = $options{background};
200  my $opacity   = $options{opacity};
201  my $encoding  = $options{encoding};
202  my $language  = $options{language};
203  my $mathstyle = $options{mathstyle};
204
205  if ($options{forcebold}) {    # for compatibility
206    $series = 'bold'; $options{forceseries} = 1; }
207  my $flags = 0
208    | ($options{forcefamily} ? $FLAG_FORCE_FAMILY : 0)
209    | ($options{forceseries} ? $FLAG_FORCE_SERIES : 0)
210    | ($options{forceshape}  ? $FLAG_FORCE_SHAPE  : 0);
211  return $class->new_internal(
212    $family,    $series, $shape, rationalizeFontSize($size),
213    $color,     $bg,     $opacity,
214    $encoding,  $language,
215    $mathstyle, $flags); }
216
217sub new_internal {
218  my ($class, @components) = @_;
219  return bless [@components], $class; }
220
221sub textDefault {
222  my ($self) = @_;
223  return $self->new_internal($DEFFAMILY, $DEFSERIES, $DEFSHAPE, DEFSIZE(),
224    $DEFCOLOR, $DEFBACKGROUND, $DEFOPACITY, $DEFENCODING, $DEFLANGUAGE, undef, 0); }
225
226sub mathDefault {
227  my ($self) = @_;
228  return $self->new_internal('math', $DEFSERIES, 'italic', DEFSIZE(),
229    $DEFCOLOR, $DEFBACKGROUND, $DEFOPACITY, undef, $DEFLANGUAGE, 'text', 0); }
230
231# Accessors
232# Using an array here is getting ridiculous!
233sub getFamily     { my ($self) = @_; return $$self[0]; }
234sub getSeries     { my ($self) = @_; return $$self[1]; }
235sub getShape      { my ($self) = @_; return $$self[2]; }
236sub getSize       { my ($self) = @_; return $$self[3]; }
237sub getColor      { my ($self) = @_; return $$self[4]; }
238sub getBackground { my ($self) = @_; return $$self[5]; }
239sub getOpacity    { my ($self) = @_; return $$self[6]; }
240sub getEncoding   { my ($self) = @_; return $$self[7]; }
241sub getLanguage   { my ($self) = @_; return $$self[8]; }
242sub getMathstyle  { my ($self) = @_; return $$self[9]; }
243sub getFlags      { my ($self) = @_; return $$self[10]; }
244
245sub toString {
246  my ($self) = @_;
247  return "Font[" . join(',', map { (defined $_ ? ToString($_) : '*') } @{$self}) . "]"; }
248
249# Perhaps it is more useful to list only the non-default components?
250sub stringify {
251  my ($self) = @_;
252  my ($fam, $ser, $shp, $siz, $col, $bkg, $opa, $enc, $lang, $mstyle, $flags) = @$self;
253  $fam = 'serif' if $fam && ($fam eq 'math');
254  return 'Font[' . join(',', map { Stringify($_) } grep { $_ }
255      (isDiff($fam, $DEFFAMILY)   ? ($fam)    : ()),
256    (isDiff($ser, $DEFSERIES)     ? ($ser)    : ()),
257    (isDiff($shp, $DEFSHAPE)      ? ($shp)    : ()),
258    (isDiff($siz, DEFSIZE())      ? ($siz)    : ()),
259    (isDiff($col, $DEFCOLOR)      ? ($col)    : ()),
260    (isDiff($bkg, $DEFBACKGROUND) ? ($bkg)    : ()),
261    (isDiff($opa, $DEFOPACITY)    ? ($opa)    : ()),
262    ($mstyle                      ? ($mstyle) : ()),
263    ($flags                       ? ($flags)  : ()),
264    )
265    . ']'; }
266
267sub equals {
268  my ($self, $other) = @_;
269  return (defined $other) && ((ref $self) eq (ref $other))
270    && (join('|', map { (defined $_ ? $_ : '*') } @$self)
271    eq join('|', map { (defined $_ ? $_ : '*') } @$other)); }
272
273sub match {
274  my ($self, $other) = @_;
275  return 1 unless defined $other;
276  return 0 unless (ref $self) eq (ref $other);
277  my @comp  = @$self;
278  my @ocomp = @$other;
279  # If any components are defined in both fonts, they must be equal.
280  while (@comp) {
281    my $c  = shift @comp;
282    my $oc = shift @ocomp;
283    return 0 if (defined $c) && (defined $oc) && ($c ne $oc); }
284  return 1; }
285
286sub makeConcrete {
287  my ($self, $concrete) = @_;
288  my ($family, $series, $shape, $size, $color, $bg, $opacity, $encoding, $lang, $mstyle, $flags) = @$self;
289  my ($ofamily, $oseries, $oshape, $osize, $ocolor, $obg, $oopacity, $oencoding, $olang, $omstyle, $oflags) = @$concrete;
290  return (ref $self)->new_internal(
291    $family   || $ofamily,   $series || $oseries, $shape || $oshape, $size || $osize,
292    $color    || $ocolor,    $bg     || $obg, (defined $opacity ? $opacity : $oopacity),
293    $encoding || $oencoding, $lang   || $olang, $mstyle || $omstyle,
294    ($flags || 0) | ($oflags || 0)); }
295
296sub isDiff {
297  my ($x, $y) = @_;
298  return (defined $x) && (!(defined $y) || ($x ne $y)); }
299
300# This method compares 2 fonts, returning the differences between them.
301# Noting that the font-related attributes in the schema distill the
302# font properties into fewer attributes (font,fontsize,color,background,opacity),
303# the return value encodes both the attribute changes that would be needed to effect
304# the font change, along with the font properties that differed
305# Namely, the result is a hash keyed on the attribute name and whose value is a hash
306#    value      => "new_attribute_value"
307#    properties => { %fontproperties }
308# Note in particular 2 interesting keys
309#   element: can specify the element tagname to use for wrapping instead of ltx:text
310#   class: can be used to add a class attribute to the wrapping element
311sub relativeTo {
312  my ($self, $other) = @_;
313  my ($fam,  $ser,  $shp,  $siz,  $col,  $bkg,  $opa,  $enc,  $lang,  $mstyle,  $flags)  = @$self;
314  my ($ofam, $oser, $oshp, $osiz, $ocol, $obkg, $oopa, $oenc, $olang, $omstyle, $oflags) = @$other;
315  $fam  = 'serif' if $fam  && ($fam eq 'math');
316  $ofam = 'serif' if $ofam && ($ofam eq 'math');
317##  my $emph = 0;
318##  $emph ||= $shp && $shp =~ s/^emph-//;
319## ##  $emph ||= $oshp && $oshp =~ s/^emph-//;
320##   $oshp && $oshp =~ s/^emph-//;
321  my @diffs = (
322    (isDiff($fam, $ofam) ? ($fam) : ()),
323    (isDiff($ser, $oser) ? ($ser) : ()),
324    (isDiff($shp, $oshp) ? ($shp) : ()));
325  return (
326    (@diffs ?
327        (font => { value => join(' ', @diffs),
328          properties => { (isDiff($fam, $ofam) ? (family => $fam) : ()),
329            (isDiff($ser, $oser) ? (series => $ser) : ()),
330            (isDiff($shp, $oshp) ? (shape  => $shp) : ()) } })
331      : ()),
332    (isDiff($siz, $osiz)
333###      ? (fontsize => { value => $siz, properties => { size => $siz } })
334      ? (fontsize => { value => relativeFontSize($siz, $osiz), properties => { size => $siz } })
335      : ()),
336    (isDiff($col, $ocol)
337      ? (color => { value => $col, properties => { color => $col } })
338      : ()),
339    (isDiff($bkg, $obkg)
340      ? (backgroundcolor => { value => $bkg, properties => { background => $bkg } })
341      : ()),
342    (isDiff($opa, $oopa)
343      ? (opacity => { value => $opa, properties => { opacity => $opa } })
344      : ()),
345    (isDiff($lang, $olang)
346      ? ('xml:lang' => { value => $lang, properties => { language => $lang } })
347      : ()),
348    (!$mstyle && $flags && ($flags & $FLAG_EMPH) && (!$oflags || !($oflags & $FLAG_EMPH))
349      ? (
350        #         class => { value => 'ltx_emph' },
351        element => { value => 'ltx:emph' }
352        )
353      : ()),
354    ### Contemplate this: We do NOT want mathstyle showing up (automatically) in the attributes
355    ### So, we presumably want to ignore differences in mathstyle
356    ### They shouldn't (by themselves) affect the display?
357###    (isDiff($mstyle, $omstyle)
358###      ? ('mathstyle' => { value => $mstyle, properties => { mathstyle => $mstyle } })
359###      : ()),
360  ); }
361
362sub distance {
363  my ($self, $other) = @_;
364  my ($fam,  $ser,  $shp,  $siz,  $col,  $bkg,  $opa,  $enc,  $lang,  $mstyle,  $flags)  = @$self;
365  my ($ofam, $oser, $oshp, $osiz, $ocol, $obkg, $oopa, $oenc, $olang, $omstyle, $oflags) = @$other;
366  $fam  = 'serif' if $fam  && ($fam eq 'math');
367  $ofam = 'serif' if $ofam && ($ofam eq 'math');
368  return
369    (isDiff($fam, $ofam) ? 1 : 0)
370    + (isDiff($ser, $oser) ? 1 : 0)
371    + (isDiff($shp, $oshp) ? 1 : 0)
372    + (isDiff($siz, $osiz) ? 1 : 0)
373    + (isDiff($col, $ocol) ? 1 : 0)
374    + (isDiff($bkg, $obkg) ? 1 : 0)
375    + (isDiff($opa, $oopa) ? 1 : 0)
376##  + (isDiff($enc,$oenc)  ? 1 : 0)
377    + (isDiff($lang, $olang) ? 1 : 0)
378    # Let's not consider mathstyle differences here, either.
379###    + (isDiff($mstyle, $omstyle) ? 1 : 0)
380    + (($flags & $FLAG_EMPH) ^ ($oflags & $FLAG_EMPH) ? 1 : 0)
381    ; }
382
383# This matches fonts when both are converted to strings (toString),
384# such as when they are set as attributes.
385# This accumulates regular expressions used by match_font
386# (which, in turn, is used in various XPath searches!)
387# It is NOT really Daemon safe....
388# Need to work out how to do this and/or cache it in STATE????
389our %FONT_REGEXP_CACHE = ();
390
391sub match_font {
392  my ($font1, $font2) = @_;
393  my $regexp = $FONT_REGEXP_CACHE{$font1};
394  if (!$regexp) {
395    if ($font1 =~ /^Font\[(.*)\]$/) {
396      my @comp = split(',', $1);
397      my $re   = '^Font\['
398        . join(',', map { ($_ eq '*' ? "[^,]+" : "\Q$_\E") } @comp)
399        . '\]$';
400      $regexp = $FONT_REGEXP_CACHE{$font1} = qr/$re/; } }
401  return $font2 =~ /$regexp/; }
402
403sub XXXfont_match_xpaths {
404  my ($font) = @_;
405  if ($font =~ /^Font\[(.*)\]$/) {
406    my @comps = split(',', $1);
407    my ($frag, @frags) = ();
408    for (my $i = 0 ; $i <= $#comps ; $i++) {
409      my $comp = $comps[$i];
410      if ($comp eq '*') {
411        push(@frags, $frag) if $frag;
412        $frag = undef; }
413      else {
414        my $post = ($i == $#comps ? ']' : ',');
415        if ($frag) {
416          $frag .= $comp . $post; }
417        else {
418          $frag = ($i == 0 ? 'Font[' : ',') . $comp . $post; } } }
419    push(@frags, $frag) if $frag;
420    return join(' and ', '@_font',
421      map { "contains(\@_font,'$_')" } @frags); } }
422
423sub font_match_xpaths {
424  my ($font) = @_;
425  if ($font =~ /^Font\[(.*)\]$/) {
426    my ($family, $series, $shape, $size, $color, $bg, $opacity, $encoding, $language,
427      $mstyle, $force) = split(',', $1);
428    # Ignore differences in:
429    #    size, background, opacity, encoding, language(?), mathstyle,
430    # force bits assumed NOT relevant, also.
431    # For now, ignore color, too
432    my @frags = ();
433    push(@frags, '[' . $family . ',') if ($family ne '*');
434    push(@frags, ',' . $series . ',') if ($series ne '*');
435    push(@frags, ',' . $shape . ',')  if ($shape ne '*');
436    #    push(@frags, ',' . $color . ',')  if ($color ne '*');
437    return join(' and ', '@_font',
438      map { "contains(\@_font,'$_')" } @frags); } }
439
440# # Presumably a text font is "sticky", if used in math?
441# sub isSticky { return 1; }
442
443#======================================================================
444our %mathstylesize = (display => 1, text => 1,
445  script => 0.7, scriptscript => 0.5);
446
447# NOTE: that we assume the size has already been adjusted for mathstyle, if necessary.
448sub computeStringSize {
449  my ($self, $string) = @_;
450  if ((!defined $string) || ($string eq '') || ($self->getFamily eq 'nullfont')) {
451    return (Dimension(0), Dimension(0), Dimension(0)); }
452  my $size = ($self->getSize || DEFSIZE() || 10); ## * $mathstylesize{ $self->getMathstyle || 'text' };
453  my $l    = (defined $string ? length($string) : 0);
454  my $u    = $size * 65535;
455  return (Dimension(0.75 * $u * $l), Dimension(0.7 * $u), Dimension(0.2 * $u)); }
456
457# Get nominal width, height base ?
458sub getNominalSize {
459  my ($self) = @_;
460  my $size = ($self->getSize || DEFSIZE() || 10); ## * $mathstylesize{ $self->getMathstyle || 'text' };
461  my $u    = $size * 65535;
462  return (Dimension(0.75 * $u), Dimension(0.7 * $u), Dimension(0.2 * $u)); }
463
464# Here's where I avoid trying to emulate Knuth's line-breaking...
465# Mostly for List & Whatsit: compute the size of a list of boxes.
466# Options _SHOULD_ include:
467#   width:  if given, pretend to simulate line breaking to that width
468#   height,depth : ?
469#   vattach : top, bottom, center, baseline (...?) affects how the height & depth are
470#      allocated when there are multiple lines.
471#   layout : horizontal or vertical !!!
472# Boxes that arent a Core Box, List, Whatsit or a string are IGNORED
473#
474# The big problem with width is to have it propogate down from where
475# it may have been specified to the actual nested box that will get wrapped!
476# Try to mask this (temporarily) by unlisting, and (pretending to ) breaking up too wide items
477#
478# Another issue; SVG needs (sometimes) real sizes, even if the programmer
479# set some dimensions to 0 (eg.)   We may need to distinguish & store
480# requested vs real sizes?
481sub computeBoxesSize {
482  my ($self, $boxes, %options) = @_;
483  my $font      = (ref $self ? $self : $STATE->lookupValue('font'));
484  my $fillwidth = $options{width};
485  if ((!defined $fillwidth) && ($fillwidth = $STATE->lookupDefinition(T_CS('\textwidth')))) {
486    $fillwidth = $fillwidth->valueOf; }    # get register
487  my $maxwidth = $fillwidth && $fillwidth->valueOf;
488  my @lines    = ();
489  my ($wd, $ht, $dp)          = (0, 0, 0);
490  my ($minwd, $minht, $mindp) = (0, 0, 0);
491  my $vattach = $options{vattach} || 'baseline';
492  no warnings 'recursion';
493  # Flatten top-level Lists (orrr pass-thru $fillwidth ???)
494  my @boxes = map { (ref $_ eq 'LaTeXML::Core::List' ? $_->unlist : $_); } @$boxes;
495  foreach my $box (@boxes) {
496    next unless defined $box;
497    next if ref $box && !$box->can('getSize');    # Care!! Since we're asking ALL args/compoments
498    ## Should any %options be inherited by the contained boxes?
499    my ($w, $h, $d) = (ref $box ? $box->getSize() : $font->computeStringSize($box));
500    if (ref $w) {
501      $wd += $w->valueOf; }
502    else {
503      Warn('expected', 'Dimension', undef,
504        "Width of " . Stringify($box) . " yielded a non-dimension: " . Stringify($w)); }
505    if (ref $h) {
506      $ht = max($ht, $h->valueOf); }
507    else {
508      Warn('expected', 'Dimension', undef,
509        "Height of " . Stringify($box) . " yielded a non-dimension: " . Stringify($h)); }
510    if (ref $d) {
511      $dp = max($dp, $d->valueOf); }
512    else {
513      Warn('expected', 'Dimension', undef,
514        "Depth of " . Stringify($box) . " yielded a non-dimension: " . Stringify($d)); }
515    if ((($options{layout} || '') eq 'vertical')    # EVERY box is a row?
516      || ((ref $box) && $box->getProperty('isBreak'))) {    # || $box is a linebreak
517      push(@lines, [$wd, $ht, $dp]); $wd = $ht = $dp = 0; }
518    elsif ((defined $maxwidth) && ($wd >= $maxwidth)) {     # or we've reached the requested width
519          # Instead of a real linebreaking algorithm, just break off if too wide.
520      push(@lines, [$wd, $ht, $dp]); $wd = $ht = $dp = 0; }
521  }
522  if ($wd) {    # be sure to get last line
523    push(@lines, [$wd, $ht, $dp]); }
524  # Deal with multiple lines
525  my $nlines = scalar(@lines);
526  if ($nlines == 0) {
527    $wd = $ht = $dp = 0; }
528  else {
529    $wd = max(map { $$_[0] } @lines);
530    $ht = sum(map { $$_[1] } @lines);
531    $dp = sum(map { $$_[2] } @lines);
532    if ($vattach eq 'top') {    # Top of box is aligned with top(?) of current text
533      my ($w, $h, $d) = $font->getNominalSize;
534      $h  = $h->valueOf;
535      $dp = $ht + $dp - $h; $ht = $h; }
536    elsif ($vattach eq 'bottom') {    # Bottom of box is aligned with bottom (?) of current text
537      $ht = $ht + $dp; $dp = 0; }
538    elsif ($vattach eq 'middle') {
539      my ($w, $h, $d) = $font->getNominalSize;
540      $h = $h->valueOf;
541      my $c = ($ht + $dp) / 2;
542      $ht = $c + $h / 2; $dp = $c - $h / 2; }
543    else {                            # default is baseline (of the 1st line)
544      my $h = $lines[0][1];
545      $dp = $ht + $dp - $h; $ht = $h; } }
546  $wd = max($minwd, $wd); $ht = max($minht, $ht); $dp = max($mindp, $dp);
547  #print "BOXES SIZE ".($wd/65536)." x ".($ht/65536)." + ".($dp/65336)." for "
548  #  .join(' ',grep {$_} map { Stringify($_) } @$boxes)."\n";
549  Debug("Size boxes " . join(',', map { $_ . '=' . ToString($options{$_}); } sort keys %options) . "\n"
550      . "  Boxes: " . join(',',  map { '[[' . ToString($_) . ']]'; } @$boxes) . "\n"
551      . "  Sizes: " . join("\n", map { _showsize(@$_); } @lines) . "\n"
552      . "  => " . _showsize($wd, $ht, $dp)) if $LaTeXML::DEBUG{'size-detailed'};
553  return (Dimension($wd), Dimension($ht), Dimension($dp)); }
554
555sub _showsize {
556  my ($wd, $ht, $dp) = @_;
557  return ($wd / 65536) . " x " . ($ht / 65536) . " + " . ($dp / 65336); }
558
559sub isSticky {
560  my ($self) = @_;
561  return $$self[0] && ($$self[0] =~ /^(?:serif|sansserif|typewriter)$/); }
562
563our %scriptstylemap = (display => 'script', text => 'script',
564  script => 'scriptscript', scriptscript => 'scriptscript');
565our %fracstylemap = (display => 'text', text => 'script',
566  script => 'scriptscript', scriptscript => 'scriptscript');
567our %stylesize = (display => 10, text => 10,
568  script => 7, scriptscript => 5);
569
570# NOTE: In math, NORMALLY, setting any one of
571#    family, series or shape
572# will, usually, automatically reset the others to thier defaults!
573# You must arrange this in the calls....
574sub merge {
575  my ($self, %options) = @_;
576  # Evaluate any functional values given.
577  foreach my $k (keys %options) {
578    $options{$k} = &{ $options{$k} }() if ref $options{$k} eq 'CODE'; }
579
580  my $family    = $options{family};
581  my $series    = $options{series};
582  my $shape     = $options{shape};
583  my $size      = rationalizeFontSize($options{size});
584  my $color     = $options{color};
585  my $bg        = $options{background};
586  my $opacity   = $options{opacity};
587  my $encoding  = $options{encoding};
588  my $language  = $options{language};
589  my $mathstyle = $options{mathstyle};
590
591  if ($options{forcebold}) {    # for compatibility
592    $series = 'bold'; $options{forceseries} = 1; }
593  my $flags = 0
594    | ($options{forcefamily} ? $FLAG_FORCE_FAMILY : 0)
595    | ($options{forceseries} ? $FLAG_FORCE_SERIES : 0)
596    | ($options{forceshape}  ? $FLAG_FORCE_SHAPE  : 0);
597
598  my $oflags = $$self[10];
599  # Fallback to positional invocation:
600  $family    = $$self[0] if (!defined $family) || ($oflags & $FLAG_FORCE_FAMILY);
601  $series    = $$self[1] if (!defined $series) || ($oflags & $FLAG_FORCE_SERIES);
602  $shape     = $$self[2] if (!defined $shape)  || ($oflags & $FLAG_FORCE_SHAPE);
603  $size      = $$self[3] if (!defined $size);
604  $color     = $$self[4] if (!defined $color);
605  $bg        = $$self[5] if (!defined $bg);
606  $opacity   = $$self[6] if (!defined $opacity);
607  $encoding  = $$self[7] if (!defined $encoding);
608  $language  = $$self[8] if (!defined $language);
609  $mathstyle = $$self[9] if (!defined $mathstyle);
610  $flags     = ($$self[10] || 0) | $flags;
611
612  if (my $scale = $options{scale}) {
613    $size = $scale * $size; }
614  # Set the mathstyle, and also the size from the mathstyle
615  # But we may need to scale that size against the existing or requested size.
616  my $stylescale = ($$self[3] ? $$self[3] / $stylesize{ $$self[9] || 'display' } : 1);
617  if    ($options{size}) { }       # Explicitly requested size, use it
618  elsif ($options{mathstyle}) {    # otherwise set the size from mathstyle
619    $size = $stylescale * $stylesize{$mathstyle}; }
620  elsif ($options{scripted}) {     # Or adjust both the mathstyle & size for scripts
621    $mathstyle = $scriptstylemap{ $mathstyle          || 'display' };
622    $size      = $stylescale * $stylesize{ $mathstyle || 'display' }; }
623  elsif ($options{fraction}) {     # Or adjust both for fractions
624    $mathstyle = $fracstylemap{ $mathstyle            || 'display' };
625    $size      = $stylescale * $stylesize{ $mathstyle || 'display' }; }
626
627  if ($options{emph}) {
628    $shape = ($shape eq 'italic' ? 'upright' : 'italic');
629    $flags |= $FLAG_EMPH; }
630  $flags &= ~$FLAG_EMPH if $mathstyle;    # Disable emph in math
631
632  my $newfont = (ref $self)->new_internal($family, $series, $shape, $size,
633    $color,     $bg, $opacity,
634    $encoding,  $language,
635    $mathstyle, $flags);
636  if (my $specialize = $options{specialize}) {
637    $newfont = $newfont->specialize($specialize); }
638  return $newfont; }
639
640# Instanciate the font for a particular class of symbols.
641# NOTE: This works in `normal' latex, but probably needs some tunability.
642# Depending on the fonts being used, the allowable combinations may be different.
643# Getting the font right is important, since the author probably
644# thinks of the identity of the symbols according to what they SEE in the printed
645# document.  Even though the markup might seem to indicate something else...
646
647# Use Unicode properties to determine font merging.
648sub specialize {
649  my ($self, $string) = @_;
650  return $self if !(defined $string) || ref $string;    # ?
651  my ($family, $series, $shape, $size, $color, $bg, $opacity,
652    $encoding, $language, $mathstyle, $flags) = @$self;
653  my $deffamily = ($flags & $FLAG_FORCE_FAMILY ? $family || $DEFFAMILY : $DEFFAMILY);
654  my $defseries = ($flags & $FLAG_FORCE_SERIES ? $series || $DEFSERIES : $DEFSERIES);
655  my $defshape  = ($flags & $FLAG_FORCE_SHAPE  ? $shape  || $DEFSHAPE  : $DEFSHAPE);
656  if (($string =~ /^\p{Latin}$/) && ($string =~ /^\p{L}$/)) {    # Latin Letter
657    $shape = 'italic' if !$shape && !$family; }
658  elsif ($string =~ /^\p{Greek}$/) {                             # Single Greek character?
659    if ($string =~ /^\p{Lu}$/) {                                 # Uppercase
660      if (!$family || ($family eq 'math')) {
661        $family = $deffamily;
662        $shape  = $defshape if $shape && ($shape ne $DEFSHAPE); } }    # if ANY shape, must be default
663    else {                                                             # Lowercase
664      $family = $deffamily if !$family || ($family ne $DEFFAMILY);
665      $shape  = 'italic'   if !$shape  || !($flags & $FLAG_FORCE_SHAPE);    # always ?
666      if ($series && ($series ne $DEFSERIES)) { $series = $defseries; }
667  } }
668  elsif ($string =~ /^\p{N}$/) {                                            # Digit
669    if (!$family || ($family eq 'math')) {
670      $family = $deffamily;
671      $shape  = $defshape; } }                                              # defaults, always.
672  else {                                                                    # Other Symbol
673    $family = $deffamily;
674    $shape  = $defshape;                                                    # defaults, always.
675    if ($series && ($series ne $DEFSERIES)) { $series = $defseries; } }
676  return (ref $self)->new_internal($family, $series, $shape, $size,
677    $color,    $bg, $opacity,
678    $encoding, $language, $mathstyle, $flags); }
679
680# A special form of merge when copying/moving nodes to a new context,
681# particularly math which become scripts or such.
682our %mathstylestep = (
683  display      => { display => 0,  text => 1,  script => 2,  scriptscript => 3 },
684  text         => { display => -1, text => 0,  script => 1,  scriptscript => 2 },
685  script       => { display => -2, text => -1, script => 0,  scriptscript => 1 },
686  scriptscript => { display => -3, text => -2, script => -1, scriptscript => 0 });
687our %stepmathstyle = (
688  display => { -3 => 'display', -2 => 'display', -1 => 'display',
689    0 => 'display', 1 => 'text', 2 => 'script', 3 => 'scriptscript' },
690  text => { -3 => 'display', -2 => 'display', -1 => 'display',
691    0 => 'text', 1 => 'script', 2 => 'scriptscript', 3 => 'scriptscript' },
692  script => { -3 => 'display', -2 => 'display', -1 => 'text',
693    0 => 'script', 1 => 'scriptscript', 2 => 'scriptscript', 3 => 'scriptscript' },
694  scriptscript => { -3 => 'display', -2 => 'text', -1 => 'script',
695    0 => 'scriptscript', 1 => 'scriptscript', 2 => 'scriptscript', 3 => 'scriptscript' });
696
697sub purestyleChanges {
698  my ($self, $other) = @_;
699  my $mathstyle      = $self->getMathstyle;
700  my $othermathstyle = $other->getMathstyle;
701  my $othercolor     = $other->getColor;
702  return (
703    scale => $other->getSize / $self->getSize,
704    (isDiff($othercolor, $DEFCOLOR) ? (color => $othercolor) : ()),
705    background => $other->getBackground,
706    opacity    => $other->getOpacity,      # should multiply or replace?
707    ($mathstyle && $othermathstyle
708      ? (mathstylestep => $mathstylestep{$mathstyle}{$othermathstyle})
709      : ()),
710  ); }
711
712sub mergePurestyle {
713  my ($self, %stylechanges) = @_;
714  my $new = $self->new_internal(@$self);
715  $$new[3] = $$self[3] * $stylechanges{scale}                            if $stylechanges{scale};
716  $$new[4] = $stylechanges{color}                                        if $stylechanges{color};
717  $$new[5] = $stylechanges{background}                                   if $stylechanges{background};
718  $$new[6] = $stylechanges{opacity}                                      if $stylechanges{opacity};
719  $$new[9] = $stepmathstyle{ $$self[9] }{ $stylechanges{mathstylestep} } if $stylechanges{mathstylestep};
720  return new; }
721
722#**********************************************************************
7231;
724
725__END__
726
727=pod
728
729=head1 NAME
730
731C<LaTeXML::Common::Font> - representation of fonts
732
733=head1 DESCRIPTION
734
735C<LaTeXML::Common::Font> represent fonts in LaTeXML.
736It extends L<LaTeXML::Common::Object>.
737
738This module defines Font objects.
739I'm not completely happy with the arrangement, or
740maybe just the use of it, so I'm not going to document extensively at this point.
741
742The attributes are
743
744 family : serif, sansserif, typewriter, caligraphic,
745          fraktur, script
746 series : medium, bold
747 shape  : upright, italic, slanted, smallcaps
748 size   : TINY, Tiny, tiny, SMALL, Small, small,
749          normal, Normal, large, Large, LARGE,
750          huge, Huge, HUGE, gigantic, Gigantic, GIGANTIC
751 color  : any named color, default is black
752
753They are usually merged against the current font, attempting to mimic the,
754sometimes counter-intuitive, way that TeX does it,  particularly for math
755
756=head1 Methods
757
758=over 4
759
760=item  C<< $font->specialize($string); >>
761
762In math mode, C<LaTeXML::Common::Font> supports computing a font reflecting
763how the specific C<$string> would be printed when
764C<$font> is active; This (attempts to) handle the curious ways that lower case
765greek often doesn't get a different font.  In particular, it recognizes the
766following classes of strings: single latin letter, single uppercase greek character,
767single lowercase greek character, digits, and others.
768
769=back
770
771=head1 AUTHOR
772
773Bruce Miller <bruce.miller@nist.gov>
774
775=head1 COPYRIGHT
776
777Public domain software, produced as part of work done by the
778United States Government & not subject to copyright in the US.
779
780=cut
781