mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

step1

Browse Source
main
Matthew Butterick 7 years ago
parent 2514b6493d
commit 12147506cb
3 changed files with 160 additions and 4 deletions
Show Stats Download Patch File Download Diff File

80
pitfall/fontkit/OS2.rkt
Unescape Escape View File

@ -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))

52
pitfall/fontkit/post.rkt
Unescape Escape View File

@ -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))

32
pitfall/restructure/number.rkt
Unescape Escape View File

@ -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))

Write Preview
Loading…
Cancel
Save