From 2818dfb3f860935ca3a036636d43f8405159897f Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 16 Dec 2015 20:41:55 -0500
Subject: 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.
---
 sdl2/events.scm | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)

(limited to 'sdl2/events.scm')

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)
@@ -653,6 +666,60 @@
                           (scancode->symbol scancode)
                           (mod->list mod)))))
 
+
+;;;
+;;; 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))))))
-- 
cgit v1.2.3