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

.

Browse Source 
original commit: 6df4e55f3ff323e1dd90338a5f431b18651f4fd8
This commit is contained in:
Robby Findler 1999-03-10 05:18:56 +00:00
parent 4df8d1a02d
commit 469acea5e4
1 changed files with 11 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/tests/mred/mem.ss
View File

@ -51,6 +51,14 @@
[(2) horizontal-pane%] [(2) horizontal-pane%]
[else (get-panel% n)])) [else (get-panel% n)]))
(define (get-image n)
(build-path (collection-path "icons")
(case (modulo n 4)
[(0) "mini-plt.xpm"]
[(1) "lock.gif"]
[(2) "help.bmp"]
[(3) "return.xbm"])))
(define (maker id n) (define (maker id n)
(sleep) (sleep)
(collect-garbage) (collect-garbage)
@ -187,8 +195,11 @@
(when offscreen? (when offscreen?
(let ([m (remember tag (make-object bitmap-dc%))] (let ([m (remember tag (make-object bitmap-dc%))]
[b0 (remember (cons tag 'f) (make-object bitmap% (get-image n)))]
[b (remember (cons tag 'u) (make-object bitmap% 100 100))] [b (remember (cons tag 'u) (make-object bitmap% 100 100))]
[b2 (remember (cons tag 'x) (make-object bitmap% 100 100))]) [b2 (remember (cons tag 'x) (make-object bitmap% 100 100))])
(unless (send b0 ok?)
(error "bitmap load error"))
(send m set-bitmap b))) (send m set-bitmap b)))
(when edit? (when edit?