From eb7409cee2cb76a5e24f9a1e3af314e2285d09aa Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 13 May 2017 19:32:28 -0700 Subject: [PATCH] nit picked --- pitfall/pitfall/kit/color.rkt | 81 ++++++++++++++++++++++++----------- pitfall/pktest/test1rkt.pdf | 36 ++++++++++------ 2 files changed, 80 insertions(+), 37 deletions(-) diff --git a/pitfall/pitfall/kit/color.rkt b/pitfall/pitfall/kit/color.rkt index faa99245..40da59b9 100644 --- a/pitfall/pitfall/kit/color.rkt +++ b/pitfall/pitfall/kit/color.rkt @@ -1,6 +1,7 @@ #lang racket/base -(require racket/class racket/string) +(require racket/class racket/string racket/match) (provide color-mixin) +(require sugar/debug) (require "helper.rkt") (define (color-mixin %) @@ -46,22 +47,22 @@ (public [@_setColor _setColor]) (define (@_setColor color stroke) - (set! color (@_normalizeColor color)) - (define op (if stroke "SCN" "scn")) - (cond - [(not color)] - #;[(is-a? color PDFGradient) - (@_setColorSpace "Pattern" stroke) - (send color apply op) - #t] ; todo - [else - (define space (if (= (length color) 4) - "DeviceCMYK" - "DeviceRGB")) - (@_setColorSpace space stroke) - (set! color (string-join (map number color) " ")) - (send this addContent (format "~a ~a" color op)) - #t])) + (set! color (@_normalizeColor color)) + (define op (if stroke "SCN" "scn")) + (cond + [(not color)] + #;[(is-a? color PDFGradient) + (@_setColorSpace "Pattern" stroke) + (send color apply op) + #t] ; todo + [else + (define space (if (= (length color) 4) + "DeviceCMYK" + "DeviceRGB")) + (@_setColorSpace space stroke) + (set! color (string-join (map number color) " ")) + (send this addContent (format "~a ~a" color op)) + #t])) (public [@_setColorSpace _setColorSpace]) @@ -73,13 +74,13 @@ (field ([@_fillColor _fillColor] #f)) (public [@fillColor fillColor]) (define (@fillColor color [opacity 1]) - (define set (@_setColor color #f)) - (when set (@fillOpacity opacity)) + (when (@_setColor color #f) + (@fillOpacity opacity)) - ;; save this for text wrapper, which needs to reset - ;; the fill color on new pages - (set! @_fillColor (list color opacity)) - this) + ;; save this for text wrapper, which needs to reset + ;; the fill color on new pages + (set! @_fillColor (list color opacity)) + this) (public [@fillOpacity fillOpacity]) @@ -90,7 +91,39 @@ (public [@_doOpacity doOpacity]) (define (@_doOpacity fillOpacity strokeOpacity) - (send this addContent "")) ; todo + (when (or fillOpacity strokeOpacity) + (when fillOpacity + (set! fillOpacity (max 0 (min 1 fillOpacity)))) + (when strokeOpacity + (set! strokeOpacity (max 0 (min 1 strokeOpacity)))) + + (define key (format "~a_~a" + (if fillOpacity (number fillOpacity) "") + (if strokeOpacity (number strokeOpacity) ""))) + + (define dictionary #f) + (define name #f) + (cond + [(hash-has-key? @_opacityRegistry key) + (match-define (list d n) (hash-ref @_opacityRegistry key)) + (set! dictionary d) + (set! name n)] + [else + (set! dictionary (mhash 'Type "ExtGState")) + (when fillOpacity + (hash-set! dictionary 'ca fillOpacity)) + (when strokeOpacity + (hash-set! dictionary 'CA strokeOpacity)) + + (set! dictionary (send this ref dictionary)) + (· dictionary end) + (++ @_opacityCount) + (define id @_opacityCount) + (set! name (format "Gs~a" id)) + (hash-set! @_opacityRegistry key (list dictionary name))]) + + (hash-set! (· this page ext_gstates) name dictionary) + (send this addContent (format "/~a gs" name)))) )) diff --git a/pitfall/pktest/test1rkt.pdf b/pitfall/pktest/test1rkt.pdf index 5f685a21..f1c5089b 100644 --- a/pitfall/pktest/test1rkt.pdf +++ b/pitfall/pktest/test1rkt.pdf @@ -1,5 +1,11 @@ %PDF-1.3 %ÿÿÿÿ +6 0 obj +<< +/ca 1 +/Type /ExtGState +>> +endobj 5 0 obj << /Parent 1 0 R @@ -11,12 +17,15 @@ endobj 4 0 obj << +/ExtGState << +/Gs1 6 0 R +>> /ProcSet [/PDF /Text /ImageB /ImageC /ImageI] >> endobj 3 0 obj << -/Length 280 +/Length 294 >> stream 1 0 0 -1 0 792 cm @@ -26,7 +35,7 @@ q 200 250 l /DeviceRGB cs 1 0.2 0 scn - +/Gs1 gs f 230 200 m 230 172.385763 252.385763 150 280 150 c @@ -36,12 +45,12 @@ f h /DeviceRGB cs 0.4 0 1 scn - +/Gs1 gs f endstream endobj -6 0 obj +7 0 obj << /CreationDate (D:19700101000000Z) /Creator (PitfallKit) @@ -62,20 +71,21 @@ endobj >> endobj xref -0 7 +0 8 0000000000 65535 f -0000000666 00000 n -0000000617 00000 n -0000000186 00000 n -0000000119 00000 n +0000000752 00000 n +0000000703 00000 n +0000000258 00000 n +0000000163 00000 n +0000000059 00000 n 0000000015 00000 n -0000000517 00000 n +0000000603 00000 n trailer << -/Info 6 0 R +/Info 7 0 R /Root 2 0 R -/Size 7 +/Size 8 >> startxref -723 +809 %%EOF