diff options
author | David Thompson <dthompson2@worcester.edu> | 2014-02-17 20:47:14 -0500 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2014-02-17 20:47:14 -0500 |
commit | 9526a0f7f5fb251eaac4e5d5035dfa32d1b106f2 (patch) | |
tree | 9ddc560e80fd95663f31d0a2b1e12c16aba46e46 | |
parent | 0af623648d1f81dd841548bed339faa09b31ef56 (diff) |
Use new signal API for mouse module.
* 2d/mouse.scm (mouse-x, mouse-y, mouse-position, mouse-last-down)
(mouse-last-up, mouse-down?): Use new signal API.
-rw-r--r-- | 2d/mouse.scm | 68 |
1 files changed, 41 insertions, 27 deletions
diff --git a/2d/mouse.scm b/2d/mouse.scm index 21e2e48..6ad39a7 100644 --- a/2d/mouse.scm +++ b/2d/mouse.scm @@ -24,7 +24,7 @@ (define-module (2d mouse) #:use-module ((sdl sdl) #:prefix SDL:) #:use-module (2d event) - #:use-module (2d signals) + #:use-module (2d signal) #:use-module (2d vector2) #:export (mouse-move-hook mouse-press-hook @@ -37,34 +37,24 @@ mouse-down?)) (define mouse-move-hook (make-hook 2)) -(define mouse-press-hook (make-hook 3)) -(define mouse-click-hook (make-hook 3)) -(define mouse-last-down (make-root-signal 'none)) -(define mouse-last-up (make-root-signal 'none)) -(define mouse-x (make-root-signal 0)) -(define mouse-y (make-root-signal 0)) -(define mouse-position (signal-map vector2 mouse-x mouse-y)) - -(define (mouse-down? button) - "Create a signal for the state of BUTTON. Value is #t when mouse -button is pressed or #f otherwise." - (define (same-button? other-button) - (eq? button other-button)) - - (define (button-filter value signal) - (signal-constant value (signal-filter #f same-button? signal))) - - (signal-merge (button-filter #f mouse-last-up) - (button-filter #t mouse-last-down))) (register-event-handler 'mouse-motion (lambda (e) (run-hook mouse-move-hook (SDL:event:motion:x e) - (SDL:event:motion:y e)) - (signal-set! mouse-x (SDL:event:motion:x e)) - (signal-set! mouse-y (SDL:event:motion:y e)))) + (SDL:event:motion:y e)))) + +(define-signal mouse-position + (hook->signal mouse-move-hook + null-vector2 + (lambda (x y) + (vector2 x y)))) + +(define-signal mouse-x (signal-map vx mouse-position)) +(define-signal mouse-y (signal-map vy mouse-position)) + +(define mouse-press-hook (make-hook 3)) (register-event-handler 'mouse-button-down @@ -72,8 +62,15 @@ button is pressed or #f otherwise." (run-hook mouse-press-hook (SDL:event:button:button e) (SDL:event:button:x e) - (SDL:event:button:y e)) - (signal-set! mouse-last-down (SDL:event:button:button e)))) + (SDL:event:button:y e)))) + +(define-signal mouse-last-down + (hook->signal mouse-press-hook + 'none + (lambda (button x y) + button))) + +(define mouse-click-hook (make-hook 3)) (register-event-handler 'mouse-button-up @@ -81,5 +78,22 @@ button is pressed or #f otherwise." (run-hook mouse-click-hook (SDL:event:button:button e) (SDL:event:button:x e) - (SDL:event:button:y e)) - (signal-set! mouse-last-up (SDL:event:button:button e)))) + (SDL:event:button:y e)))) + +(define-signal mouse-last-up + (hook->signal mouse-click-hook + 'none + (lambda (button x y) + button))) + +(define (mouse-down? button) + "Create a signal for the state of BUTTON. Value is #t when mouse +button is pressed or #f otherwise." + (define (same-button? other-button) + (eq? button other-button)) + + (define (button-filter value signal) + (signal-constant value (signal-filter #f same-button? signal))) + + (signal-merge (button-filter #f mouse-last-up) + (button-filter #t mouse-last-down))) |