From 0c98aca4c34a8426031e4e8306f7e1a3c230dd8e Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 23 Dec 2011 07:25:59 -0600 Subject: [PATCH 1/5] fix `draw-polygon' on pairs instead of `point%'s Closes PR 12455 original commit: 5bfaea25febcc8d50a75861c692aecfc3cb49876 --- collects/tests/gracket/draw.rkt | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/collects/tests/gracket/draw.rkt b/collects/tests/gracket/draw.rkt index 483d5950..6eb613e3 100644 --- a/collects/tests/gracket/draw.rkt +++ b/collects/tests/gracket/draw.rkt @@ -65,11 +65,12 @@ (send f show #t))) (define star - (list (make-object point% 30 0) - (make-object point% 48 60) - (make-object point% 0 20) - (make-object point% 60 20) - (make-object point% 12 60))) + ;; uses pairs instead of point%s + (list (cons 30 0) + (cons 48 60) + (cons 0 20) + (cons 60 20) + (cons 12 60))) (define octagon (list (make-object point% 60 60) From 521f398b64ede71b7500f57e9846c5819d822a16 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 25 Dec 2011 18:16:49 -0600 Subject: [PATCH 2/5] racket/draw: add `text-outline' to `dc-path%' original commit: 6c5c17056517da0b85506872299500e600a39cea --- collects/tests/gracket/draw.rkt | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/collects/tests/gracket/draw.rkt b/collects/tests/gracket/draw.rkt index 6eb613e3..37e9ecd4 100644 --- a/collects/tests/gracket/draw.rkt +++ b/collects/tests/gracket/draw.rkt @@ -659,6 +659,17 @@ (loop (cdr fam) (cdr stl) (cdr wgt) (cdr sze) x (+ y h) #f))))) (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: (when (and (not no-bitmaps?) last?) (let ([x 5] [y 165]) @@ -1080,6 +1091,11 @@ [(lam) (let ([r (make-object region% clip-dc)]) (send r set-path lambda-path) (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)]) (send r union (mk-rect)) (send dc set-clipping-region r))] @@ -1161,7 +1177,8 @@ (let*-values ([(x y w h) (send r get-bounding-box)] [(l) (list x y w h)] [(=~) (lambda (x y) - (<= (- x 2) y (+ x 2)))]) + (or (not y) + (<= (- x 2) y (+ x 2))))]) (unless (andmap =~ l (let ([l (case clip @@ -1170,6 +1187,7 @@ [(poly circle poly-rect) '(0. 60. 180. 180.)] [(wedge) '(26. 60. 128. 90.)] [(lam) '(58. 10. 202. 281.)] + [(A) '(#f #f #f #f)] [(rect+poly rect+circle poly^rect) '(0. -25. 180. 400.)] [(poly&rect) '(100. 60. 10. 180.)] [(roundrect) '(80. 200. 125. 40.)] @@ -1293,14 +1311,14 @@ (send canvas set-kern (send self get-value)))) (make-object choice% "Clip" '("None" "Rectangle" "Rectangle2" "Octagon" - "Circle" "Wedge" "Round Rectangle" "Lambda" + "Circle" "Wedge" "Round Rectangle" "Lambda" "A" "Rectangle + Octagon" "Rectangle + Circle" "Octagon - Rectangle" "Rectangle & Octagon" "Rectangle ^ Octagon" "Polka" "Empty") hp3 (lambda (self event) (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 polka empty) (send self get-selection))) From 9b42ce66e6151378132e5a6fbc90e1ac8f31640d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 25 Dec 2011 19:08:27 -0600 Subject: [PATCH 3/5] for `record-dc%', record initial configuration after each `erase' Closes PR 12460 original commit: 1c6378451798d2e230d841d0f8d3afc9b4c078d3 --- collects/tests/gracket/record-dc.rkt | 59 ++++++++++++++++++++++++++++ 1 file changed, 59 insertions(+) create mode 100644 collects/tests/gracket/record-dc.rkt diff --git a/collects/tests/gracket/record-dc.rkt b/collects/tests/gracket/record-dc.rkt new file mode 100644 index 00000000..14346568 --- /dev/null +++ b/collects/tests/gracket/record-dc.rkt @@ -0,0 +1,59 @@ +#lang racket/base +(require racket/class + racket/draw + racket/draw/private/record-dc) + +(define bm1 (make-bitmap 100 100)) +(define bm2 (make-bitmap 100 100)) +(define bm3 (make-bitmap 100 100)) + +(define dc1 (make-object bitmap-dc% bm1)) +(define dc2 (make-object (record-dc-mixin bitmap-dc%) bm2)) +(define dc3 (make-object bitmap-dc% bm3)) + +(define (config dc) + (send dc set-origin 2 3) + (send dc set-scale 1.1 0.9) + (send dc set-rotation 0.1) + (send dc set-initial-matrix '#(1.0 -0.1 0.1 1.0 1.0 2.0)) + (send dc set-pen "red" 2 'solid) + (send dc set-brush "blue" 'solid) + (send dc set-font (make-font #:size 32)) + (send dc set-smoothing 'smoothed) + (send dc set-text-mode 'solid) + (send dc set-alpha 0.8) + (send dc set-clipping-rect 5 5 95 95)) + +(define (draw dc) + (send dc draw-ellipse 2 2 100 100) + (send dc draw-text "Hello" 10 10)) + +(define (get-bytes bm) + (define w (send bm get-width)) + (define h (send bm get-height)) + (define bstr (make-bytes (* 4 w h))) + (send bm get-argb-pixels 0 0 w h bstr) + bstr) + +(config dc1) +(draw dc1) + +(define pre-bytes (get-bytes bm1)) + +(config dc2) +(send dc2 erase) +(draw dc2) + +(define middle-bytes (get-bytes bm2)) + +(define cms (send dc2 get-recorded-command)) + +(cms dc3) + +(define post-bytes (get-bytes bm3)) + +(unless (equal? pre-bytes middle-bytes) + (error "middle != pre")) + +(unless (equal? pre-bytes post-bytes) + (error "post != pre")) From 52405d49658339e1d549857395c68667873b9bf9 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 25 Dec 2011 19:39:25 -0600 Subject: [PATCH 4/5] 'rshift and 'rcontrol don't interrupt keybindings Closes PR 12461 original commit: e12bf33f8dcbc72969058960017e229394fcdc2f --- collects/mred/private/wxme/keymap.rkt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/collects/mred/private/wxme/keymap.rkt b/collects/mred/private/wxme/keymap.rkt index 4f66580d..50542028 100644 --- a/collects/mred/private/wxme/keymap.rkt +++ b/collects/mred/private/wxme/keymap.rkt @@ -445,7 +445,9 @@ (def/public (handle-key-event [any? obj] [key-event% event]) (let ([code (send event get-key-code)]) (or (eq? code 'shift) + (eq? code 'rshift) (eq? code 'control) + (eq? code 'rcontrol) (eq? code 'release) (let ([score (get-best-score code From 72bbc5bc82de75694ab47930781da7a647be77ee Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 26 Dec 2011 06:27:22 -0600 Subject: [PATCH 5/5] fix `text-outline' test to include a curve original commit: 3a1df23be6c5da4f12a285a5358c4e732e8349b5 --- collects/tests/gracket/draw.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/tests/gracket/draw.rkt b/collects/tests/gracket/draw.rkt index 37e9ecd4..3a6f8cdb 100644 --- a/collects/tests/gracket/draw.rkt +++ b/collects/tests/gracket/draw.rkt @@ -663,7 +663,7 @@ (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 p text-outline (make-font #:size 32) "A8" 360 190) (send dc set-pen "black" 1 'solid) (send dc set-brush "pink" 'solid) (send dc draw-path p)