35 lines
920 B
Plaintext
35 lines
920 B
Plaintext
;;; Moving an object on a canvas
|
|
;;; (drag the circle around)
|
|
|
|
(define last-x 0)
|
|
(define last-y 0)
|
|
|
|
(define (item-start-drag c x y)
|
|
(set! last-x (c 'canvasx x))
|
|
(set! last-y (c 'canvasy y)))
|
|
|
|
(define (item-drag c x y)
|
|
(set! x (c 'canvasx x))
|
|
(set! y (c 'canvasy y))
|
|
(c 'move 'current (- x last-x) (- y last-y))
|
|
(set! last-x x)
|
|
(set! last-y y))
|
|
|
|
(pack (canvas '.c1) :expand #t :fill "both")
|
|
|
|
(.c1 'create 'oval 150 150 170 170 :fill "skyblue" :tag "oval")
|
|
|
|
;;; Bindings
|
|
(.c1 'bind "oval" "<Any-Enter>" (lambda ()
|
|
(.c1 'itemconfig 'current :fill "red")))
|
|
(.c1 'bind "oval" "<Any-Leave>" (lambda ()
|
|
(.c1 'itemconfig 'current :fill "SkyBlue2")))
|
|
(.c1 'bind "oval" "<1>" (lambda (x y)
|
|
(item-start-drag .c1 x y)))
|
|
(.c1 'bind "oval" "<B1-Motion>" (lambda (x y)
|
|
(item-drag .c1 x y)))
|
|
(.c1 'bind "oval" "<ButtonRelease-1>"
|
|
(lambda ()
|
|
(.c1 'dtag 'selected)))
|
|
|