From 4bb9f94a63842a6ac6c488464f2cf149c5d97c4c Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Sun, 30 Dec 2018 17:04:07 -0800
Subject: [PATCH] introduce current-font-features

---
 pitfall/pitfall/core.rkt          |  2 +-
 pitfall/pitfall/document.rkt      |  4 ++--
 pitfall/pitfall/embedded-font.rkt |  6 +++---
 pitfall/pitfall/font.rkt          | 14 ++++++++++++++
 pitfall/pitfall/text.rkt          |  4 ++--
 5 files changed, 22 insertions(+), 8 deletions(-)

diff --git a/pitfall/pitfall/core.rkt b/pitfall/pitfall/core.rkt
index aa94e579..c26e373d 100644
--- a/pitfall/pitfall/core.rkt
+++ b/pitfall/pitfall/core.rkt
@@ -14,11 +14,11 @@
               ctm
               ctm-stack
               font-families
+              current-font-features
               current-font-size
               current-font
               registered-fonts
               line-gap
-              text-options
               x
               y
               image-registry) #:transparent #:mutable)
diff --git a/pitfall/pitfall/document.rkt b/pitfall/pitfall/document.rkt
index 342761b8..1bed52c0 100644
--- a/pitfall/pitfall/document.rkt
+++ b/pitfall/pitfall/document.rkt
@@ -31,11 +31,11 @@
   (define ctm default-ctm-value)
   (define ctm-stack null)
   (define font-families (make-hash))
+  (define current-font-features null) ; connotes default features
   (define current-font-size 12)
   (define current-font #false)
   (define registered-fonts (make-hash))
   (define line-gap 0)
-  (define text-options #false)
   (define x 0)
   (define y 0)
   (define image-registry (make-hash))
@@ -49,11 +49,11 @@
                         ctm
                         ctm-stack
                         font-families
+                        current-font-features
                         current-font-size
                         current-font
                         registered-fonts
                         line-gap
-                        text-options
                         x
                         y
                         image-registry))
diff --git a/pitfall/pitfall/embedded-font.rkt b/pitfall/pitfall/embedded-font.rkt
index 102af56b..5bd15b67 100644
--- a/pitfall/pitfall/embedded-font.rkt
+++ b/pitfall/pitfall/embedded-font.rkt
@@ -26,9 +26,9 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
             #:when c)
            v))
 
-(define (to-hex . codePoints)
+(define (to-hex . codepoints)
   (string-append*
-   (for/list ([code (in-list codePoints)])
+   (for/list ([code (in-list codepoints)])
              (~r code #:base 16 #:min-width 4 #:pad-string "0"))))
 
 (define embedded-font%
@@ -70,7 +70,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
 
     ;; called from text.rkt    
     (define/override (encode str [features null])
-      (define features-key (and features (sort features string<?)))
+      (define features-key (and features (sort features bytes<?)))
       (hash-ref! encoding-cache (cons features-key str) 
                  (λ () 
                    (define glyph-run (layout font str features-key))
diff --git a/pitfall/pitfall/font.rkt b/pitfall/pitfall/font.rkt
index 65ec6a8a..c5cd779d 100644
--- a/pitfall/pitfall/font.rkt
+++ b/pitfall/pitfall/font.rkt
@@ -41,9 +41,23 @@
   doc)
 
 (define (font-size doc size)
+  (unless (and (number? size) (not (negative? size)))
+    (raise-argument-error 'font-size "non-negative number" size))
   (set-$doc-current-font-size! doc size)
   doc)
 
+(define (font-features doc features [unfeatures null])
+  (unless (or (not features) (and (list? features) (andmap bytes? features)))
+    (raise-argument-error 'font-features "list of byte strings or #f" features))
+  (unless (and (list? unfeatures) (andmap bytes? unfeatures))
+    (raise-argument-error 'font-features "list of byte strings" unfeatures))
+  (set-$doc-current-font-features! doc
+                                   (and features
+                                        (sort (for/list ([f (in-list features)]
+                                                         #:unless (memv f unfeatures))
+                                                f) bytes<?)))
+  doc)
+
 (define (register-font doc name src)
   (hash-set! ($doc-registered-fonts doc) name (make-hasheq (list (cons 'src src))))
   doc)
diff --git a/pitfall/pitfall/text.rkt b/pitfall/pitfall/text.rkt
index 3785cb29..6f859a63 100644
--- a/pitfall/pitfall/text.rkt
+++ b/pitfall/pitfall/text.rkt
@@ -84,7 +84,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
   ;; 180321: the first call to this operation is very slow from Quad
   ;; 181126: because `encode` calls `layout`
   (match-define (list encoded-char-strs positions)
-    (send ($doc-current-font doc) encode text (hash-ref options 'features #f)))
+    (send ($doc-current-font doc) encode text (hash-ref options 'features ($doc-current-font-features doc))))
   
   (define scale (/ ($doc-current-font-size doc) 1000.0))
   (define commands empty)
@@ -148,5 +148,5 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
   (move-down doc #:factor -1))
 
 (define (string-width doc str [options (mhash)])
-  (+ (send ($doc-current-font doc) string-width str ($doc-current-font-size doc) (hash-ref options 'features #f))
+  (+ (send ($doc-current-font doc) string-width str ($doc-current-font-size doc) (hash-ref options 'features ($doc-current-font-features doc)))
      (* (hash-ref options 'characterSpacing 0) (sub1 (string-length str)))))