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

fix multiple registration of make-line-snip snipclass

Browse Source 
svn: r15691

original commit: a090aa60a91b4ea1a6ec25fcbd54194c3db605dc
This commit is contained in:
Matthew Flatt 2009-08-09 13:46:20 +00:00
parent 2b867b5bef
commit 00494f838c
1 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/embedded-gui/private/lines.ss
View File

@ -19,7 +19,7 @@
(super-new (super-new
(snip (new vline-snip%))))) (snip (new vline-snip%)))))
(define (make-line-snip draw-line stretch-w stretch-h) (define (make-line-snip draw-line stretch-w stretch-h classname)
(letrec ([c (class* snip% (stretchable-snip<%>) (letrec ([c (class* snip% (stretchable-snip<%>)
(field (field
@ -101,7 +101,7 @@
(define/override (read f) (define/override (read f)
(new c)) (new c))
(super-new)))]) (super-new)))])
(send sc set-classname "make-line-snip") (send sc set-classname classname)
(send sc set-version 1) (send sc set-version 1)
(send (get-the-snip-class-list) add sc) (send (get-the-snip-class-list) add sc)
c)) c))
@ -112,14 +112,16 @@
(lambda (dc x y width height) (lambda (dc x y width height)
(send dc draw-line x (+ y (/ height 2)) (+ x width) (+ y (/ height 2)))) (send dc draw-line x (+ y (/ height 2)) (+ x width) (+ y (/ height 2))))
true true
false)) false
"make-hline-snip"))
(define vline-snip% (define vline-snip%
(make-line-snip (make-line-snip
(lambda (dc x y width height) (lambda (dc x y width height)
(send dc draw-line (+ x (/ width 2)) y (+ x (/ width 2)) (+ y height))) (send dc draw-line (+ x (/ width 2)) y (+ x (/ width 2)) (+ y height)))
false false
true)) true
"make-line-snip"))
#| #|
(require (require