racket/gui Cocoa: repairs for Cairo and Pango

* Fix a clipped-rendering problem for text in Cairo.

 * Fix Pango's CoreText back-end to support non-BMP characters.

   Note that Emoji characters still do not render. Cairo uses
   CGContextShowGlyphsWithAdvances() to draw glyphs, but it
   would need to use CTFontDrawGlyphs() to make Emoji work.
   (Mozilla has a patch to do that for some older version
   of Cairo, so look there if it seems worth doing one day.)

 * Disable Pango's CoreText font fallbacks in favor of the
   Racket-implemented fallback.

   This is not obviously a good idea, but it restore the
   `racket/draw` hack of prefering "Arial Unicode MS". Otherwise,
   various symbol glyphs are chosen badly, such as #\u273A,
   at least on my machine.

 * Drop the clusters argument to `pango_cairo_show_glyph_string`,
   which turns out to be unnecessary.

native-pkgs

@@ -1 +1 @@
-Subproject commit 61d502ecff8b298dc0908876ee91fc8acbfe4e3e
+Subproject commit a32d6b2b4cbdc9ff184d53144157035b0eec98b4

pkgs/draw-pkgs/draw-lib/racket/draw/private/dc.rkt

@@ -1316,7 +1316,7 @@
 
     (define/private (do-text cr draw-mode s x y font combine? offset angle)
       (let* ([s (if (zero? offset) 
-                    s 
+                    s
                     (substring s offset))]
              [blank? (string=? s "")]
              [s (if (and (not draw-mode) blank?) " " s)]
@@ -1372,7 +1372,7 @@
                   (let ([layout (pango_layout_new context)]
                         [next-s #f])
                     (pango_layout_set_font_description layout desc)
-                    (when attrs (pango_layout_set_attributes layout attrs))
+                    (install-attributes! layout attrs)
                     (pango_layout_set_text layout s)
                     (let ([next-s
                            (if (or (not substitute-fonts?)
@@ -1460,7 +1460,7 @@
                           (or (hash-ref layouts (char->integer ch) #f)
                               (let ([layout (pango_layout_new context)])
                                 (pango_layout_set_font_description layout desc)
-                                (when attrs (pango_layout_set_attributes layout attrs))
+                                (install-attributes! layout attrs)
                                 (pango_layout_set_text layout (string ch))
                                 (unless (or (not substitute-fonts?)
                                             (zero? (pango_layout_get_unknown_glyphs_count layout)))
@@ -1497,7 +1497,6 @@
                             ;; loop directly affects the responsiveness of the DrRacket
                             ;; editor.
                             (let ([glyph-infos (malloc len _PangoGlyphInfo 'raw)] ;; assuming atomic until `free' below
-                                  [log-clusters (malloc len _int 'raw)]
                                   [first-font (vector-ref (hash-ref layouts (char->integer (string-ref s 0))) 3)]
                                   [first-ascent (and first-v (fl- (vector-ref first-v 1) (vector-ref first-v 2)))])
                               (and
@@ -1520,8 +1519,6 @@
                                             ;; Assume that the rect of the characters will pan out,
                                             ;; and start filling in the glyph-info array:
                                             (memcpy glyph-infos i glyphs 1 _PangoGlyphInfo)
-                                            ;; Every glyph is is own cluster:
-                                            (ptr-set! log-clusters _int i i)
                                             ;; Adjust width to be consistent with measured widths
                                             ;; used when drawing individual characters.
                                             ;; This is `set-PangoGlyphInfo-width!', but without
@@ -1531,7 +1528,7 @@
                                ;; If we get here, we can use the fast way:
                                (let ([glyph-string (make-PangoGlyphString len
                                                                           glyph-infos
-                                                                          log-clusters)])
+                                                                          #f)])
                                  ;; Move into position (based on the recorded Pango-units baseline)
                                  ;; and draw the glyphs
                                  (cairo_move_to cr 
@@ -1539,7 +1536,6 @@
                                                 (text-align-y/delta (+ y (/ (vector-ref first-v 4) (->fl PANGO_SCALE))) 0))
                                  (pango_cairo_show_glyph_string cr first-font glyph-string)
                                  (free glyph-infos)
-                                 (free log-clusters)
                                  #t)))))
                    ;; We use the slower, per-layout way:
                    (let* ([query-and-cache

pkgs/draw-pkgs/draw-lib/racket/draw/private/font.rkt

@@ -19,21 +19,31 @@
          (protect-out substitute-fonts?
                       install-alternate-face
                       font->pango-attrs
-                      font->hinting))
+                      font->hinting
+                      install-attributes!))
 
 (define-local-member-name 
   get-pango-attrs
   s-pango-attrs
   s-hinting)
 
-(define underlined-attrs (let ([l (pango_attr_list_new)])
+(define fallback-attrs (and (or xp? (eq? 'macosx (system-type)))
-                           (pango_attr_list_insert l (pango_attr_underline_new
-                                                      PANGO_UNDERLINE_SINGLE))
-                           l))
-(define fallback-attrs (and xp? 
 			    (let ([l (pango_attr_list_new)])
 			      (pango_attr_list_insert l (pango_attr_fallback_new #f))
 			      l)))
+(define underlined-attrs (let ([l (pango_attr_list_new)])
+                           (pango_attr_list_insert l (pango_attr_underline_new
+                                                      PANGO_UNDERLINE_SINGLE))
+                           (when (eq? 'macosx (system-type))
+                             (pango_attr_list_insert l (pango_attr_fallback_new #f)))
+                           l))
+
+(define always-attrs (and (eq? 'macosx (system-type)) fallback-attrs))
+
+(define (install-attributes! layout attrs)
+  (cond
+   [attrs (pango_layout_set_attributes layout attrs)]
+   [always-attrs (pango_layout_set_attributes layout always-attrs)]))
 
 (define (size? v) (and (exact-positive-integer? v)
                        (v . <= . 1024)))
@@ -74,7 +84,7 @@
        (and desc
             (let ([attrs (send font get-pango-attrs)])
               (pango_layout_set_font_description layout desc)
-              (when attrs (pango_layout_set_attributes layout attrs))
+              (install-attributes! layout attrs)
               (and (zero? (pango_layout_get_unknown_glyphs_count layout))
                    (begin
                      (hash-set! substitute-mapping (char->integer ch) face)
@@ -83,7 +93,7 @@
      (hash-set! substitute-mapping (char->integer ch) #t)
      ;; put old desc & attrs back
      (pango_layout_set_font_description layout desc)
-     (when attrs (pango_layout_set_attributes layout attrs)))))
+     (install-attributes! layout attrs))))
 
 (define (has-screen-glyph? c font desc for-label?)
   (let* ([s (cairo_image_surface_create CAIRO_FORMAT_ARGB32 1 1)]

racket/src/native-libs/build.rkt

@@ -107,6 +107,9 @@
 ;; --------------------------------------------------
 ;; Patches:
 
+;; Fix a problem with glyph extents and clipped rendering:
+(define-runtime-path cairo-coretext-patch "patches/cairo-coretext.patch")
+
 ;; Enable kerning and set DPI to 72:
 (define-runtime-path coretext-patch "patches/coretext.patch")
 
@@ -304,7 +307,8 @@
                                       null))]
     [("cairo") (config #:depends '("pixman" "fontconfig" "freetype" "libpng")
                        #:env path-flags
-                       #:configure '("--enable-xlib=no"))]
+                       #:configure '("--enable-xlib=no")
+                       #:patches (list cairo-coretext-patch))]
     [("harfbuzz") (config #:depends '("fontconfig" "freetype" "cairo")
                           #:configure '("--without-icu")
                           #:patches (if win?

racket/src/native-libs/patches/cairo-coretext.patch

@@ -0,0 +1,21 @@
+diff -r -u old/cairo-1.12.16/src/cairo-quartz-font.c new/cairo-1.12.16/src/cairo-quartz-font.c
+--- old/cairo-1.12.16/src/cairo-quartz-font.c	2014-04-15 11:04:35.000000000 -0600
++++ new/cairo-1.12.16/src/cairo-quartz-font.c	2014-04-15 11:05:43.000000000 -0600
+@@ -461,10 +461,12 @@
+ 	     bbox.size.width / emscale, bbox.size.height / emscale);
+ #endif
+ 
+-    xmin = CGRectGetMinX(bbox);
+-    ymin = CGRectGetMinY(bbox);
+-    xmax = CGRectGetMaxX(bbox);
+-    ymax = CGRectGetMaxY(bbox);
++    /* add 1 to bounds to avoid round-off error that happens somewhere
++       in the path of rendering text (e.g., "-" vs. "-d" with 12-point Menlo) */
++    xmin = CGRectGetMinX(bbox)-1;
++    ymin = CGRectGetMinY(bbox)-1;
++    xmax = CGRectGetMaxX(bbox)+1;
++    ymax = CGRectGetMaxY(bbox)+1;
+ 
+     extents.x_bearing = xmin;
+     extents.y_bearing = - ymax;
+

racket/src/native-libs/patches/coretext.patch

@@ -1,6 +1,19 @@
+diff -r -u old/pango-1.36.3/pango/pangocoretext.c new/pango-1.36.3/pango/pangocoretext.c
+--- old/pango-1.36.3/pango/pangocoretext.c	2014-03-05 21:33:55.000000000 -0700
++++ new/pango-1.36.3/pango/pangocoretext.c	2014-04-14 18:25:38.000000000 -0600
+@@ -97,8 +97,7 @@
+   bitmap = CFCharacterSetCreateBitmapRepresentation (kCFAllocatorDefault,
+                                                      charset);
+ 
+-  /* We only handle the BMP plane */
+-  length = MIN (CFDataGetLength (bitmap), 8192);
++  length = CFDataGetLength (bitmap);
+   ptr = CFDataGetBytePtr (bitmap);
+ 
+   /* FIXME: can and should this be done more efficiently? */
 diff -r -u old/pango-1.36.3/modules/basic/basic-coretext.c new/pango-1.36.3/modules/basic/basic-coretext.c
 --- old/pango-1.36.3/modules/basic/basic-coretext.c	2014-03-05 21:33:55.000000000 -0700
-+++ new/pango-1.36.3/modules/basic/basic-coretext.c	2014-03-30 09:52:46.000000000 -0600
++++ new/pango-1.36.3/modules/basic/basic-coretext.c	2014-04-14 17:50:38.000000000 -0600
 @@ -55,7 +55,8 @@
  	   PangoGlyphString *glyphs,
  	   int               i,
@@ -43,7 +56,26 @@ diff -r -u old/pango-1.36.3/modules/basic/basic-coretext.c new/pango-1.36.3/modu
  
    ct_glyph_count = CTRunGetGlyphCount (iter->current_run);
    iter->current_indices = malloc (sizeof (CFIndex *) * ct_glyph_count);
-@@ -175,6 +183,12 @@
+@@ -166,7 +174,17 @@
+ static gunichar
+ run_iterator_get_character (struct RunIterator *iter)
+ {
+-  return CFStringGetCharacterAtIndex (iter->cstr, iter->current_indices[iter->ct_i]);
++  gunichar c;
++
++  c = CFStringGetCharacterAtIndex (iter->cstr, iter->current_indices[iter->ct_i]);
++  if (c & 0xD800) {
++    /* surrogate pair */
++    gunichar c2;
++    c2 = CFStringGetCharacterAtIndex (iter->cstr, iter->current_indices[iter->ct_i]+1);
++    c = 0x10000 + (((c & 0x3FF) << 10) | (c2 & 0x3FF));
++  }
++
++  return c;
+ }
+ 
+ static CGGlyph
+@@ -175,6 +193,12 @@
    return iter->current_cgglyphs[iter->ct_i];
  }
  
@@ -56,7 +88,7 @@ diff -r -u old/pango-1.36.3/modules/basic/basic-coretext.c new/pango-1.36.3/modu
  static CFIndex
  run_iterator_get_index (struct RunIterator *iter)
  {
-@@ -297,6 +311,7 @@
+@@ -297,6 +321,7 @@
  {
    CFIndex index;
    CGGlyph cgglyph;
@@ -64,7 +96,7 @@ diff -r -u old/pango-1.36.3/modules/basic/basic-coretext.c new/pango-1.36.3/modu
    gunichar wc;
  };
  
-@@ -338,6 +353,7 @@
+@@ -338,6 +363,7 @@
        gi = g_slice_new (struct GlyphInfo);
        gi->index = run_iterator_get_index (&riter);
        gi->cgglyph = run_iterator_get_cgglyph (&riter);
@@ -72,7 +104,7 @@ diff -r -u old/pango-1.36.3/modules/basic/basic-coretext.c new/pango-1.36.3/modu
        gi->wc = run_iterator_get_character (&riter);
  
        glyph_list = g_slist_prepend (glyph_list, gi);
-@@ -426,7 +442,7 @@
+@@ -426,7 +452,7 @@
        if (gi == NULL || gi->index > gs_i)
          {
            /* gs_i is behind, insert empty glyph */
@@ -81,7 +113,7 @@ diff -r -u old/pango-1.36.3/modules/basic/basic-coretext.c new/pango-1.36.3/modu
            continue;
          }
        else if (gi->index < gs_i)
-@@ -457,7 +473,7 @@
+@@ -457,7 +483,7 @@
  
            if (result != PANGO_COVERAGE_NONE)
              {
@@ -90,7 +122,7 @@ diff -r -u old/pango-1.36.3/modules/basic/basic-coretext.c new/pango-1.36.3/modu
  
                if (g_unichar_type (gi->wc) == G_UNICODE_NON_SPACING_MARK)
                  {
-@@ -480,7 +496,7 @@
+@@ -480,7 +506,7 @@
                  }
              }
            else
@@ -125,3 +157,25 @@ diff -r -u old/pango-1.36.3/pango/pangocairo-coretextfontmap.c new/pango-1.36.3/
 -  cafontmap->dpi = 96.;
 +  cafontmap->dpi = 72.;
  }
+diff -r -u old/pango-1.36.3/pango/pangocoretext-fontmap.c new/pango-1.36.3/pango/pangocoretext-fontmap.c
+--- old/pango-1.36.3/pango/pangocoretext-fontmap.c	2014-04-14 10:56:38.000000000 -0600
++++ new/pango-1.36.3/pango/pangocoretext-fontmap.c	2014-04-14 11:01:45.000000000 -0600
+@@ -297,7 +297,8 @@
+   cf_number = (CFNumberRef)CFDictionaryGetValue (dict,
+                                                  kCTFontWeightTrait);
+ 
+-  if (CFNumberGetValue (cf_number, kCFNumberCGFloatType, &value))
++  weight = PANGO_WEIGHT_NORMAL;
++  if (cf_number && CFNumberGetValue (cf_number, kCFNumberCGFloatType, &value))
+     {
+       if (value < ct_weight_min || value > ct_weight_max)
+ 	{
+@@ -315,8 +316,6 @@
+ 	      }
+ 	}
+     }
+- else
+-   weight = PANGO_WEIGHT_NORMAL;
+ 
+   CFRelease (dict);
+