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

abstracted out edge drawing so it can be overriden

Browse Source 
svn: r10136
This commit is contained in:
Robby Findler 2008-06-04 21:36:13 +00:00
parent 9b07e92fc4
commit 50cd17833f
2 changed files with 51 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
collects/mrlib/graph.ss
View File

@ -222,7 +222,8 @@
on-mouse-over-snips
set-arrowhead-params
get-arrowhead-params
set-draw-arrow-heads?))
set-draw-arrow-heads?
draw-edges))
(define-struct rect (left top right bottom))
@ -482,6 +483,11 @@
(max b (rect-bottom rect))))]))]))
(define/override (on-paint before? dc left top right bottom dx dy draw-caret)
(when before?
(draw-edges dc left top right bottom dx dy))
(super on-paint before? dc left top right bottom dx dy draw-caret))
(define/public (draw-edges dc left top right bottom dx dy)
(let ()
;; draw-connection : link snip boolean boolean -> void
;; sets the drawing context (pen and brush)
@ -637,37 +643,33 @@
(link-dark-text from-link)
(link-light-text from-link))))
;;; body of on-paint
(when before?
(let ([old-pen (send dc get-pen)]
[old-brush (send dc get-brush)]
[old-fg (send dc get-text-foreground)]
[os (send dc get-smoothing)])
(send dc set-smoothing 'aligned)
(let ([old-pen (send dc get-pen)]
[old-brush (send dc get-brush)]
[old-fg (send dc get-text-foreground)]
[os (send dc get-smoothing)])
(send dc set-smoothing 'aligned)
(let ([pairs '()])
(for-each-to-redraw
left top right bottom
(lambda (from-link to)
(let ([from (link-snip from-link)])
(cond
[(or (memq from currently-overs)
(memq to currently-overs))
(set! pairs (cons (cons from-link to) pairs))]
[else
(draw-connection from-link to #f)]))))
(for-each (lambda (pr)
(draw-connection (car pr) (cdr pr) #t))
pairs))
(let ([pairs '()])
(for-each-to-redraw
left top right bottom
(lambda (from-link to)
(let ([from (link-snip from-link)])
(cond
[(or (memq from currently-overs)
(memq to currently-overs))
(set! pairs (cons (cons from-link to) pairs))]
[else
(draw-connection from-link to #f)]))))
(for-each (lambda (pr)
(draw-connection (car pr) (cdr pr) #t))
pairs))
(send dc set-smoothing os)
(send dc set-pen old-pen)
(send dc set-text-foreground old-fg)
(send dc set-brush old-brush)))
(send dc set-smoothing os)
(send dc set-pen old-pen)
(send dc set-text-foreground old-fg)
(send dc set-brush old-brush))))
(super on-paint before? dc left top right bottom dx dy draw-caret)))
;; for-each-to-redraw : number number number number (link snip -> void)
;; for-each-to-redraw : number number number number (link snip -> void)
(define/private (for-each-to-redraw left top right bottom f)
(let ()
;; : link snip boolean boolean -> void

19
collects/mrlib/scribblings/graph/graph-pasteboard-intf.scrbl
View File

@ -43,5 +43,22 @@ drawn on the edges between nodes.
This setting does not affect self-links---only links between two
different nodes.
}}
}
@defmethod[(draw-edges [dc (is-a?/c dc<%>)]
[left real?]
[top real?]
[right real?]
[bottom real?]
[dx real?]
[dy real?]) void?]{
This is called by the @method[editor<%> on-paint] callback of a
graph pasteboard, and is expected to draw the edges between the
snips. The argments are a subset of those passed to
@method[editor<%> on-paint] and it is only called when the
@scheme[before?] argument to @method[editor<%> on-paint]
is @scheme[#t].
}
}