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

fix a switchable button / discrete-sizes panel interaction bug

Browse Source 
also clean up the code a bit (make sure the h? argument to
set-label-visible is really a boolean and make some of the
long lines narrower)
This commit is contained in:
Robby Findler 2012-12-23 08:55:38 -06:00
parent 24725f8366
commit ccae98777a
3 changed files with 36 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/framework/private/panel.rkt
View File

@ -649,12 +649,13 @@
(define discrete-sizes<%> (interface ((class->interface panel%))
get-orientation
set-orientation))
(define (discrete-get-widths c)
(cond
[(is-a? c switchable-button%)
(list (send c get-large-width)
(send c get-small-width))]
(if (send c get-label-visible)
(list (send c get-large-width)
(send c get-small-width))
(list (send c get-without-label-small-width)))]
[(is-a? c discrete-sizes<%>)
(send c get-discrete-widths)]
[else

12
collects/mrlib/scribblings/switchable-button.scrbl
View File

@ -14,8 +14,9 @@
The @racket[panel:discrete-sizes-mixin] explicitly
uses @racket[switchable-button%]s via their
@method[switchable-button% get-small-width] and
@method[switchable-button% get-large-width] methods.
@method[switchable-button% get-small-width],
@method[switchable-button% get-large-width], and
@method[switchable-button% get-without-label-small-width] methods.
See @racket[panel:discrete-sizes-mixin] for more details.
@defconstructor/auto-super[([label (or/c string? (is-a?/c bitmap%) #f)]
@ -66,4 +67,11 @@
mode (i.e., when @racket[set-label-visible] has been called
with @racket[#t]).
}
@defmethod[(get-without-label-small-width) exact-nonnegative-integer?]{
Returns the width of the button when
it is not in label-visible
mode (i.e., when @racket[set-label-visible] has been called
with @racket[#f]).
}
}

30
collects/mrlib/switchable-button.rkt
View File

@ -7,7 +7,10 @@
(define margin 2)
(define w-circle-space 6)
(define h-circle-space 6)
(define rhs-pad 2) ;; extra space outside the bitmap, but inside the mouse highlighting (on the right)
;; extra space outside the bitmap,
;; but inside the mouse highlighting (on the right)
(define rhs-pad 2)
(define half-gray (make-object color% 127 127 127))
(define one-fifth-gray (make-object color% 200 200 200))
@ -245,10 +248,16 @@
(- (/ (send bitmap get-width) 2))
(- rhs-pad)))
(send dc draw-text label text-start (- (/ ch 2) (/ th 2)))
(draw-the-bitmap (+ text-start tw gap) (- (/ ch 2) (/ (send bitmap get-height) 2)))])]
(draw-the-bitmap (+ text-start tw gap)
(- (/ ch 2) (/ (send bitmap get-height) 2)))])]
[else
(draw-the-bitmap (- (/ cw 2) (/ (send (if with-label? bitmap alternate-bitmap) get-width) 2))
(- (/ ch 2) (/ (send (if with-label? bitmap alternate-bitmap) get-height) 2)))])
(draw-the-bitmap
(- (/ cw 2)
(/ (send (if with-label? bitmap alternate-bitmap) get-width)
2))
(- (/ ch 2)
(/ (send (if with-label? bitmap alternate-bitmap) get-height)
2)))])
(send dc set-pen pen)
(send dc set-alpha alpha)
@ -266,12 +275,14 @@
(if with-label? disable-bitmap alternate-disable-bitmap)
(send bm get-loaded-mask)))))
(define/public (set-label-visible h?)
(define/public (set-label-visible in-h?)
(define h? (and in-h? #t))
(unless (equal? with-label? h?)
(set! with-label? h?)
(update-sizes)
(update-float (and with-label? in?))
(refresh)))
(define/public (get-label-visible) with-label?)
(define/private (update-sizes)
(define dc (get-dc))
@ -306,7 +317,7 @@
margin
margin))))
(define/private (get-without-label-small-width)
(define/public (get-without-label-small-width)
(inexact->exact
(floor
(+ (send alternate-bitmap get-width)
@ -358,11 +369,14 @@
(define label "Run")
(define bitmap (make-object bitmap% (build-path (collection-path "icons") "run.png") 'png/mask))
(define foot (make-object bitmap% (build-path (collection-path "icons") "foot.png") 'png/mask))
(define foot-up (make-object bitmap% (build-path (collection-path "icons") "foot-up.png") 'png/mask))
(define foot-up
(make-object bitmap% (build-path (collection-path "icons") "foot-up.png") 'png/mask))
(define b1 (new switchable-button% [parent p] [label label] [bitmap bitmap] [callback void]))
(define b2 (new switchable-button% [parent p] [label label] [bitmap bitmap] [callback void]))
(define b3 (new switchable-button% [parent p] [label "Step"] [bitmap foot] [alternate-bitmap foot-up] [callback void]))
(define b3 (new switchable-button% [parent p] [label "Step"] [bitmap foot]
[alternate-bitmap foot-up]
[callback void]))
(define sb (new button% [parent p] [stretchable-width #t] [label "b"]))
(define swap-button
(new button%