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

.

Browse Source 
original commit: e35ea5a24a9dc6cf1ae2402b6b36b68f88c32d2c
This commit is contained in:
Matthew Flatt 2003-06-03 17:41:04 +00:00
parent 1177be3208
commit f04d1ee3ab
1 changed files with 13 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -529,7 +529,7 @@
(send the-color-database find-color "BLACK") (send the-color-database find-color "BLACK")
mred-icon)] mred-icon)]
[(mred~) [(mred~)
(send dc draw-bitmap (get-rotated) x y)] (send dc draw-bitmap (get-rotated) x y 'opaque)]
[(mred^mred~ opaque-mred^mred~ red-mred^mred~) [(mred^mred~ opaque-mred^mred~ red-mred^mred~)
(send dc draw-bitmap mred-icon x y (send dc draw-bitmap mred-icon x y
(if (eq? mask-ex-mode 'opaque-mred^mred~) (if (eq? mask-ex-mode 'opaque-mred^mred~)
@ -840,16 +840,18 @@
(lambda (b e) (lambda (b e)
(unless use-bitmap? (unless use-bitmap?
(error 'save-file "only available for pixmap/bitmap mode")) (error 'save-file "only available for pixmap/bitmap mode"))
(let ([f (get-file)]) (let ([f (put-file)])
(let ([format (when f
(cond (let ([format
[(regexp-match "[.]xbm$" f) 'xbm] (cond
[(regexp-match "[.]xpm$" f) 'xpm] [(regexp-match "[.]xbm$" f) 'xbm]
[(regexp-match "[.]jpg$" f) 'jpeg] [(regexp-match "[.]xpm$" f) 'xpm]
[else (error 'save-file "unknown suffix: ~e" f)])]) [(regexp-match "[.]jpe?g$" f) 'jpeg]
(set! save-filename f) [(regexp-match "[.]png$" f) 'png]
(set! save-file-format format) [else (error 'save-file "unknown suffix: ~e" f)])])
(send canvas on-paint))))) (set! save-filename f)
(set! save-file-format format)
(send canvas on-paint))))))
(make-object button% "PS" hp (make-object button% "PS" hp
(lambda (self event) (lambda (self event)
(send canvas on-paint #t))) (send canvas on-paint #t)))