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