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

rename

Browse Source
main
Matthew Butterick 6 years ago
parent 8c1320a2d0
commit a66814cfd7
8 changed files with 57 additions and 57 deletions
Show Stats Download Patch File Download Diff File

10
pitfall/pitfall/path.rkt
Unescape Escape View File

@ -49,10 +49,10 @@
(match-define (list a0 a1 a2 a3 a4 a5) (match-define (list a0 a1 a2 a3 a4 a5)
(append cmd-args (make-list (- 6 (length cmd-args)) #f))) (append cmd-args (make-list (- 6 (length cmd-args)) #f)))
(case cmd-name (case cmd-name
[(M) (send doc moveTo . cmd-args) [(M) (send doc move-to . cmd-args)
(values a0 a1 #f #f a0 a1)] (values a0 a1 #f #f a0 a1)]
[(m) (loop 'M (list (+ cx a0) (+ cy a1)))] [(m) (loop 'M (list (+ cx a0) (+ cy a1)))]
[(C) (send doc bezierCurveTo . cmd-args) [(C) (send doc bezier-curve-to . cmd-args)
(values a4 a5 a2 a3 sx sy)] (values a4 a5 a2 a3 sx sy)]
[(c) (loop 'C (list (+ cx a0) (+ cy a1) [(c) (loop 'C (list (+ cx a0) (+ cy a1)
(+ cx a2) (+ cy a3) (+ cx a2) (+ cy a3)
@ -64,14 +64,14 @@
(values a2 a3 a0 a1 sx sy))] (values a2 a3 a0 a1 sx sy))]
[(s) (loop 'S (list (+ cx a0) (+ cy a1) [(s) (loop 'S (list (+ cx a0) (+ cy a1)
(+ cx a2) (+ cy a3)))] (+ cx a2) (+ cy a3)))]
[(L) (send doc lineTo . cmd-args) [(L) (send doc line-to . cmd-args)
(values a0 a1 #f #f sx sy)] (values a0 a1 #f #f sx sy)]
[(l) (loop 'L (list (+ cx a0) (+ cy a1)))] [(l) (loop 'L (list (+ cx a0) (+ cy a1)))]
[(H) (loop 'L (list a0 cy))] [(H) (loop 'L (list a0 cy))]
[(h) (loop 'L (list (+ cx a0) cy))] [(h) (loop 'L (list (+ cx a0) cy))]
[(V) (loop 'L (list cx a0))] [(V) (loop 'L (list cx a0))]
[(v) (loop 'L (list cx (+ cy a0)))] [(v) (loop 'L (list cx (+ cy a0)))]
[(Q) (send doc quadraticCurveTo . cmd-args) [(Q) (send doc quadratic-curve-to . cmd-args)
(values a2 a3 a0 a1 sx sy)] (values a2 a3 a0 a1 sx sy)]
[(q) (loop 'Q (list (+ cx a0) (+ cy a1) [(q) (loop 'Q (list (+ cx a0) (+ cy a1)
(+ cx a2) (+ cy a3)))] (+ cx a2) (+ cy a3)))]
@ -79,7 +79,7 @@
(if (not px) (if (not px)
(list cx py) (list cx py)
(list (- cx (- px cx) (- cy (- py cy)))))) (list (- cx (- px cx) (- cy (- py cy))))))
(send doc quadraticCurveTo . cmd-args)] (send doc quadratic-curve-to . cmd-args)]
;; todo other path ops ;; todo other path ops
[(z) (send doc closePath . cmd-args) [(z) (send doc closePath . cmd-args)
(values sx sy px py sx sy)] (values sx sy px py sx sy)]

10
pitfall/pitfall/text.rkt
Unescape Escape View File

@ -159,17 +159,17 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
(unless (· options stroke) (unless (· options stroke)
(define fill-colorArgs (· this _fill-color)) (define fill-colorArgs (· this _fill-color))
(send this stroke-color . fill-colorArgs)) (send this stroke-color . fill-colorArgs))
(define lineWidth (if (< (· this _fontSize) 10) (define line-width (if (< (· this _fontSize) 10)
0.5 0.5
(floor (/ (· this _fontSize) 10)))) (floor (/ (· this _fontSize) 10))))
(send this lineWidth lineWidth) (send this line-width line-width)
(define d (if (· options underline) 1 2)) (define d (if (· options underline) 1 2))
(define lineY (+ y-in (/ (· this currentLineHeight) d))) (define lineY (+ y-in (/ (· this currentLineHeight) d)))
(when (· options underline) (when (· options underline)
(increment! lineY (- lineWidth))) (increment! lineY (- line-width)))
(send this moveTo x lineY) (send this move-to x lineY)
(send this lineTo (+ x (force renderedWidth)) lineY) (send this line-to (+ x (force renderedWidth)) lineY)
(send this stroke) (send this stroke)
(send this restore)) (send this restore))

38
pitfall/pitfall/vector.rkt
Unescape Escape View File

@ -23,12 +23,12 @@
closePath closePath
lineCap lineCap
lineJoin lineJoin
lineWidth line-width
dash dash
moveTo move-to
lineTo line-to
bezierCurveTo bezier-curve-to
quadraticCurveTo quadratic-curve-to
rect rect
ellipse ellipse
circle circle
@ -37,7 +37,7 @@
_windingRule _windingRule
fill fill
stroke stroke
fillAndStroke fill-and-stroke
clip clip
shear shear
transform transform
@ -90,7 +90,7 @@
"")))) ""))))
(define/contract (lineWidth this w) (define/contract (line-width this w)
(number? . ->m . object?) (number? . ->m . object?)
(send this addContent (format "~a w" (number w)))) (send this addContent (format "~a w" (number w))))
@ -112,22 +112,22 @@
[else this])) [else this]))
(define/contract (moveTo this x y) (define/contract (move-to this x y)
(number? number? . ->m . object?) (number? number? . ->m . object?)
(send this addContent (format "~a ~a m" x y))) (send this addContent (format "~a ~a m" x y)))
(define/contract (lineTo this x y) (define/contract (line-to this x y)
(number? number? . ->m . object?) (number? number? . ->m . object?)
(send this addContent (format "~a ~a l" x y))) (send this addContent (format "~a ~a l" x y)))
(define/contract (bezierCurveTo this cp1x cp1y cp2x cp2y x y) (define/contract (bezier-curve-to this cp1x cp1y cp2x cp2y x y)
(number? number? number? number? number? number? . ->m . object?) (number? number? number? number? number? number? . ->m . object?)
(send this addContent (format "~a c" (string-join (map number (list cp1x cp1y cp2x cp2y x y)) " ")))) (send this addContent (format "~a c" (string-join (map number (list cp1x cp1y cp2x cp2y x y)) " "))))
(define/contract (quadraticCurveTo this cpx cpy x y) (define/contract (quadratic-curve-to this cpx cpy x y)
(number? number? number? number . ->m . object?) (number? number? number? number . ->m . object?)
(send this addContent (format "~a v" (string-join (map number (list cpx cpy x y)) " ")))) (send this addContent (format "~a v" (string-join (map number (list cpx cpy x y)) " "))))
@ -149,11 +149,11 @@
(define ye (+ y (* r2 2))) ; y-end (define ye (+ y (* r2 2))) ; y-end
(define xm (+ x r1)) ; x-middle (define xm (+ x r1)) ; x-middle
(define ym (+ y r2)) ; y-middle (define ym (+ y r2)) ; y-middle
(moveTo this x ym) (move-to this x ym)
(bezierCurveTo this x (- ym oy) (- xm ox) y xm y) (bezier-curve-to this x (- ym oy) (- xm ox) y xm y)
(bezierCurveTo this (+ xm ox) y xe (- ym oy) xe ym) (bezier-curve-to this (+ xm ox) y xe (- ym oy) xe ym)
(bezierCurveTo this xe (+ ym oy) (+ xm ox) ye xm ye) (bezier-curve-to this xe (+ ym oy) (+ xm ox) ye xm ye)
(bezierCurveTo this (- xm ox) ye x (+ ym oy) x ym) (bezier-curve-to this (- xm ox) ye x (+ ym oy) x ym)
(closePath this)) (closePath this))
@ -166,9 +166,9 @@
(() () #:rest (listof (list/c number? number?)) . ->*m . object?) (() () #:rest (listof (list/c number? number?)) . ->*m . object?)
(cond (cond
[(pair? points) [(pair? points)
(apply moveTo this (car points)) (apply move-to this (car points))
(for ([pt (in-list (cdr points))]) (for ([pt (in-list (cdr points))])
(apply lineTo this pt)) (apply line-to this pt))
(closePath this)] (closePath this)]
[else this])) [else this]))
@ -196,7 +196,7 @@
(send this addContent "S")) (send this addContent "S"))
(define/contract (fillAndStroke this [fill #f] [stroke fill] #:rule [rule #f]) (define/contract (fill-and-stroke this [fill #f] [stroke fill] #:rule [rule #f])
(() ((or/c color-string? #f) (or/c color-string? #f) #:rule (or/c string? #f)) . ->*m . object?) (() ((or/c color-string? #f) (or/c color-string? #f) #:rule (or/c string? #f)) . ->*m . object?)
(when fill (send* this [fill-color fill] [stroke-color stroke])) (when fill (send* this [fill-color fill] [stroke-color stroke]))
(send this addContent (format "B~a" (_windingRule rule)))) (send this addContent (format "B~a" (_windingRule rule))))

6
pitfall/ptest/test1.rkt
Unescape Escape View File

@ -5,9 +5,9 @@
;; Draw a triangle and a circle ;; Draw a triangle and a circle
(send* doc (send* doc
[save] [save]
[moveTo 100 150] [move-to 100 150]
[lineTo 100 250] [line-to 100 250]
[lineTo 200 250] [line-to 200 250]
[fill "#FF3300"]) [fill "#FF3300"])
(send* doc (send* doc

4
pitfall/ptest/test10.rkt
Unescape Escape View File

@ -10,11 +10,11 @@
(send doc path (hash-ref part 'path)) (send doc path (hash-ref part 'path))
(when (hash-has-key? part "stroke-width") (when (hash-has-key? part "stroke-width")
(send doc lineWidth (string->number (hash-ref part "stroke-width")))) (send doc line-width (string->number (hash-ref part "stroke-width"))))
(if (and (not (string=? (hash-ref part 'fill "none") "none")) (if (and (not (string=? (hash-ref part 'fill "none") "none"))
(not (string=? (hash-ref part 'stroke "none") "none"))) (not (string=? (hash-ref part 'stroke "none") "none")))
(send doc fillAndStroke (hash-ref part 'fill) (hash-ref part 'stroke)) (send doc fill-and-stroke (hash-ref part 'fill) (hash-ref part 'stroke))
(begin (begin
(unless (string=? (hash-ref part 'fill "none") "none") (unless (string=? (hash-ref part 'fill "none") "none")
(send doc fill (hash-ref part 'fill))) (send doc fill (hash-ref part 'fill)))

26
pitfall/ptest/test2.rkt
Unescape Escape View File

@ -5,11 +5,11 @@
;; curved path as bezier ;; curved path as bezier
(send* doc (send* doc
[moveTo 0 20] [move-to 0 20]
[lineTo 100 160] [line-to 100 160]
[quadraticCurveTo 130 200 150 120] [quadratic-curve-to 130 200 150 120]
[bezierCurveTo 190 -40 200 200 300 150] [bezier-curve-to 190 -40 200 200 300 150]
[lineTo 400 90] [line-to 400 90]
[stroke]) [stroke])
(send* doc [translate 0 200]) (send* doc [translate 0 200])
@ -33,29 +33,29 @@
[save] [save]
[translate 400 0] [translate 400 0]
[circle 100 50 50] [circle 100 50 50]
[lineWidth 3] [line-width 3]
[fill-opacity 0.8] [fill-opacity 0.8]
[fillAndStroke "red" "#900"] [fill-and-stroke "red" "#900"]
[restore]) [restore])
(send* doc [translate 0 200]) (send* doc [translate 0 200])
;; these examples are easier to see with a large line width ;; these examples are easier to see with a large line width
(send* doc [lineWidth 25]) (send* doc [line-width 25])
;; line cap settings ;; line cap settings
(send* doc [lineCap 'butt] (send* doc [lineCap 'butt]
[moveTo 50 20] [move-to 50 20]
[lineTo 100 20] [line-to 100 20]
[stroke] [stroke]
[lineCap 'round] [lineCap 'round]
[moveTo 150 20] [move-to 150 20]
[lineTo 200 20] [line-to 200 20]
[stroke]) [stroke])
;; square line cap shown with a circle instead of a line so you can see it ;; square line cap shown with a circle instead of a line so you can see it
(send* doc [lineCap 'square] (send* doc [lineCap 'square]
[moveTo 250 20] [move-to 250 20]
[circle 275 30 15] [circle 275 30 15]
[stroke]) [stroke])

10
pitfall/ptest/test9.rkt
Unescape Escape View File

@ -3,11 +3,11 @@
(define (proc doc) (define (proc doc)
(send* doc (send* doc
[moveTo 0 20] [move-to 0 20]
[lineTo 100 160] [line-to 100 160]
[quadraticCurveTo 130 200 150 120] [quadratic-curve-to 130 200 150 120]
[bezierCurveTo 190 -40 200 200 300 150] [bezier-curve-to 190 -40 200 200 300 150]
[lineTo 400 90] [line-to 400 90]
[stroke]) [stroke])
(send* doc [translate 0 200]) (send* doc [translate 0 200])

10
pitfall/ptest/testrkt.rkt
Unescape Escape View File

@ -32,9 +32,9 @@ doc.add-page()
# Draw a triangle and a circle # Draw a triangle and a circle
doc.save() doc.save()
.moveTo(100, 150) .move-to(100, 150)
.lineTo(100, 250) .line-to(100, 250)
.lineTo(200, 250) .line-to(200, 250)
.fill("#FF3300") .fill("#FF3300")
doc.circle(280, 200, 50) doc.circle(280, 200, 50)
@ -69,10 +69,10 @@ for part in tiger
doc.path(part.path) # render an SVG path doc.path(part.path) # render an SVG path
if part['stroke-width'] if part['stroke-width']
doc.lineWidth part['stroke-width'] doc.line-width part['stroke-width']
if part.fill isnt 'none' and part.stroke isnt 'none' if part.fill isnt 'none' and part.stroke isnt 'none'
doc.fillAndStroke(part.fill, part.stroke) doc.fill-and-stroke(part.fill, part.stroke)
else else
unless part.fill is 'none' unless part.fill is 'none'
doc.fill(part.fill) doc.fill(part.fill)

Write Preview
Loading…
Cancel
Save