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

.

Browse Source 
original commit: b5ae0770c4229b80ecd9ac47de16a3b69c214b43
This commit is contained in:
Matthew Flatt 2004-12-30 18:45:51 +00:00
parent fa0140d065
commit 4825fff965
1 changed files with 23 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -67,6 +67,13 @@
(define pi (atan 0 -1))
(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)))
(define octagon
(list (make-object point% 60 60)
(make-object point% 120 60)
@ -738,15 +745,22 @@
(loop (cdr l) (+ x 20)))))))
(when last?
(send dc set-pen (make-object pen% "black" 1 'transparent))
(send dc set-brush (make-object brush% "blue" 'solid))
(send dc draw-ellipse 400 10 40 40)
(send dc draw-ellipse 400 50 40 40)
(send dc draw-ellipse 400 90 40 40)
(send dc set-pen (make-object pen% "black" 1 'solid))
(send dc draw-ellipse 400 130 40 40)
(send dc draw-ellipse 400 170 40 40)
(send dc draw-ellipse 400 210 40 40))
(let ()
(define (pen cap join)
(let ([p (make-object pen% "blue" 4 'solid)])
(send p set-cap cap)
(send p set-join join)
(send dc set-pen p)))
(send dc set-brush (make-object brush% "white" 'transparent))
(pen 'projecting 'miter)
(send dc draw-lines star 410 10)
(send dc draw-polygon star 480 10)
(pen 'round 'round)
(send dc draw-lines star 410 80)
(send dc draw-polygon star 480 80)
(pen 'butt 'bevel)
(send dc draw-lines star 410 150)
(send dc draw-polygon star 480 150)))
(when (and last? (not (or ps? (eq? dc can-dc)))
(send mem-dc get-bitmap))