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

.

Browse Source 
original commit: 83b42049a6db56a79382c48247e823672fb5e968
This commit is contained in:
Matthew Flatt 2004-12-02 14:37:35 +00:00
parent 3c39db4deb
commit 900a02248f
1 changed files with 14 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/tests/mred/draw.ss
View File

@ -540,7 +540,7 @@
(let ([x 5] [y 165])
(let ([mred-icon (get-icon)])
(case mask-ex-mode
[(plt plt-mask plt^plt)
[(plt plt-mask plt^plt mred^plt)
(let* ([plt (get-plt)]
[tmp-bm (make-object bitmap%
(send mred-icon get-width)
@ -554,12 +554,17 @@
(/ (- (send mred-icon get-height)
(send plt get-height))
2))
(send dc draw-bitmap tmp-bm x y 'solid
(send the-color-database find-color "BLACK")
(cond
[(eq? mask-ex-mode 'plt-mask) mred-icon]
[(eq? mask-ex-mode 'plt^plt) tmp-bm]
[else #f])))]
(if (eq? mask-ex-mode 'mred^plt)
(send dc draw-bitmap mred-icon x y
'solid
(send the-color-database find-color "BLACK")
tmp-bm)
(send dc draw-bitmap tmp-bm x y 'solid
(send the-color-database find-color "BLACK")
(cond
[(eq? mask-ex-mode 'plt-mask) mred-icon]
[(eq? mask-ex-mode 'plt^plt) tmp-bm]
[else #f]))))]
[(mred^mred)
(send dc draw-bitmap mred-icon x y
'solid
@ -952,13 +957,13 @@
(make-object button% "Clock" hp3 (lambda (b e) (clock #f)))
(make-object button% "Clip Clock" hp3 (lambda (b e) (clock #t)))
(make-object choice% #f
'("MrEd XOR" "PLT Middle" "PLT ^ MrEd" "MrEd ^ MrEd"
'("MrEd XOR" "PLT Middle" "PLT ^ MrEd" "MrEd ^ PLT" "MrEd ^ MrEd"
"MrEd~" "MrEd ^ MrEd~" "M^M~ Opaque" "M^M~ Red"
"PLT^PLT")
hp3
(lambda (self event)
(send canvas set-mask-ex-mode
(list-ref '(mred plt plt-mask mred^mred
(list-ref '(mred plt plt-mask mred^plt mred^mred
mred~ mred^mred~ opaque-mred^mred~ red-mred^mred~
plt^plt)
(send self get-selection)))))))