drag.scm (1216B)
1 ;;;; drag.scm 2 3 4 (define (box) (%inline "document.getElementById" "box")) 5 (define (info) (%inline "document.getElementById" "info")) 6 7 (define down #f) 8 9 (define (mouse-position event) 10 (values 11 (- (+ (.clientX event) document.body.scrollLeft) document.body.clientLeft) 12 (- (+ (.clientY event) document.body.scrollTop) document.body.clientTop))) 13 14 (define (mouse-move event) 15 (let ((event (if (void? event) window.event event))) 16 (when down 17 (call-with-values (cut mouse-position event) 18 (lambda (x y) 19 (move-element (box) x y) 20 (show-position x y)))))) 21 22 (define (move-element elt x y) 23 (set! (.style.left elt) x) 24 (set! (.style.top elt) y)) 25 26 (define (move-element-by elt x y) 27 (call-with-values (cut element-position elt) 28 (lambda (x1 y1) 29 (move-element elt (+ x1 x) (+ y1 y))))) 30 31 (define (element-position elt) 32 (values 33 (.offsetLeft elt) 34 (.offsetTop elt))) 35 36 (define (show-position x y) 37 (set! (.innerHTML (info)) 38 (jstring 39 (string-append 40 (number->string x) "/" (number->string y))))) 41 42 (set! document.onmousemove (callback mouse-move)) 43 (set! document.onmousedown (callback (lambda () (set! down #t)))) 44 (set! document.onmouseup (callback (lambda () (set! down #f))))