events: Add mouse button event bindings.

* sdl2/bindings.scm (SDL_BUTTON_LEFT, SDL_BUTTON_RIGHT,
  SDL_BUTTON_MIDDLE, SDL_BUTTON_X1, SDL_BUTTON_X2): New variables.
* sdl2/events.scm (<mouse-button-event>): New record type.
 (make-mouse-button-event, mouse-button-event?,
  mouse-button-down-event?, mouse-button-up-event?,
  mouse-button-event-timestamp, mouse-button-event-window-id,
  mouse-button-event-which, mouse-button-event-button,
  mouse-button-event-pressed?, mouse-button-event-clicks,
  mouse-button-event-x, parse-mouse-button-event): New procedures.
  (poll-event): Add support for mouse button events.

2 files changed, 81 insertions, 0 deletions

diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm
index 9bf7913..43f0be6 100644
--- a/sdl2/bindings.scm
+++ b/sdl2/bindings.scm
@@ -807,6 +807,17 @@ RETURN-TYPE and accept arguments of ARG-TYPES."
 
 
 ;;;
+;;; Mouse
+;;;
+
+(define-public SDL_BUTTON_LEFT   1)
+(define-public SDL_BUTTON_MIDDLE 2)
+(define-public SDL_BUTTON_RIGHT  3)
+(define-public SDL_BUTTON_X1     4)
+(define-public SDL_BUTTON_X2     5)
+
+
+;;;
 ;;; Timer
 ;;;
 
diff --git a/sdl2/events.scm b/sdl2/events.scm
index ad798a8..1d40a38 100644
--- a/sdl2/events.scm
+++ b/sdl2/events.scm
@@ -48,6 +48,19 @@
             keyboard-event-repeat
             keyboard-event-keysym
 
+            make-mouse-button-event
+            mouse-button-event?
+            mouse-button-down-event?
+            mouse-button-up-event?
+            mouse-button-event-timestamp
+            mouse-button-event-window-id
+            mouse-button-event-which
+            mouse-button-event-button
+            mouse-button-event-pressed?
+            mouse-button-event-clicks
+            mouse-button-event-x
+            mouse-button-event-y
+
             poll-event))
 
 (define (make-sdl-event)
@@ -655,6 +668,60 @@
 
 
 ;;;
+;;; Mouse
+;;;
+
+(define-record-type <mouse-button-event>
+  (make-mouse-button-event timestamp window-id which
+                           button pressed? clicks x y)
+  mouse-button-event?
+  (timestamp mouse-button-event-timestamp)
+  (window-id mouse-button-event-window-id)
+  (which mouse-button-event-which)
+  (button mouse-button-event-button)
+  (pressed? mouse-button-event-pressed?)
+  (clicks mouse-button-event-clicks)
+  (x mouse-button-event-x)
+  (y mouse-button-event-y))
+
+(define (mouse-button-down-event? e)
+  "Return #t if E is a mouse button down event."
+  (and (mouse-button-event? e)
+       (mouse-button-event-pressed? e)))
+
+(define (mouse-button-up-event? e)
+  "Return #t if E is a mouse button up event."
+  (and (mouse-button-event? e)
+       (not (mouse-button-event-pressed? e))))
+
+(define (parse-mouse-button-event ptr)
+  (define types
+    (list uint32  ; type
+          uint32  ; timestamp
+          uint32  ; windowID
+          uint32  ; which
+          uint8   ; button
+          uint8   ; state
+          uint8   ; clicks
+          uint8   ; padding1
+          int32   ; x
+          int32)) ; y
+
+  (define (button->symbol n)
+    (list-ref '(left middle right x1 x2) (1- n)))
+
+  (match (parse-c-struct ptr types)
+    ((_ timestamp window-id which button state clicks _ x y)
+     (make-mouse-button-event timestamp
+                              window-id
+                              which
+                              (button->symbol button)
+                              (= state ffi:SDL_PRESSED)
+                              clicks
+                              x y))))
+
+
+;;;
 ;;; Event management
 ;;;
 
@@ -670,4 +737,7 @@
             ((or (= type ffi:SDL_KEYDOWN)
                  (= type ffi:SDL_KEYUP))
              (parse-keyboard-event ptr))
+            ((or (= type ffi:SDL_MOUSEBUTTONDOWN)
+                 (= type ffi:SDL_MOUSEBUTTONUP))
+             (parse-mouse-button-event ptr))
             (else 'fixme:unsupported-event))))))