From ad885430d0c2fe55c7982e9cd8bed98745c6c35d Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Sun, 30 Dec 2018 20:37:26 -0800
Subject: [PATCH] improve features semantics

---
 pitfall/pitfall/document.rkt      |  2 +-
 pitfall/pitfall/embedded-font.rkt |  8 +++---
 pitfall/pitfall/font.rkt          | 44 ++++++++++++++++++++++++-------
 pitfall/ptest/test19.rkt          |  2 +-
 4 files changed, 40 insertions(+), 16 deletions(-)

diff --git a/pitfall/pitfall/document.rkt b/pitfall/pitfall/document.rkt
index 1bed52c0..8a93e948 100644
--- a/pitfall/pitfall/document.rkt
+++ b/pitfall/pitfall/document.rkt
@@ -31,7 +31,7 @@
   (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-features null)
   (define current-font-size 12)
   (define current-font #false)
   (define registered-fonts (make-hash))
diff --git a/pitfall/pitfall/embedded-font.rkt b/pitfall/pitfall/embedded-font.rkt
index 5bd15b67..a1c51076 100644
--- a/pitfall/pitfall/embedded-font.rkt
+++ b/pitfall/pitfall/embedded-font.rkt
@@ -69,11 +69,11 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
     (define encoding-cache (make-hash))
 
     ;; called from text.rkt    
-    (define/override (encode str [features null])
-      (define features-key (and features (sort features bytes<?)))
-      (hash-ref! encoding-cache (cons features-key str) 
+    (define/override (encode str [features-in null])
+      (define features (sort (remove-duplicates features-in) bytes<? #:key car))
+      (hash-ref! encoding-cache (cons str features) 
                  (λ () 
-                   (define glyph-run (layout font str features-key))
+                   (define glyph-run (layout font str #:features features))
                    (define glyphs (glyphrun-glyphs glyph-run))
                    (define positions (glyphrun-positions glyph-run))
                    (define len (vector-length glyphs))
diff --git a/pitfall/pitfall/font.rkt b/pitfall/pitfall/font.rkt
index c5cd779d..c63ee200 100644
--- a/pitfall/pitfall/font.rkt
+++ b/pitfall/pitfall/font.rkt
@@ -3,6 +3,7 @@
   "core.rkt"
   racket/match
   racket/class
+  racket/list
   "standard-font.rkt"
   "embedded-font.rkt")
 (provide (all-defined-out))
@@ -46,16 +47,39 @@
   (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<?)))
+(define (net-features feats)
+  ;; filter out pairs of features with opposing (0 and 1) values
+  (let loop ([feats (remove-duplicates feats)]
+             [acc null])
+    (cond
+      [(empty? feats) acc]
+      [(empty? (cdr feats)) (loop empty (cons (car feats) acc))]
+      [else (define first-feat (car feats))
+            (match (cdr feats)
+              [(list head ... (? (λ (f) (bytes=? (car f) (car first-feat)))) tail ...)
+               (loop (append head tail) acc)]
+              [rest (loop rest (cons first-feat acc))])])))
+
+(define (font-features doc [features-on null] [features-off null])
+  (unless (and (list? features-on) (andmap bytes? features-on))
+    (raise-argument-error 'font-features "list of feature byte strings" features-on))
+  (unless (and (list? features-off) (andmap bytes? features-off))
+    (raise-argument-error 'font-features "list of feature byte strings" 'features-off))
+
+  (define (make-feat-pairs feats val)
+    (for/list ([f (in-list feats)])
+      (match f
+        [(cons (? bytes?) (? exact-nonnegative-integer?)) f]
+        [(? bytes?) (cons f val)]
+        [else
+         (raise-argument-error 'font-features
+                               "byte string or byte string + integer pair" f)])))
+  
+  (define new-features (append (make-feat-pairs features-on 1)
+                               (make-feat-pairs features-off 0)))
+  
+  (set-$doc-current-font-features!
+   doc (net-features (append ($doc-current-font-features doc) new-features)))
   doc)
 
 (define (register-font doc name src)
diff --git a/pitfall/ptest/test19.rkt b/pitfall/ptest/test19.rkt
index 0db9f9af..64a02e8d 100644
--- a/pitfall/ptest/test19.rkt
+++ b/pitfall/ptest/test19.rkt
@@ -14,7 +14,7 @@
   [font doc "the-font"]
   [font-size doc 100]
   [text doc "A&B" 100 100 (hash 'width #f)]
-  [text doc "X&Y" 100 200 (hash 'width #f 'features '(ss03))])
+  [text doc "X&Y" 100 200 (hash 'width #f 'features (list (cons #"ss03" 1)))])
 
 ;; test against non-subsetted font version
 (define-runtime-path this "test19rkt.pdf")