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

redex: fix stepper

Browse Source 
This was exposed by the removal of the undefined value.

It's not clear if there was a bug lurking here or not.
The call to "move" was being bypassed on the initialization
of "pb", so the side effect of setting "set-visible?" wouldn't
have happened. Either that really didn't cause any problems,
or perhaps things looked strange briefly until the user did
something.
This commit is contained in:
Burke Fetscher 2014-05-23 12:38:56 -05:00
parent 81cd1e3404
commit 8ed5a32d5d
1 changed files with 20 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
pkgs/redex-pkgs/redex-gui-lib/redex/private/stepper.rkt
View File

@ -80,10 +80,26 @@ todo:
(define dp (new vertical-panel% [parent f])) (define dp (new vertical-panel% [parent f]))
(define upper-hp (new horizontal-panel% [parent dp])) (define upper-hp (new horizontal-panel% [parent dp]))
(define lower-hp (new horizontal-panel% [alignment '(center center)] [parent f] [stretchable-height #f])) (define lower-hp (new horizontal-panel% [alignment '(center center)] [parent f] [stretchable-height #f]))
(define pb (new columnar-pasteboard%
[moved (λ (a b c d) (define (moved left top right bottom)
(when (procedure? moved) (let ([bx (box 0)])
(moved a b c d)))])) (let loop ([path path])
(cond
[(null? path) (void)]
[else
(let* ([path-ele (car path)]
[snip (send (car path-ele) get-big-snip)]
[visible?
(or (begin (send pb get-snip-location snip bx #f #f)
(<= left (unbox bx) right))
(begin (send pb get-snip-location snip bx #f #t)
(<= left (unbox bx) right)))])
(for-each (λ (node) (send node set-visible? visible?))
path-ele))
(loop (cdr path))]))))
(define pb (new columnar-pasteboard% [moved moved]))
(define ec (new forward-size-editor-canvas% [parent upper-hp] [editor pb] [style '(#;no-vscroll)])) (define ec (new forward-size-editor-canvas% [parent upper-hp] [editor pb] [style '(#;no-vscroll)]))
(define bp-outer (new vertical-panel% [parent upper-hp] [stretchable-width #f])) (define bp-outer (new vertical-panel% [parent upper-hp] [stretchable-width #f]))
(define bp (new vertical-panel% [parent bp-outer] [stretchable-width #f])) (define bp (new vertical-panel% [parent bp-outer] [stretchable-width #f]))
@ -268,23 +284,6 @@ todo:
(update-everything) (update-everything)
(update-highlight-to-end))) (update-highlight-to-end)))
(define (moved left top right bottom)
(let ([bx (box 0)])
(let loop ([path path])
(cond
[(null? path) (void)]
[else
(let* ([path-ele (car path)]
[snip (send (car path-ele) get-big-snip)]
[visible?
(or (begin (send pb get-snip-location snip bx #f #f)
(<= left (unbox bx) right))
(begin (send pb get-snip-location snip bx #f #t)
(<= left (unbox bx) right)))])
(for-each (λ (node) (send node set-visible? visible?))
path-ele))
(loop (cdr path))]))))
(define (get-path-to-root node) (define (get-path-to-root node)
(let loop ([node node] (let loop ([node node]
[acc null]) [acc null])