summaryrefslogtreecommitdiff
path: root/sdl2
diff options
context:
space:
mode:
authorEkaitz Zarraga <ekaitz@elenq.tech>2022-07-22 14:43:22 +0200
committerDavid Thompson <dthompson2@worcester.edu>2022-07-25 20:54:02 -0400
commit6789ffa5366604d361267e96732f25f391943130 (patch)
treee4cee4c1aaa276ed466c64133739d590c0fec02a /sdl2
parent697a403617b97b4ce333132dae89cb009f6b6e3b (diff)
mouse: Add cursor manipulation bindings.
* sdl2/bindings.scm (SDL_SYSTEM_CURSOR_ARROW, SDL_SYSTEM_CURSOR_IBEAM) (SDL_SYSTEM_CURSOR_WAIT, SDL_SYSTEM_CURSOR_CROSSHAIR) (SDL_SYSTEM_CURSOR_WAITARROW, SDL_SYSTEM_CURSOR_SIZENWSE) (SDL_SYSTEM_CURSOR_SIZENESW, SDL_SYSTEM_CURSOR_SIZEWE) (SDL_SYSTEM_CURSOR_SIZENS, SDL_SYSTEM_CURSOR_SIZEALL) (SDL_SYSTEM_CURSOR_NO, SDL_SYSTEM_CURSOR_HAND, SDL_NUM_SYSTEM_CURSORS): New variables. (sdl-create-system-cursor, sdl-create-color-cursor, sdl-free-cursor) (sdl-set-cursor, sdl-get-cursor, sdl-show-cursor): New procedures. * sdl2/input/mouse.scm (make-system-cursor, make-surface-cursor) (set-cursor!, get-cursor, delete-cursor!): New procedures. * doc/api.texi (Mouse): Document the added features
Diffstat (limited to 'sdl2')
-rw-r--r--sdl2/bindings.scm33
-rw-r--r--sdl2/input/mouse.scm74
2 files changed, 105 insertions, 2 deletions
diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm
index 897a0dc..954aa8b 100644
--- a/sdl2/bindings.scm
+++ b/sdl2/bindings.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2015, 2016, 2021 David Thompson <dthompson2@worcester.edu>
;;; Copyright © 2018 Eero Leno <eero@leno.fi>
;;; Copyright © 2019 Pierre-Antoine Rouby <contact@parouby.fr>
+;;; Copyright © 2022 Ekaitz Zarraga <ekaitz@elenq.tech>
;;;
;;; This file is part of guile-sdl2.
;;;
@@ -1028,6 +1029,38 @@ RETURN-TYPE and accept arguments of ARG-TYPES."
(define-foreign sdl-warp-mouse-global
int "SDL_WarpMouseGlobal" (list int int))
+(define-public SDL_SYSTEM_CURSOR_ARROW 0)
+(define-public SDL_SYSTEM_CURSOR_IBEAM 1)
+(define-public SDL_SYSTEM_CURSOR_WAIT 2)
+(define-public SDL_SYSTEM_CURSOR_CROSSHAIR 3)
+(define-public SDL_SYSTEM_CURSOR_WAITARROW 4)
+(define-public SDL_SYSTEM_CURSOR_SIZENWSE 5)
+(define-public SDL_SYSTEM_CURSOR_SIZENESW 6)
+(define-public SDL_SYSTEM_CURSOR_SIZEWE 7)
+(define-public SDL_SYSTEM_CURSOR_SIZENS 8)
+(define-public SDL_SYSTEM_CURSOR_SIZEALL 9)
+(define-public SDL_SYSTEM_CURSOR_NO 10)
+(define-public SDL_SYSTEM_CURSOR_HAND 11)
+(define-public SDL_NUM_SYSTEM_CURSORS 12)
+
+(define-foreign sdl-create-system-cursor
+ '* "SDL_CreateSystemCursor" (list int))
+
+(define-foreign sdl-create-color-cursor
+ '* "SDL_CreateColorCursor" (list '* int int))
+
+(define-foreign sdl-free-cursor
+ void "SDL_FreeCursor" (list '*))
+
+(define-foreign sdl-set-cursor
+ void "SDL_SetCursor" (list '*))
+
+(define-foreign sdl-get-cursor
+ '* "SDL_GetCursor" '())
+
+(define-foreign sdl-show-cursor
+ int "SDL_ShowCursor" (list int))
+
;;;
;;; Timer
diff --git a/sdl2/input/mouse.scm b/sdl2/input/mouse.scm
index ba0d81e..4a3869d 100644
--- a/sdl2/input/mouse.scm
+++ b/sdl2/input/mouse.scm
@@ -1,5 +1,6 @@
;;; guile-sdl2 --- FFI bindings for SDL2
;;; Copyright © 2017, 2021 David Thompson <dthompson2@worcester.edu>
+;;; Copyright © 2022 Ekaitz Zarraga <ekaitz@elenq.tech>
;;;
;;; This file is part of guile-sdl2.
;;;
@@ -19,12 +20,13 @@
;;; Commentary:
;;
-;; Mouse input.
+;; Mouse input and cursor manipulation.
;;
;;; Code:
(define-module (sdl2 input mouse)
#:use-module (ice-9 match)
+ #:use-module (ice-9 format)
#:use-module (rnrs bytevectors)
#:use-module (sdl2)
#:use-module ((sdl2 bindings) #:prefix ffi:)
@@ -35,7 +37,12 @@
mouse-button-released?
set-show-cursor!
cursor-visible?
- warp-mouse))
+ warp-mouse
+ create-system-cursor
+ create-surface-cursor
+ get-cursor
+ set-cursor!
+ delete-cursor!))
(define (make-int)
(make-bytevector (sizeof int)))
@@ -92,3 +99,66 @@ coordinates (X, Y)."
x y)
(unless (= (ffi:sdl-warp-mouse-global x y) 0)
(sdl-error "warp-mouse" "failed to warp mouse globally"))))
+
+
+;;;
+;;; Cursors
+;;;
+
+(define-wrapped-pointer-type <cursor>
+ cursor?
+ wrap-cursor unwrap-cursor
+ (lambda (cursor port)
+ (format port "#<cursor ~x>"
+ (pointer-address (unwrap-cursor cursor)))))
+
+(define (make-system-cursor cursor-type)
+ "Return a new cursor from the system's available set, chosen by
+CURSOR-TYPE. Valid cursor types are: arrow, crosshair, hand, i-beam,
+no, size-north-south, size-northwest-southeast,
+size-northeast-southwest, size-east-west, size-all, wait, and
+wait-arrow."
+ (let* ((id (case cursor-type
+ ((arrow) ffi:SDL_SYSTEM_CURSOR_ARROW)
+ ((crosshair) ffi:SDL_SYSTEM_CURSOR_CROSSHAIR)
+ ((hand) ffi:SDL_SYSTEM_CURSOR_HAND)
+ ((i-beam) ffi:SDL_SYSTEM_CURSOR_IBEAM)
+ ((no) ffi:SDL_SYSTEM_CURSOR_NO)
+ ((size-north-south) ffi:SDL_SYSTEM_CURSOR_SIZENS)
+ ((size-northwest-southeast) ffi:SDL_SYSTEM_CURSOR_SIZENWSE)
+ ((size-northeast-southwest) ffi:SDL_SYSTEM_CURSOR_SIZENESW)
+ ((size-west-east) ffi:SDL_SYSTEM_CURSOR_SIZEWE)
+ ((size-all) ffi:SDL_SYSTEM_CURSOR_SIZEALL)
+ ((wait) ffi:SDL_SYSTEM_CURSOR_WAIT)
+ ((wait-arrow) ffi:SDL_SYSTEM_CURSOR_WAITARROW)
+ (else
+ (sdl-error "make-system-cursor" "unknown cursor type"))))
+ (ptr (ffi:sdl-create-system-cursor id)))
+ (if (null-pointer? ptr)
+ (sdl-error "make-system-cursor" "failed to create system cursor")
+ (wrap-cursor ptr))))
+
+(define (make-color-cursor surface hot-x hot-y)
+ "Make a cursor from SURFACE with a hot spot of (HOT-X, HOT-Y)."
+ (let ((ptr (ffi:sdl-create-color-cursor
+ ((@@ (sdl2 surface) unwrap-surface) surface) hot-x hot-y)))
+ (if (null-pointer? ptr)
+ (sdl-error "make-color-cursor" "failed to create color cursor")
+ (wrap-cursor ptr))))
+
+(define (get-cursor)
+ "Return the cursor currently in use. The returned cursor object is
+internally managed and it's not necessary to call delete-cursor! for
+it."
+ (wrap-cursor (ffi:sdl-get-cursor)))
+
+(define (set-cursor! cursor)
+ "Set current cursor to CURSOR. If CURSOR is #f, the system default
+cursor is restored."
+ (ffi:sdl-set-cursor (if cursor
+ (unwrap-cursor cursor)
+ %null-pointer)))
+
+(define (delete-cursor! cursor)
+ "Free the memory used by CURSOR. Be careful!"
+ (ffi:sdl-free-cursor (unwrap-cursor cursor)))