measured font — not working

main
Matthew Butterick 7 years ago
parent f16f3d8502
commit b3bd647916

Binary file not shown.

@ -0,0 +1,244 @@
#lang racket/base
(require ffi/unsafe
ffi/unsafe/define
racket/draw/private/libs)
(define-syntax-rule (define+provide id val)
(begin
(define id val)
(provide id)))
(define-runtime-lib freetype-lib
[(unix) #f] ; todo: get unix runtime path
[(macosx) (ffi-lib "libfreetype.6.dylib")]
[(windows) (ffi-lib "libfreetype-6.dll")])
(define-ffi-definer define-freetype freetype-lib #:provide provide)
;; types
(define _void-pointer (_cpointer 'void-pointer))
(define _char _byte)
(define _char-pointer (_cpointer 'char-pointer))
(define _uchar _ubyte)
(define _FT_Byte _ubyte)
(define _FT_Bytes _bytes)
(define _FT_Char _char)
(define _FT_Int _int)
(define _FT_UInt _uint)
(define _FT_Int16 _short)
(define _FT_UInt16 _ushort)
(define _FT_Int32 _int32)
(define _FT_UInt32 _uint32)
(define _FT_Short _short)
(define _FT_UShort _ushort)
(define _FT_Long _long)
(define _FT_ULong _ulong)
(define _FT_Bool _byte)
(define _FT_Offset _size) ;; equivalent to _size_t?
(define _FT_PtrDist _ptrdiff) ;; equivalent to _longlong?
(define _FT_String _char)
(define _FT_String-pointer (_cpointer 'FT_String-pointer)) ;; char*
(define _FT_Tag _FT_UInt32)
(define _FT_Error _int)
(define _FT_Fixed _long)
(define _FT_Pointer _void-pointer)
(define _FT_Pos _long)
(define _FT_FWord _short)
(define _FT_UFWord _ushort)
(define _FT_F26Dot16 _short)
(define _FT_F26Dot6 _long)
(define _FT_Glyph_Format _int)
(define _FT_Encoding _int)
(define _FT_Generic_Finalizer (_cpointer '_FT_Generic_Finalizer (_fun _void-pointer -> _void)))
(define _FT_LibraryRec (_cpointer 'FT_LibraryRec))
(define _FT_Library (_cpointer 'FT_Library))
(define-cstruct _FT_Bitmap_Size
([height _FT_Short]
[width _FT_Short]
[size _FT_Pos]
[x_ppem _FT_Pos]
[y_ppem _FT_Pos]))
(define-cstruct _FT_CharMapRec
([face _void-pointer] ; should be FT_Face
[encoding _FT_Encoding]
[platform_id _FT_UShort]
[encoding_id _FT_UShort]))
(define _FT_Charmap _FT_CharMapRec-pointer)
(define _FT_CharMap-pointer (_cpointer 'FT_CharMap-pointer))
(define-cstruct _FT_Generic
([data _void-pointer]
[finalizer _FT_Generic_Finalizer]))
(define-cstruct _FT_BBox
([xMin _FT_Pos]
[yMin _FT_Pos]
[xMax _FT_Pos]
[yMax _FT_Pos]))
(define-cstruct _FT_Glyph_Metrics
([width _FT_Pos]
[height _FT_Pos]
[horiBearingX _FT_Pos]
[horiBearingY _FT_Pos]
[horiAdvance _FT_Pos]
[vertBearingX _FT_Pos]
[vertBearingY _FT_Pos]
[vertAdvance _FT_Pos]))
(define-cstruct _FT_Vector
([x _FT_Pos]
[y _FT_Pos]))
(provide (struct-out FT_Vector)
_FT_Vector _FT_Vector-pointer)
(define-cstruct _FT_Bitmap
([rows _int]
[width _int]
[pitch _int]
[buffer (_cpointer 'buffer)]
[num_grays _short]
[pixel_mode _ubyte]
[palette_mode _char]
[palette _void-pointer]))
(define-cstruct _FT_Outline
([n_contours _short]
[n_points _short]
[points _FT_Vector-pointer]
[tags (_cpointer 'tags)]
[contours (_cpointer 'contours)]
[flags _int]))
(define-cstruct _FT_GlyphSlotRec
([library _FT_Library]
[face _void-pointer]
[next _void-pointer]
[reserved _uint]
[generic _FT_Generic]
[metrics _FT_Glyph_Metrics]
[linearHoriAdvance _FT_Fixed]
[linearVertAdvance _FT_Fixed]
[advance _FT_Vector]
[format _FT_Glyph_Format]
[bitmap _FT_Bitmap]
[bitmap_left _FT_Int]
[bitmap_top _FT_Int]
[outline _FT_Outline]
[num_subglyphs _FT_UInt]
[subglyphs _void-pointer]
[control_data _void-pointer]
[control_len _long]
[lsb_delta _FT_Pos]
[rsb_delta _FT_Pos]
[other _void-pointer]
[internal _void-pointer]))
(define _FT_GlyphSlot _FT_GlyphSlotRec-pointer)
(provide (struct-out FT_GlyphSlotRec)
_FT_GlyphSlotRec _FT_GlyphSlotRec-pointer)
(define-cstruct _FT_Size_Metrics
([x_ppem _FT_UShort]
[y_ppem _FT_UShort]
[x_scale _FT_Fixed]
[y_scale _FT_Fixed]
[ascender _FT_Pos]
[descender _FT_Pos]
[height _FT_Pos]
[max_advance _FT_Pos]))
(define-cstruct _FT_SizeRec
([face _void-pointer]
[generic _FT_Generic]
[metrics _FT_Size_Metrics]
[internal _void-pointer]))
(define _FT_Size _FT_SizeRec-pointer)
(define-cstruct _FT_FaceRec
([num_faces _FT_Long]
[face_index _FT_Long]
[face_flag _FT_Long]
[style_flags _FT_Long]
[num_glyphs _FT_Long]
[family_name _string] ; probably _string is a better choice
[style_name _string]
[num_fixed_sizes _FT_Int]
[available_sizes _FT_Bitmap_Size-pointer]
[num_charmaps _FT_Int]
[charmaps _FT_CharMap-pointer]
[generic _FT_Generic]
[bbox _FT_BBox]
[units_per_EM _FT_UShort]
[ascender _FT_Short]
[descender _FT_Short]
[height _FT_Short]
[max_advance_width _FT_Short]
[max_advance_height _FT_Short]
[underline_position _FT_Short]
[underline_thickness _FT_Short]
[glyph _FT_GlyphSlot]
[size _FT_Size]
[charmap _FT_Charmap]
[driver _void-pointer]
[memory _void-pointer]
[stream _void-pointer]
[sizes_list_head _void-pointer]
[sizes_list_tail _void-pointer]
[autohint _FT_Generic]
[extensions _void-pointer]
[internal _void-pointer]))
(define _FT_Face _FT_FaceRec-pointer)
(provide (struct-out FT_FaceRec)
_FT_FaceRec _FT_FaceRec-pointer)
(define _full-path
(make-ctype _path
path->complete-path
values))
(define-freetype FT_Init_FreeType (_fun (ftl : (_ptr o _FT_Library))
-> (err : _FT_Error)
-> (if (zero? err) ftl (error 'FT_Init_FreeType))))
(define-freetype FT_New_Face (_fun _FT_Library _full-path _FT_Long
(ftf : (_ptr o (_or-null _FT_Face)))
-> (err : _FT_Error)
-> (if (zero? err) ftf (error 'FT_New_Face (format "error ~a" err)))))
(define-freetype FT_Done_Face (_fun _FT_Face
-> (err : _FT_Error)
-> (unless (zero? err) (error 'FT_Done_Face (format "error ~a" err)))))
(define-freetype FT_Done_FreeType (_fun _FT_Library -> (err : _FT_Error) -> (if (zero? err) (void) (error 'FT_Done_FreeType))))
(define-freetype FT_Get_Kerning (_fun _FT_Face _FT_UInt _FT_UInt _FT_UInt
(ftv : (_ptr o _FT_Vector))
-> (err : _FT_Error)
-> (if (zero? err) ftv (error 'FT_Get_Kerning (format "error ~a" err)))))
(define-freetype FT_Get_Char_Index (_fun _FT_Face _FT_ULong
-> _FT_UInt))
(define-freetype FT_Load_Glyph (_fun _FT_Face _FT_UInt _FT_Int32
-> (err : _FT_Error)))
(define-freetype FT_Load_Char (_fun _FT_Face _FT_ULong _FT_Int32
-> (err : _FT_Error)))
(define+provide FT_KERNING_UNSCALED 2)
(define+provide FT_LOAD_DEFAULT 0)
(define+provide FT_LOAD_RENDER (expt 2 2))
(define+provide FT_LOAD_LINEAR_DESIGN (expt 2 13))
(define+provide FT_LOAD_NO_RECURSE (expt 2 10))

@ -0,0 +1,31 @@
#lang br
(require "freetype-ffi.rkt")
(provide (all-defined-out))
(define ft-library (FT_Init_FreeType))
(define ft-face-cache (make-hash))
(define (font-pathstring->ft-face font-pathstring)
(hash-ref! ft-face-cache font-pathstring
(λ ()
(unless (file-exists? font-pathstring)
(error 'measure-char (format "font path ~v does not exist" font-pathstring)))
(FT_New_Face ft-library font-pathstring 0))))
(define (get-glyph-idx font-pathstring char)
(FT_Get_Char_Index (font-pathstring->ft-face font-pathstring) (char->integer char)))
(define (measure-char font-pathstring char)
(measure-char-idx font-pathstring (get-glyph-idx font-pathstring char)))
(define (measure-char-idx font-pathstring glyph-idx)
(define ft-face (font-pathstring->ft-face font-pathstring))
(FT_Load_Glyph ft-face glyph-idx FT_LOAD_NO_RECURSE) ; loads into FTFace's 'glyph' slot
(define width (FT_Vector-x (FT_GlyphSlotRec-advance (FT_FaceRec-glyph ft-face))))
width)
(module+ test
(require rackunit)
(check-equal? (measure-char "miso.otf" #\f) 296)
(check-equal? (measure-char-idx "miso.otf" 46) 296))

@ -49,7 +49,6 @@ ET
'Type 'Font
'Subtype 'Type1
'Name 'F1
'BaseFont 'Helvetica
'FontDescriptor (co-io-ref 9 0)))
@ -69,7 +68,7 @@ ET
(co-io 9 0
(make-co-dict
'Type 'FontDescriptor
'FontName 'Miso
'FontName 'FiraSansOTLight
'FontFile3 (co-io-ref 10 0)
'Flags 262178
'FontBBox (co-array '(-177 -269 1123 866))
@ -85,4 +84,4 @@ ET
'AvgWidth 478
'ItalicAngle 0))
(co-io 10 0 (make-font-co-stream "miso.otf"))
(co-io 10 0 (make-font-co-stream "fira.otf"))

@ -0,0 +1,87 @@
#lang at-exp s-exp pitfall/render
;; catalog object
(co-io 1 0 (co-catalog #:pages (co-io-ref 2 0)))
;; pages
(co-io 2 0 (co-pages #:kids (list (co-io-ref 3 0))
#:count 1))
;; page
(co-io 3 0 (co-page #:parent (co-io-ref 2 0)
#:mediabox '(0 0 400 400)
#:resources (co-io-ref 4 0)
#:contents (co-io-ref 5 0)
; the value of annots must be an array
#:annots (co-array (list (co-io-ref 7 0)))
))
#;#:annots (co-io-ref 7 0)
;; resources
(co-io 4 0
(make-co-dict
'ProcSet (co-array '(PDF Text))
'Font (make-co-dict 'F1 (co-io-ref 6 0))))
;; contents
(co-io 5 0
(make-co-stream
#"
BT
/F1 48 Tf
(Hello) Tj
(World) Tj
ET
"))
;; font
(co-io 6 0
(make-co-dict
'Type 'Font
'Subtype 'Type1
'Name 'F1
'BaseFont 'FiraSansOTMedium
'FontDescriptor (co-io-ref 9 0)
'FirstChar 0
'LastChar 1150
'Widths (co-array (for/list ([i (in-range (add1 1150))])
(define m (measure-char-idx "fira.otf" i))
(displayln m)
m))
'Encoding 'MacRomanEncoding))
(co-io 7 0
(make-co-dict 'Type 'Annot
'Subtype 'Link
'Rect (co-array '(100 100 150 125))
'A (co-io-ref 8 0)))
(co-io 8 0
(make-co-dict 'Type 'Action
'S 'URI
'URI (co-string "http://practicaltypography.com")))
(co-io 9 0
(make-co-dict
'Type 'FontDescriptor
'FontName 'FiraSansOTLight
'FontFile3 (co-io-ref 10 0)
'Flags 4
'FontBBox (co-array '(-177 -269 1123 866))
'MissingWidth 255
'StemV 105
'StemH 45
'CapHeight 660
'XHeight 394
'Ascent 720
'Descent -270
'Leading 83
'MaxWidth 1212
'AvgWidth 478
'ItalicAngle 0))
(co-io 10 0 (make-font-co-stream "fira.otf"))

@ -1,10 +1,9 @@
#lang at-exp racket/base
(require (for-syntax racket/base)
racket/string pitfall/struct br/define racket/bytes sugar/debug racket/format racket/file)
#lang at-exp br
(require racket/string pitfall/struct pitfall/measure br/define racket/bytes sugar/debug racket/format racket/file)
(provide (all-defined-out)
(all-from-out pitfall/struct)
(all-from-out pitfall/struct pitfall/measure)
file->bytes
(except-out (all-from-out racket/base) #%module-begin))
(except-out (all-from-out br) #%module-begin))
(define-macro (mb . ARGS)
#'(#%module-begin (render-args . ARGS)))

Loading…
Cancel
Save