From 12147506cb86c85d98992498d1b2239867d48800 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 19 Jun 2017 12:30:23 -0700 Subject: [PATCH] step1 --- pitfall/fontkit/OS2.rkt | 80 ++++++++++++++++++++++++++++++++++ pitfall/fontkit/post.rkt | 52 ++++++++++++++++++++++ pitfall/restructure/number.rkt | 32 ++++++++++++-- 3 files changed, 160 insertions(+), 4 deletions(-) create mode 100644 pitfall/fontkit/OS2.rkt create mode 100644 pitfall/fontkit/post.rkt diff --git a/pitfall/fontkit/OS2.rkt b/pitfall/fontkit/OS2.rkt new file mode 100644 index 00000000..4e4e90a1 --- /dev/null +++ b/pitfall/fontkit/OS2.rkt @@ -0,0 +1,80 @@ +#lang fontkit/racket +(require restructure) +(provide (all-defined-out)) + +#| +approximates +https://github.com/mbutterick/fontkit/blob/master/src/tables/OS2.js +|# + +(define-subclass VersionedStruct (ROS/2)) + +(define OS/2 (let () + (define header-fields + (dictify 'xAvgCharWidth int16be ;; average weighted advance width of lower case letters and space + 'usWeightClass uint16be ;; visual weight of stroke in glyphs + 'usWidthClass uint16be ;; relative change from the normal aspect ratio (width to height ratio) + ;; Indicates font embedding licensing rights + 'fsType (+Bitfield uint16be '(null noEmbedding viewOnly editable null null null null noSubsetting bitmapOnly)) + 'ySubscriptXSize int16be ;; recommended horizontal size in pixels for subscripts + 'ySubscriptYSize int16be ;; recommended vertical size in pixels for subscripts + 'ySubscriptXOffset int16be ;; recommended horizontal offset for subscripts + 'ySubscriptYOffset int16be ;; recommended vertical offset form the baseline for subscripts + 'ySuperscriptXSize int16be ;; recommended horizontal size in pixels for superscripts + 'ySuperscriptYSize int16be ;; recommended vertical size in pixels for superscripts + 'ySuperscriptXOffset int16be ;; recommended horizontal offset for superscripts + 'ySuperscriptYOffset int16be ;; recommended vertical offset from the baseline for superscripts + 'yStrikeoutSize int16be ;; width of the strikeout stroke + 'yStrikeoutPosition int16be ;; position of the strikeout stroke relative to the baseline + 'sFamilyClass int16be ;; classification of font-family design + 'panose (+Array uint8 10) ;; describe the visual characteristics of a given typeface + 'ulCharRange (+Array uint32be 4) + 'vendorID (+String 4) ;; four character identifier for the font vendor + ;; bit field containing information about the font + 'fsSelection (+Bitfield uint16 '(italic underscore negative outlined strikeout bold regular useTypoMetrics wws oblique)) + 'usFirstCharIndex uint16be ;; The minimum Unicode index in this font + 'usLastCharIndex uint16be ;; The maximum Unicode index in this font + )) + + (define type-1-extra + (dictify 'typoAscender int16be + 'typoDescender int16be + 'typoLineGap int16be + 'winAscent uint16be + 'winDescent uint16be + 'codePageRange (+Array uint32be 2))) + + (define type-2-extra + (dictify 'xHeight int16be + 'capHeight int16be + 'defaultChar uint16be + 'breakChar uint16be + 'maxContent uint16be)) + + (define type-5-extra + (dictify 'usLowerOpticalPointSize uint16be + 'usUpperOpticalPointSize uint16be)) + + (make-object ROS/2 + uint16be + (dictify + 0 (append header-fields null) + 1 (append header-fields type-1-extra) + 2 (append header-fields type-1-extra type-2-extra) + 3 (append header-fields type-1-extra type-2-extra) + 4 (append header-fields type-1-extra type-2-extra) + 5 (append header-fields type-1-extra type-2-extra type-5-extra))))) + +(test-module + (define ip (open-input-file charter-path)) + (define dir (deserialize (read (open-input-file charter-directory-path)))) + (define offset (· dir tables OS/2 offset)) + (define len (· dir tables OS/2 length)) + (check-equal? offset 360) + (check-equal? len 96) + (define ds (+DecodeStream (peek-bytes len offset ip))) + (define version (send uint16be decode ds)) + (send OS/2 force-version! version) + (define table-data (send OS/2 decode ds)) + (check-equal? (· table-data panose) '(2 0 5 3 6 0 0 2 0 4)) + (check-equal? (· table-data sFamilyClass) 0)) diff --git a/pitfall/fontkit/post.rkt b/pitfall/fontkit/post.rkt new file mode 100644 index 00000000..0dba6ede --- /dev/null +++ b/pitfall/fontkit/post.rkt @@ -0,0 +1,52 @@ +#lang fontkit/racket +(require restructure) +(provide (all-defined-out)) + +#| +approximates +https://github.com/mbutterick/fontkit/blob/master/src/tables/post.js +|# + + +(define-subclass VersionedStruct (Rpost)) + +(define post (let () + (define header-fields + (dictify 'italicAngle fixed32be ;; Italic angle in counter-clockwise degrees from the vertical. + 'underlinePosition int16be ;; Suggested distance of the top of the underline from the baseline + 'underlineThickness int16be ;; Suggested values for the underline thickness + 'isFixedPitch uint32be ;; Whether the font is monospaced + 'minMemType42 uint32be ;; Minimum memory usage when a TrueType font is downloaded as a Type 42 font + 'maxMemType42 uint32be ;; Maximum memory usage when a TrueType font is downloaded as a Type 42 font + 'minMemType1 uint32be ;; Minimum memory usage when a TrueType font is downloaded as a Type 1 font + 'maxMemType1 uint32be ;; Maximum memory usage when a TrueType font is downloaded as a Type 1 font + )) + + + (make-object Rpost + fixed32be + (dictify + 1 (append header-fields null) + 2 (append header-fields (dictify 'numberOfGlyphs uint16be + 'glyphNameIndex (+Array uint16be 'numberOfGlyphs) + ;; this field causes problems due to deficiency in String class + ;; 'names (+Array (+String uint8)) + )) + 2.5 (append header-fields (dictify 'numberOfGlyphs uint16be + 'offsets (+Array uint8))) + 3 (append header-fields null) + 4 (append header-fields (dictify 'map (+Array uint32be (λ (t) (· (send (· t parent) _getTable 'maxp) numGlyphs))))))))) + +(test-module + (define ip (open-input-file charter-path)) + (define dir (deserialize (read (open-input-file charter-directory-path)))) + (define offset (· dir tables post offset)) + (define len (· dir tables post length)) + (check-equal? offset 41520) + (check-equal? len 514) + (define ds (+DecodeStream (peek-bytes len offset ip))) + (define version (send fixed32be decode ds)) + (send post force-version! version) + (define table-data (send post decode ds)) + (check-equal? (· table-data underlineThickness) 58) + (check-equal? (· table-data underlinePosition) -178)) \ No newline at end of file diff --git a/pitfall/restructure/number.rkt b/pitfall/restructure/number.rkt index 2892d2a0..7a1d3f7c 100644 --- a/pitfall/restructure/number.rkt +++ b/pitfall/restructure/number.rkt @@ -39,13 +39,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (values signed-min signed-max) (values (- signed-min signed-min) (- signed-max signed-min))))) - (define/augment (decode stream . args) + (define/augride (decode stream . args) (define bstr (send stream read _size)) (if (= 1 _size) (+ (bytes-ref bstr 0) (if _signed? bound-min 0)) (integer-bytes->integer bstr _signed? (eq? endian 'be)))) - (define/augment (encode stream val-in) + (define/augride (encode stream val-in) (define val (if (integer? val-in) (inexact->exact val-in) val-in)) ;; todo: better bounds checking (unless (<= bound-min val bound-max) @@ -54,7 +54,25 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (bytes (- val (if _signed? bound-min 0))) (integer->integer-bytes val _size _signed? (eq? endian 'be)))) (send stream write bstr))) - + +(define-subclass* Number (Fixed size [fixed-endian (if (system-big-endian?) 'be 'le)] [fracBits (floor (/ size 2))]) + (super-make-object (string->symbol (format "int~a" size)) fixed-endian) + (field [_point (expt 2 fracBits)]) + + (define/override (decode stream . args) + (define result (/ (super decode stream args) _point 1.0)) + (if (integer? result) (inexact->exact result) result)) + + (define/override (encode stream val) + (super encode stream (floor (* val _point))))) + +(define fixed16 (+Fixed 16)) +(define fixed16be (+Fixed 16 'be)) +(define fixed16le (+Fixed 16 'le)) +(define fixed32 (+Fixed 32)) +(define fixed32be (+Fixed 32 'be)) +(define fixed32le (+Fixed 32 'le)) + (test-module (check-exn exn:fail:contract? (λ () (+Number 'not-a-valid-type))) @@ -117,5 +135,11 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (check-equal? (send uint8 size) 1) (check-equal? (send uint16 size) 2) (check-equal? (send uint32 size) 4) - (check-equal? (send double size) 8)) + (check-equal? (send double size) 8) + + (define es (+EncodeStream)) + (send fixed16be encode es 123.45) + (check-equal? (send es dump) #"{s") + (define ds (+DecodeStream (send es dump))) + (check-equal? (ceiling (* (send fixed16be decode ds) 100)) 12345.0))