w32uniscribe.c 46.8 KB
Newer Older
1
/* Font backend for the Microsoft W32 Uniscribe API.
2
   Windows-specific parts of the HarfBuzz font backend.
Paul Eggert's avatar
Paul Eggert committed
3
   Copyright (C) 2008-2019 Free Software Foundation, Inc.
4 5 6

This file is part of GNU Emacs.

7
GNU Emacs is free software: you can redistribute it and/or modify
8
it under the terms of the GNU General Public License as published by
9 10
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
11 12 13 14 15 16 17

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
Paul Eggert's avatar
Paul Eggert committed
18
along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
19 20 21


#include <config.h>
Eli Zaretskii's avatar
Eli Zaretskii committed
22 23
/* Override API version - Uniscribe is only available as standard
   since Windows 2000, though most users of older systems will have it
24
   since it installs with Internet Explorer 5.0 and other software.
Eli Zaretskii's avatar
Eli Zaretskii committed
25 26 27 28
   Also, MinGW64 w32api headers by default define OPENTYPE_TAG typedef
   only if _WIN32_WINNT >= 0x0600.  We only use the affected APIs if
   they are available, so there is no chance of calling non-existent
   functions.  */
29
#undef _WIN32_WINNT
Eli Zaretskii's avatar
Eli Zaretskii committed
30
#define _WIN32_WINNT 0x0600
31 32
#include <windows.h>
#include <usp10.h>
33 34 35 36 37 38 39 40 41
#ifdef HAVE_HARFBUZZ
# include <math.h>	/* for lround */
# include <hb.h>
# if GNUC_PREREQ (4, 3, 0)
#  define bswap_32(v)  __builtin_bswap32(v)
# else
#  include <byteswap.h>
# endif
#endif
42 43 44 45

#include "lisp.h"
#include "w32term.h"
#include "frame.h"
46
#include "composite.h"
47 48
#include "font.h"
#include "w32font.h"
Daniel Colascione's avatar
Daniel Colascione committed
49
#include "pdumper.h"
50
#include "w32common.h"
51

52
/* Extension of w32font_info used by Uniscribe and HarfBuzz backends.  */
53 54 55
struct uniscribe_font_info
{
  struct w32font_info w32_font;
56 57 58 59 60 61
  /* This is used by the Uniscribe backend as a pointer to the script
     cache, and by the HarfBuzz backend as a pointer to a hb_font_t
     object.  */
  void *cache;
  /* This is used by the HarfBuzz backend to store the font scale.  */
  double scale;
62 63 64 65 66
};

int uniscribe_available = 0;

/* EnumFontFamiliesEx callback.  */
67 68 69
static int CALLBACK ALIGN_STACK add_opentype_font_name_to_list (ENUMLOGFONTEX *,
								NEWTEXTMETRICEX *,
								DWORD, LPARAM);
70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
#ifdef HAVE_HARFBUZZ

struct font_driver harfbuzz_font_driver;
int harfbuzz_available = 0;

/* Typedefs for HarfBuzz functions which we call through function
   pointers initialized after we load the HarfBuzz DLL.  */
DEF_DLL_FN (hb_blob_t *, hb_blob_create,
	    (const char *, unsigned int, hb_memory_mode_t, void *,
	     hb_destroy_func_t));
DEF_DLL_FN (hb_face_t *, hb_face_create_for_tables,
	    (hb_reference_table_func_t, void *, hb_destroy_func_t));
DEF_DLL_FN (unsigned, hb_face_get_glyph_count, (const hb_face_t *));
DEF_DLL_FN (hb_font_t *, hb_font_create, (hb_face_t *));
DEF_DLL_FN (void, hb_font_destroy, (hb_font_t *));
DEF_DLL_FN (void, hb_face_destroy, (hb_face_t *));
DEF_DLL_FN (unsigned int, hb_face_get_upem, (hb_face_t *));
DEF_DLL_FN (hb_bool_t, hb_font_get_nominal_glyph,
	    (hb_font_t *, hb_codepoint_t, hb_codepoint_t *));

#define hb_blob_create fn_hb_blob_create
#define hb_face_create_for_tables fn_hb_face_create_for_tables
#define hb_face_get_glyph_count fn_hb_face_get_glyph_count
#define hb_font_create fn_hb_font_create
#define hb_font_destroy fn_hb_font_destroy
#define hb_face_destroy fn_hb_face_destroy
#define hb_face_get_upem fn_hb_face_get_upem
#define hb_font_get_nominal_glyph fn_hb_font_get_nominal_glyph
#endif

100
/* Used by uniscribe_otf_capability.  */
101
static Lisp_Object otf_features (HDC context, const char *table);
102 103

static int
104
memq_no_quit (Lisp_Object elt, Lisp_Object list)
105 106 107 108 109 110 111 112 113
{
  while (CONSP (list) && ! EQ (XCAR (list), elt))
    list = XCDR (list);
  return (CONSP (list));
}


/* Font backend interface implementation.  */
static Lisp_Object
Dmitry Antipov's avatar
Dmitry Antipov committed
114
uniscribe_list (struct frame *f, Lisp_Object font_spec)
115
{
116
  Lisp_Object fonts = w32font_list_internal (f, font_spec, true);
117
  FONT_ADD_LOG ("uniscribe-list", font_spec, fonts);
118
  return fonts;
119 120 121
}

static Lisp_Object
Dmitry Antipov's avatar
Dmitry Antipov committed
122
uniscribe_match (struct frame *f, Lisp_Object font_spec)
123
{
124
  Lisp_Object entity = w32font_match_internal (f, font_spec, true);
125
  FONT_ADD_LOG ("uniscribe-match", font_spec, entity);
126
  return entity;
127 128 129
}

static Lisp_Object
Dmitry Antipov's avatar
Dmitry Antipov committed
130
uniscribe_list_family (struct frame *f)
131 132 133 134 135
{
  Lisp_Object list = Qnil;
  LOGFONT font_match_pattern;
  HDC dc;

136
  memset (&font_match_pattern, 0, sizeof (font_match_pattern));
137 138 139
  /* Limit enumerated fonts to outline fonts to save time.  */
  font_match_pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;

140 141 142 143 144 145
  /* Prevent quitting while EnumFontFamiliesEx runs and conses the
     list it will return.  That's because get_frame_dc acquires the
     critical section, so we cannot quit before we release it in
     release_frame_dc.  */
  Lisp_Object prev_quit = Vinhibit_quit;
  Vinhibit_quit = Qt;
146 147 148 149 150 151
  dc = get_frame_dc (f);

  EnumFontFamiliesEx (dc, &font_match_pattern,
                      (FONTENUMPROC) add_opentype_font_name_to_list,
                      (LPARAM) &list, 0);
  release_frame_dc (f, dc);
152
  Vinhibit_quit = prev_quit;
153 154 155 156

  return list;
}

157
static Lisp_Object
Dmitry Antipov's avatar
Dmitry Antipov committed
158
uniscribe_open (struct frame *f, Lisp_Object font_entity, int pixel_size)
159
{
160
  Lisp_Object font_object
161 162
    = font_make_object (VECSIZE (struct uniscribe_font_info),
			font_entity, pixel_size);
163
  struct uniscribe_font_info *uniscribe_font
164
    = (struct uniscribe_font_info *) XFONT_OBJECT (font_object);
165

166 167 168 169
  if (!NILP (AREF (font_entity, FONT_TYPE_INDEX)))
    ASET (font_object, FONT_TYPE_INDEX, AREF (font_entity, FONT_TYPE_INDEX));
  else	/* paranoia: this should never happen */
    ASET (font_object, FONT_TYPE_INDEX, Quniscribe);
170

171
  if (!w32font_open_internal (f, font_entity, pixel_size, font_object))
172
    {
173
      return Qnil;
174 175 176 177
    }

  /* Initialize the cache for this font.  */
  uniscribe_font->cache = NULL;
178

179
  /* Uniscribe and HarfBuzz backends use glyph indices.  */
180 181
  uniscribe_font->w32_font.glyph_idx = ETO_GLYPH_INDEX;

182 183 184 185 186 187
#ifdef HAVE_HARFBUZZ
  if (EQ (AREF (font_object, FONT_TYPE_INDEX), Qharfbuzz))
    uniscribe_font->w32_font.font.driver = &harfbuzz_font_driver;
  else
#endif  /* HAVE_HARFBUZZ */
    uniscribe_font->w32_font.font.driver = &uniscribe_font_driver;
188

189
  return font_object;
190 191 192
}

static void
193
uniscribe_close (struct font *font)
194 195 196 197
{
  struct uniscribe_font_info *uniscribe_font
    = (struct uniscribe_font_info *) font;

198 199 200 201 202 203
#ifdef HAVE_HARFBUZZ
  if (uniscribe_font->w32_font.font.driver == &harfbuzz_font_driver
      && uniscribe_font->cache)
    hb_font_destroy ((hb_font_t *) uniscribe_font->cache);
  else
#endif
204
  if (uniscribe_font->cache)
205 206 207
    ScriptFreeCache ((SCRIPT_CACHE) &(uniscribe_font->cache));

  uniscribe_font->cache = NULL;
208

209
  w32font_close (font);
210 211 212
}

/* Return a list describing which scripts/languages FONT supports by
213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232
   which GSUB/GPOS features of OpenType tables.

   Implementation note: otf_features called by this function uses
   GetFontData to access the font tables directly, instead of using
   ScriptGetFontScriptTags etc. APIs even if those are available.  The
   reason is that font-get, which uses the result of this function,
   expects a cons cell (GSUB . GPOS) where the features are reported
   separately for these 2 OTF tables, while the Uniscribe APIs report
   the features as a single list.  There doesn't seem to be a reason
   for returning the features in 2 separate parts, except for
   compatibility with libotf; the features are disjoint (each can
   appear only in one of the 2 slots), and no client of this data
   discerns between the two slots: the few that request this data all
   look in both slots.  If use of the Uniscribe APIs ever becomes
   necessary here, and the 2 separate slots are still required, it
   should be possible to split the feature list the APIs return into 2
   because each sub-list is alphabetically sorted, so the place where
   the sorting order breaks is where the GSUB features end and GPOS
   features begin.  But for now, this is not necessary, so we leave
   the original code in place.  */
233
static Lisp_Object
234
uniscribe_otf_capability (struct font *font)
235 236 237 238 239 240 241 242
{
  HDC context;
  HFONT old_font;
  struct frame *f;
  Lisp_Object capability = Fcons (Qnil, Qnil);
  Lisp_Object features;

  f = XFRAME (selected_frame);
243 244 245 246 247
  /* Prevent quitting while we cons the lists in otf_features.
     That's because get_frame_dc acquires the critical section, so we
     cannot quit before we release it in release_frame_dc.  */
  Lisp_Object prev_quit = Vinhibit_quit;
  Vinhibit_quit = Qt;
248
  context = get_frame_dc (f);
249
  old_font = SelectObject (context, FONT_HANDLE (font));
250 251 252 253 254 255 256 257

  features = otf_features (context, "GSUB");
  XSETCAR (capability, features);
  features = otf_features (context, "GPOS");
  XSETCDR (capability, features);

  SelectObject (context, old_font);
  release_frame_dc (f, context);
258
  Vinhibit_quit = prev_quit;
259 260 261 262 263 264

  return capability;
}

/* Uniscribe implementation of shape for font backend.

265 266 267 268 269
   Shape text in LGSTRING.  See the docstring of
   `composition-get-gstring' for the format of LGSTRING.  If the
   (N+1)th element of LGSTRING is nil, input of shaping is from the
   1st to (N)th elements.  In each input glyph, FROM, TO, CHAR, and
   CODE are already set.
270 271 272
   DIRECTION is either L2R or R2L, or nil if unknown.  During
   redisplay, this comes from applying the UBA, is passed from
   composition_reseat_it, and is used by the HarfBuzz shaper.
273 274 275 276 277

   This function updates all fields of the input glyphs.  If the
   output glyphs (M) are more than the input glyphs (N), (N+1)th
   through (M)th elements of LGSTRING are updated possibly by making
   a new glyph object and storing it in LGSTRING.  If (M) is greater
278 279
   than the length of LGSTRING, nil should be returned.  In that case,
   this function is called again with a larger LGSTRING.  */
280
static Lisp_Object
281
uniscribe_shape (Lisp_Object lgstring, Lisp_Object direction)
282
{
283 284 285
  struct font *font = CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring));
  struct uniscribe_font_info *uniscribe_font
    = (struct uniscribe_font_info *) font;
286
  EMACS_UINT nchars;
287
  int nitems, max_items, i, max_glyphs, done_glyphs;
288 289 290 291 292 293 294 295
  wchar_t *chars;
  WORD *glyphs, *clusters;
  SCRIPT_ITEM *items;
  SCRIPT_VISATTR *attributes;
  int *advances;
  GOFFSET *offsets;
  ABC overall_metrics;
  HRESULT result;
296 297 298
  struct frame * f = NULL;
  HDC context = NULL;
  HFONT old_font = NULL;
299 300

  /* Get the chars from lgstring in a form we can use with uniscribe.  */
301
  max_glyphs = nchars = LGSTRING_GLYPH_LEN (lgstring);
302
  done_glyphs = 0;
303
  chars = (wchar_t *) alloca (nchars * sizeof (wchar_t));
304 305 306
  /* FIXME: This loop assumes that characters in the input LGSTRING
     are all inside the BMP.  Need to encode characters beyond the BMP
     as UTF-16.  */
307 308 309 310 311 312 313 314 315 316 317 318 319 320
  for (i = 0; i < nchars; i++)
    {
      /* lgstring can be bigger than the number of characters in it, in
	 the case where more glyphs are required to display those characters.
         If that is the case, note the real number of characters.  */
      if (NILP (LGSTRING_GLYPH (lgstring, i)))
	nchars = i;
      else
	chars[i] = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, i));
    }

  /* First we need to break up the glyph string into runs of glyphs that
     can be treated together.  First try a single run.  */
  max_items = 2;
Dmitry Antipov's avatar
Dmitry Antipov committed
321
  items = xmalloc (sizeof (SCRIPT_ITEM) * max_items + 1);
322

323
  while ((result = ScriptItemize (chars, nchars, max_items, NULL, NULL,
324 325 326 327 328
				  items, &nitems)) == E_OUTOFMEMORY)
    {
      /* If that wasn't enough, keep trying with one more run.  */
      max_items++;
      items = (SCRIPT_ITEM *) xrealloc (items,
329
					sizeof (SCRIPT_ITEM) * max_items + 1);
330 331
    }

332
  if (FAILED (result))
333 334 335 336 337 338 339 340 341 342 343 344 345
    {
      xfree (items);
      return Qnil;
    }

  glyphs = alloca (max_glyphs * sizeof (WORD));
  clusters = alloca (nchars * sizeof (WORD));
  attributes = alloca (max_glyphs * sizeof (SCRIPT_VISATTR));
  advances = alloca (max_glyphs * sizeof (int));
  offsets = alloca (max_glyphs * sizeof (GOFFSET));

  for (i = 0; i < nitems; i++)
    {
346
      int nglyphs, nchars_in_run;
347
      nchars_in_run = items[i+1].iCharPos - items[i].iCharPos;
348 349 350 351
      /* Force ScriptShape to generate glyphs in the same order as
	 they are in the input LGSTRING, which is in the logical
	 order.  */
      items[i].a.fLogicalOrder = 1;
352

353 354
      /* Context may be NULL here, in which case the cache should be
         used without needing to select the font.  */
355
      result = ScriptShape (context, (SCRIPT_CACHE) &(uniscribe_font->cache),
356 357 358
			    chars + items[i].iCharPos, nchars_in_run,
			    max_glyphs - done_glyphs, &(items[i].a),
			    glyphs, clusters, attributes, &nglyphs);
359 360 361 362 363 364 365 366

      if (result == E_PENDING && !context)
	{
	  /* This assumes the selected frame is on the same display as the
	     one we are drawing.  It would be better for the frame to be
	     passed in.  */
	  f = XFRAME (selected_frame);
	  context = get_frame_dc (f);
367
	  old_font = SelectObject (context, FONT_HANDLE (font));
368

369
	  result = ScriptShape (context, (SCRIPT_CACHE) &(uniscribe_font->cache),
370 371 372 373 374
				chars + items[i].iCharPos, nchars_in_run,
				max_glyphs - done_glyphs, &(items[i].a),
				glyphs, clusters, attributes, &nglyphs);
	}

375 376 377 378 379 380
      if (result == E_OUTOFMEMORY)
	{
	  /* Need a bigger lgstring.  */
	  lgstring = Qnil;
	  break;
	}
381
      else if (FAILED (result))
382 383 384 385
	{
	  /* Can't shape this run - return results so far if any.  */
	  break;
	}
386 387 388 389 390 391
      else if (items[i].a.fNoGlyphIndex)
	{
	  /* Glyph indices not supported by this font (or OS), means we
	     can't really do any meaningful shaping.  */
	  break;
	}
392 393
      else
	{
394
	  result = ScriptPlace (context, (SCRIPT_CACHE) &(uniscribe_font->cache),
395 396
				glyphs, nglyphs, attributes, &(items[i].a),
				advances, offsets, &overall_metrics);
397 398 399 400 401
	  if (result == E_PENDING && !context)
	    {
	      /* Cache not complete...  */
	      f = XFRAME (selected_frame);
	      context = get_frame_dc (f);
402
	      old_font = SelectObject (context, FONT_HANDLE (font));
403

404 405
	      result = ScriptPlace (context,
				    (SCRIPT_CACHE) &(uniscribe_font->cache),
406 407 408 409
				    glyphs, nglyphs, attributes, &(items[i].a),
				    advances, offsets, &overall_metrics);
	    }
          if (SUCCEEDED (result))
410
	    {
411
	      int j, from, to, adj_offset = 0;
412
	      int cluster_offset = 0;
413

414
	      from = 0;
415
	      to = from;
416 417 418 419 420

	      for (j = 0; j < nglyphs; j++)
		{
		  int lglyph_index = j + done_glyphs;
		  Lisp_Object lglyph = LGSTRING_GLYPH (lgstring, lglyph_index);
421
		  ABC char_metric;
422
		  unsigned gl;
423 424 425

		  if (NILP (lglyph))
		    {
426
		      lglyph = LGLYPH_NEW ();
427 428
		      LGSTRING_SET_GLYPH (lgstring, lglyph_index, lglyph);
		    }
429 430 431 432 433
		  /* Copy to a 32-bit data type to shut up the
		     compiler warning in LGLYPH_SET_CODE about
		     comparison being always false.  */
		  gl = glyphs[j];
		  LGLYPH_SET_CODE (lglyph, gl);
434

435 436
		  /* Detect clusters, for linking codes back to
		     characters.  */
437
		  if (attributes[j].fClusterStart)
438
		    {
439 440 441
		      while (from < nchars_in_run && clusters[from] < j)
			from++;
		      if (from >= nchars_in_run)
442
			from = to = nchars_in_run - 1;
443 444 445
		      else
			{
			  int k;
446 447
			  to = nchars_in_run - 1;
			  for (k = from + 1; k < nchars_in_run; k++)
448 449 450
			    {
			      if (clusters[k] > j)
				{
451
				  to = k - 1;
452 453 454 455
				  break;
				}
			    }
			}
456
		      cluster_offset = 0;
457 458 459 460 461 462 463 464 465 466 467 468 469 470 471

		      /* For RTL text, the Uniscribe shaper prepares
			 the values in ADVANCES array for layout in
			 reverse order, whereby "advance width" is
			 applied to move the pen in reverse direction
			 and _before_ drawing the glyph.  Since we
			 draw glyphs in their normal left-to-right
			 order, we need to adjust the coordinates of
			 each non-base glyph in a grapheme cluster via
			 X-OFF component of the gstring's ADJUSTMENT
			 sub-vector.  This loop computes, for each
			 grapheme cluster, the initial value of the
			 adjustment for the base character, which is
			 then updated for each successive glyph in the
			 grapheme cluster.  */
472 473
		      /* FIXME: Should we use DIRECTION here instead
			 of what ScriptItemize guessed?  */
474 475 476 477 478 479 480 481 482 483 484
		      if (items[i].a.fRTL)
			{
			  int j1 = j;

			  adj_offset = 0;
			  while (j1 < nglyphs && !attributes[j1].fClusterStart)
			    {
			      adj_offset += advances[j1];
			      j1++;
			    }
			}
485 486
		    }

487 488 489 490 491
		  int char_idx = items[i].iCharPos + from + cluster_offset;
		  if (from + cluster_offset > to)
		    char_idx = items[i].iCharPos + to;
		  cluster_offset++;
		  LGLYPH_SET_CHAR (lglyph, chars[char_idx]);
492 493
		  LGLYPH_SET_FROM (lglyph, items[i].iCharPos + from);
		  LGLYPH_SET_TO (lglyph, items[i].iCharPos + to);
494

495 496 497 498 499
		  /* Metrics.  */
		  LGLYPH_SET_WIDTH (lglyph, advances[j]);
		  LGLYPH_SET_ASCENT (lglyph, font->ascent);
		  LGLYPH_SET_DESCENT (lglyph, font->descent);

500 501 502
		  result = ScriptGetGlyphABCWidth
		    (context, (SCRIPT_CACHE) &(uniscribe_font->cache),
		     glyphs[j], &char_metric);
503 504 505 506 507
		  if (result == E_PENDING && !context)
		    {
		      /* Cache incomplete... */
		      f = XFRAME (selected_frame);
		      context = get_frame_dc (f);
508
		      old_font = SelectObject (context, FONT_HANDLE (font));
509 510 511
		      result = ScriptGetGlyphABCWidth
			(context, (SCRIPT_CACHE) &(uniscribe_font->cache),
			 glyphs[j], &char_metric);
512
		    }
513

514
		  if (SUCCEEDED (result))
515
		    {
516 517 518 519 520
		      int lbearing = char_metric.abcA;
		      int rbearing = char_metric.abcA + char_metric.abcB;

		      LGLYPH_SET_LBEARING (lglyph, lbearing);
		      LGLYPH_SET_RBEARING (lglyph, rbearing);
521 522
		    }
		  else
523
		    {
524 525
		      LGLYPH_SET_LBEARING (lglyph, 0);
		      LGLYPH_SET_RBEARING (lglyph, advances[j]);
526
		    }
527

528 529 530 531 532
		  if (offsets[j].du || offsets[j].dv
		      /* For non-base glyphs of RTL grapheme clusters,
			 adjust the X offset even if both DU and DV
			 are zero.  */
		      || (!attributes[j].fClusterStart && items[i].a.fRTL))
533
		    {
534 535
		      Lisp_Object vec = make_uninit_vector (3);

536 537 538 539 540 541 542 543
		      if (items[i].a.fRTL)
			{
			  /* Empirically, it looks like Uniscribe
			     interprets DU in reverse direction for
			     RTL clusters.  E.g., if we don't reverse
			     the direction, the Hebrew point HOLAM is
			     drawn above the right edge of the base
			     consonant, instead of above the left edge.  */
544
			  ASET (vec, 0, make_fixnum (-offsets[j].du
545 546 547 548 549 550
						     + adj_offset));
			  /* Update the adjustment value for the width
			     advance of the glyph we just emitted.  */
			  adj_offset -= 2 * advances[j];
			}
		      else
551
			ASET (vec, 0, make_fixnum (offsets[j].du + adj_offset));
552 553 554 555
		      /* In the font definition coordinate system, the
			 Y coordinate points up, while in our screen
			 coordinates Y grows downwards.  So we need to
			 reverse the sign of Y-OFFSET here.  */
556
		      ASET (vec, 1, make_fixnum (-offsets[j].dv));
557
		      /* Based on what ftfont.c does... */
558
		      ASET (vec, 2, make_fixnum (advances[j]));
559
		      LGLYPH_SET_ADJUSTMENT (lglyph, vec);
560
		    }
561
		  else
562 563 564 565 566 567 568
		    {
		      LGLYPH_SET_ADJUSTMENT (lglyph, Qnil);
		      /* Update the adjustment value to compensate for
			 the width of the base character.  */
		      if (items[i].a.fRTL)
			adj_offset -= advances[j];
		    }
569 570
		}
	    }
571 572 573 574 575
	}
      done_glyphs += nglyphs;
    }

  xfree (items);
576 577 578 579 580 581

  if (context)
    {
      SelectObject (context, old_font);
      release_frame_dc (f, context);
    }
582 583 584 585

  if (NILP (lgstring))
    return Qnil;
  else
586
    return make_fixnum (done_glyphs);
587 588 589
}

/* Uniscribe implementation of encode_char for font backend.
590
   Return a glyph code of FONT for character C (Unicode code point).
591 592
   If FONT doesn't have such a glyph, return FONT_INVALID_CODE.  */
static unsigned
593
uniscribe_encode_char (struct font *font, int c)
594
{
595 596 597
  HDC context = NULL;
  struct frame *f = NULL;
  HFONT old_font = NULL;
598
  unsigned code = FONT_INVALID_CODE;
599 600 601 602 603 604
  wchar_t ch[2];
  int len;
  SCRIPT_ITEM* items;
  int nitems;
  struct uniscribe_font_info *uniscribe_font
    = (struct uniscribe_font_info *)font;
605 606 607

  if (c < 0x10000)
    {
608 609
      ch[0] = (wchar_t) c;
      len = 1;
610 611
    }
  else
612 613
    {
      DWORD surrogate = c - 0x10000;
614

615
      /* High surrogate: U+D800 - U+DBFF.  */
616
      ch[0] = 0xD800 + ((surrogate >> 10) & 0x03FF);
617
      /* Low surrogate: U+DC00 - U+DFFF.  */
618
      ch[1] = 0xDC00 + (surrogate & 0x03FF);
619 620
      len = 2;
    }
621

622 623
  /* Non BMP characters must be handled by the uniscribe shaping
     engine as GDI functions (except blindly displaying lines of
Juanma Barranquero's avatar
Juanma Barranquero committed
624
     Unicode text) and the promising looking ScriptGetCMap do not
625 626
     convert surrogate pairs to glyph indexes correctly.  */
    {
627
      items = (SCRIPT_ITEM *) alloca (sizeof (SCRIPT_ITEM) * 2 + 1);
628 629 630
      if (SUCCEEDED (ScriptItemize (ch, len, 2, NULL, NULL, items, &nitems)))
	{
	  HRESULT result;
631 632 633 634 635 636
          /* Surrogates seem to need 2 here, even though only one glyph is
	     returned.  Indic characters can also produce 2 or more glyphs for
	     a single code point, but they need to use uniscribe_shape
	     above for correct display.  */
          WORD glyphs[2], clusters[2];
          SCRIPT_VISATTR attrs[2];
637 638
          int nglyphs;

639 640 641 642
	  /* Force ScriptShape to generate glyphs in the logical
	     order.  */
	  items[0].a.fLogicalOrder = 1;

643 644
          result = ScriptShape (context,
				(SCRIPT_CACHE) &(uniscribe_font->cache),
645
                                ch, len, 2, &(items[0].a),
646 647 648 649 650 651 652 653
                                glyphs, clusters, attrs, &nglyphs);

          if (result == E_PENDING)
            {
              /* Use selected frame until API is updated to pass
                 the frame.  */
              f = XFRAME (selected_frame);
              context = get_frame_dc (f);
654
              old_font = SelectObject (context, FONT_HANDLE (font));
655 656
              result = ScriptShape (context,
				    (SCRIPT_CACHE) &(uniscribe_font->cache),
657 658 659 660 661
                                    ch, len, 2, &(items[0].a),
                                    glyphs, clusters, attrs, &nglyphs);
            }

          if (SUCCEEDED (result) && nglyphs == 1)
662
            {
663
	      /* Some fonts return .notdef glyphs instead of failing.
Juanma Barranquero's avatar
Juanma Barranquero committed
664
	         (TrueType spec reserves glyph code 0 for .notdef)  */
665 666
	      if (glyphs[0])
		code = glyphs[0];
667
            }
668 669 670 671 672 673
          else if (SUCCEEDED (result) || result == E_OUTOFMEMORY)
            {
              /* This character produces zero or more than one glyph
                 when shaped. But we still need the return from here
                 to be valid for the shaping engine to be invoked
                 later.  */
674 675
              result = ScriptGetCMap (context,
				      (SCRIPT_CACHE) &(uniscribe_font->cache),
676
                                      ch, len, 0, glyphs);
677
              if (SUCCEEDED (result) && glyphs[0])
678
                code = glyphs[0];
679 680
            }
	}
681
    }
682 683 684 685 686
    if (context)
      {
	SelectObject (context, old_font);
	release_frame_dc (f, context);
      }
687

688
    return code;
689 690 691 692 693 694 695
}

/*
   Shared with w32font:
   Lisp_Object uniscribe_get_cache (Lisp_Object frame);
   void uniscribe_free_entity (Lisp_Object font_entity);
   int uniscribe_has_char (Lisp_Object entity, int c);
696 697
   void uniscribe_text_extents (struct font *font, unsigned *code,
                                int nglyphs, struct font_metrics *metrics);
698 699 700 701
   int uniscribe_draw (struct glyph_string *s, int from, int to,
                       int x, int y, int with_background);

   Unused:
Dmitry Antipov's avatar
Dmitry Antipov committed
702 703
   int uniscribe_prepare_face (struct frame *f, struct face *face);
   void uniscribe_done_face (struct frame *f, struct face *face);
704 705 706 707 708
   int uniscribe_get_bitmap (struct font *font, unsigned code,
                             struct font_bitmap *bitmap, int bits_per_pixel);
   void uniscribe_free_bitmap (struct font *font, struct font_bitmap *bitmap);
   int uniscribe_anchor_point (struct font *font, unsigned code,
                               int index, int *x, int *y);
Dmitry Antipov's avatar
Dmitry Antipov committed
709 710
   int uniscribe_start_for_frame (struct frame *f);
   int uniscribe_end_for_frame (struct frame *f);
711 712 713 714 715 716 717

*/


/* Callback function for EnumFontFamiliesEx.
   Adds the name of opentype fonts to a Lisp list (passed in as the
   lParam arg). */
718
static int CALLBACK ALIGN_STACK
719 720 721
add_opentype_font_name_to_list (ENUMLOGFONTEX *logical_font,
				NEWTEXTMETRICEX *physical_font,
				DWORD font_type, LPARAM list_object)
722 723 724 725 726 727 728 729 730 731 732 733 734 735 736
{
  Lisp_Object* list = (Lisp_Object *) list_object;
  Lisp_Object family;

  /* Skip vertical fonts (intended only for printing)  */
  if (logical_font->elfLogFont.lfFaceName[0] == '@')
    return 1;

  /* Skip non opentype fonts.  Count old truetype fonts as opentype,
     as some of them do contain GPOS and GSUB data that Uniscribe
     can make use of.  */
  if (!(physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE)
      && font_type != TRUETYPE_FONTTYPE)
    return 1;

Juanma Barranquero's avatar
Juanma Barranquero committed
737
  /* Skip fonts that have no Unicode coverage.  */
738 739 740 741 742 743
  if (!physical_font->ntmFontSig.fsUsb[3]
      && !physical_font->ntmFontSig.fsUsb[2]
      && !physical_font->ntmFontSig.fsUsb[1]
      && !(physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff))
    return 1;

744
  family = intern_font_name (logical_font->elfLogFont.lfFaceName);
745 746 747 748 749 750 751 752 753
  if (! memq_no_quit (family, *list))
    *list = Fcons (family, *list);

  return 1;
}


/* :otf property handling.
   Since the necessary Uniscribe APIs for getting font tag information
754
   are only available in Vista, we may need to parse the font data directly
755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784
   according to the OpenType Specification.  */

/* Push into DWORD backwards to cope with endianness.  */
#define OTF_TAG(STR)                                          \
  ((STR[3] << 24) | (STR[2] << 16) | (STR[1] << 8) | STR[0])

#define OTF_INT16_VAL(TABLE, OFFSET, PTR)		     \
  do {							     \
    BYTE temp, data[2];					     \
    if (GetFontData (context, TABLE, OFFSET, data, 2) != 2)  \
      goto font_table_error;				     \
    temp = data[0], data[0] = data[1], data[1] = temp;	     \
    memcpy (PTR, data, 2);				     \
  } while (0)

/* Do not reverse the bytes, because we will compare with a OTF_TAG value
   that has them reversed already.  */
#define OTF_DWORDTAG_VAL(TABLE, OFFSET, PTR)                    \
  do {								\
    if (GetFontData (context, TABLE, OFFSET, PTR, 4) != 4)	\
      goto font_table_error;					\
  } while (0)

#define OTF_TAG_VAL(TABLE, OFFSET, STR)			     \
  do {							     \
    if (GetFontData (context, TABLE, OFFSET, STR, 4) != 4)   \
      goto font_table_error;				     \
    STR[4] = '\0';                                           \
  } while (0)

785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948
#define SNAME(VAL) SSDATA (SYMBOL_NAME (VAL))

/* Uniscribe APIs available only since Windows Vista.  */
typedef HRESULT (WINAPI *ScriptGetFontScriptTags_Proc)
  (HDC, SCRIPT_CACHE *, SCRIPT_ANALYSIS *, int, OPENTYPE_TAG *, int *);

typedef HRESULT (WINAPI *ScriptGetFontLanguageTags_Proc)
  (HDC, SCRIPT_CACHE *, SCRIPT_ANALYSIS *, OPENTYPE_TAG, int, OPENTYPE_TAG *, int *);

typedef HRESULT (WINAPI *ScriptGetFontFeatureTags_Proc)
  (HDC, SCRIPT_CACHE *, SCRIPT_ANALYSIS *, OPENTYPE_TAG, OPENTYPE_TAG, int, OPENTYPE_TAG *, int *);

ScriptGetFontScriptTags_Proc script_get_font_scripts_fn;
ScriptGetFontLanguageTags_Proc script_get_font_languages_fn;
ScriptGetFontFeatureTags_Proc script_get_font_features_fn;

static bool uniscribe_new_apis;

/* Verify that all the required features in FEATURES, each of whose
   elements is a list or nil, can be found among the N feature tags in
   FTAGS.  Return 'true' if the required features are supported,
   'false' if not.  Each list in FEATURES can include an element of
   nil, which means all the elements after it must not be in FTAGS.  */
static bool
uniscribe_check_features (Lisp_Object features[2], OPENTYPE_TAG *ftags, int n)
{
  int j;

  for (j = 0; j < 2; j++)
    {
      bool negative = false;
      Lisp_Object rest;

      for (rest = features[j]; CONSP (rest); rest = XCDR (rest))
	{
	  Lisp_Object feature = XCAR (rest);

	  /* The font must NOT have any of the features after nil.
	     See the doc string of 'font-spec', under ':otf'.  */
	  if (NILP (feature))
	    negative = true;
	  else
	    {
	      OPENTYPE_TAG feature_tag = OTF_TAG (SNAME (feature));
	      int i;

	      for (i = 0; i < n; i++)
		{
		  if (ftags[i] == feature_tag)
		    {
		      /* Test fails if we find a feature that the font
			 must NOT have.  */
		      if (negative)
			return false;
		      break;
		    }
		}

	      /* Test fails if we do NOT find a feature that the font
		 should have.  */
	      if (i >= n && !negative)
		return false;
	    }
	}
    }

  return true;
}

/* Check if font supports the required OTF script/language/features
   using the Unsicribe APIs available since Windows Vista.  We prefer
   these APIs as a kind of future-proofing Emacs: they seem to
   retrieve script tags that the old code (and also libotf) doesn't
   seem to be able to get, e.g., some fonts that claim support for
   "dev2" script don't show "deva", but the new APIs do report it.  */
static int
uniscribe_check_otf_1 (HDC context, Lisp_Object script, Lisp_Object lang,
		       Lisp_Object features[2], int *retval)
{
  SCRIPT_CACHE cache = NULL;
  OPENTYPE_TAG tags[32], script_tag, lang_tag;
  int max_tags = ARRAYELTS (tags);
  int ntags, i, ret = 0;
  HRESULT rslt;

  *retval = 0;

  rslt = script_get_font_scripts_fn (context, &cache, NULL, max_tags,
				     tags, &ntags);
  if (FAILED (rslt))
    {
      DebPrint (("ScriptGetFontScriptTags failed with 0x%x\n", rslt));
      ret = -1;
      goto no_support;
    }
  if (NILP (script))
    script_tag = OTF_TAG ("DFLT");
  else
    script_tag = OTF_TAG (SNAME (script));
  for (i = 0; i < ntags; i++)
    if (tags[i] == script_tag)
      break;

  if (i >= ntags)
    goto no_support;

  if (NILP (lang))
    lang_tag = OTF_TAG ("dflt");
  else
    {
      rslt = script_get_font_languages_fn (context, &cache, NULL, script_tag,
					   max_tags, tags, &ntags);
      if (FAILED (rslt))
	{
	  DebPrint (("ScriptGetFontLanguageTags failed with 0x%x\n", rslt));
	  ret = -1;
	  goto no_support;
	}
      if (ntags == 0)
	lang_tag = OTF_TAG ("dflt");
      else
	{
	  lang_tag = OTF_TAG (SNAME (lang));
	  for (i = 0; i < ntags; i++)
	    if (tags[i] == lang_tag)
	      break;

	  if (i >= ntags)
	    goto no_support;
	}
    }

  if (!NILP (features[0]))
    {
      /* Are the 2 feature lists valid?  */
      if (!CONSP (features[0])
	  || (!NILP (features[1]) && !CONSP (features[1])))
	goto no_support;
      rslt = script_get_font_features_fn (context, &cache, NULL,
					  script_tag, lang_tag,
					  max_tags, tags, &ntags);
      if (FAILED (rslt))
	{
	  DebPrint (("ScriptGetFontFeatureTags failed with 0x%x\n", rslt));
	  ret = -1;
	  goto no_support;
	}

      /* ScriptGetFontFeatureTags doesn't let us query features
	 separately for GSUB and GPOS, so we check them all together.
	 It doesn't really matter, since the features in GSUB and GPOS
	 are disjoint, i.e. no feature can appear in both tables.  */
      if (!uniscribe_check_features (features, tags, ntags))
	goto no_support;
    }

  ret = 1;
  *retval = 1;

 no_support:
  if (cache)
    ScriptFreeCache (&cache);
  return ret;
}
949 950 951 952

/* Check if font supports the otf script/language/features specified.
   OTF_SPEC is in the format
     (script lang [(gsub_feature ...)|nil] [(gpos_feature ...)]?) */
953 954
int
uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec)
955 956 957 958 959 960 961 962 963 964
{
  Lisp_Object script, lang, rest;
  Lisp_Object features[2];
  DWORD feature_tables[2];
  DWORD script_tag, default_script, lang_tag = 0;
  struct frame * f;
  HDC context;
  HFONT check_font, old_font;
  int i, retval = 0;

965
  /* Check the spec is in the right format.  */
Tom Tromey's avatar
Tom Tromey committed
966
  if (!CONSP (otf_spec) || XFIXNUM (Flength (otf_spec)) < 3)
967 968
    return 0;

969 970 971 972 973 974 975 976 977 978 979 980 981 982
  /* Break otf_spec into its components.  */
  script = XCAR (otf_spec);
  rest = XCDR (otf_spec);

  lang = XCAR (rest);
  rest = XCDR (rest);

  features[0] = XCAR (rest);
  rest = XCDR (rest);
  if (NILP (rest))
    features[1] = Qnil;
  else
    features[1] = XCAR (rest);

983 984 985 986 987 988 989 990 991 992 993 994
  /* Set up graphics context so we can use the font.  */
  f = XFRAME (selected_frame);
  context = get_frame_dc (f);
  check_font = CreateFontIndirect (font);
  old_font = SelectObject (context, check_font);

  /* If we are on Vista or later, use the new APIs.  */
  if (uniscribe_new_apis
      && !w32_disable_new_uniscribe_apis
      && uniscribe_check_otf_1 (context, script, lang, features, &retval) != -1)
    goto done;

995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013
  /* Set up tags we will use in the search.  */
  feature_tables[0] = OTF_TAG ("GSUB");
  feature_tables[1] = OTF_TAG ("GPOS");
  default_script = OTF_TAG ("DFLT");
  if (NILP (script))
    script_tag = default_script;
  else
    script_tag = OTF_TAG (SNAME (script));
  if (!NILP (lang))
    lang_tag = OTF_TAG (SNAME (lang));

  /* Scan GSUB and GPOS tables.  */
  for (i = 0; i < 2; i++)
    {
      int j, n_match_features;
      unsigned short scriptlist_table, feature_table, n_scripts;
      unsigned short script_table, langsys_table, n_langs;
      unsigned short feature_index, n_features;
      DWORD tbl = feature_tables[i];
1014 1015
      DWORD feature_id, *ftags;
      Lisp_Object farray[2];
1016 1017 1018 1019 1020

      /* Skip if no features requested from this table.  */
      if (NILP (features[i]))
	continue;

1021 1022 1023 1024
      /* If features is not a cons, this font spec is messed up.  */
      if (!CONSP (features[i]))
	goto no_support;

1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040
      /* Read GPOS/GSUB header.  */
      OTF_INT16_VAL (tbl, 4, &scriptlist_table);
      OTF_INT16_VAL (tbl, 6, &feature_table);
      OTF_INT16_VAL (tbl, scriptlist_table, &n_scripts);

      /* Find the appropriate script table.  */
      script_table = 0;
      for (j = 0; j < n_scripts; j++)
	{
	  DWORD script_id;
	  OTF_DWORDTAG_VAL (tbl, scriptlist_table + 2 + j * 6, &script_id);
	  if (script_id == script_tag)
	    {
	      OTF_INT16_VAL (tbl, scriptlist_table + 6 + j * 6, &script_table);
	      break;
	    }
1041
#if 0	  /* Causes false positives.  */
1042 1043 1044 1045
	  /* If there is a DFLT script defined in the font, use it
	     if the specified script is not found.  */
	  else if (script_id == default_script)
	    OTF_INT16_VAL (tbl, scriptlist_table + 6 + j * 6, &script_table);
1046
#endif
1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082
	}
      /* If no specific or default script table was found, then this font
	 does not support the script.  */
      if (!script_table)
	goto no_support;

      /* Offset is from beginning of scriptlist_table.  */
      script_table += scriptlist_table;

      /* Get default langsys table.  */
      OTF_INT16_VAL (tbl, script_table, &langsys_table);

      /* If lang was specified, see if font contains a specific entry.  */
      if (!NILP (lang))
	{
	  OTF_INT16_VAL (tbl, script_table + 2, &n_langs);

	  for (j = 0; j < n_langs; j++)
	    {
	      DWORD lang_id;
	      OTF_DWORDTAG_VAL (tbl, script_table + 4 + j * 6, &lang_id);
	      if (lang_id == lang_tag)
		{
		  OTF_INT16_VAL (tbl, script_table + 8 + j * 6, &langsys_table);
		  break;
		}
	    }
	}

      if (!langsys_table)
	goto no_support;

      /* Offset is from beginning of script table.  */
      langsys_table += script_table;

      /* If there are no features to check, skip checking.  */
1083
      if (NILP (features[i]))
1084
	continue;
1085 1086 1087 1088
      if (!CONSP (features[i]))
	goto no_support;

      n_match_features = 0;
1089

1090
      /* First get required feature (if any).  */
1091
      OTF_INT16_VAL (tbl, langsys_table + 2, &feature_index);
1092 1093 1094 1095 1096 1097 1098
      if (feature_index != 0xFFFF)
	n_match_features = 1;
      OTF_INT16_VAL (tbl, langsys_table + 4, &n_features);
      n_match_features += n_features;
      USE_SAFE_ALLOCA;
      SAFE_NALLOCA (ftags, 1, n_match_features);
      int k = 0;
1099 1100
      if (feature_index != 0xFFFF)
	{
1101 1102 1103
	  OTF_DWORDTAG_VAL (tbl, feature_table + 2 + feature_index * 6,
			    &feature_id);
	  ftags[k++] = feature_id;
1104
	}
1105
      /* Now get all the other features.  */
1106 1107 1108
      for (j = 0; j < n_features; j++)
	{
	  OTF_INT16_VAL (tbl, langsys_table + 6 + j * 2, &feature_index);
1109 1110 1111
	  OTF_DWORDTAG_VAL (tbl, feature_table + 2 + feature_index * 6,
			    &feature_id);
	  ftags[k++] = feature_id;
1112 1113
	}

1114 1115 1116 1117
      /* Check the features for this table.  */
      farray[0] = features[i];
      farray[1] = Qnil;
      if (!uniscribe_check_features (farray, ftags, n_match_features))
1118
	goto no_support;
1119
      SAFE_FREE ();
1120 1121 1122 1123
    }

  retval = 1;

1124
 done:
1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135
 no_support:
 font_table_error:
  /* restore graphics context.  */
  SelectObject (context, old_font);
  DeleteObject (check_font);
  release_frame_dc (f, context);

  return retval;
}

static Lisp_Object
1136
otf_features (HDC context, const char *table)
1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147
{
  Lisp_Object script_list = Qnil;
  unsigned short scriptlist_table, n_scripts, feature_table;
  DWORD tbl = OTF_TAG (table);
  int i, j, k;

  /* Look for scripts in the table.  */
  OTF_INT16_VAL (tbl, 4, &scriptlist_table);
  OTF_INT16_VAL (tbl, 6, &feature_table);
  OTF_INT16_VAL (tbl, scriptlist_table, &n_scripts);

1148
  for (i = n_scripts - 1; i >= 0; i--)
1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172
    {
      char script[5], lang[5];
      unsigned short script_table, lang_count, langsys_table, feature_count;
      Lisp_Object script_tag, langsys_list, langsys_tag, feature_list;
      unsigned short record_offset = scriptlist_table + 2 + i * 6;
      OTF_TAG_VAL (tbl, record_offset, script);
      OTF_INT16_VAL (tbl, record_offset + 4, &script_table);

      /* Offset is from beginning of script table.  */
      script_table += scriptlist_table;

      script_tag = intern (script);
      langsys_list = Qnil;

      /* Optional default lang.  */
      OTF_INT16_VAL (tbl, script_table, &langsys_table);
      if (langsys_table)
	{
	  /* Offset is from beginning of script table.  */
	  langsys_table += script_table;

	  langsys_tag = Qnil;
	  feature_list = Qnil;
	  OTF_INT16_VAL (tbl, langsys_table + 4, &feature_count);
1173
	  for (k = feature_count - 1; k >= 0; k--)
1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187
	    {
	      char feature[5];
	      unsigned short index;
	      OTF_INT16_VAL (tbl, langsys_table + 6 + k * 2, &index);
	      OTF_TAG_VAL (tbl, feature_table + 2 + index * 6, feature);
	      feature_list = Fcons (intern (feature), feature_list);
	    }
	  langsys_list = Fcons (Fcons (langsys_tag, feature_list),
				langsys_list);
	}

      /* List of supported languages.  */
      OTF_INT16_VAL (tbl, script_table + 2, &lang_count);

1188
      for (j = lang_count - 1; j >= 0; j--)
1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199
	{
	  record_offset = script_table + 4 + j * 6;
	  OTF_TAG_VAL (tbl, record_offset, lang);
	  OTF_INT16_VAL (tbl, record_offset + 4, &langsys_table);

	  /* Offset is from beginning of script table.  */
	  langsys_table += script_table;

	  langsys_tag = intern (lang);
	  feature_list = Qnil;
	  OTF_INT16_VAL (tbl, langsys_table + 4, &feature_count);
1200
	  for (k = feature_count - 1; k >= 0; k--)
1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221
	    {
	      char feature[5];
	      unsigned short index;
	      OTF_INT16_VAL (tbl, langsys_table + 6 + k * 2, &index);
	      OTF_TAG_VAL (tbl, feature_table + 2 + index * 6, feature);
	      feature_list = Fcons (intern (feature), feature_list);
	    }
	  langsys_list = Fcons (Fcons (langsys_tag, feature_list),
				langsys_list);

	}

      script_list = Fcons (Fcons (script_tag, langsys_list), script_list);
    }

  return script_list;

font_table_error:
  return Qnil;
}

1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381
#ifdef HAVE_HARFBUZZ

/* W32 implementation of the 'list' method for HarfBuzz backend.  */
static Lisp_Object
w32hb_list (struct frame *f, Lisp_Object font_spec)
{
  Lisp_Object fonts = w32font_list_internal (f, font_spec, true);
  FONT_ADD_LOG ("harfbuzz-list", font_spec, fonts);

  for (Lisp_Object tail = fonts; CONSP (tail); tail = XCDR (tail))
    ASET (XCAR (tail), FONT_TYPE_INDEX, Qharfbuzz);

  return fonts;
}

/* W32 implementation of the 'match' method for HarfBuzz backend.  */
static Lisp_Object
w32hb_match (struct frame *f, Lisp_Object font_spec)
{
  Lisp_Object entity = w32font_match_internal (f, font_spec, true);
  FONT_ADD_LOG ("harfbuzz-match", font_spec, entity);

  if (! NILP (entity))
    ASET (entity, FONT_TYPE_INDEX, Qharfbuzz);
  return entity;
}

/* Callback function to free memory.  We need this so we could pass it
   to HarfBuzz as the function to call to destroy objects for which we
   allocated data by calling our 'malloc' (as opposed to 'malloc' from
   the MS CRT, against which HarfBuzz was linked).  */
static void
free_cb (void *ptr)
{
  free (ptr);
}

/* A function used as reference_table_func for HarfBuzz.  It returns
   the data of a specified table of a font as a blob.  */
static hb_blob_t *
w32hb_get_font_table (hb_face_t *face, hb_tag_t tag, void *data)
{
  struct frame *f = XFRAME (selected_frame);
  HDC context = get_frame_dc (f);
  HFONT old_font = SelectObject (context, (HFONT) data);
  char *font_data = NULL;
  DWORD font_data_size = 0, val;
  DWORD table = bswap_32 (tag);
  hb_blob_t *blob = NULL;

  val = GetFontData (context, table, 0, font_data, font_data_size);
  if (val != GDI_ERROR)
    {
      font_data_size = val;
      /* Don't call xmalloc, because it can signal an error, while
	 we are inside a critical section established by get_frame_dc.  */
      font_data = malloc (font_data_size);
      if (font_data)
	{
	  val = GetFontData (context, table, 0, font_data, font_data_size);
	  if (val != GDI_ERROR)
	    blob = hb_blob_create (font_data, font_data_size,
				   HB_MEMORY_MODE_READONLY, font_data, free_cb);
	}
    }

  /* Restore graphics context.  */
  SelectObject (context, old_font);
  release_frame_dc (f, context);

  return blob;
}

/* Helper function used by the HarfBuzz implementations of the
   encode_char, has_char, and begin_hb_font methods.  It creates an
   hb_font_t object for a given Emacs font.  */
static hb_font_t *
w32hb_get_font (struct font *font, double *scale)
{
  hb_font_t *hb_font = NULL;
  HFONT font_handle = FONT_HANDLE (font);
  hb_face_t *hb_face =
    hb_face_create_for_tables (w32hb_get_font_table, font_handle, NULL);
  if (hb_face_get_glyph_count (hb_face) > 0)
    hb_font = hb_font_create (hb_face);

  struct uniscribe_font_info *uniscribe_font =
    (struct uniscribe_font_info *) font;
  unsigned upem = hb_face_get_upem (hb_face);
  eassert (upem > 0);
  /* https://support.microsoft.com/en-sg/help/74299/info-calculating-the-logical-height-and-point-size-of-a-font.  */
  LONG font_point_size =
    uniscribe_font->w32_font.metrics.tmHeight
    - uniscribe_font->w32_font.metrics.tmInternalLeading;
  /* https://docs.microsoft.com/en-us/typography/opentype/spec/ttch01,
     under "Converting FUnits to pixels".  */
  *scale = font_point_size * 1.0 / upem;

  hb_face_destroy (hb_face);

  /* FIXME: Can hb_font be non-NULL and yet invalid?  Compare to get_empty?  */
  return hb_font;
}

/* W32 implementation of encode_char method for HarfBuzz backend.  */
static unsigned
w32hb_encode_char (struct font *font, int c)
{
  struct uniscribe_font_info *uniscribe_font
    = (struct uniscribe_font_info *) font;
  eassert (uniscribe_font->w32_font.font.driver == &harfbuzz_font_driver);
  hb_font_t *hb_font = uniscribe_font->cache;

  /* First time we use this font with HarfBuzz, create the hb_font_t
     object and cache it.  */
  if (!hb_font)
    {
      double scale;
      hb_font = w32hb_get_font (font, &scale);
      if (!hb_font)
	return FONT_INVALID_CODE;

      uniscribe_font->cache = hb_font;
      eassert (scale > 0.0);
      uniscribe_font->scale = scale;
    }
  hb_codepoint_t glyph;
  if (hb_font_get_nominal_glyph (hb_font, c, &glyph))
    return glyph;
  return FONT_INVALID_CODE;
}

/* W32 implementation of HarfBuzz begin_hb_font and end_hb_font
   methods.  */

/* Return a HarfBuzz font object for FONT and store in POSITION_UNIT
   the scale factor to convert a hb_position_t value to the number of
   pixels.  Return NULL if HarfBuzz font object is not available for
   FONT.  */
static hb_font_t *
w32hb_begin_font (struct font *font, double *position_unit)
{
  struct uniscribe_font_info *uniscribe_font
    = (struct uniscribe_font_info *) font;
  eassert (uniscribe_font->w32_font.font.driver == &harfbuzz_font_driver);

  /* First time we use this font with HarfBuzz, create the hb_font_t
     object and cache it.  */
  if (!uniscribe_font->cache)
    {
      double scale;
      uniscribe_font->cache = w32hb_get_font (font, &scale);
      eassert (scale > 0.0);
      uniscribe_font->scale = scale;
    }
  *position_unit = uniscribe_font->scale;
  return (hb_font_t *) uniscribe_font->cache;
}
#endif	/* HAVE_HARFBUZZ */

1382 1383 1384 1385 1386 1387 1388
#undef OTF_INT16_VAL
#undef OTF_TAG_VAL
#undef OTF_TAG


struct font_driver uniscribe_font_driver =
  {
1389
    LISPSYM_INITIALLY (Quniscribe),
1390
    0, /* case insensitive */
1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406
    w32font_get_cache,
    uniscribe_list,
    uniscribe_match,
    uniscribe_list_family,
    NULL, /* free_entity */
    uniscribe_open,
    uniscribe_close,
    NULL, /* prepare_face */
    NULL, /* done_face */
    w32font_has_char,
    uniscribe_encode_char,
    w32font_text_extents,
    w32font_draw,
    NULL, /* get_bitmap */
    NULL, /* free_bitmap */
    NULL, /* anchor_point */
1407
    uniscribe_otf_capability, /* Defined so (font-get FONTOBJ :otf) works.  */
1408 1409 1410
    NULL, /* otf_drive - use shape instead.  */
    NULL, /* start_for_frame */
    NULL, /* end_for_frame */
1411 1412 1413 1414 1415
    uniscribe_shape,
    NULL, /* check */
    NULL, /* get_variation_glyphs */
    NULL, /* filter_properties */
    NULL, /* cached_font_ok */
1416 1417 1418 1419
  };

/* Note that this should be called at every startup, not just when dumping,
   as it needs to test for the existence of the Uniscribe library.  */
1420 1421
void syms_of_w32uniscribe (void);

Daniel Colascione's avatar
Daniel Colascione committed
1422 1423
static void syms_of_w32uniscribe_for_pdumper (void);

1424
void
1425
syms_of_w32uniscribe (void)
Daniel Colascione's avatar
Daniel Colascione committed
1426 1427 1428 1429
{
  pdumper_do_now_and_after_load (syms_of_w32uniscribe_for_pdumper);
}

1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441
#ifdef HAVE_HARFBUZZ
static bool
load_harfbuzz_funcs (HMODULE library)
{
  LOAD_DLL_FN (library, hb_blob_create);
  LOAD_DLL_FN (library, hb_face_create_for_tables);
  LOAD_DLL_FN (library, hb_face_get_glyph_count);
  LOAD_DLL_FN (library, hb_font_create);
  LOAD_DLL_FN (library, hb_font_destroy);
  LOAD_DLL_FN (library, hb_face_get_upem);
  LOAD_DLL_FN (library, hb_face_destroy);
  LOAD_DLL_FN (library, hb_font_get_nominal_glyph);
1442
  return hbfont_init_w32_funcs (library);
1443 1444 1445
}
#endif	/* HAVE_HARFBUZZ */

Daniel Colascione's avatar
Daniel Colascione committed
1446 1447
static void
syms_of_w32uniscribe_for_pdumper (void)
1448
{
1449
  /* Don't init Uniscribe and HarfBuzz when dumping */
1450 1451 1452
  if (!initialized)
    return;

1453 1454
  /* Don't register if Uniscribe is not available.  */
  HMODULE uniscribe = GetModuleHandle ("usp10");
1455 1456 1457 1458 1459 1460
  if (!uniscribe)
    return;

  uniscribe_available = 1;

  register_font_driver (&uniscribe_font_driver, NULL);
1461 1462

  script_get_font_scripts_fn = (ScriptGetFontScriptTags_Proc)
1463
    get_proc_addr (uniscribe, "ScriptGetFontScriptTags");
1464
  script_get_font_languages_fn = (ScriptGetFontLanguageTags_Proc)
1465
    get_proc_addr (uniscribe, "ScriptGetFontLanguageTags");
1466
  script_get_font_features_fn = (ScriptGetFontFeatureTags_Proc)
1467
    get_proc_addr (uniscribe, "ScriptGetFontFeatureTags");
1468 1469 1470 1471 1472 1473
  if (script_get_font_scripts_fn
      && script_get_font_languages_fn
      && script_get_font_features_fn)
    uniscribe_new_apis = true;
  else
    uniscribe_new_apis = false;
1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494

#ifdef HAVE_HARFBUZZ
  /* Currently, HarfBuzz DLLs are always named libharfbuzz-0.dll, as
     the project keeps the ABI backeard-compatible.  So we can
     hard-code the name of the library here, for now.  If they ever
     break ABI compatibility, we may need to load the DLL that
     corresponds to the HarfBuzz version for which Emacs was built.  */
  HMODULE harfbuzz = LoadLibrary ("libharfbuzz-0.dll");
  /* Don't register if HarfBuzz is not available.  */
  if (!harfbuzz)
    return;

  if (!load_harfbuzz_funcs (harfbuzz))
    return;

  harfbuzz_available = 1;
  harfbuzz_font_driver = uniscribe_font_driver;
  harfbuzz_font_driver.type = Qharfbuzz;
  harfbuzz_font_driver.list = w32hb_list;
  harfbuzz_font_driver.match = w32hb_match;
  harfbuzz_font_driver.encode_char = w32hb_encode_char;
1495 1496
  harfbuzz_font_driver.shape = hbfont_shape;
  harfbuzz_font_driver.combining_capability = hbfont_combining_capability;
1497 1498 1499
  harfbuzz_font_driver.begin_hb_font = w32hb_begin_font;
  register_font_driver (&harfbuzz_font_driver, NULL);
#endif	/* HAVE_HARFBUZZ */
1500
}