suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

racket/draw: add text-outline' to dc-path%'

Browse Source 
original commit: 6c5c17056517da0b85506872299500e600a39cea
This commit is contained in:
Matthew Flatt 2011-12-25 18:16:49 -06:00
parent 0c98aca4c3
commit 521f398b64
1 changed files with 21 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/tests/gracket/draw.rkt
View File

@ -659,6 +659,17 @@
(loop (cdr fam) (cdr stl) (cdr wgt) (cdr sze) x (+ y h) #f))))) (loop (cdr fam) (cdr stl) (cdr wgt) (cdr sze) x (+ y h) #f)))))
(send dc set-pen save-pen))) (send dc set-pen save-pen)))
;; Text paths:
(let ([p (make-object dc-path%)]
[old-pen (send dc get-pen)]
[old-brush (send dc get-brush)])
(send p text-outline (make-font #:size 32) "A" 360 190)
(send dc set-pen "black" 1 'solid)
(send dc set-brush "pink" 'solid)
(send dc draw-path p)
(send dc set-pen old-pen)
(send dc set-brush old-brush))
; Bitmap copying: ; Bitmap copying:
(when (and (not no-bitmaps?) last?) (when (and (not no-bitmaps?) last?)
(let ([x 5] [y 165]) (let ([x 5] [y 165])
@ -1080,6 +1091,11 @@
[(lam) (let ([r (make-object region% clip-dc)]) [(lam) (let ([r (make-object region% clip-dc)])
(send r set-path lambda-path) (send r set-path lambda-path)
(send dc set-clipping-region r))] (send dc set-clipping-region r))]
[(A) (let ([p (new dc-path%)]
[r (make-object region% clip-dc)])
(send p text-outline (make-font #:size 256) "A" 10 10)
(send r set-path p)
(send dc set-clipping-region r))]
[(rect+poly) (let ([r (mk-poly 'winding)]) [(rect+poly) (let ([r (mk-poly 'winding)])
(send r union (mk-rect)) (send r union (mk-rect))
(send dc set-clipping-region r))] (send dc set-clipping-region r))]
@ -1161,7 +1177,8 @@
(let*-values ([(x y w h) (send r get-bounding-box)] (let*-values ([(x y w h) (send r get-bounding-box)]
[(l) (list x y w h)] [(l) (list x y w h)]
[(=~) (lambda (x y) [(=~) (lambda (x y)
(<= (- x 2) y (+ x 2)))]) (or (not y)
(<= (- x 2) y (+ x 2))))])
(unless (andmap =~ l (unless (andmap =~ l
(let ([l (let ([l
(case clip (case clip
@ -1170,6 +1187,7 @@
[(poly circle poly-rect) '(0. 60. 180. 180.)] [(poly circle poly-rect) '(0. 60. 180. 180.)]
[(wedge) '(26. 60. 128. 90.)] [(wedge) '(26. 60. 128. 90.)]
[(lam) '(58. 10. 202. 281.)] [(lam) '(58. 10. 202. 281.)]
[(A) '(#f #f #f #f)]
[(rect+poly rect+circle poly^rect) '(0. -25. 180. 400.)] [(rect+poly rect+circle poly^rect) '(0. -25. 180. 400.)]
[(poly&rect) '(100. 60. 10. 180.)] [(poly&rect) '(100. 60. 10. 180.)]
[(roundrect) '(80. 200. 125. 40.)] [(roundrect) '(80. 200. 125. 40.)]
@ -1293,14 +1311,14 @@
(send canvas set-kern (send self get-value)))) (send canvas set-kern (send self get-value))))
(make-object choice% "Clip" (make-object choice% "Clip"
'("None" "Rectangle" "Rectangle2" "Octagon" '("None" "Rectangle" "Rectangle2" "Octagon"
"Circle" "Wedge" "Round Rectangle" "Lambda" "Circle" "Wedge" "Round Rectangle" "Lambda" "A"
"Rectangle + Octagon" "Rectangle + Circle" "Rectangle + Octagon" "Rectangle + Circle"
"Octagon - Rectangle" "Rectangle & Octagon" "Rectangle ^ Octagon" "Polka" "Octagon - Rectangle" "Rectangle & Octagon" "Rectangle ^ Octagon" "Polka"
"Empty") "Empty")
hp3 hp3
(lambda (self event) (lambda (self event)
(set! clip (list-ref (set! clip (list-ref
'(none rect rect2 poly circle wedge roundrect lam '(none rect rect2 poly circle wedge roundrect lam A
rect+poly rect+circle poly-rect poly&rect poly^rect rect+poly rect+circle poly-rect poly&rect poly^rect
polka empty) polka empty)
(send self get-selection))) (send self get-selection)))