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

.

Browse Source 
original commit: 0eba27c303497f2e733c3e2a325261b6bd7a3ea9
This commit is contained in:
Matthew Flatt 2003-06-03 18:10:23 +00:00
parent 4466c65936
commit 7398262c78
2 changed files with 26 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/mred/draw-info.txt
View File

@ -251,6 +251,8 @@ The "MrEd XOR" menu selects a icon:
- "M^M~ Red" - Same as two previous, but drawn red instead of black.
- "PLT^PLT" - The PLT Middle image, but translucent
----------
Finally, print these instructions by hitting the "Print" button at the

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

@ -505,24 +505,26 @@
(let ([x 5] [y 165])
(let ([mred-icon (get-icon)])
(case mask-ex-mode
[(plt plt-mask)
(let* ([plt (get-plt)]
[tmp-bm (make-object bitmap%
(send mred-icon get-width)
(send mred-icon get-height)
#f)]
[tmp-dc (make-object bitmap-dc% tmp-bm)])
(send tmp-dc draw-bitmap plt
(/ (- (send mred-icon get-width)
(send plt get-width))
2)
(/ (- (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")
(and (eq? mask-ex-mode 'plt-mask)
mred-icon)))]
[(plt plt-mask plt^plt)
(let* ([plt (get-plt)]
[tmp-bm (make-object bitmap%
(send mred-icon get-width)
(send mred-icon get-height)
#f)]
[tmp-dc (make-object bitmap-dc% tmp-bm)])
(send tmp-dc draw-bitmap plt
(/ (- (send mred-icon get-width)
(send plt get-width))
2)
(/ (- (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])))]
[(mred^mred)
(send dc draw-bitmap mred-icon x y
'solid
@ -911,12 +913,14 @@
(make-object button% "Clip Clock" hp3 (lambda (b e) (clock #t)))
(make-object choice% #f
'("MrEd XOR" "PLT Middle" "PLT ^ MrEd" "MrEd ^ MrEd"
"MrEd~" "MrEd ^ MrEd~" "M^M~ Opaque" "M^M~ Red")
"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
mred~ mred^mred~ opaque-mred^mred~ red-mred^mred~)
mred~ mred^mred~ opaque-mred^mred~ red-mred^mred~
plt^plt)
(send self get-selection)))))))
(send f show #t))