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

Refactoring.

Browse Source
This commit is contained in:
Vincent St-Amour 2012-07-25 16:27:58 -04:00
parent f50d64b3b2
commit 8bceeadaab
1 changed files with 26 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
collects/typed-racket/optimizer/tool/tool.rkt
View File

@ -200,35 +200,34 @@
;; control panel ;; control panel
(define panel #f) (define panel #f)
(define (create-panel)
(set! panel (new horizontal-panel%
[parent (get-area-container)]
[stretchable-height #f]))
(new button%
[label "Clear"]
[parent panel]
[callback (lambda _ (close-optimization-coach))])
(for ([(l f) (in-pairs check-boxes)])
(new check-box%
[label l]
[parent panel]
[callback
(lambda _
(define definitions (get-definitions-text))
(define filters (send definitions get-filters))
(send definitions set-filters! (if (memq f filters)
(remq f filters)
(cons f filters)))
;; redraw
(send definitions add-highlights))]
[value #f]))) ; will be updated in `show-optimization-coach'
(define/public (show-optimization-coach) (define/public (show-optimization-coach)
(define area-container (get-area-container)) (cond [panel (send (get-area-container) add-child panel)]
(define definitions (get-definitions-text)) [else (create-panel)])
(define filters (send definitions get-filters))
(cond [panel
(send area-container add-child panel)]
[else
(set! panel (new horizontal-panel%
[parent area-container]
[stretchable-height #f]))
(new button%
[label "Clear"]
[parent panel]
[callback (lambda _ (close-optimization-coach))])
(for ([(l f) (in-pairs check-boxes)])
(new check-box%
[label l]
[parent panel]
[callback
(lambda _
(define definitions (get-definitions-text))
(define filters (send definitions get-filters))
(send definitions set-filters! (if (memq f filters)
(remq f filters)
(cons f filters)))
;; redraw
(send definitions add-highlights))]
[value (memq f filters)]))])
;; update check-boxes ;; update check-boxes
(define filters (send (get-definitions-text) get-filters))
(for ([c (in-list (for/list ([c (in-list (send panel get-children))] (for ([c (in-list (for/list ([c (in-list (send panel get-children))]
#:when (is-a? c check-box%)) #:when (is-a? c check-box%))
c))] c))]