From 10fb8d3daebf8bfea4ee82c29f085adaf899073f Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Thu, 13 May 2021 09:48:25 -0400
Subject: input: mouse: Add bindings for showing/hiding/moving the mouse
 cursor.

---
 sdl2/bindings.scm    | 16 +++++++++++++++-
 sdl2/input/mouse.scm | 26 ++++++++++++++++++++++++--
 2 files changed, 39 insertions(+), 3 deletions(-)

(limited to 'sdl2')

diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm
index 4deb900..8d85c63 100644
--- a/sdl2/bindings.scm
+++ b/sdl2/bindings.scm
@@ -1,5 +1,5 @@
 ;;; guile-sdl2 --- FFI bindings for SDL2
-;;; Copyright © 2015, 2016 David Thompson <davet@gnu.org>
+;;; Copyright © 2015, 2016, 2021 David Thompson <dthompson2@worcester.edu>
 ;;; Copyright © 2018 Eero Leno <eero@leno.fi>
 ;;; Copyright © 2019 Pierre-Antoine Rouby <contact@parouby.fr>
 ;;;
@@ -380,6 +380,11 @@ RETURN-TYPE and accept arguments of ARG-TYPES."
 ;;; Events
 ;;;
 
+(define-public SDL_QUERY -1)
+(define-public SDL_IGNORE 0)
+(define-public SDL_DISABLE 0)
+(define-public SDL_ENABLE 1)
+
 (define-public SDL_QUIT #x100)
 (define-public SDL_APP_TERMINATING #x101)
 (define-public SDL_APP_LOWMEMORY #x102)
@@ -1002,6 +1007,15 @@ RETURN-TYPE and accept arguments of ARG-TYPES."
 (define-foreign sdl-get-mouse-state
   uint32 "SDL_GetMouseState" '(* *))
 
+(define-foreign sdl-show-cursor
+  int "SDL_ShowCursor" (list int))
+
+(define-foreign sdl-warp-mouse-in-window
+  void "SDL_WarpMouseInWindow" (list '* int int))
+
+(define-foreign sdl-warp-mouse-global
+  int "SDL_WarpMouseGlobal" (list int int))
+
 
 ;;;
 ;;; Timer
diff --git a/sdl2/input/mouse.scm b/sdl2/input/mouse.scm
index c172909..ba0d81e 100644
--- a/sdl2/input/mouse.scm
+++ b/sdl2/input/mouse.scm
@@ -1,5 +1,5 @@
 ;;; guile-sdl2 --- FFI bindings for SDL2
-;;; Copyright © 2017 David Thompson <davet@gnu.org>
+;;; Copyright © 2017, 2021 David Thompson <dthompson2@worcester.edu>
 ;;;
 ;;; This file is part of guile-sdl2.
 ;;;
@@ -32,7 +32,10 @@
   #:export (mouse-x
             mouse-y
             mouse-button-pressed?
-            mouse-button-released?))
+            mouse-button-released?
+            set-show-cursor!
+            cursor-visible?
+            warp-mouse))
 
 (define (make-int)
   (make-bytevector (sizeof int)))
@@ -70,3 +73,22 @@
 (define (mouse-button-released? button)
   "Return #t if BUTTON is not currently being pressed."
   (not (mouse-button-pressed? button)))
+
+(define (set-show-cursor! show?)
+  "If SHOW? is #t, show the mouse cursor.  Otherwise, hide it."
+  (when (< (ffi:sdl-show-cursor (if show? ffi:SDL_ENABLE ffi:SDL_DISABLE)) 0)
+    (sdl-error "set-show-cursor!" "failed to modify cursor visibility")))
+
+(define (cursor-visible?)
+  "Return #t if the mouse cursor is currently visible."
+  (= (ffi:sdl-show-cursor ffi:SDL_QUERY) ffi:SDL_ENABLE))
+
+(define* (warp-mouse x y #:optional window)
+  "Warp mouse cursor to (X, Y) relative to WINDOW.  If WINDOW is not
+provided, the mouse cursor is moved to the global screen
+coordinates (X, Y)."
+  (if window
+      (ffi:sdl-warp-mouse-in-window ((@@ (sdl2 video) unwrap-window) window)
+                                    x y)
+      (unless (= (ffi:sdl-warp-mouse-global x y) 0)
+        (sdl-error "warp-mouse" "failed to warp mouse globally"))))
-- 
cgit v1.2.3