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

docs bug (as noted by Marijn on racket-dev)

Browse Source 
original commit: c9fcde258f4ec413a50c7ab696fadc7646cacb4c
This commit is contained in:
Robby Findler 2011-12-27 08:51:58 -06:00
commit 218ea84e74
4 changed files with 89 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/mred/private/wxme/keymap.rkt
View File

@ -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

2
collects/scribblings/framework/frame.scrbl
View File

@ -554,7 +554,7 @@
width and height of the screen, whichever is smaller.
@defconstructor[((filename string?)
(editor% (is-a?/c editor<%>))
(editor% (implementation?/c editor:basic<%>))
(parent (or/c (is-a?/c frame%) false/c) #f)
(width (or/c (integer-in 0 10000) false/c) #f)
(height (or/c (integer-in 0 10000) false/c) #f)

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

@ -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)
@ -658,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) "A8" 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])
@ -1079,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))]
@ -1160,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
@ -1169,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.)]
@ -1292,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)))

59
collects/tests/gracket/record-dc.rkt Normal file
View File

@ -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"))