From 7e7937bc09238320c11e3321debf603671131baa Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 14 May 2017 21:23:04 -0700 Subject: [PATCH] touchups --- pitfall/pitfall/color.rkt | 69 +++++++++++++++++------------------ pitfall/pitfall/document.rkt | 3 +- pitfall/pitfall/reference.rkt | 26 +++++++------ pitfall/pitfall/vector.rkt | 6 +-- 4 files changed, 54 insertions(+), 50 deletions(-) diff --git a/pitfall/pitfall/color.rkt b/pitfall/pitfall/color.rkt index 42afe61e..ea7ec9ee 100644 --- a/pitfall/pitfall/color.rkt +++ b/pitfall/pitfall/color.rkt @@ -26,39 +26,38 @@ (set-field! _gradCount this 0)) -(define/contract (_normalizeColor this color) - ((or/c string? (listof number?)) . ->m . (or/c (listof number?) #f)) +(define/contract (_normalizeColor color) + ((or/c string? (listof number?)) . -> . (or/c (listof number?) #f)) ;; parses color string into list of values - (cond - #;[(is-a? color PDFGradient) color] ; todo - ;; 3-digit hex becomes 6-digit hex - [(and (string? color) - (regexp-match #px"^#(?i:[0-9A-F]){3}$" color)) - (_normalizeColor this - (list->string (cdr (apply append - (for/list ([c (in-string color)]) - (list c c))))))] ; change #abc to ##aabbcc then drop the first char - ;; 6-digit hexish string becomes list of hex numbers and maybe #f vals - [(and (string? color) (= 7 (string-length color)) (string-prefix? color "#")) - (_normalizeColor this - (for/list ([str (in-list (regexp-match* #rx".." (string-trim color "#")))]) - (string->number str 16)))] ; match two at a time and convert to hex - ;; named color - [(and (string? color) (hash-ref namedColors color #f)) => (curry _normalizeColor this)] - ;; array of numbers - [(and (list? color) (andmap number? color)) - (for/list ([i (in-list color)]) - (define x (/ i (case (length color) - [(3) 255.0] ; RGB - [(4) 100.0] ; CMYK - [else 1.0]))) - (if (integer? x) (inexact->exact x) x))] - [else #f])) + (let loop ([color color]) + (cond + #;[(is-a? color PDFGradient) color] ; todo + ;; 3-digit hex becomes 6-digit hex + [(and (string? color) + (regexp-match #px"^#(?i:[0-9A-F]){3}$" color)) + (loop (list->string (cdr (apply append + (for/list ([c (in-string color)]) + (list c c))))))] ; change #abc to ##aabbcc then drop the first char + ;; 6-digit hexish string becomes list of hex numbers and maybe #f vals + [(and (string? color) (= 7 (string-length color)) (string-prefix? color "#")) + (loop (for/list ([str (in-list (regexp-match* #rx".." (string-trim color "#")))]) + (string->number str 16)))] ; match two at a time and convert to hex + ;; named color + [(and (string? color) (hash-ref namedColors color #f)) => loop] + ;; array of numbers + [(and (list? color) (andmap number? color)) + (for/list ([i (in-list color)]) + (define x (/ i (case (length color) + [(3) 255.0] ; RGB + [(4) 100.0] ; CMYK + [else 1.0]))) + (if (integer? x) (inexact->exact x) x))] + [else #f]))) (define/contract (_setColor this color stroke) (color-string? (or/c #f number?) . ->m . boolean?) - (let ([color (_normalizeColor this color)] + (let ([color (_normalizeColor color)] [op (if stroke "SCN" "scn")]) (cond [(not color)] @@ -84,7 +83,7 @@ (define/contract (fillColor this color [opacity 1]) ((color-string?) ((or/c number? #f)) . ->*m . object?) - (unless (_normalizeColor this color) + (unless (_normalizeColor color) (raise-argument-error 'fillColor "valid color string" color)) (when (_setColor this color #f) (fillOpacity this opacity)) @@ -280,9 +279,9 @@ (module+ test (require rackunit) (define c (new (color-mixin))) - (check-equal? (_normalizeColor c "#6699Cc") '(0.4 0.6 0.8)) - (check-false (_normalizeColor c "#88aaCCC")) - (check-equal? (_normalizeColor c "#69C") '(0.4 0.6 0.8)) - (check-equal? (_normalizeColor c "#69c") '(0.4 0.6 0.8)) - (check-false (_normalizeColor c "#8aCC")) - (check-equal? (_normalizeColor c "aqua") '(0 1 1))) \ No newline at end of file + (check-equal? (_normalizeColor "#6699Cc") '(0.4 0.6 0.8)) + (check-false (_normalizeColor "#88aaCCC")) + (check-equal? (_normalizeColor "#69C") '(0.4 0.6 0.8)) + (check-equal? (_normalizeColor "#69c") '(0.4 0.6 0.8)) + (check-false (_normalizeColor "#8aCC")) + (check-equal? (_normalizeColor "aqua") '(0 1 1))) \ No newline at end of file diff --git a/pitfall/pitfall/document.rkt b/pitfall/pitfall/document.rkt index 2691ae7c..8dbb81a0 100644 --- a/pitfall/pitfall/document.rkt +++ b/pitfall/pitfall/document.rkt @@ -126,7 +126,8 @@ (newBuffer (string-append data "\n")) data)]) (push this data) - (void (increment-field! _offset this (buffer-length data))))) + (increment-field! _offset this (buffer-length data)) + (void))) (define/contract (addContent this data) diff --git a/pitfall/pitfall/reference.rkt b/pitfall/pitfall/reference.rkt index e6d4b74c..b7e1289f 100644 --- a/pitfall/pitfall/reference.rkt +++ b/pitfall/pitfall/reference.rkt @@ -45,6 +45,7 @@ (hash-update! (· this data) 'Length (λ (len) (+ len (buffer-length chunk))))]) (callback)) + (define/contract (end this [chunk #f]) (() ((or/c any/c #f)) . ->*m . void?) ; (super) ; todo @@ -52,23 +53,26 @@ (void) ; todo (deflate-end) (send this finalize))) + (define/contract (finalize this) (->m void?) (set-field! offset this (· this document _offset)) - - (send (· this document) _write (format "~a ~a obj" (· this id) (· this gen))) - (send (· this document) _write (convert (· this data))) - (when (positive? (length (· this chunks))) - (send (· this document) _write "stream") - (for ([chunk (in-list (· this chunks))]) - (send (· this document) _write chunk)) + (define this-doc (· this document)) + (send* this-doc + [_write (format "~a ~a obj" (· this id) (· this gen))] + [_write (convert (· this data))]) - (set-field! chunks this null) ; free up memory - (send (· this document) _write "\nendstream")) + (let ([this-chunks (· this chunks)]) + (when (positive? (length this-chunks)) + (send this-doc _write "stream") + (for ([chunk (in-list this-chunks)]) + (send this-doc _write chunk)) + (send this-doc _write "\nendstream"))) - (send (· this document) _write "endobj") - (send (· this document) _refEnd this)) + (send* this-doc + [_write "endobj"] + [_refEnd this])) (define/contract (toString this) (->m string?) diff --git a/pitfall/pitfall/vector.rkt b/pitfall/pitfall/vector.rkt index f70a8b0a..65639cce 100644 --- a/pitfall/pitfall/vector.rkt +++ b/pitfall/pitfall/vector.rkt @@ -84,8 +84,8 @@ (number? number? number? . ->m . object?) (ellipse this x y radius)) -(define/contract (_windingRule this rule) - ((or/c string? #f) . ->m . string?) +(define/contract (_windingRule rule) + ((or/c string? #f) . -> . string?) (if (and (string? rule) (regexp-match #rx"^even-?odd$" rule)) "*" "")) (define/contract (fill this color [rule #f]) @@ -94,7 +94,7 @@ (set! rule color) (set! color #f)) (when color (send this fillColor color)) ;; fillColor method is from color mixin - (send this addContent (format "f~a" (_windingRule this rule)))) + (send this addContent (format "f~a" (_windingRule rule)))) (define tm/c (list/c number? number? number? number? number? number?)) (define/contract (make-transform-string ctm)