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

fix a bug in the case that the character with a breakpoint or a

Browse Source 
stack highlight triangle is on the left edge of a line

closes PR 12379
This commit is contained in:
Robby Findler 2011-11-26 17:18:39 -06:00
parent 081dc6c9a1
commit 5adc74fdf0
1 changed files with 19 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/gui-debugger/debug-tool.rkt
View File

@ -291,23 +291,34 @@
(values #f #f)))] (values #f #f)))]
[else (values #f #f)]))))) [else (values #f #f)])))))
;; text% start end -> (values left top right bottom) ;; text% start -> (values left top right bottom)
;; (four numbers that indicate the locations in pixels of the ;; (four numbers that indicate the locations in pixels of the
;; box bounding the text between start and end ;; box bounding the text between start and end
(define/private (find-char-box text left-pos right-pos) (define/private (find-char-box text pos)
(define start-pos (max 0 (- pos 1)))
(define end-pos (+ start-pos 1))
(let ([xlb (box 0)] (let ([xlb (box 0)]
[ylb (box 0)] [ylb (box 0)]
[xrb (box 0)] [xrb (box 0)]
[yrb (box 0)]) [yrb (box 0)])
(send text position-location left-pos xlb ylb #t) (send text position-location start-pos xlb ylb #t)
(send text position-location right-pos xrb yrb #f) (send text position-location end-pos xrb yrb #f)
(let*-values ([(xl-off yl-off) (send text editor-location-to-dc-location (let*-values ([(xl-off yl-off) (send text editor-location-to-dc-location
(unbox xlb) (unbox ylb))] (unbox xlb) (unbox ylb))]
[(xl yl) (dc-location-to-editor-location xl-off yl-off)] [(xl yl) (dc-location-to-editor-location xl-off yl-off)]
[(xr-off yr-off) (send text editor-location-to-dc-location [(xr-off yr-off) (send text editor-location-to-dc-location
(unbox xrb) (unbox yrb))] (unbox xrb) (unbox yrb))]
[(xr yr) (dc-location-to-editor-location xr-off yr-off)]) [(xr yr) (dc-location-to-editor-location xr-off yr-off)])
(values xl yl xr yr)))) (cond
[(= (send text position-line start-pos)
(send text position-line end-pos))
(values xl yl xr yr)]
[else
;; in this case, the open paren we want to draw on top of is on
;; a different line from the operator following it, so we just
;; give ourselves a little space and draw something, instead of
;; returning strange results (and possibly crashing)
(values xl yl (+ 10 xl) (+ yl 10))]))))
(define/private (render v) (define/private (render v)
(send (get-tab) render v)) (send (get-tab) render v))
@ -490,7 +501,7 @@
breakpoints breakpoints
(lambda (pos enabled?) (lambda (pos enabled?)
(when (and (>= pos 0) (or enabled? (and mouse-over-pos (= mouse-over-pos pos)))) (when (and (>= pos 0) (or enabled? (and mouse-over-pos (= mouse-over-pos pos))))
(let*-values ([(xl yl xr yr) (find-char-box this (sub1 pos) pos)] (let*-values ([(xl yl xr yr) (find-char-box this pos)]
[(diameter) (- xr xl)] [(diameter) (- xr xl)]
[(yoff) (/ (- yr yl diameter) 2)]) [(yoff) (/ (- yr yl diameter) 2)])
(let ([op (send dc get-pen)] (let ([op (send dc get-pen)]
@ -515,9 +526,9 @@
[frame-num (send (get-tab) get-frame-num)] [frame-num (send (get-tab) get-frame-num)]
[break-status (send (get-tab) get-break-status)]) [break-status (send (get-tab) get-break-status)])
(when (and (eq? frame-defs this) start end) (when (and (eq? frame-defs this) start end)
(let*-values ([(xl yl xr yr) (find-char-box this (sub1 start) start)] (let*-values ([(xl yl xr yr) (find-char-box this start)]
[(ym) (average yl yr)] [(ym) (average yl yr)]
[(xa ya xb yb) (find-char-box this (sub1 end) end)] [(xa ya xb yb) (find-char-box this end)]
[(diameter) (- xb xa)] [(diameter) (- xb xa)]
[(yoff) (/ (- yb ya diameter) 2)] [(yoff) (/ (- yb ya diameter) 2)]
[(ym2) (average ya yb)]) [(ym2) (average ya yb)])