diff options
| -rw-r--r-- | doc/api.texi | 41 | ||||
| -rw-r--r-- | sdl2/bindings.scm | 33 | ||||
| -rw-r--r-- | sdl2/input/mouse.scm | 74 |
3 files changed, 146 insertions, 2 deletions
diff --git a/doc/api.texi b/doc/api.texi index 8e0fe73..85e5bf7 100644 --- a/doc/api.texi +++ b/doc/api.texi @@ -313,6 +313,47 @@ Return @code{#t} if @var{button} is currently being pressed. Return @code{#t} if @var{button} is not currently being pressed. @end deffn +@deffn {Procedure} make-system-cursor cursor-type +Create a new cursor from the system's available set, chosen by +@var{cursor-type}. The possible values for @var{cursor-type} are: + +@itemize +@item @code{arrow} +@item @code{crosshair} +@item @code{hand} +@item @code{i-beam} +@item @code{size-north-south} +@item @code{size-northwest-southeast} +@item @code{size-northeast-southwest} +@item @code{size-west-east} +@item @code{size-all} +@item @code{no} +@item @code{wait} +@item @code{wait-arrow} +@end itemize + +@end deffn + +@deffn {Procedure} make-surface-cursor surface hot-x hot-y +Create a new cursor from a surface and the given hotspot coordinates +(@var{hot-x}, @var{hot-y}). +@end deffn + +@deffn {Procedure} get-cursor +Return the cursor currently in use. The returned cursor object is +internally managed and it's not necessary to call +@code{delete-cursor!} for it. +@end deffn + +@deffn {Procedure} set-cursor! cursor +Set the current cursor to @var{cursor}. If @var{cursor} is @code{#f}, +the system default cursor is restored. +@end deffn + +@deffn {Procedure} delete-cursor! cursor +Free the memory used by @var{cursor}. Be careful! +@end deffn + @node Joysticks @subsection Joysticks 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))) |