diff --git a/pitfall/pitfall/fira.otf b/pitfall/pitfall/fira.otf new file mode 100755 index 00000000..280fe8a7 Binary files /dev/null and b/pitfall/pitfall/fira.otf differ diff --git a/pitfall/pitfall/freetype-ffi.rkt b/pitfall/pitfall/freetype-ffi.rkt new file mode 100644 index 00000000..1749a904 --- /dev/null +++ b/pitfall/pitfall/freetype-ffi.rkt @@ -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)) + + + diff --git a/pitfall/pitfall/measure.rkt b/pitfall/pitfall/measure.rkt new file mode 100644 index 00000000..06aec3da --- /dev/null +++ b/pitfall/pitfall/measure.rkt @@ -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)) diff --git a/pitfall/pitfall/minimal-embedded-font.rkt b/pitfall/pitfall/minimal-embedded-font.rkt index 530e0c17..cd945919 100644 --- a/pitfall/pitfall/minimal-embedded-font.rkt +++ b/pitfall/pitfall/minimal-embedded-font.rkt @@ -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")) diff --git a/pitfall/pitfall/minimal-measured-font.rkt b/pitfall/pitfall/minimal-measured-font.rkt new file mode 100644 index 00000000..1b800ca4 --- /dev/null +++ b/pitfall/pitfall/minimal-measured-font.rkt @@ -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")) diff --git a/pitfall/pitfall/render.rkt b/pitfall/pitfall/render.rkt index 5871e6dc..ebf0e4fe 100644 --- a/pitfall/pitfall/render.rkt +++ b/pitfall/pitfall/render.rkt @@ -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)))