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

pasteboard snip-sizing repairs

Browse Source 
svn: r14464

original commit: 0e7e85269d1cbee351831094d8c793d39b55b7d2
This commit is contained in:
Matthew Flatt 2009-04-08 13:16:51 +00:00
parent 2e537cd062
commit b311d7ed1b
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/mred/private/wxme/pasteboard.ss
View File

@ -337,7 +337,7 @@
[f? #f]) [f? #f])
(set-box! f? (find-dot loc x y dx dy)) (set-box! f? (find-dot loc x y dx dy))
(set! sizedxm dx) (set! sizedxm dx)
(set! sizedxm dy) (set! sizedym dy)
(when f? (when f?
(set! resizing snip)) (set! resizing snip))
(init-dragging event))))) (init-dragging event)))))
@ -1102,11 +1102,11 @@
;; ---------------------------------------- ;; ----------------------------------------
(define/private (find-dot loc x y dxm dym) (define/private (find-dot loc x y dxm dym)
(define (check-y) (define (check-y can-mid?)
(cond (cond
[(inbox? (loc-y loc) y) [(inbox? (loc-y loc) y)
(set-box! dym -1) #t] (set-box! dym -1) #t]
[(inbox? (loc-vm loc) y) [(and can-mid? (inbox? (loc-vm loc) y))
(set-box! dym 0) #t] (set-box! dym 0) #t]
[(inbox? (loc-b loc) y) [(inbox? (loc-b loc) y)
(set-box! dym 1) #t] (set-box! dym 1) #t]
@ -1114,13 +1114,13 @@
(cond (cond
[(inbox? (loc-x loc) x) [(inbox? (loc-x loc) x)
(set-box! dxm -1) (set-box! dxm -1)
(check-y)] (check-y #t)]
[(inbox? (loc-hm loc) x) [(inbox? (loc-hm loc) x)
(set-box! dxm 0) (set-box! dxm 0)
(check-y)] (check-y #f)]
[(inbox? (loc-r loc) x) [(inbox? (loc-r loc) x)
(set-box! dxm 1) (set-box! dxm 1)
(check-y)] (check-y #t)]
[else #f])) [else #f]))
(def/public (find-snip [real? x] [real? y] [(make-or-false snip%) [after #f]]) (def/public (find-snip [real? x] [real? y] [(make-or-false snip%) [after #f]])