manual font substitution for Mac OS X
This commit is contained in:
Matthew Flatt
parent
ca29be4eb1
commit
ff57455150
|
|
@ -52,7 +52,9 @@
|
|||
[sip (make-object check-box% "Size in Pixels" p4 refresh-sample)]
|
||||
[sym (make-object check-box% "Map as Symbol" p4 refresh-sample)]
|
||||
[size (make-object slider% "Size:" 4 127 p2 refresh-sample 12)]
|
||||
[sample (make-object text-field% "Sample" f void "The quick brown fox jumped over the lazy dog" '(multiple))]
|
||||
[sample (make-object text-field% "Sample" f void
|
||||
"The quick brown fox jumped over the lazy dog\n(\u3bb (x) x)\n"
|
||||
'(multiple))]
|
||||
[edit (send sample get-editor)]
|
||||
[done (lambda (ok) (lambda (b e) (set! ok? ok) (send f show #f)))]
|
||||
[get-font (lambda () (let ([face (send face get-string-selection)])
|
||||
|
|
|
|||
|
|
@ -444,15 +444,7 @@
|
|||
[real? left] [real? top] [real? bottom] [real? right]
|
||||
[real? dx] [real? dy] [symbol? caret])
|
||||
(unless (has-flag? s-flags INVISIBLE)
|
||||
(send dc draw-text (replace-nuls (substring s-buffer s-dtext (+ s-dtext s-count))) x y #f)
|
||||
(when (eq? (system-type) 'unix)
|
||||
(when (send s-style get-underlined)
|
||||
(let ([descent (send s-style get-text-descent dc)]
|
||||
[h (send s-style get-text-height dc)])
|
||||
(let ([y (if (descent . >= . 2)
|
||||
(+ y (- h (/ descent 2)))
|
||||
(+ y (- h descent)))])
|
||||
(send dc draw-line x y (+ x str-w) y)))))))
|
||||
(send dc draw-text (replace-nuls (substring s-buffer s-dtext (+ s-dtext s-count))) x y #f)))
|
||||
|
||||
(def/override (split [exact-nonnegative-integer? position] [box? first] [box? second])
|
||||
(let ([count s-count])
|
||||
|
|
|
|||
|
|
@ -921,28 +921,59 @@
|
|||
[x (if rotate? 0.0 x)]
|
||||
[y (if rotate? 0.0 y)])
|
||||
(if combine?
|
||||
(let ([layout (pango_layout_new context)])
|
||||
(pango_layout_set_font_description layout desc)
|
||||
(when attrs (pango_layout_set_attributes layout attrs))
|
||||
(pango_layout_set_text layout s)
|
||||
(when draw?
|
||||
(cairo_move_to cr x y)
|
||||
(pango_cairo_show_layout cr layout))
|
||||
(begin0
|
||||
(if draw?
|
||||
(void)
|
||||
(let ([logical (make-PangoRectangle 0 0 0 0)])
|
||||
(pango_layout_get_extents layout #f logical)
|
||||
(values (if blank?
|
||||
0.0
|
||||
(integral (/ (PangoRectangle-width logical) (exact->inexact PANGO_SCALE))))
|
||||
(integral (/ (PangoRectangle-height logical) (exact->inexact PANGO_SCALE)))
|
||||
(integral (/ (- (PangoRectangle-height logical)
|
||||
(pango_layout_get_baseline layout))
|
||||
(exact->inexact PANGO_SCALE)))
|
||||
0.0)))
|
||||
(g_object_unref layout)
|
||||
(when rotate? (cairo_restore cr))))
|
||||
(let loop ([s s] [w 0.0] [h 0.0] [d 0.0] [a 0.0])
|
||||
(cond
|
||||
[(not s)
|
||||
(when rotate? (cairo_restore cr))
|
||||
(values w h d a)]
|
||||
[else
|
||||
(let ([layout (pango_layout_new context)]
|
||||
[next-s #f])
|
||||
(pango_layout_set_font_description layout desc)
|
||||
(when attrs (pango_layout_set_attributes layout attrs))
|
||||
(pango_layout_set_text layout s)
|
||||
(let ([next-s
|
||||
(if (zero? (pango_layout_get_unknown_glyphs_count layout))
|
||||
#f
|
||||
;; look for the first character in the string without a glyph
|
||||
(let ([ok-count
|
||||
(let ([len (string-length s)])
|
||||
(let loop ([lo 0] [hi (sub1 len)] [i (quotient len 2)])
|
||||
(cond
|
||||
[(= lo hi) lo]
|
||||
[else
|
||||
(pango_layout_set_text layout (substring s lo i))
|
||||
(if (zero? (pango_layout_get_unknown_glyphs_count layout))
|
||||
;; ok so far, so look higher
|
||||
(if (= i lo)
|
||||
lo
|
||||
(loop i hi (+ i (quotient (- hi i) 2))))
|
||||
;; still not ok; look lower
|
||||
(loop lo i (+ lo (quotient (- i lo) 2))))])))])
|
||||
(pango_layout_set_text layout (substring s 0 (max 1 ok-count)))
|
||||
(when (zero? ok-count)
|
||||
;; find a face that works for the long character:
|
||||
(install-alternate-face layout font desc attrs))
|
||||
(substring s (max 1 ok-count))))])
|
||||
(when draw?
|
||||
(cairo_move_to cr (+ x w) y)
|
||||
(pango_cairo_show_layout cr layout))
|
||||
(cond
|
||||
[(and draw? (not next-s))
|
||||
(g_object_unref layout)
|
||||
(void)]
|
||||
[else
|
||||
(let ([logical (make-PangoRectangle 0 0 0 0)])
|
||||
(pango_layout_get_extents layout #f logical)
|
||||
(let ([nw (if blank?
|
||||
0.0
|
||||
(integral (/ (PangoRectangle-width logical) (exact->inexact PANGO_SCALE))))]
|
||||
[nh (integral (/ (PangoRectangle-height logical) (exact->inexact PANGO_SCALE)))]
|
||||
[nd (integral (/ (- (PangoRectangle-height logical)
|
||||
(pango_layout_get_baseline layout))
|
||||
(exact->inexact PANGO_SCALE)))]
|
||||
[na 0.0])
|
||||
(loop next-s (+ w nw) (max h nh) (max d nd) (max a na))))])))]))
|
||||
(let ([logical (make-PangoRectangle 0 0 0 0)])
|
||||
(begin0
|
||||
(for/fold ([w 0.0][h 0.0][d 0.0][a 0.0])
|
||||
|
|
@ -955,10 +986,12 @@
|
|||
(pango_layout_set_font_description layout desc)
|
||||
(when attrs (pango_layout_set_attributes layout attrs))
|
||||
(pango_layout_set_text layout (string ch))
|
||||
(unless (zero? (pango_layout_get_unknown_glyphs_count layout))
|
||||
;; No good glyph; look for an alternate face
|
||||
(install-alternate-face layout font desc attrs))
|
||||
(hash-set! layouts key layout)
|
||||
layout)))])
|
||||
(pango_cairo_update_layout cr layout)
|
||||
;; (cairo_show_glyphs cr (make-cairo_glyph_t 65 x y) 1)
|
||||
(when draw?
|
||||
(cairo_move_to cr (+ x w) y)
|
||||
(pango_cairo_show_layout cr layout))
|
||||
|
|
@ -971,6 +1004,29 @@
|
|||
[la 0.0])
|
||||
(values (if blank? 0.0 (+ w lw)) (max h lh) (max d ld) (max a la)))))
|
||||
(when rotate? (cairo_restore cr))))))))
|
||||
|
||||
|
||||
(define/private (install-alternate-face layout font desc attrs)
|
||||
(or
|
||||
(for/or ([face (in-list (get-face-list))])
|
||||
(let ([desc (get-pango (make-object font%
|
||||
(send font get-point-size)
|
||||
face
|
||||
(send font get-family)
|
||||
(send font get-style)
|
||||
(send font get-weight)
|
||||
(send font get-underlined)
|
||||
(send font get-smoothing)
|
||||
(send font get-size-in-pixels)))])
|
||||
(and desc
|
||||
(let ([attrs (send font get-pango-attrs)])
|
||||
(pango_layout_set_font_description layout desc)
|
||||
(when attrs (pango_layout_set_attributes layout attrs))
|
||||
(zero? (pango_layout_get_unknown_glyphs_count layout))))))
|
||||
(begin
|
||||
;; put old desc & attrs back
|
||||
(pango_layout_set_font_description layout desc)
|
||||
(when attrs (pango_layout_set_attributes layout attrs)))))
|
||||
|
||||
(def/public (get-char-width)
|
||||
10.0)
|
||||
|
|
@ -1138,7 +1194,20 @@
|
|||
(send tmp-dc set-bitmap #f)
|
||||
tmp-bm))
|
||||
|
||||
(def/public (glyph-exists? [char? c]) #t)
|
||||
(def/public (glyph-exists? [char? c])
|
||||
(with-cr
|
||||
#f
|
||||
cr
|
||||
(let ([desc (get-pango font)])
|
||||
(unless context
|
||||
(set! context (pango_cairo_create_context cr)))
|
||||
(let ([layout (pango_layout_new context)])
|
||||
(pango_layout_set_font_description layout desc)
|
||||
(pango_layout_set_text layout (string c))
|
||||
(pango_cairo_update_layout cr layout)
|
||||
(begin0
|
||||
(zero? (pango_layout_get_unknown_glyphs_count layout))
|
||||
(g_object_unref layout))))))
|
||||
|
||||
)
|
||||
dc%)
|
||||
|
|
@ -47,9 +47,12 @@
|
|||
(define PangoLayout (_cpointer 'PangoLayout))
|
||||
(define PangoFontDescription (_cpointer 'PangoFontDescription))
|
||||
(define PangoFontFamily (_cpointer 'PangoFontFamily))
|
||||
(define PangoFont (_cpointer 'PangoFont))
|
||||
(define PangoFontMap (_cpointer 'PangoFontMap))
|
||||
(define PangoAttrList (_cpointer 'PangoAttrList))
|
||||
(define PangoAttribute (_cpointer 'PangoAttribute))
|
||||
(define PangoLanguage (_cpointer 'PangoLanguage))
|
||||
(define PangoCoverage (_cpointer 'PangoCoverage))
|
||||
|
||||
(define-cstruct _PangoRectangle ([x _int]
|
||||
[y _int]
|
||||
|
|
@ -88,6 +91,16 @@
|
|||
(define-pango pango_font_family_get_name (_fun PangoFontFamily -> _string)) ;; not an allocator
|
||||
(define-pango pango_font_family_is_monospace (_fun PangoFontFamily -> _bool))
|
||||
|
||||
(define-pango pango_language_get_default (_fun -> PangoLanguage))
|
||||
(define-pango pango_font_map_load_font (_fun PangoFontMap PangoContext PangoFontDescription -> (_or-null PangoFont)))
|
||||
(define-pango pango_coverage_unref (_fun PangoCoverage -> _void)
|
||||
#:wrap (deallocator))
|
||||
(define-pango pango_font_get_coverage (_fun PangoFont PangoLanguage -> PangoCoverage)
|
||||
#:wrap (allocator pango_coverage_unref))
|
||||
(define-pango pango_coverage_get (_fun PangoCoverage _int -> _int))
|
||||
|
||||
(define-pango pango_layout_get_unknown_glyphs_count (_fun PangoLayout -> _int))
|
||||
|
||||
(define-pango pango_attr_list_unref (_fun PangoAttrList -> _void)
|
||||
#:wrap (deallocator))
|
||||
(define-pango pango_attr_list_new (_fun -> PangoAttrList)
|
||||
|
|
@ -100,6 +113,8 @@
|
|||
#:wrap (deallocator))
|
||||
(define-pango pango_attr_underline_new (_fun _int -> PangoAttribute)
|
||||
#:wrap (allocator pango_attribute_destroy))
|
||||
(define-pango pango_attr_fallback_new (_fun _bool -> PangoAttribute)
|
||||
#:wrap (allocator pango_attribute_destroy))
|
||||
|
||||
(define-pango pango_layout_set_attributes (_fun PangoLayout PangoAttrList -> _void))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
Information on building 3rd-party libraries needed for
|
||||
Mac OS X GRacket.
|
||||
Information on building 3rd-party libraries needed for Mac OS X GRacket.
|
||||
|
||||
Get these packages (or newer, if compatible):
|
||||
pkg-config-0.23.tar.gz
|
||||
|
|
@ -15,10 +14,18 @@ Patches:
|
|||
cairo/src/cairo-quartz-font.c:656:
|
||||
if (width < 1) width = 1;
|
||||
if (height < 1) height = 1;
|
||||
glib/glib/gconvert.c:54:
|
||||
glib/glib/gconvert.c:54: change to
|
||||
#if !(defined(__APPLE__) && defined(__LP64__)) && !defined(USE_LIBICONV_GNU) && defined (_LIBICONV_H)
|
||||
pango/pango/modules.c:573:
|
||||
pango/pango/modules.c:573: change to
|
||||
// read_modules ();
|
||||
pango/modules/basic/basic-atsui.c:60: add
|
||||
if (!glyph) { glyph = PANGO_GET_UNKNOWN_GLYPH(glyph); }
|
||||
pango/pangocairo-atsuifont.c:141: add
|
||||
metrics->underline_position = -metrics->underline_position;
|
||||
pango_quantize_line_geometry (&metrics->underline_thickness,
|
||||
&metrics->underline_position);
|
||||
metrics->underline_position = -(metrics->underline_position
|
||||
+ metrics->underline_thickness);
|
||||
|
||||
Configures (where <dest> is some temporary area):
|
||||
pkg-config: --prefix=<dest>
|
||||
|
|
@ -38,3 +45,48 @@ Install:
|
|||
* do not include a trailing slash
|
||||
* double-check installed libraries to ensure that they do not
|
||||
have <dest> in their shared-library paths
|
||||
|
||||
--------------------------------------------------
|
||||
|
||||
DESTDIR=
|
||||
WORKDIR=
|
||||
ARCHDIR=
|
||||
|
||||
cd "$WORKDIR"
|
||||
tar zxf "$ARCHDIR"pkg-config-0.23.tar.gz
|
||||
tar zxf "$ARCHDIR"libpng-1.4.0.tar.gz
|
||||
tar zxf "$ARCHDIR"pixman-0.17.14.tar.gz
|
||||
tar zxf "$ARCHDIR"cairo-1.9.6.tar.gz
|
||||
tar zxf "$ARCHDIR"gettext-0.17.tar.gz
|
||||
tar zxf "$ARCHDIR"glib-2.22.4.tar.gz
|
||||
tar zxf "$ARCHDIR"pango-1.28.0.tar.gz
|
||||
cd pkg-config-0.23/
|
||||
./configure --prefix="$DESTDIR"
|
||||
make
|
||||
make install
|
||||
cd ../libpng-1.4.0/
|
||||
./configure --prefix="$DESTDIR"
|
||||
make
|
||||
make install
|
||||
cd ..
|
||||
cd pixman-0.17.14/
|
||||
./configure --prefix="$DESTDIR"
|
||||
make
|
||||
make install
|
||||
cd ../cairo-1.9.6/
|
||||
env PATH="$DESTDIR"/bin:"$PATH" ./configure --disable-xlib --disable-ft --disable-fc --prefix="$DESTDIR"
|
||||
make
|
||||
make install
|
||||
cd ../gettext-0.17/
|
||||
./configure --prefix="$DESTDIR"
|
||||
make
|
||||
make install
|
||||
cd ../glib
|
||||
cd ../glib-2.22.4/
|
||||
env PATH="$DESTDIR"/bin:"$PATH" CFLAGS=-I"$DESTDIR"/include LDFLAGS=-L"$DESTDIR"/lib ./configure --prefix="$DESTDIR"
|
||||
make
|
||||
make install
|
||||
cd ../pango-1.28.0/
|
||||
env PATH="$DESTDIR"/bin:"$PATH" ./configure --without-x --with-included-modules=yes --with-dynamic-modules=no --prefix="$DESTDIR"
|
||||
make
|
||||
make install
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@
|
|||
|
||||
(define (fixup p p-new)
|
||||
(printf "Fixing ~s\n" p-new)
|
||||
(system (format "install_name_tool -id ~a ~a" p-new (file-name-from-path p-new)))
|
||||
(system (format "install_name_tool -id ~a ~a" (file-name-from-path p-new) p-new))
|
||||
(for-each (lambda (s)
|
||||
(system (format "install_name_tool -change ~a @loader_path/~a ~a"
|
||||
(format "~a/~a.dylib" from s)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user