From 4acf8c9466dd2abb308f9a0e1b5c929c374b4b24 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Wed, 30 Mar 2022 20:55:51 +0900 Subject: [PATCH 01/31] adding Window creation hints enum --- glfw-bindings.lisp | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index dfa2d96..953682f 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -392,7 +392,27 @@ CFFI's defcallback that takes care of GLFW specifics." (:context-robustness #x00022005) (:opengl-forward-compat #x00022006) (:opengl-debug-context #x00022007) - (:opengl-profile #X00022008)) + (:opengl-profile #X00022008) + ;;added + ;;window-hint + (:doublebuffer #x00021010) + (:context-creation-api #x0002200b) + (:auto-iconify #x00020006) + (:maximized #x00020008) + (:center-cursor #x00020009) + (:transparent-framebuffer #x0002000a) + (:focus-on-show #x0002000c) + (:scale-to-monitor #x0002200c) + ;;context + (:context-release-behavior #x00022009) + (:context-no-error #x0002200a) + ;;not-tested + #+darwin :cocoa-retina-framebuffer + #+darwin :cocoa-frame-name + #+darwin :cocoa-graphics-switching + #+linux (:x11-class-name #x00024001) + #+linux (:x11-instance-name #x00024002) + ) (defcenum (opengl-api) (:no-api 0) From 7d8b67547527a0ce316fcde863155c1417bc93e0 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Wed, 30 Mar 2022 23:53:53 +0900 Subject: [PATCH 02/31] add bindings of window reference. --- glfw-bindings.lisp | 68 +++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 64 insertions(+), 4 deletions(-) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 953682f..27d3a9f 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -93,7 +93,18 @@ get-required-instance-extensions get-instance-proc-address physical-device-presentation-support-p - create-window-surface)) + create-window-surface + + ;;added + set-window-icon + get-window-frame-size + maximize-window + focus-window + request-window-attention + set-window-maximize-callback + set-window-content-scale-callback + wait-events-timeout + )) ;; internal stuff (export @@ -407,9 +418,9 @@ CFFI's defcallback that takes care of GLFW specifics." (:context-release-behavior #x00022009) (:context-no-error #x0002200a) ;;not-tested - #+darwin :cocoa-retina-framebuffer - #+darwin :cocoa-frame-name - #+darwin :cocoa-graphics-switching + #+darwin (:cocoa-retina-framebuffer #x00023001) + #+darwin (:cocoa-frame-name #x00023002) + #+darwin (:cocoa-graphics-switching #x00023003) #+linux (:x11-class-name #x00024001) #+linux (:x11-instance-name #x00024002) ) @@ -463,6 +474,12 @@ CFFI's defcallback that takes care of GLFW specifics." (blue :pointer) (size :unsigned-int)) +;;added +(defcstruct image + (width :int) + (height :int) + (pixels :string)) + (defctype window :pointer) (defctype monitor :pointer) @@ -571,6 +588,9 @@ Returns previously set callback." (defcfun ("glfwWindowHint" window-hint) :void (target window-hint) (hint :int)) +(defcfun ("glfwWindowHintString" window-hint-string) :void + (target window-hint) (hint (:pointer :char))) + (defcfun ("glfwCreateWindow" create-window) (float-traps-masked window) "Returns a window pointer that shares resources with the window SHARED or NULL." (width :int) (height :int) (title :string) (monitor monitor) (shared window)) @@ -587,6 +607,10 @@ Returns previously set callback." (defcfun ("glfwSetWindowTitle" set-window-title) :void (window window) (title :string)) +;;added pointer? +(defcfun ("glfwSetWindowIcon" set-window-icon) :void + (window window) (image-count :int) (images (:pointer (:struct image)))) + (defcfun ("glfwSetWindowMonitor" set-window-monitor) :void (window window) (monitor monitor) (x-position :int) (y-position :int) @@ -642,18 +666,39 @@ Returns previously set callback." window window :pointer w :pointer h :void) (list (mem-ref w :int) (mem-ref h :int)))) +;;added +(defun get-window-framesize (window) + "returns size (left top right bottom) of frame size." + (with-foreign-objects ((left :int) (top :int) (right :int) (bottom :int)) + (foreign-funcall "glfwGetWindowFrameSize" + window window + :pointer left :pointer top :pointer right :pointer bottom :void) + (list (mem-ref left :int) (mem-ref top :int) (mem-ref right :int) (mem-ref bottom :int)))) + (defcfun ("glfwIconifyWindow" iconify-window) :void (window window)) (defcfun ("glfwRestoreWindow" restore-window) :void (window window)) +;;added +(defcfun ("glfwMaximizeWindow" maximize-window) :void + (window window)) + (defcfun ("glfwShowWindow" show-window) :void (window window)) (defcfun ("glfwHideWindow" hide-window) :void (window window)) +;;added +(defcfun ("glfwFocusWindow" focus-window) :void + (window window)) + +;;added +(defcfun ("glfwRequestWindowAttention" request-window-attention) :void + (window window)) + (defcfun ("glfwGetWindowMonitor" get-window-monitor) monitor (window window)) @@ -696,6 +741,17 @@ Returns previously set callback." Returns previously set callback." (window window) (iconify-fun :pointer)) +;;added +(defcfun ("glfwsetWindowMaximizeCallback" set-window-maximize-callback) :pointer + "MAXIMIZE-FUN is a callback of type 'void (* GLFWwindowmaximizefun)(GLFWwindow*,int)'. + Returns previously set callback." + (window window) (maximize-fun :pointer)) +;;added +(defcfun ("glfwSetWindowContentScaleCallback" set-window-content-scale-callback) :pointer + "CONTENTS-SCALE-FUN is a callback of type 'void (* GLFWwindowContentsScalefun)(GLFWwindow*,float,float)'. + Returns previously set callback." + (window window) (contents-scale-fun :pointer)) + (defcfun ("glfwSetFramebufferSizeCallback" set-framebuffer-size-callback) :pointer "FRAMEBUFFER-SIZE-FUN is a callback of type 'void (* GLFWframebuffersizefun)(GLFWwindow*,int,int)'. Returns previously set callback." @@ -706,6 +762,10 @@ Returns previously set callback." (defcfun ("glfwWaitEvents" wait-events) (float-traps-masked :void)) +;;added trapps-masked? +(defcfun ("glfwWaitEventsTimeout" wait-events-timeout) :void + (timeout :double)) + (defcfun ("glfwPostEmptyEvent" post-empty-event) :void) (defcfun ("glfwGetInputMode" get-input-mode) :int From a01a32e2295171135b26db5a203b31fcd7ce520a Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Thu, 31 Mar 2022 00:17:57 +0900 Subject: [PATCH 03/31] add glfw3.3 glfw3.2 for foreign library --- glfw-bindings.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 27d3a9f..a077223 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -113,10 +113,10 @@ (define-foreign-library (glfw) (:darwin (:or ; homebrew naming - "libglfw3.1.dylib" "libglfw3.dylib" + "libglfw3.3.dylib" "libglfw3.2.dylib" "libglfw3.1.dylib" "libglfw3.dylib" ; cmake build naming - "libglfw.3.1.dylib" "libglfw.3.dylib")) - (:unix (:or "libglfw.so.3.1" "libglfw.so.3")) + "libglfw.3.3.dylib" "libglfw.3.2.dylib" "libglfw.3.1.dylib" "libglfw.3.dylib")) + (:unix (:or "libglfw.so.3.3" "libglfw.wo.3.2" "libglfw.so.3.1" "libglfw.so.3" "libglfw.so")) (:windows "glfw3.dll") (t (:or (:default "libglfw3") (:default "libglfw")))) From 5d7f6f24d711ea7694347a23ce9150bb869f22c0 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Thu, 31 Mar 2022 00:29:51 +0900 Subject: [PATCH 04/31] tweaked set-gamma-ramp's binding because of warning of cffi --- glfw-bindings.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index a077223..f74c3d6 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -580,7 +580,7 @@ Returns previously set callback." '(:struct gamma-ramp))) (defcfun ("glfwSetGammaRamp" set-gamma-ramp) :void - (monitor monitor) (ramp gamma-ramp)) + (monitor monitor) (ramp (:pointer (:struct gamma-ramp)))) (defcfun ("glfwDefaultWindowHints" default-window-hints) :void "Reset all window hints to defaults.") From 173a82db8799bd245a5989e2d59ea20f56ba7ce9 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Thu, 31 Mar 2022 01:43:10 +0900 Subject: [PATCH 05/31] add bindings of window --- glfw-bindings.lisp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index f74c3d6..281b1b3 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -414,6 +414,8 @@ CFFI's defcallback that takes care of GLFW specifics." (:transparent-framebuffer #x0002000a) (:focus-on-show #x0002000c) (:scale-to-monitor #x0002200c) + (:hovered #x0002000b) + (:floating #x00020007) ;;context (:context-release-behavior #x00022009) (:context-no-error #x0002200a) From e43fd6a7b5674a3a4c924ed4d4b50343369ae372 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Thu, 31 Mar 2022 02:10:41 +0900 Subject: [PATCH 06/31] add binding except input --- glfw-bindings.lisp | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 281b1b3..37274d9 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -14,7 +14,7 @@ get-monitors get-primary-monitor get-monitor-position - get-monitor-work-area + get-monitor-work-area ;get-monitor-workarea? get-monitor-physical-size get-monitor-content-scale get-monitor-name @@ -96,6 +96,7 @@ create-window-surface ;;added + ;;window set-window-icon get-window-frame-size maximize-window @@ -104,6 +105,9 @@ set-window-maximize-callback set-window-content-scale-callback wait-events-timeout + ;;monitor + set-monitor-user-pointer + get-monitor-user-pointer )) ;; internal stuff @@ -554,6 +558,13 @@ Returns the previous error callback." (defcfun ("glfwGetMonitorName" get-monitor-name) :string (monitor monitor)) +;;added +(defcfun ("glfwSetMonitorUserPointer" set-monitor-user-pointer) :void + (monitor monitor) (pointer :pointer)) +;;added +(defcfun ("glfwGetMonitorUserPointer" get-monitor-user-pointer) :pointer + (monitor monitor)) + (defcfun ("glfwSetMonitorCallback" set-monitor-callback) :pointer "MONITOR-FUN is a callback of type 'void (* GLFWmonitorfun)(GLFWmonitor*,int)'. Returns previously set callback." From a23235d7cede0d2b027db9bca4e53faa9ce428d0 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Thu, 31 Mar 2022 04:06:28 +0900 Subject: [PATCH 07/31] add input bindings --- glfw-bindings.lisp | 152 ++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 149 insertions(+), 3 deletions(-) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 37274d9..84e6d62 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -108,7 +108,25 @@ ;;monitor set-monitor-user-pointer get-monitor-user-pointer - )) + ;;input + get-key-scancode + get-key-name + raw-mouse-motion-supported-p + create-cursor + create-standard-cursor + set-cursor + get-joystick-hat + set-joystick-user-pointer + get-joystick-user-pointer + joystick-gamepad + set-joystick-callback + update-gamepad-mappings + get-gamepad-name + get-gamepad-state + get-timer-value + get-timer-frequency + set-drop-callback + )) ;; internal stuff (export @@ -330,11 +348,26 @@ CFFI's defcallback that takes care of GLFW specifics." (:right-super 347) (:menu 348)) +;;added caps-lock#x10 num-lock#x20 (defbitfield (mod-keys) :shift :control :alt - :super) + :super + :caps-lock + :num-lock) + +;;added +(defbitfield (hat) + (:centered #x0000) + (:up #x0001) + (:right #x0002) + (:down #x0004) + (:left #x0008) + (:right-up #x0003) + (:right-down #x0006) + (:left-up #x0009) + (:left-down #x000c)) (defcenum (mouse) (:1 0) @@ -368,6 +401,15 @@ CFFI's defcallback that takes care of GLFW specifics." :16 (:last 15)) +;;added +(defcenum (cursor-shape) + (:arrow #x00036001) + (:ibeam #x00036002) + (:crosshair #x00036003) + (:hand #x00036004) + (:hresize #x00036005) + (:vresize #x00036006)) + (defcenum (errors) (:not-initialized #x00010001) (:no-current-context #x00010002) @@ -453,13 +495,47 @@ CFFI's defcallback that takes care of GLFW specifics." (defcenum (input-mode) (:cursor #X00033001) (:sticky-keys #X00033002) - (:sticky-mouse-buttons #x00033003)) + (:sticky-mouse-buttons #x00033003) + ;;added + (:lock-key-mods #x00033004) + (:raw-mouse-motion #x00033005)) (defcenum (cursor-mode) (:normal #X00034001) (:hidden #X00034002) (:disabled #X00034003)) +;;added +(defcenum (gamepad-buttons) + (:a 0) + (:b 1) + (:x 2) + (:y 3) + (:left-bumper 4) + (:right-bumper 5) + (:back 6) + (:start 7) + (:guide 8) + (:left-thumb 9) + (:right-thumb 10) + (:dpad-up 11) + (:dpad-right 12) + (:dpad-down 13) + (:dpad-left) + (:last 14) + (:cross 0) + (:circle 1) + (:square 2) + (:triangle 3)) +;;added +(defcenum (gamepad-axis) + (:left-x 0) + (:left-y 1) + (:right-x 2) + (:right-y 3) + (:left-trigger 4) + (:right-trigger 5)) + (defcenum (vk-result :int) (:error-native-window-in-use-khr -1000000001) ;; returned by glfwCreateWindowSurface if the window has not been created with GLFW_NO_API (:error-extension-not-present -7) ;; returned by glfwCreateWindowSurface if the required extensions have not been enabled on the VkInstance @@ -485,9 +561,15 @@ CFFI's defcallback that takes care of GLFW specifics." (width :int) (height :int) (pixels :string)) +;;added +(defcstruct gamepad-state + (buttons (:pointer :char)) + (axes (:pointer :float))) (defctype window :pointer) (defctype monitor :pointer) +;;added +(defctype cursor :pointer) ;; vulkan handles (defctype vk-instance :pointer) @@ -787,9 +869,17 @@ Returns previously set callback." (defcfun ("glfwSetInputMode" set-input-mode) :void (window window) (mode input-mode) (value :int)) +;;added +(defcfun ("glfwGetKeyScancode" get-key-scancode) :int + (key key)) + (defcfun ("glfwGetKey" get-key) key-action (window window) (key key)) +;;added +(defcfun ("glfwGetKeyName" get-key-name) :string + (key key) (scancode :int)) + (defcfun ("glfwGetMouseButton" get-mouse-button) key-action (window window) (button mouse)) @@ -803,6 +893,19 @@ Returns previously set callback." (defcfun ("glfwSetCursorPos" set-cursor-position) :void (window window) (x :double) (y :double)) +;;added +(defcfun ("glfwCreateCursor" create-cursor) (float-traps-masked cursor) + (image (:pointer (:struct image))) (xhot :int) (yhot :int)) +;;added +(defcfun ("glfwCreateStandardCursor" create-standard-cursor) (:pointer cursor) + (shape cursor-shape)) +;;added +(defcfun ("glfwDestroyCursor" destroy-cursor) :void + (cursor (:pointer cursor))) +;;added +(defcfun ("glfwSetCursor" set-cursor) :void + (window window) (cursor cursor)) + (defcfun ("glfwSetKeyCallback" set-key-callback) :pointer "KEY-FUN is a callback of type 'void (* GLFWkeyfun)(GLFWwindow*,int,int,int,int)'. Returns previously set callback." @@ -836,6 +939,9 @@ Returns previously set callback." (defcfun ("glfwJoystickPresent" joystick-present-p) :boolean (joystick :int)) +;;added +(defcfun ("glfwRawMouseMotionSupported" raw-mouse-motion-supported-p) :int) + (defun get-joystick-axes (joystick) "Returns list of values for each axes of the joystick." (with-foreign-object (count :int) @@ -854,9 +960,37 @@ Returns previously set callback." (mem-ref count :int) 'key-action))) +;;added +(defcfun ("glfwGetJoystickHats" get-joystick-hats) (:pointer hat) + (jid joystick) (count (:pointer :int))) + (defcfun ("glfwGetJoystickName" get-joystick-name) :string (joystick :int)) +;;added +(defcfun ("glfwSetJoystickUserPointer" set-joystick-user-pointer) :void + (joystick joystick) (pointer :pointer)) +;;added +(defcfun ("glfwGetJoystickUserPointer" get-joystick-user-pointer) :pointer + (joystick joystick)) +;;added +(defcfun ("glfwJoystickGamepad" joystick-gamepad) :int + (joystick joystick)) +;;added +(defcfun ("glfwSetJoystickCallback" set-joystick-callback) :pointer + "JOYSTICK-FUN is a callback of type 'void (* GLFWjoystickfun)(int joystick,int event)'. +Returns previously set callback." + (JOYSTICK-FUN :pointer)) +;;added +(defcfun ("glfwUpdateGamepadMappings" update-gamepad-mappings) :int + (string :string)) +;;added +(defcfun ("glfwGetGamepadName" get-gamepad-name) :string + (joystick joystick)) +;;added +(defcfun ("glfwGetGamepadState" get-gamepad-state) :int + (joystick joystick) (gamepad-state (:pointer (:struct gamepad-state)))) + ;;;; ### Clipboard (defcfun ("glfwSetClipboardString" set-clipboard-string) :void (window window) (string :string)) @@ -870,6 +1004,18 @@ Returns previously set callback." (defcfun ("glfwSetTime" set-time) :void (time :double)) +;;added +(defcfun ("glfwGetTimerValue" get-timer-value) :uint64) +;;added +(defcfun ("glfwGetTimerFrequency" get-timer-frequency) :uint64) + +;;;; ### files +;;added +(defcfun ("glfwSetDropCallback" set-drop-callback) :pointer + "DROP-FUN is a callback of type 'void (* GLFWdropfun)(GLFWwindow*,int path_count,string)'. +Returns previously set callback." + (DROP-FUN :pointer)) + ;;;; ### Context (defcfun ("glfwMakeContextCurrent" make-context-current) :void (window window)) From b6c3c7663dd13e1427439dff68a935d475f3e040 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Sat, 2 Apr 2022 02:27:32 +0900 Subject: [PATCH 08/31] Rearranged the order of definition according to glfw reference for ease of reading --- glfw-bindings.lisp | 137 +++++++++++++++++++++++++-------------------- 1 file changed, 75 insertions(+), 62 deletions(-) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 84e6d62..768e924 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -220,11 +220,81 @@ CFFI's defcallback that takes care of GLFW specifics." (alexandria:define-constant +dont-care+ -1) ;;;; ## GLFW Types + (defcenum (key-action) :release :press :repeat) +;;; # Gamepad axes +;;added +(defcenum (gamepad-axes) + (:left-x 0) + (:left-y 1) + (:right-x 2) + (:right-y 3) + (:left-trigger 4) + (:right-trigger 5) + (:last 5)) + +;;added +;;; # Gamepad buttons +(defcenum (gamepad-buttons) + (:a 0) + (:b 1) + (:x 2) + (:y 3) + (:left-bumper 4) + (:right-bumper 5) + (:back 6) + (:start 7) + (:guide 8) + (:left-thumb 9) + (:right-thumb 10) + (:dpad-up 11) + (:dpad-right 12) + (:dpad-down 13) + (:dpad-left) + (:last 14) + (:cross 0) + (:circle 1) + (:square 2) + (:triangle 3)) + +;;added +;;; # joystick hat states +(defbitfield (hat) + (:centered #x0000) + (:up #x0001) + (:right #x0002) + (:down #x0004) + (:left #x0008) + (:right-up #x0003) + (:right-down #x0006) + (:left-up #x0009) + (:left-down #x000c)) + +;;; # Joysticks +(defcenum (joystick) + :1 + :2 + :3 + :4 + :5 + :6 + :7 + :8 + :9 + :10 + :11 + :12 + :13 + :14 + :15 + :16 + (:last 15)) + +;;; # KeyBoard Keys (defcenum (key) (:unknown -1) (:space 32) @@ -349,6 +419,7 @@ CFFI's defcallback that takes care of GLFW specifics." (:menu 348)) ;;added caps-lock#x10 num-lock#x20 +;;; # Modifier key flags (defbitfield (mod-keys) :shift :control @@ -357,18 +428,7 @@ CFFI's defcallback that takes care of GLFW specifics." :caps-lock :num-lock) -;;added -(defbitfield (hat) - (:centered #x0000) - (:up #x0001) - (:right #x0002) - (:down #x0004) - (:left #x0008) - (:right-up #x0003) - (:right-down #x0006) - (:left-up #x0009) - (:left-down #x000c)) - +;;; # Mouse buttons (defcenum (mouse) (:1 0) (:2 1) @@ -382,26 +442,8 @@ CFFI's defcallback that takes care of GLFW specifics." (:left 0) (:right 1)) -(defcenum (joystick) - :1 - :2 - :3 - :4 - :5 - :6 - :7 - :8 - :9 - :10 - :11 - :12 - :13 - :14 - :15 - :16 - (:last 15)) - ;;added +;;Standard cursor shapes (defcenum (cursor-shape) (:arrow #x00036001) (:ibeam #x00036002) @@ -410,6 +452,7 @@ CFFI's defcallback that takes care of GLFW specifics." (:hresize #x00036005) (:vresize #x00036006)) +;;; # Error codes (defcenum (errors) (:not-initialized #x00010001) (:no-current-context #x00010002) @@ -421,6 +464,7 @@ CFFI's defcallback that takes care of GLFW specifics." (:platform-error #X00010008) (:format-unavailable #x00010009)) +;;; # window-hint (defcenum (window-hint) (:focused #X00020001) (:iconified #X00020002) @@ -505,37 +549,6 @@ CFFI's defcallback that takes care of GLFW specifics." (:hidden #X00034002) (:disabled #X00034003)) -;;added -(defcenum (gamepad-buttons) - (:a 0) - (:b 1) - (:x 2) - (:y 3) - (:left-bumper 4) - (:right-bumper 5) - (:back 6) - (:start 7) - (:guide 8) - (:left-thumb 9) - (:right-thumb 10) - (:dpad-up 11) - (:dpad-right 12) - (:dpad-down 13) - (:dpad-left) - (:last 14) - (:cross 0) - (:circle 1) - (:square 2) - (:triangle 3)) -;;added -(defcenum (gamepad-axis) - (:left-x 0) - (:left-y 1) - (:right-x 2) - (:right-y 3) - (:left-trigger 4) - (:right-trigger 5)) - (defcenum (vk-result :int) (:error-native-window-in-use-khr -1000000001) ;; returned by glfwCreateWindowSurface if the window has not been created with GLFW_NO_API (:error-extension-not-present -7) ;; returned by glfwCreateWindowSurface if the required extensions have not been enabled on the VkInstance From ecda32c412e9e47907595c90949bd9659d7754d7 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Sat, 2 Apr 2022 04:49:18 +0900 Subject: [PATCH 09/31] arranged function --- glfw-bindings.lisp | 158 +++++++++++++++++++++++++++++---------------- 1 file changed, 104 insertions(+), 54 deletions(-) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 768e924..e216c6c 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -96,6 +96,7 @@ create-window-surface ;;added + get-version-string ;;window set-window-icon get-window-frame-size @@ -118,7 +119,7 @@ get-joystick-hat set-joystick-user-pointer get-joystick-user-pointer - joystick-gamepad + joystick-is-gamepad set-joystick-callback update-gamepad-mappings get-gamepad-name @@ -126,6 +127,8 @@ get-timer-value get-timer-frequency set-drop-callback + get-joystick-guid + set-char-mods-callback )) ;; internal stuff @@ -517,25 +520,45 @@ CFFI's defcallback that takes care of GLFW specifics." #+linux (:x11-instance-name #x00024002) ) +;; # for client-api hit (defcenum (opengl-api) (:no-api 0) (:opengl-api #X00030001) (:opengl-es-api #X00030002)) +#| +;; # for context-creation-api +not recommended +(defcenum (context-robustness) + (:no-robustness 0) + (:no-reset-notification #x00031001) + (:lose-context-on-reset #x00031002)) +|# + +;; # for context-robustness hint (defcenum (robustness) (:no-robustness 0) (:no-reset-notification #x00031001) (:lose-context-on-reset #x00031002)) +;; # for context-release-behavior hint +(defcenum (release-behavior) + (:any-release-behavior 0) + (:release-behavior-flush #x00035001) + (:release-behavior-none #x00035002)) + +;; # for opengl-profile hint (defcenum (opengl-profile) (:opengl-any-profile 0) (:opengl-core-profile #x00032001) (:opengl-compat-profile #x00032002)) +;; # for monitor callbacks (defcenum (monitor-event) (:connected #X00040001) (:disconnected #X00040002)) +;; # for get-input-mode function etc (defcenum (input-mode) (:cursor #X00033001) (:sticky-keys #X00033002) @@ -544,11 +567,13 @@ CFFI's defcallback that takes care of GLFW specifics." (:lock-key-mods #x00033004) (:raw-mouse-motion #x00033005)) +;; # for set-input-mode function (defcenum (cursor-mode) (:normal #X00034001) (:hidden #X00034002) (:disabled #X00034003)) +;; # for create-window-surface (defcenum (vk-result :int) (:error-native-window-in-use-khr -1000000001) ;; returned by glfwCreateWindowSurface if the window has not been created with GLFW_NO_API (:error-extension-not-present -7) ;; returned by glfwCreateWindowSurface if the required extensions have not been enabled on the VkInstance @@ -604,6 +629,7 @@ CFFI's defcallback that takes care of GLFW specifics." (foreign-funcall "glfwGetVersion" :pointer major :pointer minor :pointer rev) (values (mem-ref major :int) (mem-ref minor :int) (mem-ref rev :int)))) +;;added (defcfun ("glfwGetVersionString" get-version-string) :string) (defcfun ("glfwSetErrorCallback" set-error-callback) :pointer @@ -612,6 +638,7 @@ Returns the previous error callback." (error-fun :pointer)) ;;;; ### Window and monitor functions +;;;; ### Monitor function (defun get-monitors () "Returns list of pointers to opaque monitor objects." (with-foreign-object (count :int) @@ -690,6 +717,7 @@ Returns previously set callback." (defcfun ("glfwSetGammaRamp" set-gamma-ramp) :void (monitor monitor) (ramp (:pointer (:struct gamma-ramp)))) +;;;; ### Monitor function (defcfun ("glfwDefaultWindowHints" default-window-hints) :void "Reset all window hints to defaults.") @@ -715,15 +743,10 @@ Returns previously set callback." (defcfun ("glfwSetWindowTitle" set-window-title) :void (window window) (title :string)) -;;added pointer? +;;added (defcfun ("glfwSetWindowIcon" set-window-icon) :void (window window) (image-count :int) (images (:pointer (:struct image)))) -(defcfun ("glfwSetWindowMonitor" set-window-monitor) :void - (window window) (monitor monitor) - (x-position :int) (y-position :int) - (width :int) (height :int) (refresh-rate :int)) - (defun get-window-position (window) "Returns position of upper left corner of window (x y) in screen coordinates." (with-foreign-objects ((x :int) (y :int)) @@ -734,16 +757,6 @@ Returns previously set callback." (defcfun ("glfwSetWindowPos" set-window-position) :void (window window) (x :int) (y :int)) -(defun get-window-opacity (window) - "Returns opacity of window." - (with-foreign-objects ((x :float)) - (foreign-funcall "glfwGetWindowOpacity" - window window :pointer x :void) - (mem-ref x :float))) - -(defcfun ("glfwSetWindowOpacity" set-window-opacity) :void - (window window) (x :float)) - (defun get-window-size (window) "Returns size (w h) in screen coordinates." (with-foreign-objects ((w :int) (h :int)) @@ -760,6 +773,15 @@ Returns previously set callback." (defcfun ("glfwSetWindowAspectRatio" set-window-aspect-ratio) :void (window window) (width :int) (height :int)) +;;added +(defun get-window-frame-size (window) + "returns size (left top right bottom) of frame size." + (with-foreign-objects ((left :int) (top :int) (right :int) (bottom :int)) + (foreign-funcall "glfwGetWindowFrameSize" + window window + :pointer left :pointer top :pointer right :pointer bottom :void) + (list (mem-ref left :int) (mem-ref top :int) (mem-ref right :int) (mem-ref bottom :int)))) + (defun get-window-content-scale (window) "Returned scale is (x-scale y-scale)." (with-foreign-objects ((x-scale :float) (y-scale :float)) @@ -767,21 +789,15 @@ Returns previously set callback." window window :pointer x-scale :pointer y-scale :void) (list (mem-ref x-scale :float) (mem-ref y-scale :float)))) -(defun get-framebuffer-size (window) - "Returns size (w h) of framebuffer in pixels." - (with-foreign-objects ((w :int) (h :int)) - (foreign-funcall "glfwGetFramebufferSize" - window window :pointer w :pointer h :void) - (list (mem-ref w :int) (mem-ref h :int)))) +(defun get-window-opacity (window) + "Returns opacity of window." + (with-foreign-objects ((x :float)) + (foreign-funcall "glfwGetWindowOpacity" + window window :pointer x :void) + (mem-ref x :float))) -;;added -(defun get-window-framesize (window) - "returns size (left top right bottom) of frame size." - (with-foreign-objects ((left :int) (top :int) (right :int) (bottom :int)) - (foreign-funcall "glfwGetWindowFrameSize" - window window - :pointer left :pointer top :pointer right :pointer bottom :void) - (list (mem-ref left :int) (mem-ref top :int) (mem-ref right :int) (mem-ref bottom :int)))) +(defcfun ("glfwSetWindowOpacity" set-window-opacity) :void + (window window) (x :float)) (defcfun ("glfwIconifyWindow" iconify-window) :void (window window)) @@ -810,6 +826,18 @@ Returns previously set callback." (defcfun ("glfwGetWindowMonitor" get-window-monitor) monitor (window window)) +(defcfun ("glfwSetWindowMonitor" set-window-monitor) :void + (window window) (monitor monitor) + (x-position :int) (y-position :int) + (width :int) (height :int) (refresh-rate :int)) + +(defun get-framebuffer-size (window) + "Returns size (w h) of framebuffer in pixels." + (with-foreign-objects ((w :int) (h :int)) + (foreign-funcall "glfwGetFramebufferSize" + window window :pointer w :pointer h :void) + (list (mem-ref w :int) (mem-ref h :int)))) + (defcfun ("glfwGetWindowAttrib" get-window-attribute) :int (window window) (attribute window-hint)) @@ -854,17 +882,18 @@ Returns previously set callback." "MAXIMIZE-FUN is a callback of type 'void (* GLFWwindowmaximizefun)(GLFWwindow*,int)'. Returns previously set callback." (window window) (maximize-fun :pointer)) -;;added -(defcfun ("glfwSetWindowContentScaleCallback" set-window-content-scale-callback) :pointer - "CONTENTS-SCALE-FUN is a callback of type 'void (* GLFWwindowContentsScalefun)(GLFWwindow*,float,float)'. - Returns previously set callback." - (window window) (contents-scale-fun :pointer)) (defcfun ("glfwSetFramebufferSizeCallback" set-framebuffer-size-callback) :pointer "FRAMEBUFFER-SIZE-FUN is a callback of type 'void (* GLFWframebuffersizefun)(GLFWwindow*,int,int)'. Returns previously set callback." (window window) (framebuffer-size-fun :pointer)) +;;added +(defcfun ("glfwSetWindowContentScaleCallback" set-window-content-scale-callback) :pointer + "CONTENTS-SCALE-FUN is a callback of type 'void (* GLFWwindowContentsScalefun)(GLFWwindow*,float,float)'. + Returns previously set callback." + (window window) (contents-scale-fun :pointer)) + ;;;; ### Events and input (defcfun ("glfwPollEvents" poll-events) (float-traps-masked :void)) @@ -876,6 +905,10 @@ Returns previously set callback." (defcfun ("glfwPostEmptyEvent" post-empty-event) :void) +(defcfun ("glfwSwapBuffers" swap-buffers) :void + (window window)) + +;;;; ### Input function (defcfun ("glfwGetInputMode" get-input-mode) :int (window window) (mode input-mode)) @@ -883,16 +916,18 @@ Returns previously set callback." (window window) (mode input-mode) (value :int)) ;;added +(defcfun ("glfwRawMouseMotionSupported" raw-mouse-motion-supported-p) :int) + +;;added +(defcfun ("glfwGetKeyName" get-key-name) :string + (key key) (scancode :int)) +;;added (defcfun ("glfwGetKeyScancode" get-key-scancode) :int (key key)) (defcfun ("glfwGetKey" get-key) key-action (window window) (key key)) -;;added -(defcfun ("glfwGetKeyName" get-key-name) :string - (key key) (scancode :int)) - (defcfun ("glfwGetMouseButton" get-mouse-button) key-action (window window) (button mouse)) @@ -909,12 +944,15 @@ Returns previously set callback." ;;added (defcfun ("glfwCreateCursor" create-cursor) (float-traps-masked cursor) (image (:pointer (:struct image))) (xhot :int) (yhot :int)) + ;;added (defcfun ("glfwCreateStandardCursor" create-standard-cursor) (:pointer cursor) (shape cursor-shape)) + ;;added (defcfun ("glfwDestroyCursor" destroy-cursor) :void (cursor (:pointer cursor))) + ;;added (defcfun ("glfwSetCursor" set-cursor) :void (window window) (cursor cursor)) @@ -929,6 +967,12 @@ Returns previously set callback." Returns previously set callback." (window window) (char-fun :pointer)) +;;added +(defcfun ("glfwSetCharModsCallback" set-char-mods-callback) :pointer + "CHAR-MODS-FUN is a callback of type 'void (* GLFWCharModsfun)(GLFWwindow*,pointer)'. +Returns previously set callback." + (window window) (char-mods-fun :pointer)) + (defcfun ("glfwSetMouseButtonCallback" set-mouse-button-callback) :pointer "MOUSE-BUTTON-FUN is a callback of type 'void (* GLFWmousebuttonfun)(GLFWwindow*,int,int,int)'. Returns previously set callback." @@ -949,12 +993,16 @@ Returns previously set callback." Returns previously set callback." (window window) (SCROLL-FUN :pointer)) +;;;; ### files +;;added +(defcfun ("glfwSetDropCallback" set-drop-callback) :pointer + "DROP-FUN is a callback of type 'void (* GLFWdropfun)(GLFWwindow*,int path_count,string)'. +Returns previously set callback." + (DROP-FUN :pointer)) + (defcfun ("glfwJoystickPresent" joystick-present-p) :boolean (joystick :int)) -;;added -(defcfun ("glfwRawMouseMotionSupported" raw-mouse-motion-supported-p) :int) - (defun get-joystick-axes (joystick) "Returns list of values for each axes of the joystick." (with-foreign-object (count :int) @@ -980,26 +1028,36 @@ Returns previously set callback." (defcfun ("glfwGetJoystickName" get-joystick-name) :string (joystick :int)) +;;added +(defcfun ("glfwGetJoystickGUID" get-joystick-guid) :string + (joystick :int)) + ;;added (defcfun ("glfwSetJoystickUserPointer" set-joystick-user-pointer) :void (joystick joystick) (pointer :pointer)) + ;;added (defcfun ("glfwGetJoystickUserPointer" get-joystick-user-pointer) :pointer (joystick joystick)) + ;;added -(defcfun ("glfwJoystickGamepad" joystick-gamepad) :int +(defcfun ("glfwJoystickIsGamepad" joystick-is-gamepad) :int (joystick joystick)) + ;;added (defcfun ("glfwSetJoystickCallback" set-joystick-callback) :pointer "JOYSTICK-FUN is a callback of type 'void (* GLFWjoystickfun)(int joystick,int event)'. Returns previously set callback." (JOYSTICK-FUN :pointer)) + ;;added (defcfun ("glfwUpdateGamepadMappings" update-gamepad-mappings) :int (string :string)) + ;;added (defcfun ("glfwGetGamepadName" get-gamepad-name) :string (joystick joystick)) + ;;added (defcfun ("glfwGetGamepadState" get-gamepad-state) :int (joystick joystick) (gamepad-state (:pointer (:struct gamepad-state)))) @@ -1019,15 +1077,9 @@ Returns previously set callback." ;;added (defcfun ("glfwGetTimerValue" get-timer-value) :uint64) -;;added -(defcfun ("glfwGetTimerFrequency" get-timer-frequency) :uint64) -;;;; ### files ;;added -(defcfun ("glfwSetDropCallback" set-drop-callback) :pointer - "DROP-FUN is a callback of type 'void (* GLFWdropfun)(GLFWwindow*,int path_count,string)'. -Returns previously set callback." - (DROP-FUN :pointer)) +(defcfun ("glfwGetTimerFrequency" get-timer-frequency) :uint64) ;;;; ### Context (defcfun ("glfwMakeContextCurrent" make-context-current) :void @@ -1035,9 +1087,6 @@ Returns previously set callback." (defcfun ("glfwGetCurrentContext" get-current-context) window) -(defcfun ("glfwSwapBuffers" swap-buffers) :void - (window window)) - (defcfun ("glfwSwapInterval" swap-interval) :void (interval :int)) @@ -1047,6 +1096,7 @@ Returns previously set callback." (defcfun ("glfwGetProcAddress" get-proc-address) :pointer (proc-name :string)) +;;;; ### Vulkan function (defcfun ("glfwVulkanSupported" vulkan-supported-p) :boolean) (defun get-required-instance-extensions () From 089d73d2e3cf9bc9a47b8f515241a1136c9f57f0 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Sat, 2 Apr 2022 05:05:58 +0900 Subject: [PATCH 10/31] add comment for enum --- glfw-bindings.lisp | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index e216c6c..7c4eea1 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -558,7 +558,7 @@ not recommended (:connected #X00040001) (:disconnected #X00040002)) -;; # for get-input-mode function etc +;; # for get-input-mode and set-input-mode (defcenum (input-mode) (:cursor #X00033001) (:sticky-keys #X00033002) @@ -599,6 +599,7 @@ not recommended (width :int) (height :int) (pixels :string)) + ;;added (defcstruct gamepad-state (buttons (:pointer :char)) @@ -687,8 +688,10 @@ Returns the previous error callback." (defcfun ("glfwGetMonitorUserPointer" get-monitor-user-pointer) :pointer (monitor monitor)) +monitor-event (defcfun ("glfwSetMonitorCallback" set-monitor-callback) :pointer - "MONITOR-FUN is a callback of type 'void (* GLFWmonitorfun)(GLFWmonitor*,int)'. + "MONITOR-FUN is a callback of type 'void (* GLFWmonitorfun)(GLFWmonitor* monitor,int event)'. + event is one of the monitor-event Returns previously set callback." (monitor-fun :pointer)) @@ -913,6 +916,8 @@ Returns previously set callback." (window window) (mode input-mode)) (defcfun ("glfwSetInputMode" set-input-mode) :void + "if mode is :cursor value is cursor-mode + else value is true or false" (window window) (mode input-mode) (value :int)) ;;added From 855ee4fad1018690e4948f4cfc83c030d73f509c Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Sat, 2 Apr 2022 05:08:47 +0900 Subject: [PATCH 11/31] bug fix --- glfw-bindings.lisp | 1 - 1 file changed, 1 deletion(-) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 7c4eea1..1af1b30 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -688,7 +688,6 @@ Returns the previous error callback." (defcfun ("glfwGetMonitorUserPointer" get-monitor-user-pointer) :pointer (monitor monitor)) -monitor-event (defcfun ("glfwSetMonitorCallback" set-monitor-callback) :pointer "MONITOR-FUN is a callback of type 'void (* GLFWmonitorfun)(GLFWmonitor* monitor,int event)'. event is one of the monitor-event From 9e700b0f1020e2fcc667b1d7aafc6ca792401ead Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Sat, 2 Apr 2022 05:39:51 +0900 Subject: [PATCH 12/31] bug fix --- glfw-bindings.lisp | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 1af1b30..81acd94 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -598,7 +598,7 @@ not recommended (defcstruct image (width :int) (height :int) - (pixels :string)) + (pixels (:pointer :uchar))) ;;added (defcstruct gamepad-state @@ -1027,10 +1027,10 @@ Returns previously set callback." ;;added (defcfun ("glfwGetJoystickHats" get-joystick-hats) (:pointer hat) - (jid joystick) (count (:pointer :int))) + (jid :int) (count (:pointer :int))) (defcfun ("glfwGetJoystickName" get-joystick-name) :string - (joystick :int)) + (joystick :int));jid ;;added (defcfun ("glfwGetJoystickGUID" get-joystick-guid) :string @@ -1038,15 +1038,15 @@ Returns previously set callback." ;;added (defcfun ("glfwSetJoystickUserPointer" set-joystick-user-pointer) :void - (joystick joystick) (pointer :pointer)) + (joystick :int) (pointer :pointer)) ;;added (defcfun ("glfwGetJoystickUserPointer" get-joystick-user-pointer) :pointer - (joystick joystick)) + (joystick :int)) ;;added (defcfun ("glfwJoystickIsGamepad" joystick-is-gamepad) :int - (joystick joystick)) + (joystick :int)) ;;added (defcfun ("glfwSetJoystickCallback" set-joystick-callback) :pointer @@ -1060,11 +1060,11 @@ Returns previously set callback." ;;added (defcfun ("glfwGetGamepadName" get-gamepad-name) :string - (joystick joystick)) + (joystick :int)) ;;added (defcfun ("glfwGetGamepadState" get-gamepad-state) :int - (joystick joystick) (gamepad-state (:pointer (:struct gamepad-state)))) + (joystick :int) (gamepad-state (:pointer (:struct gamepad-state)))) ;;;; ### Clipboard (defcfun ("glfwSetClipboardString" set-clipboard-string) :void From a4d0db41daad7ba4842548325d68c015bfb29e7a Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Sun, 3 Apr 2022 18:46:20 +0900 Subject: [PATCH 13/31] defined image-related functions --- cl-glfw3.lisp | 36 ++++++++++++++++++++++++++++++++++++ glfw-bindings.lisp | 1 + 2 files changed, 37 insertions(+) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index de0a800..8229bd5 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -89,6 +89,31 @@ (when (/= major 3) (error "Local GLFW is ~a.~a.~a, should be above 3.x" major minor rev))) +;;;; image +(defstruct image + (width) + (height) + (pixels)) + +(defmacro with-image-pointer ((image-var image) &body body) + "translate image object from lisp to C and bind pointer of C image object to image-var symbol" + (alexandria:with-gensyms (width height pixels image-ptr) + (alexandria:once-only (image) + `(let ((,width (image-width ,image)) + (,height (image-height ,image))) + (cffi:with-foreign-objects ((,image-ptr '(:struct %glfw:image)) + (,pixels :uchar (* ,width ,height 4)));4=rgba + (loop for col from 0 below ,height do + (loop for row from 0 below ,width do + (let ((address (+ row (* ,width col)))) + (setf (cffi:mem-aref ,pixels address) + (aref (image-pixels ,image) address))))) + (setf (cffi:foreign-slot-value ,image-ptr '(:struct %glfw:image) '%glfw::width) ,width + (cffi:foreign-slot-value ,image-ptr '(:struct %glfw:image) '%glfw::height) ,height + (cffi:foreign-slot-value ,image-ptr '(:struct %glfw:image) '%glfw::pixels) ,pixels) + (let ((,image-var ,image-ptr)) + ,@body)))))) + ;;;; ## Window and monitor functions (defmacro import-export (&rest symbols) `(eval-when (:compile-toplevel :load-toplevel :execute) @@ -264,6 +289,14 @@ SHARED: The window whose context to share resources with." (defun iconify-window (&optional (window *window*)) (%glfw:iconify-window window)) +(defun set-window-icon (image &optional (window *window*)) + (cond ((null image) (%glfw:set-window-icon window 0 (cffi:null-pointer))) + (t (with-image-pointer (pointer image) (%glfw:set-window-icon window 0 pointer))))) + +(defun create-cursor (image xhot yhot) + (cond ((null image) (%glfw:create-cursor (cffi:null-pointer) xhot yhot)) + (t (with-image-pointer (pointer image) (%glfw:create-cursor pointer xhot yhot))))) + (defun restore-window (&optional (window *window*)) (%glfw:restore-window window)) @@ -436,6 +469,9 @@ SHARED: The window whose context to share resources with." (import-export %glfw:joystick-present-p %glfw:get-joystick-axes %glfw:get-joystick-buttons %glfw:get-joystick-name) +;;added +(deftype joystick-id () '(integer 0 15)) + ;;;; ## Clipboard (defun set-clipboard-string (string &optional (window *window*)) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 81acd94..ae6cb9e 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -97,6 +97,7 @@ ;;added get-version-string + image ;;window set-window-icon get-window-frame-size From 0967196d7dadb6eb91a8477bba0c9c0b43b1b365 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Sun, 3 Apr 2022 19:18:02 +0900 Subject: [PATCH 14/31] check & re-arrange export name --- cl-glfw3.lisp | 8 +++--- glfw-bindings.lisp | 69 +++++++++++++++++++++++++--------------------- 2 files changed, 41 insertions(+), 36 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index 8229bd5..f370645 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -101,16 +101,16 @@ (alexandria:once-only (image) `(let ((,width (image-width ,image)) (,height (image-height ,image))) - (cffi:with-foreign-objects ((,image-ptr '(:struct %glfw:image)) + (cffi:with-foreign-objects ((,image-ptr '(:struct %glfw::image)) (,pixels :uchar (* ,width ,height 4)));4=rgba (loop for col from 0 below ,height do (loop for row from 0 below ,width do (let ((address (+ row (* ,width col)))) (setf (cffi:mem-aref ,pixels address) (aref (image-pixels ,image) address))))) - (setf (cffi:foreign-slot-value ,image-ptr '(:struct %glfw:image) '%glfw::width) ,width - (cffi:foreign-slot-value ,image-ptr '(:struct %glfw:image) '%glfw::height) ,height - (cffi:foreign-slot-value ,image-ptr '(:struct %glfw:image) '%glfw::pixels) ,pixels) + (setf (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::width) ,width + (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::height) ,height + (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::pixels) ,pixels) (let ((,image-var ,image-ptr)) ,@body)))))) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index ae6cb9e..e7fc78a 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -6,11 +6,13 @@ (export '(+dont-care+ + ;;initialize init terminate get-version get-version-string set-error-callback + ;;monitor get-monitors get-primary-monitor get-monitor-position @@ -18,6 +20,8 @@ get-monitor-physical-size get-monitor-content-scale get-monitor-name + set-monitor-user-pointer ;added + get-monitor-user-pointer ;added set-monitor-callback get-video-modes get-video-mode @@ -27,6 +31,7 @@ set-gamma get-gamma-ramp set-gamma-ramp + ;;window default-window-hints window-hint create-window @@ -34,6 +39,7 @@ window-should-close-p set-window-should-close set-window-title + set-window-icon ;added get-window-opacity set-window-opacity get-window-position @@ -42,12 +48,16 @@ set-window-size set-window-size-limits set-window-aspect-ratio + get-window-frame-size ;added get-window-content-scale get-framebuffer-size iconify-window restore-window + maximize-window ;added show-window hide-window + focus-window ;added + request-window-attention ;added get-window-monitor get-window-attribute set-window-user-pointer @@ -58,37 +68,63 @@ set-window-refresh-callback set-window-focus-callback set-window-iconify-callback + set-window-maximize-callback ;added set-framebuffer-size-callback + set-window-content-scale-callback ;added set-window-monitor poll-events wait-events + wait-events-timeout ;added post-empty-event + ;;input get-input-mode set-input-mode + raw-mouse-motion-supported-p ;added + get-key-name ;added + get-key-scancode ;added get-key get-mouse-button get-cursor-position set-cursor-position + create-cursor ;added + create-standard-cursor ;added + destroy-cursor ;added + set-cursor ;added set-key-callback set-char-callback + set-char-mods-callback ;;added set-mouse-button-callback set-cursor-position-callback set-cursor-enter-callback set-scroll-callback + set-drop-callback ;added joystick-present-p get-joystick-axes get-joystick-buttons + get-joystick-hats ;added get-joystick-name + get-joystick-guid ;added + set-joystick-user-pointer ;added + get-joystick-user-pointer ;added + joystick-is-gamepad ;added + set-joystick-callback ;added + update-gamepad-mappings ;added + get-gamepad-name ;added + get-gamepad-state ;added set-clipboard-string get-clipboard-string get-time set-time + get-timer-value ;added + get-timer-frequency ;added + ;;context make-context-current get-current-context swap-buffers swap-interval extension-supported-p get-proc-address + ;;vulkan vulkan-supported-p get-required-instance-extensions get-instance-proc-address @@ -96,40 +132,9 @@ create-window-surface ;;added - get-version-string - image ;;window - set-window-icon - get-window-frame-size - maximize-window - focus-window - request-window-attention - set-window-maximize-callback - set-window-content-scale-callback - wait-events-timeout ;;monitor - set-monitor-user-pointer - get-monitor-user-pointer ;;input - get-key-scancode - get-key-name - raw-mouse-motion-supported-p - create-cursor - create-standard-cursor - set-cursor - get-joystick-hat - set-joystick-user-pointer - get-joystick-user-pointer - joystick-is-gamepad - set-joystick-callback - update-gamepad-mappings - get-gamepad-name - get-gamepad-state - get-timer-value - get-timer-frequency - set-drop-callback - get-joystick-guid - set-char-mods-callback )) ;; internal stuff @@ -631,7 +636,6 @@ not recommended (foreign-funcall "glfwGetVersion" :pointer major :pointer minor :pointer rev) (values (mem-ref major :int) (mem-ref minor :int) (mem-ref rev :int)))) -;;added (defcfun ("glfwGetVersionString" get-version-string) :string) (defcfun ("glfwSetErrorCallback" set-error-callback) :pointer @@ -1005,6 +1009,7 @@ Returns previously set callback." Returns previously set callback." (DROP-FUN :pointer)) +;;;; ### joystick (defcfun ("glfwJoystickPresent" joystick-present-p) :boolean (joystick :int)) From c3906ed89696d4cbcd9e959b596aadc58e296d6b Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Sun, 3 Apr 2022 19:30:03 +0900 Subject: [PATCH 15/31] changed name get-monitor-work-area -> get-monitor-workarea and add warning --- cl-glfw3.lisp | 10 +++++++++- glfw-bindings.lisp | 8 ++++---- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index f370645..d109b3d 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -20,6 +20,7 @@ with-init def-monitor-callback *window* + image ;added create-window destroy-window with-window @@ -27,6 +28,7 @@ window-should-close-p set-window-should-close set-window-title + set-window-icon ;added get-window-opacity set-window-opacity get-window-position @@ -65,6 +67,7 @@ get-mouse-button get-cursor-position set-cursor-position + create-cursor def-key-callback def-char-callback def-mouse-button-callback @@ -150,7 +153,12 @@ (unwind-protect (progn ,@body) (%glfw:terminate)))) -(import-export %glfw:get-monitors %glfw:get-primary-monitor %glfw:get-monitor-position %glfw:get-monitor-work-area %glfw:get-monitor-physical-size %glfw:get-monitor-content-scale %glfw:get-monitor-name %glfw:set-monitor-callback %glfw:get-video-modes %glfw:get-video-mode %glfw:set-gamma %glfw:get-gamma-ramp %glfw:set-gamma-ramp %glfw:terminate) +(import-export %glfw:get-monitors %glfw:get-primary-monitor %glfw:get-monitor-position %glfw:get-monitor-workarea %glfw:get-monitor-physical-size %glfw:get-monitor-content-scale %glfw:get-monitor-name %glfw:set-monitor-callback %glfw:get-video-modes %glfw:get-video-mode %glfw:set-gamma %glfw:get-gamma-ramp %glfw:set-gamma-ramp %glfw:terminate) + +;added +(defun get-monitor-work-area (monitor) + (warn "get-monitor-work-area is inconsistent name of foreign function.~% get-monitor-workarea is recommended") + (%glfw:get-monitor-workarea monitor)) (defmacro def-monitor-callback (name (monitor event) &body body) `(%glfw:define-glfw-callback ,name diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index e7fc78a..34ece65 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -16,7 +16,7 @@ get-monitors get-primary-monitor get-monitor-position - get-monitor-work-area ;get-monitor-workarea? + get-monitor-workarea ;get-monitor-workarea? get-monitor-physical-size get-monitor-content-scale get-monitor-name @@ -39,7 +39,7 @@ window-should-close-p set-window-should-close set-window-title - set-window-icon ;added + set-window-icon ;added exported get-window-opacity set-window-opacity get-window-position @@ -86,7 +86,7 @@ get-mouse-button get-cursor-position set-cursor-position - create-cursor ;added + create-cursor ;added exported create-standard-cursor ;added destroy-cursor ;added set-cursor ;added @@ -662,7 +662,7 @@ Returns the previous error callback." monitor monitor :pointer x :pointer y :void) (list (mem-ref x :int) (mem-ref y :int)))) -(defun get-monitor-work-area (monitor) +(defun get-monitor-workarea (monitor) "Returned work area is (x y w h) in screen coordinates." (with-foreign-objects ((x :int) (y :int) (w :int) (h :int)) (foreign-funcall "glfwGetMonitorWorkarea" From 399abfce560b19a38499f9c116b01a20364ebb10 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Sun, 3 Apr 2022 19:50:45 +0900 Subject: [PATCH 16/31] defined window functions in cl-glfw package --- cl-glfw3.lisp | 40 ++++++++++++++++++++++++++++++++++++++-- glfw-bindings.lisp | 16 ++++++++-------- 2 files changed, 46 insertions(+), 10 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index d109b3d..f97a7cf 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -28,7 +28,7 @@ window-should-close-p set-window-should-close set-window-title - set-window-icon ;added + set-window-icon get-window-opacity set-window-opacity get-window-position @@ -37,13 +37,17 @@ set-window-size set-window-size-limits set-window-aspect-ratio + get-window-frame-size set-window-monitor get-window-content-scale get-framebuffer-size iconify-window restore-window + maximize-window show-window hide-window +focus-window + request-window-attention get-window-monitor get-window-attribute get-context-version @@ -53,14 +57,18 @@ def-window-refresh-callback def-window-focus-callback def-window-iconify-callback +def-window-maximize-callback def-framebuffer-size-callback +def-window-content-scale-callback set-window-position-callback set-window-size-callback set-window-close-callback set-window-refresh-callback set-window-focus-callback set-window-iconify-callback +set-window-maximize-callback set-framebuffer-size-callback +set-window-content-scale-callback get-input-mode set-input-mode get-key @@ -282,6 +290,9 @@ SHARED: The window whose context to share resources with." (defun set-window-aspect-ratio (width height &optional (window *window*)) (%glfw:set-window-aspect-ratio window width height)) +(defun get-window-frame-size (&optional (window *window*)) + (%glfw:get-window-frame-size window)) + (defun get-window-content-scale (&optional (window *window*)) (%glfw:get-window-content-scale window)) @@ -308,12 +319,21 @@ SHARED: The window whose context to share resources with." (defun restore-window (&optional (window *window*)) (%glfw:restore-window window)) +(defun maximize-window (&optional (window *window*)) + (%glfw:maximize-window window)) + (defun show-window (&optional (window *window*)) (%glfw:show-window window)) (defun hide-window (&optional (window *window*)) (%glfw:hide-window window)) +(defun focus-window (&optional (window *window*)) + (%glfw:focus-window window)) + +(defun request-window-attention (&optional (window *window*)) + (%glfw:request-window-attention window)) + (defun get-window-monitor (&optional (window *window*)) (let ((monitor (%glfw:get-window-monitor window))) (unless (cffi:null-pointer-p monitor) @@ -365,11 +385,21 @@ SHARED: The window whose context to share resources with." ((,window :pointer) (,iconifiedp :boolean)) ,@body)) +(defmacro def-window-maximize-callback (name (window maximizedp) &body body) + `(%glfw:define-glfw-callback ,name + ((,window :pointer) (,maximizedp :boolean)) + ,@body)) + (defmacro def-framebuffer-size-callback (name (window w h) &body body) `(%glfw:define-glfw-callback ,name ((,window :pointer) (,w :int) (,h :int)) ,@body)) +(defmacro def-window-content-scale-callback (name (window xscale yscale) &body body) + `(%glfw:define-glfw-callback ,name + ((,window :pointer) (,xscale :float) (,yscale ,:float)) + ,@body)) + (defun set-window-position-callback (callback-name &optional (window *window*)) (%glfw:set-window-position-callback window (cffi:get-callback callback-name))) @@ -388,11 +418,17 @@ SHARED: The window whose context to share resources with." (defun set-window-iconify-callback (callback-name &optional (window *window*)) (%glfw:set-window-iconify-callback window (cffi:get-callback callback-name))) +(defun set-window-maximize-callback (callback-name &optional (window *window*)) + (%glfw:set-window-maximize-callback window callback-name)) + (defun set-framebuffer-size-callback (callback-name &optional (window *window*)) (%glfw:set-framebuffer-size-callback window (cffi:get-callback callback-name))) +(defun set-window-content-scale-callback (callback-name &optional (window *window*)) + (%glfw:set-window-content-scale-callback window (cffi:get-callback callback-name))) + ;;;; ## Events and input -(import-export %glfw:poll-events %glfw:wait-events %glfw:post-empty-event) +(import-export %glfw:poll-events %glfw:wait-events %glfw:wait-events-timeout %glfw:post-empty-event) (defun get-input-mode (mode &optional (window *window*)) "Mode is one of :CURSOR :STICKY-KEYS or :STICKY-MOUSE-BUTTONS." diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 34ece65..2e8eb31 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -16,7 +16,7 @@ get-monitors get-primary-monitor get-monitor-position - get-monitor-workarea ;get-monitor-workarea? + get-monitor-workarea get-monitor-physical-size get-monitor-content-scale get-monitor-name @@ -48,16 +48,16 @@ set-window-size set-window-size-limits set-window-aspect-ratio - get-window-frame-size ;added + get-window-frame-size ;added exported get-window-content-scale get-framebuffer-size iconify-window restore-window - maximize-window ;added + maximize-window ;added exported show-window hide-window - focus-window ;added - request-window-attention ;added + focus-window ;added exported + request-window-attention ;added exported get-window-monitor get-window-attribute set-window-user-pointer @@ -68,13 +68,13 @@ set-window-refresh-callback set-window-focus-callback set-window-iconify-callback - set-window-maximize-callback ;added + set-window-maximize-callback ;added exported set-framebuffer-size-callback - set-window-content-scale-callback ;added + set-window-content-scale-callback ;added exported set-window-monitor poll-events wait-events - wait-events-timeout ;added + wait-events-timeout ;added exported post-empty-event ;;input get-input-mode From 0fc60fda96212dd38e31ad17d061d4975906bb80 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Sun, 3 Apr 2022 23:15:29 +0900 Subject: [PATCH 17/31] defined all bindings in cl-glfw3 --- cl-glfw3.lisp | 46 ++++++++++++++++++++++++++++++++++------ glfw-bindings.lisp | 53 ++++++++++++++++++++++++++-------------------- 2 files changed, 70 insertions(+), 29 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index f97a7cf..da0c312 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -75,19 +75,24 @@ set-window-content-scale-callback get-mouse-button get-cursor-position set-cursor-position - create-cursor +create-cursor +set-cursor def-key-callback def-char-callback +def-char-mods-callback def-mouse-button-callback def-cursor-pos-callback def-cursor-enter-callback def-scroll-callback + def-drop-callback set-key-callback set-char-callback +set-char-mods-callback set-mouse-button-callback set-cursor-position-callback set-cursor-enter-callback set-scroll-callback +def-joystick-callback set-clipboard-string get-clipboard-string make-context-current @@ -312,10 +317,6 @@ SHARED: The window whose context to share resources with." (cond ((null image) (%glfw:set-window-icon window 0 (cffi:null-pointer))) (t (with-image-pointer (pointer image) (%glfw:set-window-icon window 0 pointer))))) -(defun create-cursor (image xhot yhot) - (cond ((null image) (%glfw:create-cursor (cffi:null-pointer) xhot yhot)) - (t (with-image-pointer (pointer image) (%glfw:create-cursor pointer xhot yhot))))) - (defun restore-window (&optional (window *window*)) (%glfw:restore-window window)) @@ -459,6 +460,13 @@ SHARED: The window whose context to share resources with." (defun set-cursor-position (x y &optional (window *window*)) (%glfw:set-cursor-position window x y)) +(defun create-cursor (image xhot yhot) + (cond ((null image) (%glfw:create-cursor (cffi:null-pointer) xhot yhot)) + (t (with-image-pointer (pointer image) (%glfw:create-cursor pointer xhot yhot))))) + +(defun set-cursor (cursor &optional (window *window*)) + (%glfw:set-cursor window cursor)) + (defmacro def-key-callback (name (window key scancode action mod-keys) &body body) `(%glfw:define-glfw-callback ,name ((,window :pointer) (,key %glfw::key) (,scancode :int) @@ -472,6 +480,13 @@ SHARED: The window whose context to share resources with." (let ((,char (code-char ,char-code))) ,@body)))) +(defmacro def-char-mods-callback (name (window char mod-keys) &body body) + (let ((char-code (gensym "char"))) + `(%glfw:define-glfw-callback ,name + ((,window :pointer) (,char-code :unsigned-int) (,mod-keys %glfw::mod-keys)) + (let ((,char (code-char ,char-code))) + ,@body)))) + (defmacro def-mouse-button-callback (name (window button action mod-keys) &body body) `(%glfw:define-glfw-callback ,name ((,window :pointer) (,button %glfw::mouse) @@ -493,12 +508,27 @@ SHARED: The window whose context to share resources with." ((,window :pointer) (,x :double) (,y :double)) ,@body)) +;;added +;;must: support function +(defmacro def-drop-callback (name (window number-of-pathes pathes) &body body) + `(%glfw:define-glfw-callback ,name + ((,window :pointer) (,number-of-pathes :int) (,pathes (:pointer (:pointer (:struct :char))))) + ,@body)) + +(defmacro def-joystick-callback (name (joystick event) &body body) + `(%glfw:define-glfw-callback ,name + ((,joystick int) (,event %glfw::monitor-event)) + ,@body)) + (defun set-key-callback (callback-name &optional (window *window*)) (%glfw:set-key-callback window (cffi:get-callback callback-name))) (defun set-char-callback (callback-name &optional (window *window*)) (%glfw:set-char-callback window (cffi:get-callback callback-name))) +(defun set-char-mods-callback (callback-name &optional (window *window*)) + (%glfw:set-char-mods-callback window (cffi:get-callback callback-name))) + (defun set-mouse-button-callback (callback-name &optional (window *window*)) (%glfw:set-mouse-button-callback window (cffi:get-callback callback-name))) @@ -511,7 +541,11 @@ SHARED: The window whose context to share resources with." (defun set-scroll-callback (callback-name &optional (window *window*)) (%glfw:set-scroll-callback window (cffi:get-callback callback-name))) -(import-export %glfw:joystick-present-p %glfw:get-joystick-axes %glfw:get-joystick-buttons %glfw:get-joystick-name) +(import-export %glfw:raw-mouse-motion-supported-p %glfw:get-key-name %glfw:get-key-scancode %glfw:destroy-cursor + %glfw:create-standard-cursor + %glfw:joystick-present-p %glfw:get-joystick-axes %glfw:get-joystick-buttons %glfw:get-joystick-hats + %glfw:get-joystick-name %glfw:get-joystick-guid %glfw:joystick-is-gamepad-p %glfw:update-gamepad-mappings + %glfw:get-gamepad-name %glfw:get-gamepad-state %glfw:get-timer-value %glfw:get-timer-frequency) ;;added (deftype joystick-id () '(integer 0 15)) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 2e8eb31..4045b94 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -79,44 +79,44 @@ ;;input get-input-mode set-input-mode - raw-mouse-motion-supported-p ;added - get-key-name ;added - get-key-scancode ;added + raw-mouse-motion-supported-p ;added exported + get-key-name ;added exported + get-key-scancode ;added exported get-key get-mouse-button get-cursor-position set-cursor-position create-cursor ;added exported - create-standard-cursor ;added - destroy-cursor ;added - set-cursor ;added + create-standard-cursor ;added exported + destroy-cursor ;added exported + set-cursor ;added exported set-key-callback set-char-callback - set-char-mods-callback ;;added + set-char-mods-callback ;;added exported set-mouse-button-callback set-cursor-position-callback set-cursor-enter-callback set-scroll-callback - set-drop-callback ;added + set-drop-callback ;added exported joystick-present-p get-joystick-axes get-joystick-buttons - get-joystick-hats ;added + get-joystick-hats ;added exported get-joystick-name - get-joystick-guid ;added + get-joystick-guid ;added exported set-joystick-user-pointer ;added get-joystick-user-pointer ;added - joystick-is-gamepad ;added - set-joystick-callback ;added - update-gamepad-mappings ;added - get-gamepad-name ;added - get-gamepad-state ;added + joystick-is-gamepad-p ;added exported + set-joystick-callback ;added exported + update-gamepad-mappings ;added exported + get-gamepad-name ;added exported + get-gamepad-state ;added exported set-clipboard-string get-clipboard-string get-time set-time - get-timer-value ;added - get-timer-frequency ;added + get-timer-value ;added exported + get-timer-frequency ;added exported ;;context make-context-current get-current-context @@ -559,6 +559,7 @@ not recommended (:opengl-core-profile #x00032001) (:opengl-compat-profile #x00032002)) +;;todo monitor-event -> connect-event joystick is also associated ;; # for monitor callbacks (defcenum (monitor-event) (:connected #X00040001) @@ -1005,7 +1006,7 @@ Returns previously set callback." ;;;; ### files ;;added (defcfun ("glfwSetDropCallback" set-drop-callback) :pointer - "DROP-FUN is a callback of type 'void (* GLFWdropfun)(GLFWwindow*,int path_count,string)'. + "DROP-FUN is a callback of type 'void (* GLFWdropfun)(GLFWwindow*,int path_count,struct char** path_names)'. Returns previously set callback." (DROP-FUN :pointer)) @@ -1032,8 +1033,14 @@ Returns previously set callback." 'key-action))) ;;added -(defcfun ("glfwGetJoystickHats" get-joystick-hats) (:pointer hat) - (jid :int) (count (:pointer :int))) +(defun get-joystick-hats (joystick) + "Returns list of values for direction of the joystick." + (with-foreign-object (count :int) + (c-array->list (foreign-funcall "glfwGetJoystickHats" + :int joystick :pointer count + :pointer) + (mem-ref count :int) + 'hats))) (defcfun ("glfwGetJoystickName" get-joystick-name) :string (joystick :int));jid @@ -1051,7 +1058,7 @@ Returns previously set callback." (joystick :int)) ;;added -(defcfun ("glfwJoystickIsGamepad" joystick-is-gamepad) :int +(defcfun ("glfwJoystickIsGamepad" joystick-is-gamepad-p) :boolean (joystick :int)) ;;added @@ -1061,7 +1068,7 @@ Returns previously set callback." (JOYSTICK-FUN :pointer)) ;;added -(defcfun ("glfwUpdateGamepadMappings" update-gamepad-mappings) :int +(defcfun ("glfwUpdateGamepadMappings" update-gamepad-mappings) :boolean (string :string)) ;;added @@ -1069,7 +1076,7 @@ Returns previously set callback." (joystick :int)) ;;added -(defcfun ("glfwGetGamepadState" get-gamepad-state) :int +(defcfun ("glfwGetGamepadState" get-gamepad-state) :boolean (joystick :int) (gamepad-state (:pointer (:struct gamepad-state)))) ;;;; ### Clipboard From 9f0bc04ecef2fa825bf1a3ec3fc05c1c5c4e54a8 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Mon, 4 Apr 2022 00:03:45 +0900 Subject: [PATCH 18/31] monitor-event -> connection-event --- cl-glfw3.lisp | 6 +++--- glfw-bindings.lisp | 5 ++--- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index da0c312..5999dbe 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -112,7 +112,7 @@ def-joystick-callback (pixels)) (defmacro with-image-pointer ((image-var image) &body body) - "translate image object from lisp to C and bind pointer of C image object to image-var symbol" + "Internal function. translate image object from lisp to C and bind pointer of C image object to image-var symbol" (alexandria:with-gensyms (width height pixels image-ptr) (alexandria:once-only (image) `(let ((,width (image-width ,image)) @@ -175,7 +175,7 @@ def-joystick-callback (defmacro def-monitor-callback (name (monitor event) &body body) `(%glfw:define-glfw-callback ,name - ((,monitor :pointer) (,event %glfw::monitor-event)) + ((,monitor :pointer) (,event %glfw::connection-event)) ,@body)) (defvar *window* nil @@ -517,7 +517,7 @@ SHARED: The window whose context to share resources with." (defmacro def-joystick-callback (name (joystick event) &body body) `(%glfw:define-glfw-callback ,name - ((,joystick int) (,event %glfw::monitor-event)) + ((,joystick int) (,event %glfw::connection-event)) ,@body)) (defun set-key-callback (callback-name &optional (window *window*)) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 4045b94..2b26fd6 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -559,9 +559,8 @@ not recommended (:opengl-core-profile #x00032001) (:opengl-compat-profile #x00032002)) -;;todo monitor-event -> connect-event joystick is also associated ;; # for monitor callbacks -(defcenum (monitor-event) +(defcenum (connection-event) (:connected #X00040001) (:disconnected #X00040002)) @@ -696,7 +695,7 @@ Returns the previous error callback." (defcfun ("glfwSetMonitorCallback" set-monitor-callback) :pointer "MONITOR-FUN is a callback of type 'void (* GLFWmonitorfun)(GLFWmonitor* monitor,int event)'. - event is one of the monitor-event + event is one of the connection-event Returns previously set callback." (monitor-fun :pointer)) From 9713fa5c08349614527b6aa3f53a53fe063251d0 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Mon, 4 Apr 2022 01:20:49 +0900 Subject: [PATCH 19/31] redefined initialize function. Args of initialize and with-init are changed but of with-init-window isn't. --- cl-glfw3.lisp | 18 ++++++++++++------ glfw-bindings.lisp | 10 +++++++++- 2 files changed, 21 insertions(+), 7 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index 5999dbe..de14fee 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -18,9 +18,10 @@ set-error-callback initialize with-init +get-monitor-work-area def-monitor-callback *window* - image ;added + image create-window destroy-window with-window @@ -149,27 +150,32 @@ def-joystick-callback (defun set-error-callback (callback-name) (%glfw:set-error-callback (cffi:get-callback callback-name))) -(defun initialize () +(defun initialize (&key (joystick-hat-buttons t) + (cocoa-chdid-resources t) + (cocoa-menubar t)) "Start GLFW" + (%glfw:init-hint :joystick-hat-buttons joystick-hat-buttons) + (%glfw:init-hint :cocoa-chdid-resources cocoa-chdid-resources) + (%glfw:init-hint :cocoa-menubar cocoa-menubar) (let ((result (%glfw:init))) (unless result (error "Error initializing glfw.")) result)) -(defmacro with-init (&body body) +(defmacro with-init ((&rest init-keys) &body body) "Wrap BODY with an initialized GLFW instance, ensuring proper termination. If no error callback is set when this is called, a default error callback is set." `(progn (let ((prev-error-fun (set-error-callback 'default-error-fun))) (unless (cffi:null-pointer-p prev-error-fun) (%glfw:set-error-callback prev-error-fun))) - (initialize) + (initialize ,@init-keys) (unwind-protect (progn ,@body) (%glfw:terminate)))) (import-export %glfw:get-monitors %glfw:get-primary-monitor %glfw:get-monitor-position %glfw:get-monitor-workarea %glfw:get-monitor-physical-size %glfw:get-monitor-content-scale %glfw:get-monitor-name %glfw:set-monitor-callback %glfw:get-video-modes %glfw:get-video-mode %glfw:set-gamma %glfw:get-gamma-ramp %glfw:set-gamma-ramp %glfw:terminate) -;added (defun get-monitor-work-area (monitor) + "Inconsistent name of get-monitor-workarea. old-version used this name" (warn "get-monitor-work-area is inconsistent name of foreign function.~% get-monitor-workarea is recommended") (%glfw:get-monitor-workarea monitor)) @@ -259,7 +265,7 @@ SHARED: The window whose context to share resources with." (defmacro with-init-window ((&rest window-keys) &body body) "Convenience macro for setting up GLFW and opening a window." - `(with-init + `(with-init () (with-window ,window-keys ,@body))) (defun window-should-close-p (&optional (window *window*)) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 2b26fd6..407cba9 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -9,6 +9,7 @@ ;;initialize init terminate +init-hint ;added exported get-version get-version-string set-error-callback @@ -92,7 +93,7 @@ set-cursor ;added exported set-key-callback set-char-callback - set-char-mods-callback ;;added exported + set-char-mods-callback ;added exported set-mouse-button-callback set-cursor-position-callback set-cursor-enter-callback @@ -229,6 +230,10 @@ CFFI's defcallback that takes care of GLFW specifics." (alexandria:define-constant +dont-care+ -1) ;;;; ## GLFW Types +(defcenum (initialize-hint) + (:joystick-hat-buttons #x00050001) + (:cocoa-chdid-resources #x00051001) + (:cocoa-menubar #x00051002)) (defcenum (key-action) :release @@ -630,6 +635,9 @@ not recommended (defcfun ("glfwInit" init) :boolean) (defcfun ("glfwTerminate" terminate) :void) +(defcfun ("glfwInitHint" init-hint) :void + (hint initialize-hint) (value :boolean)) + (defun get-version () "Returns major, minor, and revison numbers of GLFW library. May be called before INIT." (with-foreign-objects ((major :int) (minor :int) (rev :int)) From 668b9773a21353f6b421d2e96692d8dfa133bef7 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Mon, 4 Apr 2022 03:04:44 +0900 Subject: [PATCH 20/31] add hints for create-window --- cl-glfw3.lisp | 97 ++++++++++++++++++++++++++++++++-------------- glfw-bindings.lisp | 54 ++++++++++++-------------- 2 files changed, 92 insertions(+), 59 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index de14fee..2d30c9c 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -196,6 +196,14 @@ def-joystick-callback (resizable t) (visible t) (decorated t) + (focused t) + (auto-iconify t) + (floating nil) + (maximized nil) + (center-cursor t) + (transparent-framebuffer nil) + (focus-on-show t) + (scale-to-monitor nil) (red-bits 8) (green-bits 8) (blue-bits 8) (alpha-bits 8) (depth-bits 24) (stencil-bits 8) (accum-red-bits 0) (accum-green-bits 0) (accum-blue-bits 0) @@ -205,48 +213,79 @@ def-joystick-callback (refresh-rate 0) (stereo nil) (srgb-capable nil) + (doublebuffer t) (client-api :opengl-api) + (context-creation-api :native-context-api) (context-version-major 1) (context-version-minor 0) (context-robustness :no-robustness) + (context-release-behavior :any-release-behavior) (opengl-forward-compat nil) (opengl-debug-context nil) - (opengl-profile :opengl-any-profile)) + (opengl-profile :opengl-any-profile) + (cocoa-retina-framebuffer t) + (cocoa-frame-name "") + (cocoa-graphics-switching nil) + (x11-class-name "") + (x11-instance-name "") + ) "This function handles all window hints. MONITOR: The monitor on which the window should be full-screen. SHARED: The window whose context to share resources with." (macrolet ((output-hints (&rest hints) - `(progn - ,@(loop for (name type) in hints collect - `(%glfw:window-hint - ,(intern (string-upcase - (symbol-name name)) :keyword) - (cffi:convert-to-foreign ,name ,type)))))) - (output-hints - (resizable :boolean) - (visible :boolean) - (decorated :boolean) - (red-bits :int) (green-bits :int) (blue-bits :int) (alpha-bits :int) - (depth-bits :int) (stencil-bits :int) - (accum-red-bits :int) (accum-green-bits :int) (accum-blue-bits :int) - (accum-alpha-bits :int) - (aux-buffers :int) - (samples :int) - (refresh-rate :int) - (stereo :boolean) - (srgb-capable :boolean) - (client-api '%glfw::opengl-api) - (context-version-major :int) - (context-version-minor :int) - (context-robustness '%glfw::robustness) - (opengl-forward-compat :boolean) - (opengl-debug-context :boolean) - (opengl-profile '%glfw::opengl-profile))) + (flet ((stringhint-p (hintname) + (member hintname '(cocoa-frame-name x11-class-name x11-instance-name)))) + `(progn + ,@(loop for (name type) in hints collect + `(,(if (stringhint-p (intern (string-upcase + (symbol-name name)))) + '%glfw:window-hint-string + '%glfw:window-hint) + ,(intern (string-upcase + (symbol-name name)) :keyword) + (cffi:convert-to-foreign ,name ,type))))))) + (output-hints + (resizable :boolean) + (visible :boolean) + (decorated :boolean) + (focused :boolean) + (auto-iconify :boolean) + (floating :boolean) + (maximized :boolean) + (center-cursor :boolean) + (transparent-framebuffer :boolean) + (focus-on-show :boolean) + (scale-to-monitor :boolean) + (red-bits :int) (green-bits :int) (blue-bits :int) (alpha-bits :int) + (depth-bits :int) (stencil-bits :int) + (accum-red-bits :int) (accum-green-bits :int) (accum-blue-bits :int) + (accum-alpha-bits :int) + (aux-buffers :int) + (samples :int) + (refresh-rate :int) + (stereo :boolean) + (srgb-capable :boolean) + (doublebuffer :boolean) + (client-api '%glfw::opengl-api) + (context-creation-api '%glfw::context-creation) + (context-version-major :int) + (context-version-minor :int) + (context-robustness '%glfw::robustness) + (context-release-behavior '%glfw::release-behavior) + (opengl-forward-compat :boolean) + (opengl-debug-context :boolean) + (opengl-profile '%glfw::opengl-profile) + (cocoa-retina-framebuffer :boolean) + (cocoa-frame-name :string) + (cocoa-graphics-switching :boolean) + (x11-class-name :string) + (x11-instance-name :string) + )) (let ((window (%glfw:create-window width height title monitor shared))) (if (cffi:null-pointer-p window) - (error "Error creating window.") - (if (eq client-api :no-api) + (error "Error creating window.") + (if (eq client-api :no-api) (setf *window* window) (make-context-current window))))) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 407cba9..3779753 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -35,6 +35,7 @@ init-hint ;added exported ;;window default-window-hints window-hint + window-hint-string create-window destroy-window window-should-close-p @@ -485,6 +486,13 @@ CFFI's defcallback that takes care of GLFW specifics." (:resizable #X00020003) (:visible #X00020004) (:decorated #X00020005) + (:auto-iconify #x00020006) ;added + (:floating #x00020007) ;added + (:maximized #x00020008) ;added + (:center-cursor #x00020009) ;added + (:transparent-framebuffer #x0002000a) ;added + (:hovered #x0002000b) ;added + (:focus-on-show #x0002000c) ;added (:red-bits #X00021001) (:green-bits #X00021002) (:blue-bits #X00021003) @@ -500,6 +508,7 @@ CFFI's defcallback that takes care of GLFW specifics." (:samples #X0002100d) (:srgb-capable #X0002100E) (:refresh-rate #X0002100F) + (:doublebuffer #x00021010) ;added (:client-api #X00022001) (:context-version-major #x00022002) (:context-version-minor #x00022003) @@ -508,27 +517,15 @@ CFFI's defcallback that takes care of GLFW specifics." (:opengl-forward-compat #x00022006) (:opengl-debug-context #x00022007) (:opengl-profile #X00022008) - ;;added - ;;window-hint - (:doublebuffer #x00021010) - (:context-creation-api #x0002200b) - (:auto-iconify #x00020006) - (:maximized #x00020008) - (:center-cursor #x00020009) - (:transparent-framebuffer #x0002000a) - (:focus-on-show #x0002000c) - (:scale-to-monitor #x0002200c) - (:hovered #x0002000b) - (:floating #x00020007) - ;;context - (:context-release-behavior #x00022009) - (:context-no-error #x0002200a) - ;;not-tested - #+darwin (:cocoa-retina-framebuffer #x00023001) - #+darwin (:cocoa-frame-name #x00023002) - #+darwin (:cocoa-graphics-switching #x00023003) - #+linux (:x11-class-name #x00024001) - #+linux (:x11-instance-name #x00024002) + (:context-release-behavior #x00022009) ;added + (:context-no-error #x0002200a) ;added + (:context-creation-api #x0002200b) ;added + (:scale-to-monitor #x0002200c) ;added + (:cocoa-retina-framebuffer #x00023001) ;added + (:cocoa-frame-name #x00023002) ;added + (:cocoa-graphics-switching #x00023003) ;added + (:x11-class-name #x00024001) ;added + (:x11-instance-name #x00024002) ;added ) ;; # for client-api hit @@ -537,14 +534,11 @@ CFFI's defcallback that takes care of GLFW specifics." (:opengl-api #X00030001) (:opengl-es-api #X00030002)) -#| -;; # for context-creation-api -not recommended -(defcenum (context-robustness) - (:no-robustness 0) - (:no-reset-notification #x00031001) - (:lose-context-on-reset #x00031002)) -|# +;; # for context-creation-api hint +(defcenum (context-creation) + (:native-context-api #x00036001) + (:egl-context-api #x00036002) + (osmesa-context #x00036003)) ;; # for context-robustness hint (defcenum (robustness) @@ -740,7 +734,7 @@ Returns previously set callback." (target window-hint) (hint :int)) (defcfun ("glfwWindowHintString" window-hint-string) :void - (target window-hint) (hint (:pointer :char))) + (target window-hint) (window-hint-string :string)) (defcfun ("glfwCreateWindow" create-window) (float-traps-masked window) "Returns a window pointer that shares resources with the window SHARED or NULL." From ec59908b928669e1e8a7a032cb8d40532ed90491 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Mon, 4 Apr 2022 17:08:25 +0900 Subject: [PATCH 21/31] new example and bugfix --- cl-glfw3-examples.asd | 3 ++- cl-glfw3.lisp | 52 ++++++++++++++++++++++++++++++------------- examples/events.lisp | 21 +++++++++++++++++ examples/icons.lisp | 49 ++++++++++++++++++++++++++++++++++++++++ glfw-bindings.lisp | 19 ++++++---------- 5 files changed, 115 insertions(+), 29 deletions(-) create mode 100644 examples/icons.lisp diff --git a/cl-glfw3-examples.asd b/cl-glfw3-examples.asd index 0795e73..ff2dd18 100644 --- a/cl-glfw3-examples.asd +++ b/cl-glfw3-examples.asd @@ -11,4 +11,5 @@ (:file "basic-window") (:file "fragment-shader") (:file "particles-basic") - (:file "events"))) + (:file "events") + (:file "icons"))) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index 2d30c9c..a6ffdf8 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -18,10 +18,16 @@ set-error-callback initialize with-init -get-monitor-work-area + get-monitor-work-area def-monitor-callback *window* image + make-image + image-width + image-height + image-pixels + copy-image + image-p create-window destroy-window with-window @@ -77,6 +83,8 @@ set-window-content-scale-callback get-cursor-position set-cursor-position create-cursor + with-cursor + with-standard-cursor set-cursor def-key-callback def-char-callback @@ -93,6 +101,7 @@ set-char-mods-callback set-cursor-position-callback set-cursor-enter-callback set-scroll-callback + set-drop-callback def-joystick-callback set-clipboard-string get-clipboard-string @@ -118,18 +127,16 @@ def-joystick-callback (alexandria:once-only (image) `(let ((,width (image-width ,image)) (,height (image-height ,image))) - (cffi:with-foreign-objects ((,image-ptr '(:struct %glfw::image)) - (,pixels :uchar (* ,width ,height 4)));4=rgba - (loop for col from 0 below ,height do - (loop for row from 0 below ,width do - (let ((address (+ row (* ,width col)))) - (setf (cffi:mem-aref ,pixels address) - (aref (image-pixels ,image) address))))) - (setf (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::width) ,width - (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::height) ,height - (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::pixels) ,pixels) - (let ((,image-var ,image-ptr)) - ,@body)))))) + (cffi:with-foreign-objects ((,image-ptr '(:struct %glfw::image))) + (cffi:with-foreign-pointer (,pixels (* ,width ,height 4));4=rgba + (loop for i from 0 below (* ,width ,height 4) do + (setf (cffi:mem-ref ,pixels :uchar i) + (aref (image-pixels ,image) i))) + (setf (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::width) ,width + (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::height) ,height + (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::pixels) ,pixels) + (let ((,image-var ,image-ptr)) + ,@body))))))) ;;;; ## Window and monitor functions (defmacro import-export (&rest symbols) @@ -360,7 +367,7 @@ SHARED: The window whose context to share resources with." (defun set-window-icon (image &optional (window *window*)) (cond ((null image) (%glfw:set-window-icon window 0 (cffi:null-pointer))) - (t (with-image-pointer (pointer image) (%glfw:set-window-icon window 0 pointer))))) + (t (with-image-pointer (pointer image) (%glfw:set-window-icon window 1 pointer))))) (defun restore-window (&optional (window *window*)) (%glfw:restore-window window)) @@ -465,7 +472,7 @@ SHARED: The window whose context to share resources with." (%glfw:set-window-iconify-callback window (cffi:get-callback callback-name))) (defun set-window-maximize-callback (callback-name &optional (window *window*)) - (%glfw:set-window-maximize-callback window callback-name)) + (%glfw:set-window-maximize-callback window (cffi:get-callback callback-name))) (defun set-framebuffer-size-callback (callback-name &optional (window *window*)) (%glfw:set-framebuffer-size-callback window (cffi:get-callback callback-name))) @@ -509,6 +516,16 @@ SHARED: The window whose context to share resources with." (cond ((null image) (%glfw:create-cursor (cffi:null-pointer) xhot yhot)) (t (with-image-pointer (pointer image) (%glfw:create-cursor pointer xhot yhot))))) +(defmacro with-cursor ((var image x y) &body body) + `(unwind-protect (let ((,var (create-cursor ,image ,x ,y))) + ,@body) + (%glfw:destroy-cursor ,var))) + +(defmacro with-standard-cursor ((var shape) &body body) + `(unwind-protect (let ((,var (%glfw:create-standard-cursor ,shape))) + ,@body) + (%glfw:destroy-cursor ,var))) + (defun set-cursor (cursor &optional (window *window*)) (%glfw:set-cursor window cursor)) @@ -557,7 +574,7 @@ SHARED: The window whose context to share resources with." ;;must: support function (defmacro def-drop-callback (name (window number-of-pathes pathes) &body body) `(%glfw:define-glfw-callback ,name - ((,window :pointer) (,number-of-pathes :int) (,pathes (:pointer (:pointer (:struct :char))))) + ((,window :pointer) (,number-of-pathes :int) (,pathes (:pointer (:pointer :string)))) ,@body)) (defmacro def-joystick-callback (name (joystick event) &body body) @@ -586,6 +603,9 @@ SHARED: The window whose context to share resources with." (defun set-scroll-callback (callback-name &optional (window *window*)) (%glfw:set-scroll-callback window (cffi:get-callback callback-name))) +(defun set-drop-callback (callback-name) + (%glfw:set-drop-callback (cffi:get-callback callback-name))) + (import-export %glfw:raw-mouse-motion-supported-p %glfw:get-key-name %glfw:get-key-scancode %glfw:destroy-cursor %glfw:create-standard-cursor %glfw:joystick-present-p %glfw:get-joystick-axes %glfw:get-joystick-buttons %glfw:get-joystick-hats diff --git a/examples/events.lisp b/examples/events.lisp index a48e995..80af13b 100644 --- a/examples/events.lisp +++ b/examples/events.lisp @@ -7,6 +7,7 @@ (defparameter *keys-pressed* nil) (defparameter *buttons-pressed* nil) (defparameter *window-size* nil) +(defparameter *dropped-files* nil) (defun update-window-title (window) (set-window-title (format nil "size ~A | keys ~A | buttons ~A" @@ -35,6 +36,23 @@ (setf *window-size* (list w h)) (update-window-title window)) +(def-window-iconify-callback iconify-callback (window minp) + (declare (ignore window)) + (format t "~a~%" (if minp + 'min + 'not-min))) + +(def-window-maximize-callback maximize-callback (window maxp) + (declare (ignore window)) + (format t "~a~%" (if maxp + 'max + 'not-max))) + +(def-drop-callback drop-print-callback (window num pathes) + (declare (ignore window pathes)) + (pushnew num *dropped-files*) + (deletef *dropped-files* num)) + (defun events-example () ;; Graphics calls on OS X must occur in the main thread (with-body-in-main-thread () @@ -42,6 +60,9 @@ (set-key-callback 'key-callback) (set-mouse-button-callback 'mouse-callback) (set-window-size-callback 'window-size-callback) + (set-window-iconify-callback 'iconify-callback) + (set-window-maximize-callback 'maximize-callback) + (set-drop-callback 'drop-print-callback) (setf *window-size* (get-window-size)) (update-window-title *window*) (loop until (window-should-close-p) do (wait-events))))) diff --git a/examples/icons.lisp b/examples/icons.lisp new file mode 100644 index 0000000..ecdbe44 --- /dev/null +++ b/examples/icons.lisp @@ -0,0 +1,49 @@ +;;;; icons.lisp +;;;; This example shows changed icon. +(in-package #:cl-glfw3-examples) + +(export '(icons-example)) + +(defun create-colored-square-image (width height &key (r #xff) (g #xff) (b #xff)) + (let ((pixels (make-array (* 4 width height) :initial-element #xff))) + (loop for i from 0 below (* 4 width height) by 4 do + (setf (aref pixels (+ i 0)) r);red + (setf (aref pixels (+ i 1)) g);green + (setf (aref pixels (+ i 2)) b);blue + (setf (aref pixels (+ i 3)) #xff));alpha + (make-image :width width :height height :pixels pixels))) + +(defparameter *red-image* (create-colored-square-image 48 48 :r #xff :g 0 :b 0)) +(defparameter *green-image* (create-colored-square-image 48 48 :r 0 :g #xff :b 0)) +(defparameter *blue-image* (create-colored-square-image 48 48 :r 0 :g 0 :b #xff)) + +(defun icons-example () + ;; Graphics calls on OS X must occur in the main thread + (with-body-in-main-thread () + (with-init-window (:title "Icon test" :width 600 :height 400) + (set-window-icon *green-image*) + (let ((cursors (make-array 9 :initial-contents `(,(create-cursor *red-image* 0 0) + ,(create-cursor *green-image* 0 0) + ,(create-cursor *blue-image* 0 0) + ,(create-standard-cursor :arrow) + ,(create-standard-cursor :ibeam) + ,(create-standard-cursor :crosshair) + ,(create-standard-cursor :hand) + ,(create-standard-cursor :hresize) + ,(create-standard-cursor :vresize)))) + (cursor-num 0)) + (def-mouse-button-callback mouse-cursor-change-callback (window button action mod-keys) + (declare (ignore window mod-keys)) + (if (eq action :press) + (setf cursor-num (mod (+ cursor-num + (cond ((eq button :left) 1) + ((eq button :right) -1) + (t 0))) + 9)) + (set-cursor (aref cursors cursor-num)))) + (set-mouse-button-callback 'mouse-cursor-change-callback) + (set-cursor (aref cursors cursor-num)) + (loop until (window-should-close-p) + ;do (swap-buffers) + do (poll-events)) + (loop for i from 0 below 9 do (destroy-cursor (aref cursors i))))))) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 3779753..5146575 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -41,7 +41,7 @@ init-hint ;added exported window-should-close-p set-window-should-close set-window-title - set-window-icon ;added exported + set-window-icon ;added exported tested get-window-opacity set-window-opacity get-window-position @@ -70,7 +70,7 @@ init-hint ;added exported set-window-refresh-callback set-window-focus-callback set-window-iconify-callback - set-window-maximize-callback ;added exported + set-window-maximize-callback ;added exported tested set-framebuffer-size-callback set-window-content-scale-callback ;added exported set-window-monitor @@ -88,10 +88,10 @@ init-hint ;added exported get-mouse-button get-cursor-position set-cursor-position - create-cursor ;added exported - create-standard-cursor ;added exported - destroy-cursor ;added exported - set-cursor ;added exported + create-cursor ;added exported tested + create-standard-cursor ;added exported tested + destroy-cursor ;added exported tested + set-cursor ;added exported tested set-key-callback set-char-callback set-char-mods-callback ;added exported @@ -132,11 +132,6 @@ init-hint ;added exported get-instance-proc-address physical-device-presentation-support-p create-window-surface - - ;;added - ;;window - ;;monitor - ;;input )) ;; internal stuff @@ -887,7 +882,7 @@ Returns previously set callback." (window window) (iconify-fun :pointer)) ;;added -(defcfun ("glfwsetWindowMaximizeCallback" set-window-maximize-callback) :pointer +(defcfun ("glfwSetWindowMaximizeCallback" set-window-maximize-callback) :pointer "MAXIMIZE-FUN is a callback of type 'void (* GLFWwindowmaximizefun)(GLFWwindow*,int)'. Returns previously set callback." (window window) (maximize-fun :pointer)) From ae0b22b4c52236837bd162779d3cd00ac315eaec Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Tue, 5 Apr 2022 03:36:33 +0900 Subject: [PATCH 22/31] (pointer image) -> image --- cl-glfw3.lisp | 41 +++++++++++++++++----- examples/icons.lisp | 85 ++++++++++++++++++++++++++++++++++----------- glfw-bindings.lisp | 6 ++-- 3 files changed, 100 insertions(+), 32 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index a6ffdf8..2b67be1 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -116,13 +116,37 @@ def-joystick-callback (error "Local GLFW is ~a.~a.~a, should be above 3.x" major minor rev))) ;;;; image -(defstruct image - (width) - (height) - (pixels)) +(defstruct (image + (:constructor make-image (width height + &aux (width width) (height height) + (pixels (make-array (* 4 width height)))))) + width + height + pixels) + +(defmacro with-image-pointer ((var image) &body body) + "Internal function" + ;;マクロの準備 + (alexandria:with-gensyms (width height pixels image-ptr) + (alexandria:once-only (image) + `(let ((,width (image-width ,image)) + (,height (image-height ,image))) + ;;ポインタを取得し中身をalloc + (cffi:with-foreign-pointer (,image-ptr ,(* 2 3));int*2+pointer=int*3=2*3 bytes + ;;中身を詰める + (cffi:with-foreign-pointer (,pixels (* 1 ,width ,height 4));4=rgba + (loop for i from 0 below (* ,width ,height 4) do + (setf (cffi:mem-ref ,pixels :uchar i) + (aref (image-pixels ,image) i))) + (setf (cffi:mem-ref ,image-ptr :int) ,width + (cffi:mem-ref ,image-ptr :int 4) ,height + (cffi:mem-ref ,image-ptr :pointer 8) ,pixels) + ;;ポインタを変数に束縛しbody展開 + (let ((,var ,image-ptr)) + ,@body))))))) -(defmacro with-image-pointer ((image-var image) &body body) - "Internal function. translate image object from lisp to C and bind pointer of C image object to image-var symbol" +(defmacro with-image-array-pointer ((var image) &body body) + "Internal function. translate image object from lisp to C and bind pointer of C image object to var symbol" (alexandria:with-gensyms (width height pixels image-ptr) (alexandria:once-only (image) `(let ((,width (image-width ,image)) @@ -135,7 +159,7 @@ def-joystick-callback (setf (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::width) ,width (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::height) ,height (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::pixels) ,pixels) - (let ((,image-var ,image-ptr)) + (let ((,var ,image-ptr)) ,@body))))))) ;;;; ## Window and monitor functions @@ -367,7 +391,8 @@ SHARED: The window whose context to share resources with." (defun set-window-icon (image &optional (window *window*)) (cond ((null image) (%glfw:set-window-icon window 0 (cffi:null-pointer))) - (t (with-image-pointer (pointer image) (%glfw:set-window-icon window 1 pointer))))) + (t (with-image-array-pointer (pointer image) + (%glfw:set-window-icon window 1 pointer))))) (defun restore-window (&optional (window *window*)) (%glfw:restore-window window)) diff --git a/examples/icons.lisp b/examples/icons.lisp index ecdbe44..83e515a 100644 --- a/examples/icons.lisp +++ b/examples/icons.lisp @@ -4,33 +4,76 @@ (export '(icons-example)) -(defun create-colored-square-image (width height &key (r #xff) (g #xff) (b #xff)) - (let ((pixels (make-array (* 4 width height) :initial-element #xff))) - (loop for i from 0 below (* 4 width height) by 4 do - (setf (aref pixels (+ i 0)) r);red - (setf (aref pixels (+ i 1)) g);green - (setf (aref pixels (+ i 2)) b);blue - (setf (aref pixels (+ i 3)) #xff));alpha - (make-image :width width :height height :pixels pixels))) +(defparameter *cl* #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 1 1 0 0 0 0 0 2 0 0 0 0 0 + 0 0 1 0 0 1 0 0 0 0 2 0 0 0 0 0 + 0 1 0 0 0 0 0 0 0 0 2 0 0 0 0 0 + 0 1 0 0 0 0 0 0 0 0 2 0 0 0 0 0 + 0 0 1 0 0 1 0 0 0 0 2 0 0 0 0 0 + 0 0 0 1 1 0 0 0 0 0 2 2 2 2 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 1 0 2 0 3 0 0 + 0 0 0 0 0 0 0 0 0 0 0 2 0 3 0 0 + 0 0 0 0 0 0 0 0 0 0 2 0 0 0 3 0 + 0 0 0 0 0 0 0 0 0 0 2 0 0 0 3 0 + 0 0 0 0 0 0 0 0 0 0 0 2 0 3 0 0 + 0 0 0 0 0 0 0 0 0 0 0 2 0 3 0 0)) + +(defun dot-image (width height array) + (let ((image (make-image width height))) + (loop for j from 0 below height do + (loop for i from 0 below width do + (multiple-value-bind (red green blue alpha) + (ecase (aref array (+ i (* j width))) + (0 (values 0 0 0 0));transparent + (1 (values #xff 0 0 #xff));red + (2 (values 0 #xff 0 #xff));green + (3 (values 0 0 #xff #xff));blue + (4 (values #xff #xff 0 #xff));yellow + (5 (values #xff 0 #xff #xff));magenta + (6 (values 0 #xff #xff #xff));cyan + (7 (values #xff #xff #xff #xff));white + (8 (values 0 0 0 #xff)));black + (setf (aref (image-pixels image) (+ 0 (* 4 (+ i (* j width))))) red) + (setf (aref (image-pixels image) (+ 1 (* 4 (+ i (* j width))))) green) + (setf (aref (image-pixels image) (+ 2 (* 4 (+ i (* j width))))) blue) + (setf (aref (image-pixels image) (+ 3 (* 4 (+ i (* j width))))) alpha)))) + image)) + +(defparameter *cl-image* (dot-image 16 16 *cl*)) +(defparameter *red-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 1))) +(defparameter *green-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 2))) +(defparameter *blue-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 3))) +(defparameter *yellow-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 4))) +(defparameter *magenta-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 5))) +(defparameter *cyan-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 6))) +(defparameter *white-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 7))) +(defparameter *black-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 8))) +(defparameter *color-check* (dot-image 48 48 (make-array (* 48 48) + :initial-contents + (let ((acc nil)) + (loop for i from 1 below 9 do + (dotimes (j (* 6 48)) + (push i acc))) + (reverse acc))))) -(defparameter *red-image* (create-colored-square-image 48 48 :r #xff :g 0 :b 0)) -(defparameter *green-image* (create-colored-square-image 48 48 :r 0 :g #xff :b 0)) -(defparameter *blue-image* (create-colored-square-image 48 48 :r 0 :g 0 :b #xff)) (defun icons-example () ;; Graphics calls on OS X must occur in the main thread (with-body-in-main-thread () (with-init-window (:title "Icon test" :width 600 :height 400) - (set-window-icon *green-image*) - (let ((cursors (make-array 9 :initial-contents `(,(create-cursor *red-image* 0 0) - ,(create-cursor *green-image* 0 0) - ,(create-cursor *blue-image* 0 0) - ,(create-standard-cursor :arrow) - ,(create-standard-cursor :ibeam) - ,(create-standard-cursor :crosshair) - ,(create-standard-cursor :hand) - ,(create-standard-cursor :hresize) - ,(create-standard-cursor :vresize)))) + (set-window-icon *cl-image*) + (let ((cursors (make-array 9 :initial-contents (list (create-cursor *color-check* 0 0) + (create-cursor *red-image* 0 0) + (create-cursor *blue-image* 0 0) + (create-standard-cursor :arrow) + (create-standard-cursor :ibeam) + (create-standard-cursor :crosshair) + (create-standard-cursor :hand) + (create-standard-cursor :hresize) + (create-standard-cursor :vresize)))) (cursor-num 0)) (def-mouse-button-callback mouse-cursor-change-callback (window button action mod-keys) (declare (ignore window mod-keys)) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 5146575..7175b3a 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -948,16 +948,16 @@ Returns previously set callback." (window window) (x :double) (y :double)) ;;added -(defcfun ("glfwCreateCursor" create-cursor) (float-traps-masked cursor) +(defcfun ("glfwCreateCursor" create-cursor) cursor (image (:pointer (:struct image))) (xhot :int) (yhot :int)) ;;added -(defcfun ("glfwCreateStandardCursor" create-standard-cursor) (:pointer cursor) +(defcfun ("glfwCreateStandardCursor" create-standard-cursor) cursor (shape cursor-shape)) ;;added (defcfun ("glfwDestroyCursor" destroy-cursor) :void - (cursor (:pointer cursor))) + (cursor cursor)) ;;added (defcfun ("glfwSetCursor" set-cursor) :void From 0d410a026cceff064ffc091812b26b2577551e91 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Wed, 6 Apr 2022 05:24:52 +0900 Subject: [PATCH 23/31] add set-window-attribute --- cl-glfw3.lisp | 19 ++++++++++--------- examples/icons.lisp | 25 +++++++++++++------------ glfw-bindings.lisp | 22 +++++++++++++++++----- 3 files changed, 40 insertions(+), 26 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index 2b67be1..86d98f3 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -118,22 +118,21 @@ def-joystick-callback ;;;; image (defstruct (image (:constructor make-image (width height - &aux (width width) (height height) + &aux (pixels (make-array (* 4 width height)))))) + "Pixels is array of each color-bit and alpha-bit of image. each pixel has RGBA data, start form top-eft and arranged left-to-right, top-to-bottom." width height pixels) +#| (defmacro with-image-pointer ((var image) &body body) "Internal function" - ;;マクロの準備 (alexandria:with-gensyms (width height pixels image-ptr) (alexandria:once-only (image) `(let ((,width (image-width ,image)) (,height (image-height ,image))) - ;;ポインタを取得し中身をalloc (cffi:with-foreign-pointer (,image-ptr ,(* 2 3));int*2+pointer=int*3=2*3 bytes - ;;中身を詰める (cffi:with-foreign-pointer (,pixels (* 1 ,width ,height 4));4=rgba (loop for i from 0 below (* ,width ,height 4) do (setf (cffi:mem-ref ,pixels :uchar i) @@ -141,11 +140,11 @@ def-joystick-callback (setf (cffi:mem-ref ,image-ptr :int) ,width (cffi:mem-ref ,image-ptr :int 4) ,height (cffi:mem-ref ,image-ptr :pointer 8) ,pixels) - ;;ポインタを変数に束縛しbody展開 (let ((,var ,image-ptr)) ,@body))))))) +|# -(defmacro with-image-array-pointer ((var image) &body body) +(defmacro with-image-pointer ((var image) &body body) "Internal function. translate image object from lisp to C and bind pointer of C image object to var symbol" (alexandria:with-gensyms (width height pixels image-ptr) (alexandria:once-only (image) @@ -391,7 +390,7 @@ SHARED: The window whose context to share resources with." (defun set-window-icon (image &optional (window *window*)) (cond ((null image) (%glfw:set-window-icon window 0 (cffi:null-pointer))) - (t (with-image-array-pointer (pointer image) + (t (with-image-pointer (pointer image) (%glfw:set-window-icon window 1 pointer))))) (defun restore-window (&optional (window *window*)) @@ -420,11 +419,13 @@ SHARED: The window whose context to share resources with." (defun get-window-attribute (attribute &optional (window *window*)) (let ((value (%glfw:get-window-attribute window attribute))) (ccase attribute - ((:focused :iconified :resizable :visible :decorated :opengl-forward-compat :opengl-debug-context) + ((:focused :iconified :maximized :hovered :visible :resizable :decorated :auto-iconify :floating :transparent-framebuffer :focus-on-show :opengl-forward-compat :opengl-debug-context :context-no-error) (cffi:convert-from-foreign value :boolean)) (:client-api (cffi:foreign-enum-keyword '%glfw::opengl-api value)) + (:context-creation-api (cffi:foreign-enum-keyword '%glfw::context-creation value)) ((:context-version-major :context-version-minor :context-revision) value) (:opengl-profile (cffi:foreign-enum-keyword '%glfw::opengl-profile value)) + (:context-release-behavior (cffi:foreign-enum-keyword '%glfw::release-behavior value)) (:context-robustness (cffi:foreign-enum-keyword '%glfw::robustness value))))) (defun get-context-version (&optional (window *window*)) @@ -506,7 +507,7 @@ SHARED: The window whose context to share resources with." (%glfw:set-window-content-scale-callback window (cffi:get-callback callback-name))) ;;;; ## Events and input -(import-export %glfw:poll-events %glfw:wait-events %glfw:wait-events-timeout %glfw:post-empty-event) +(import-export %glfw:poll-events %glfw:wait-events %glfw:wait-events-timeout %glfw:post-empty-event %glfw:set-window-attribute) (defun get-input-mode (mode &optional (window *window*)) "Mode is one of :CURSOR :STICKY-KEYS or :STICKY-MOUSE-BUTTONS." diff --git a/examples/icons.lisp b/examples/icons.lisp index 83e515a..504593f 100644 --- a/examples/icons.lisp +++ b/examples/icons.lisp @@ -65,15 +65,16 @@ (with-body-in-main-thread () (with-init-window (:title "Icon test" :width 600 :height 400) (set-window-icon *cl-image*) - (let ((cursors (make-array 9 :initial-contents (list (create-cursor *color-check* 0 0) - (create-cursor *red-image* 0 0) - (create-cursor *blue-image* 0 0) - (create-standard-cursor :arrow) - (create-standard-cursor :ibeam) - (create-standard-cursor :crosshair) - (create-standard-cursor :hand) - (create-standard-cursor :hresize) - (create-standard-cursor :vresize)))) + (let ((cursors (make-array 10 :initial-contents (list (create-cursor *color-check* 0 0) + (create-cursor *yellow-image* 48 0) + (create-cursor *red-image* 0 48) + (create-cursor *blue-image* 24 24) + (create-standard-cursor :arrow) + (create-standard-cursor :ibeam) + (create-standard-cursor :crosshair) + (create-standard-cursor :hand) + (create-standard-cursor :hresize) + (create-standard-cursor :vresize)))) (cursor-num 0)) (def-mouse-button-callback mouse-cursor-change-callback (window button action mod-keys) (declare (ignore window mod-keys)) @@ -82,11 +83,11 @@ (cond ((eq button :left) 1) ((eq button :right) -1) (t 0))) - 9)) + 10)) (set-cursor (aref cursors cursor-num)))) (set-mouse-button-callback 'mouse-cursor-change-callback) (set-cursor (aref cursors cursor-num)) (loop until (window-should-close-p) - ;do (swap-buffers) do (poll-events)) - (loop for i from 0 below 9 do (destroy-cursor (aref cursors i))))))) + (loop for i from 0 below 10 do + (destroy-cursor (aref cursors i))))))) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 7175b3a..605d310 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -42,17 +42,17 @@ init-hint ;added exported set-window-should-close set-window-title set-window-icon ;added exported tested - get-window-opacity - set-window-opacity get-window-position set-window-position get-window-size - set-window-size set-window-size-limits set-window-aspect-ratio + set-window-size + get-framebuffer-size get-window-frame-size ;added exported get-window-content-scale - get-framebuffer-size + get-window-opacity + set-window-opacity iconify-window restore-window maximize-window ;added exported @@ -61,7 +61,9 @@ init-hint ;added exported focus-window ;added exported request-window-attention ;added exported get-window-monitor + set-window-monitor get-window-attribute + set-window-attribute ;added set-window-user-pointer get-window-user-pointer set-window-position-callback @@ -73,7 +75,6 @@ init-hint ;added exported set-window-maximize-callback ;added exported tested set-framebuffer-size-callback set-window-content-scale-callback ;added exported - set-window-monitor poll-events wait-events wait-events-timeout ;added exported @@ -523,6 +524,14 @@ CFFI's defcallback that takes care of GLFW specifics." (:x11-instance-name #x00024002) ;added ) +;;window attributes for set-window-attributes +(defcenum (window-attribute) + (:decorated #x00020005) + (:resizeable #x00020003) + (:floating #x00020007) + (:auto-iconify #x00020005) + (focus-on-show #x0002000c)) + ;; # for client-api hit (defcenum (opengl-api) (:no-api 0) @@ -845,6 +854,9 @@ Returns previously set callback." (defcfun ("glfwGetWindowAttrib" get-window-attribute) :int (window window) (attribute window-hint)) +(defcfun ("glfwSetWindowAttrib" set-window-attribute) :void + (window window) (attrib window-attribute) (value :boolean)) + (defcfun ("glfwSetWindowUserPointer" set-window-user-pointer) :void (window window) (pointer :pointer)) From 9ee97e03a5386a2ba62742b18341a946121ed095 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Wed, 6 Apr 2022 05:30:22 +0900 Subject: [PATCH 24/31] set-window-attribute *window* --- cl-glfw3.lisp | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index 86d98f3..d567ff5 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -57,6 +57,7 @@ focus-window request-window-attention get-window-monitor get-window-attribute + set-window-attribute get-context-version def-window-position-callback def-window-size-callback @@ -428,6 +429,9 @@ SHARED: The window whose context to share resources with." (:context-release-behavior (cffi:foreign-enum-keyword '%glfw::release-behavior value)) (:context-robustness (cffi:foreign-enum-keyword '%glfw::robustness value))))) +(defun set-window-attribute (attribute value &optional (window *window*)) + (%glfw:set-window-attribute window attribute value)) + (defun get-context-version (&optional (window *window*)) "Convenience function returning (opengl-context-major-version opengl-context-minor-version opengl-context-revision)." (list (get-window-attribute :context-version-major window) @@ -507,7 +511,7 @@ SHARED: The window whose context to share resources with." (%glfw:set-window-content-scale-callback window (cffi:get-callback callback-name))) ;;;; ## Events and input -(import-export %glfw:poll-events %glfw:wait-events %glfw:wait-events-timeout %glfw:post-empty-event %glfw:set-window-attribute) +(import-export %glfw:poll-events %glfw:wait-events %glfw:wait-events-timeout %glfw:post-empty-event) (defun get-input-mode (mode &optional (window *window*)) "Mode is one of :CURSOR :STICKY-KEYS or :STICKY-MOUSE-BUTTONS." From d97a66de911f5b86b5318f41a579f4b2bddbd829 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Wed, 6 Apr 2022 05:47:25 +0900 Subject: [PATCH 25/31] add glfw-blob foreign library --- glfw-bindings.lisp | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 605d310..1ae9ff2 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -144,9 +144,15 @@ init-hint ;added exported ; homebrew naming "libglfw3.3.dylib" "libglfw3.2.dylib" "libglfw3.1.dylib" "libglfw3.dylib" ; cmake build naming - "libglfw.3.3.dylib" "libglfw.3.2.dylib" "libglfw.3.1.dylib" "libglfw.3.dylib")) - (:unix (:or "libglfw.so.3.3" "libglfw.wo.3.2" "libglfw.so.3.1" "libglfw.so.3" "libglfw.so")) - (:windows "glfw3.dll") + "libglfw.3.3.dylib" "libglfw.3.2.dylib" "libglfw.3.1.dylib" "libglfw.3.dylib" + ;;glfw-blob + "libglfw.dylib.bodged")) + (:unix (:or "libglfw.so.3.3" "libglfw.wo.3.2" "libglfw.so.3.1" "libglfw.so.3" "libglfw.so" + ;;glfw-blob + "libglfw.so.bodged")) + (:windows (:or "glfw3.dll" + ;;glfw-blob + "libglfw.dll.bodged")) (t (:or (:default "libglfw3") (:default "libglfw")))) (use-foreign-library glfw) From e8210a420274445a41ec49859536cb6482584aa7 Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Wed, 6 Apr 2022 06:07:06 +0900 Subject: [PATCH 26/31] deleted with-cursor --- cl-glfw3.lisp | 31 ---------------------- glfw-bindings.lisp | 66 +++++++++++++++++++++++----------------------- 2 files changed, 33 insertions(+), 64 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index d567ff5..a2605d6 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -84,8 +84,6 @@ set-window-content-scale-callback get-cursor-position set-cursor-position create-cursor - with-cursor - with-standard-cursor set-cursor def-key-callback def-char-callback @@ -126,25 +124,6 @@ def-joystick-callback height pixels) -#| -(defmacro with-image-pointer ((var image) &body body) - "Internal function" - (alexandria:with-gensyms (width height pixels image-ptr) - (alexandria:once-only (image) - `(let ((,width (image-width ,image)) - (,height (image-height ,image))) - (cffi:with-foreign-pointer (,image-ptr ,(* 2 3));int*2+pointer=int*3=2*3 bytes - (cffi:with-foreign-pointer (,pixels (* 1 ,width ,height 4));4=rgba - (loop for i from 0 below (* ,width ,height 4) do - (setf (cffi:mem-ref ,pixels :uchar i) - (aref (image-pixels ,image) i))) - (setf (cffi:mem-ref ,image-ptr :int) ,width - (cffi:mem-ref ,image-ptr :int 4) ,height - (cffi:mem-ref ,image-ptr :pointer 8) ,pixels) - (let ((,var ,image-ptr)) - ,@body))))))) -|# - (defmacro with-image-pointer ((var image) &body body) "Internal function. translate image object from lisp to C and bind pointer of C image object to var symbol" (alexandria:with-gensyms (width height pixels image-ptr) @@ -546,16 +525,6 @@ SHARED: The window whose context to share resources with." (cond ((null image) (%glfw:create-cursor (cffi:null-pointer) xhot yhot)) (t (with-image-pointer (pointer image) (%glfw:create-cursor pointer xhot yhot))))) -(defmacro with-cursor ((var image x y) &body body) - `(unwind-protect (let ((,var (create-cursor ,image ,x ,y))) - ,@body) - (%glfw:destroy-cursor ,var))) - -(defmacro with-standard-cursor ((var shape) &body body) - `(unwind-protect (let ((,var (%glfw:create-standard-cursor ,shape))) - ,@body) - (%glfw:destroy-cursor ,var))) - (defun set-cursor (cursor &optional (window *window*)) (%glfw:set-cursor window cursor)) diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 1ae9ff2..df1d192 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -9,8 +9,8 @@ ;;initialize init terminate -init-hint ;added exported - get-version +init-hint +get-version get-version-string set-error-callback ;;monitor @@ -21,8 +21,8 @@ init-hint ;added exported get-monitor-physical-size get-monitor-content-scale get-monitor-name - set-monitor-user-pointer ;added - get-monitor-user-pointer ;added + set-monitor-user-pointer + get-monitor-user-pointer set-monitor-callback get-video-modes get-video-mode @@ -41,7 +41,7 @@ init-hint ;added exported window-should-close-p set-window-should-close set-window-title - set-window-icon ;added exported tested + set-window-icon get-window-position set-window-position get-window-size @@ -49,21 +49,21 @@ init-hint ;added exported set-window-aspect-ratio set-window-size get-framebuffer-size - get-window-frame-size ;added exported + get-window-frame-size get-window-content-scale get-window-opacity set-window-opacity iconify-window restore-window - maximize-window ;added exported + maximize-window show-window hide-window - focus-window ;added exported - request-window-attention ;added exported + focus-window + request-window-attention get-window-monitor set-window-monitor get-window-attribute - set-window-attribute ;added + set-window-attribute set-window-user-pointer get-window-user-pointer set-window-position-callback @@ -72,54 +72,54 @@ init-hint ;added exported set-window-refresh-callback set-window-focus-callback set-window-iconify-callback - set-window-maximize-callback ;added exported tested + set-window-maximize-callback set-framebuffer-size-callback - set-window-content-scale-callback ;added exported + set-window-content-scale-callback poll-events wait-events - wait-events-timeout ;added exported + wait-events-timeout post-empty-event ;;input get-input-mode set-input-mode - raw-mouse-motion-supported-p ;added exported - get-key-name ;added exported - get-key-scancode ;added exported + raw-mouse-motion-supported-p + get-key-name + get-key-scancode get-key get-mouse-button get-cursor-position set-cursor-position - create-cursor ;added exported tested - create-standard-cursor ;added exported tested - destroy-cursor ;added exported tested - set-cursor ;added exported tested + create-cursor + create-standard-cursor + destroy-cursor + set-cursor set-key-callback set-char-callback - set-char-mods-callback ;added exported + set-char-mods-callback set-mouse-button-callback set-cursor-position-callback set-cursor-enter-callback set-scroll-callback - set-drop-callback ;added exported + set-drop-callback joystick-present-p get-joystick-axes get-joystick-buttons - get-joystick-hats ;added exported + get-joystick-hats get-joystick-name - get-joystick-guid ;added exported - set-joystick-user-pointer ;added - get-joystick-user-pointer ;added - joystick-is-gamepad-p ;added exported - set-joystick-callback ;added exported - update-gamepad-mappings ;added exported - get-gamepad-name ;added exported - get-gamepad-state ;added exported + get-joystick-guid + set-joystick-user-pointer + get-joystick-user-pointer + joystick-is-gamepad-p + set-joystick-callback + update-gamepad-mappings + get-gamepad-name + get-gamepad-state set-clipboard-string get-clipboard-string get-time set-time - get-timer-value ;added exported - get-timer-frequency ;added exported + get-timer-value + get-timer-frequency ;;context make-context-current get-current-context From 3d329752be4a3f45a34fc3f14908cbc6f0a1af4f Mon Sep 17 00:00:00 2001 From: unknown Date: Wed, 27 Apr 2022 08:45:30 +0900 Subject: [PATCH 27/31] fixed image's timing to free --- cl-glfw3.lisp | 83 ++++++++++++++++++++++++++++++++------------- examples/icons.lisp | 57 +++++++++++++++++++++++++++++++ 2 files changed, 116 insertions(+), 24 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index a2605d6..7d4be58 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -21,13 +21,6 @@ get-monitor-work-area def-monitor-callback *window* - image - make-image - image-width - image-height - image-pixels - copy-image - image-p create-window destroy-window with-window @@ -114,32 +107,74 @@ def-joystick-callback (when (/= major 3) (error "Local GLFW is ~a.~a.~a, should be above 3.x" major minor rev))) -;;;; image -(defstruct (image - (:constructor make-image (width height - &aux - (pixels (make-array (* 4 width height)))))) - "Pixels is array of each color-bit and alpha-bit of image. each pixel has RGBA data, start form top-eft and arranged left-to-right, top-to-bottom." - width - height - pixels) - +(defmacro with-image-pointer ((&rest bind*) &body body) + "Internal function" + (let ((gensym-pixels-vars (mapcar (lambda (x) (gensym (format nil "~a" x))) + (mapcar #'first bind*)));マクロ中で使う変数sをリストにまとめて保管 + (img-binding-list (gensym "IMG-BINDING-LIST")));画像の評価を束縛する変数 + ;;画像の評価を1度だけにするため,letで束縛。上は束縛するための変数sをリストで保存している + `(let ((,img-binding-list (list ,@(mapcar (lambda (x) + (assert (typep x '(simple-array (unsigned-byte 8) (* * 4)))) + (cadr x)) + bind*)))) + ;;画像のピクセルデータの大きさの配列をallocしてgensym変数sに束縛 + (destructuring-bind ,gensym-pixels-vars + (mapcar (lambda (img-array) + (cffi:foreign-alloc :unsigned-char :count (array-total-size img-array))) + ,img-binding-list) + (unwind-protect + (progn + ;;画像のピクセルデータの中身を詰める + (mapc (lambda (img-array pixel-array-ptr) + (let ((height (array-dimension img-array 0)) + (width (array-dimension img-array 1))) + (loop for i from 0 below width do + (loop for j from 0 below height do + (loop for k from 0 below (array-dimension img-array 2) do + (setf (cffi:mem-ref pixel-array-ptr :unsigned-char (+ k (* i 4) + (* j (* width 4)))) + (aref img-array j i k))))))) + ,img-binding-list + (list ,@gensym-pixels-vars)) + ;;画像ストラクチャをallocしてbind*で示された変数に束縛 + (destructuring-bind ,(mapcar #'first bind*) + (loop for i from 0 below ,(length bind*) collect (cffi:foreign-alloc :int :count 3)) + (unwind-protect + (progn + ;;画像ストラクチャに中身を詰める + (mapc (lambda (img-structure-ptr image-array pixel-array-ptr) + (setf (cffi:mem-ref img-structure-ptr :int) (array-dimension image-array 1);width + (cffi:mem-ref img-structure-ptr :int 4) (array-dimension image-array 0);height + (cffi:mem-ref img-structure-ptr :pointer 8) pixel-array-ptr)) + (list ,@(mapcar #'first bind*)) + ,img-binding-list + (list ,@gensym-pixels-vars)) + ,@body) + (mapc #'cffi:foreign-free (list ,@(mapcar #'first bind*)))))) + (mapc #'cffi:foreign-free (list ,@gensym-pixels-vars))))))) + +#| (defmacro with-image-pointer ((var image) &body body) - "Internal function. translate image object from lisp to C and bind pointer of C image object to var symbol" + "Internal function" + ;;マクロの準備 (alexandria:with-gensyms (width height pixels image-ptr) (alexandria:once-only (image) `(let ((,width (image-width ,image)) (,height (image-height ,image))) - (cffi:with-foreign-objects ((,image-ptr '(:struct %glfw::image))) - (cffi:with-foreign-pointer (,pixels (* ,width ,height 4));4=rgba + ;;ポインタを取得し中身をalloc + (cffi:with-foreign-pointer (,image-ptr ,(* 2 3));int*2+pointer=int*3=2*3 bytes + ;;中身を詰める + (cffi:with-foreign-pointer (,pixels (* 1 ,width ,height 4));4=rgba (loop for i from 0 below (* ,width ,height 4) do (setf (cffi:mem-ref ,pixels :uchar i) (aref (image-pixels ,image) i))) - (setf (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::width) ,width - (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::height) ,height - (cffi:foreign-slot-value ,image-ptr '(:struct %glfw::image) '%glfw::pixels) ,pixels) + (setf (cffi:mem-ref ,image-ptr :int) ,width + (cffi:mem-ref ,image-ptr :int 4) ,height + (cffi:mem-ref ,image-ptr :pointer 8) ,pixels) + ;;ポインタを変数に束縛しbody展開 (let ((,var ,image-ptr)) ,@body))))))) +|# ;;;; ## Window and monitor functions (defmacro import-export (&rest symbols) @@ -523,7 +558,7 @@ SHARED: The window whose context to share resources with." (defun create-cursor (image xhot yhot) (cond ((null image) (%glfw:create-cursor (cffi:null-pointer) xhot yhot)) - (t (with-image-pointer (pointer image) (%glfw:create-cursor pointer xhot yhot))))) + (t (with-image-pointer ((pointer image)) (%glfw:create-cursor pointer xhot yhot))))) (defun set-cursor (cursor &optional (window *window*)) (%glfw:set-cursor window cursor)) diff --git a/examples/icons.lisp b/examples/icons.lisp index 504593f..61dee3b 100644 --- a/examples/icons.lisp +++ b/examples/icons.lisp @@ -21,6 +21,23 @@ 0 0 0 0 0 0 0 0 0 0 0 2 0 3 0 0 0 0 0 0 0 0 0 0 0 0 0 2 0 3 0 0)) +(defparameter *cl2* #2a((0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) + (0 0 0 1 1 0 0 0 0 0 2 0 0 0 0 0) + (0 0 1 0 0 1 0 0 0 0 2 0 0 0 0 0) + (0 1 0 0 0 0 0 0 0 0 2 0 0 0 0 0) + (0 1 0 0 0 0 0 0 0 0 2 0 0 0 0 0) + (0 0 1 0 0 1 0 0 0 0 2 0 0 0 0 0) + (0 0 0 1 1 0 0 0 0 0 2 2 2 2 0 0) + (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) + (0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0) + (0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0) + (0 0 0 0 0 0 0 0 0 1 0 2 0 3 0 0) + (0 0 0 0 0 0 0 0 0 0 0 2 0 3 0 0) + (0 0 0 0 0 0 0 0 0 0 2 0 0 0 3 0) + (0 0 0 0 0 0 0 0 0 0 2 0 0 0 3 0) + (0 0 0 0 0 0 0 0 0 0 0 2 0 3 0 0) + (0 0 0 0 0 0 0 0 0 0 0 2 0 3 0 0))) + (defun dot-image (width height array) (let ((image (make-image width height))) (loop for j from 0 below height do @@ -42,6 +59,30 @@ (setf (aref (image-pixels image) (+ 3 (* 4 (+ i (* j width))))) alpha)))) image)) +(defun dot-image+ (dot-array) + (let* ((width (array-dimension dot-array 0)) + (height (array-dimension dot-array 1)) + (image (make-array `(,height ,width 4)))) + (loop for j from 0 below height do + (loop for i from 0 below width do + (destructuring-bind (r g b a) + (ecase (aref dot-array i j) + (0 '(0 0 0 0));transparent + (1 '(#xff 0 0 #xff));red + (2 '(0 #xff 0 #xff));green + (3 '(0 0 #xff #xff));blue + (4 '(#xff #xff 0 #xff));yellow + (5 '(#xff 0 #xff #xff));magenta + (6 '(0 #xff #xff #xff));cyan + (7 '(#xff #xff #xff #xff));white + (8 '(0 0 0 #xff)));black + (setf (aref image i j 0) r) + (setf (aref image i j 1) g) + (setf (aref image i j 2) b) + (setf (aref image i j 3) a)))) + image)) + +#| (defparameter *cl-image* (dot-image 16 16 *cl*)) (defparameter *red-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 1))) (defparameter *green-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 2))) @@ -58,6 +99,22 @@ (dotimes (j (* 6 48)) (push i acc))) (reverse acc))))) +|# +(defparameter *cl-image* (dot-image+ *cl2*)) +(defparameter *red-image* (dot-image+ (make-array '(48 48) :initial-element 1))) +(defparameter *green-image* (dot-image+ (make-array '(48 48) :initial-element 2))) +(defparameter *blue-image* (dot-image+ (make-array '(48 48) :initial-element 3))) +(defparameter *yellow-image* (dot-image+ (make-array '(48 48) :initial-element 4))) +(defparameter *magenta-image* (dot-image+ (make-array '(48 48) :initial-element 5))) +(defparameter *cyan-image* (dot-image+ (make-array '(48 48) :initial-element 6))) +(defparameter *white-image* (dot-image+ (make-array '(48 48) :initial-element 7))) +(defparameter *black-image* (dot-image+ (make-array '(48 48) :initial-element 8))) +(defparameter *color-check* (dot-image+ (let ((img (make-array '(45 45)))) + (loop for i from 1 below 45 do + (loop for j from 0 below 45 do + (setf (aref img i j) + (floor (/ i 5))))) + img))) (defun icons-example () From ec1c4845105ab0597d4382aa115d5b025a831c49 Mon Sep 17 00:00:00 2001 From: unknown Date: Wed, 27 Apr 2022 09:40:32 +0900 Subject: [PATCH 28/31] rebase fixing image --- cl-glfw3.lisp | 11 +++--- examples/icons.lisp | 82 +++++++-------------------------------------- 2 files changed, 20 insertions(+), 73 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index 7d4be58..345c812 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -109,14 +109,17 @@ def-joystick-callback (defmacro with-image-pointer ((&rest bind*) &body body) "Internal function" - (let ((gensym-pixels-vars (mapcar (lambda (x) (gensym (format nil "~a" x))) + (let ((gensym-pixels-vars (mapcar (lambda (x) + (gensym (format nil "~a" x))) (mapcar #'first bind*)));マクロ中で使う変数sをリストにまとめて保管 (img-binding-list (gensym "IMG-BINDING-LIST")));画像の評価を束縛する変数 ;;画像の評価を1度だけにするため,letで束縛。上は束縛するための変数sをリストで保存している `(let ((,img-binding-list (list ,@(mapcar (lambda (x) - (assert (typep x '(simple-array (unsigned-byte 8) (* * 4)))) (cadr x)) bind*)))) + (mapc (lambda (img) + (assert (typep img '(simple-array (unsigned-byte 8) (* * 4))))) + ,img-binding-list) ;;画像のピクセルデータの大きさの配列をallocしてgensym変数sに束縛 (destructuring-bind ,gensym-pixels-vars (mapcar (lambda (img-array) @@ -405,8 +408,8 @@ SHARED: The window whose context to share resources with." (defun set-window-icon (image &optional (window *window*)) (cond ((null image) (%glfw:set-window-icon window 0 (cffi:null-pointer))) - (t (with-image-pointer (pointer image) - (%glfw:set-window-icon window 1 pointer))))) + (t (with-image-pointer ((pointer image)) + (%glfw:set-window-icon window 1 pointer))))) (defun restore-window (&optional (window *window*)) (%glfw:restore-window window)) diff --git a/examples/icons.lisp b/examples/icons.lisp index 61dee3b..6d39ffa 100644 --- a/examples/icons.lisp +++ b/examples/icons.lisp @@ -4,24 +4,7 @@ (export '(icons-example)) -(defparameter *cl* #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 1 1 0 0 0 0 0 2 0 0 0 0 0 - 0 0 1 0 0 1 0 0 0 0 2 0 0 0 0 0 - 0 1 0 0 0 0 0 0 0 0 2 0 0 0 0 0 - 0 1 0 0 0 0 0 0 0 0 2 0 0 0 0 0 - 0 0 1 0 0 1 0 0 0 0 2 0 0 0 0 0 - 0 0 0 1 1 0 0 0 0 0 2 2 2 2 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 1 0 2 0 3 0 0 - 0 0 0 0 0 0 0 0 0 0 0 2 0 3 0 0 - 0 0 0 0 0 0 0 0 0 0 2 0 0 0 3 0 - 0 0 0 0 0 0 0 0 0 0 2 0 0 0 3 0 - 0 0 0 0 0 0 0 0 0 0 0 2 0 3 0 0 - 0 0 0 0 0 0 0 0 0 0 0 2 0 3 0 0)) - -(defparameter *cl2* #2a((0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) +(defparameter *cl* #2a((0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) (0 0 0 1 1 0 0 0 0 0 2 0 0 0 0 0) (0 0 1 0 0 1 0 0 0 0 2 0 0 0 0 0) (0 1 0 0 0 0 0 0 0 0 2 0 0 0 0 0) @@ -38,31 +21,10 @@ (0 0 0 0 0 0 0 0 0 0 0 2 0 3 0 0) (0 0 0 0 0 0 0 0 0 0 0 2 0 3 0 0))) -(defun dot-image (width height array) - (let ((image (make-image width height))) - (loop for j from 0 below height do - (loop for i from 0 below width do - (multiple-value-bind (red green blue alpha) - (ecase (aref array (+ i (* j width))) - (0 (values 0 0 0 0));transparent - (1 (values #xff 0 0 #xff));red - (2 (values 0 #xff 0 #xff));green - (3 (values 0 0 #xff #xff));blue - (4 (values #xff #xff 0 #xff));yellow - (5 (values #xff 0 #xff #xff));magenta - (6 (values 0 #xff #xff #xff));cyan - (7 (values #xff #xff #xff #xff));white - (8 (values 0 0 0 #xff)));black - (setf (aref (image-pixels image) (+ 0 (* 4 (+ i (* j width))))) red) - (setf (aref (image-pixels image) (+ 1 (* 4 (+ i (* j width))))) green) - (setf (aref (image-pixels image) (+ 2 (* 4 (+ i (* j width))))) blue) - (setf (aref (image-pixels image) (+ 3 (* 4 (+ i (* j width))))) alpha)))) - image)) - -(defun dot-image+ (dot-array) +(defun dot-image (dot-array) (let* ((width (array-dimension dot-array 0)) (height (array-dimension dot-array 1)) - (image (make-array `(,height ,width 4)))) + (image (make-array `(,height ,width 4) :element-type '(unsigned-byte 8)))) (loop for j from 0 below height do (loop for i from 0 below width do (destructuring-bind (r g b a) @@ -82,34 +44,16 @@ (setf (aref image i j 3) a)))) image)) -#| -(defparameter *cl-image* (dot-image 16 16 *cl*)) -(defparameter *red-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 1))) -(defparameter *green-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 2))) -(defparameter *blue-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 3))) -(defparameter *yellow-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 4))) -(defparameter *magenta-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 5))) -(defparameter *cyan-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 6))) -(defparameter *white-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 7))) -(defparameter *black-image* (dot-image 48 48 (make-array (* 48 48) :initial-element 8))) -(defparameter *color-check* (dot-image 48 48 (make-array (* 48 48) - :initial-contents - (let ((acc nil)) - (loop for i from 1 below 9 do - (dotimes (j (* 6 48)) - (push i acc))) - (reverse acc))))) -|# -(defparameter *cl-image* (dot-image+ *cl2*)) -(defparameter *red-image* (dot-image+ (make-array '(48 48) :initial-element 1))) -(defparameter *green-image* (dot-image+ (make-array '(48 48) :initial-element 2))) -(defparameter *blue-image* (dot-image+ (make-array '(48 48) :initial-element 3))) -(defparameter *yellow-image* (dot-image+ (make-array '(48 48) :initial-element 4))) -(defparameter *magenta-image* (dot-image+ (make-array '(48 48) :initial-element 5))) -(defparameter *cyan-image* (dot-image+ (make-array '(48 48) :initial-element 6))) -(defparameter *white-image* (dot-image+ (make-array '(48 48) :initial-element 7))) -(defparameter *black-image* (dot-image+ (make-array '(48 48) :initial-element 8))) -(defparameter *color-check* (dot-image+ (let ((img (make-array '(45 45)))) +(defparameter *cl-image* (dot-image *cl*)) +(defparameter *red-image* (dot-image (make-array '(48 48) :initial-element 1))) +(defparameter *green-image* (dot-image (make-array '(48 48) :initial-element 2))) +(defparameter *blue-image* (dot-image (make-array '(48 48) :initial-element 3))) +(defparameter *yellow-image* (dot-image (make-array '(48 48) :initial-element 4))) +(defparameter *magenta-image* (dot-image (make-array '(48 48) :initial-element 5))) +(defparameter *cyan-image* (dot-image (make-array '(48 48) :initial-element 6))) +(defparameter *white-image* (dot-image (make-array '(48 48) :initial-element 7))) +(defparameter *black-image* (dot-image (make-array '(48 48) :initial-element 8))) +(defparameter *color-check* (dot-image (let ((img (make-array '(45 45)))) (loop for i from 1 below 45 do (loop for j from 0 below 45 do (setf (aref img i j) From 5b6ea42e1498d4d8ef3437bfc1ed3aaf45aa466f Mon Sep 17 00:00:00 2001 From: unknown Date: Thu, 5 May 2022 05:23:35 +0900 Subject: [PATCH 29/31] redefined drop-callback --- cl-glfw3.lisp | 8 ++++---- examples/events.lisp | 21 +++++++++++++++++---- glfw-bindings.lisp | 21 ++++++++++++++++++++- 3 files changed, 41 insertions(+), 9 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index 345c812..975348f 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -610,8 +610,8 @@ SHARED: The window whose context to share resources with." ;;added ;;must: support function (defmacro def-drop-callback (name (window number-of-pathes pathes) &body body) - `(%glfw:define-glfw-callback ,name - ((,window :pointer) (,number-of-pathes :int) (,pathes (:pointer (:pointer :string)))) + `(%glfw::define-glfw-drop-callback ,name + ((,window :pointer) (,number-of-pathes :int) (,pathes (:pointer :string))) ,@body)) (defmacro def-joystick-callback (name (joystick event) &body body) @@ -640,8 +640,8 @@ SHARED: The window whose context to share resources with." (defun set-scroll-callback (callback-name &optional (window *window*)) (%glfw:set-scroll-callback window (cffi:get-callback callback-name))) -(defun set-drop-callback (callback-name) - (%glfw:set-drop-callback (cffi:get-callback callback-name))) +(defun set-drop-callback (callback-name &optional (window *window*)) + (%glfw:set-drop-callback window (cffi:get-callback callback-name))) (import-export %glfw:raw-mouse-motion-supported-p %glfw:get-key-name %glfw:get-key-scancode %glfw:destroy-cursor %glfw:create-standard-cursor diff --git a/examples/events.lisp b/examples/events.lisp index 80af13b..dd4532c 100644 --- a/examples/events.lisp +++ b/examples/events.lisp @@ -7,7 +7,6 @@ (defparameter *keys-pressed* nil) (defparameter *buttons-pressed* nil) (defparameter *window-size* nil) -(defparameter *dropped-files* nil) (defun update-window-title (window) (set-window-title (format nil "size ~A | keys ~A | buttons ~A" @@ -48,10 +47,24 @@ 'max 'not-max))) +#| +(def-drop-callback drop-print-callback+ (window num pathes) + (declare (ignore window)) + (format t "drop~%num:~a, pathes: ~a~%" num pathes) + (let ((p-list (loop for i from 0 below num collect + (pathname (cffi:mem-aref pathes :string i))))) + (print p-list))) +|# + (def-drop-callback drop-print-callback (window num pathes) - (declare (ignore window pathes)) - (pushnew num *dropped-files*) - (deletef *dropped-files* num)) + (declare (ignore window)) + (print num) + (print pathes)) +#| + (dotimes (i num) + (print i) + (print (cffi:mem-aref pathes :string i)))) +|# (defun events-example () ;; Graphics calls on OS X must occur in the main thread diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index df1d192..28ff20e 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -227,6 +227,25 @@ CFFI's defcallback that takes care of GLFW specifics." (with-float-traps-restored ,@actual-body)))) +(defmacro define-glfw-drop-callback (&whole whole name args &body body) + "Define a DROP callback. +This macro trunslate pointer passed from glfw to list of pathname +then call callback-function as lambda function." + (multiple-value-bind (actual-body decls doc) + (parse-body body :documentation t :whole whole) + `(defcallback ,name :void ,args + ,@(or doc) + (funcall (lambda ,(mapcar #'first args) + ,@decls + (with-float-traps-restored + ,@actual-body)) + ,(first (first args)) ;;window + ,(first (second args)) ;;counter + (loop :for i :from 0 :below ,(first (second args)) :collect ;;pathes + (pathname (cffi:mem-aref ,(first (third args)) :string i))))))) + + + (defun c-array->list (array count &optional (type :pointer)) (loop for i below count collect (mem-aref array type i))) @@ -1022,7 +1041,7 @@ Returns previously set callback." (defcfun ("glfwSetDropCallback" set-drop-callback) :pointer "DROP-FUN is a callback of type 'void (* GLFWdropfun)(GLFWwindow*,int path_count,struct char** path_names)'. Returns previously set callback." - (DROP-FUN :pointer)) + (window window) (DROP-FUN :pointer)) ;;;; ### joystick (defcfun ("glfwJoystickPresent" joystick-present-p) :boolean From a489e27074690e5c8390abaec22a24a538ab0e87 Mon Sep 17 00:00:00 2001 From: unknown Date: Thu, 5 May 2022 15:17:54 +0900 Subject: [PATCH 30/31] redefined with-window & examples --- cl-glfw3.lisp | 142 ++++++++++++++++++++++++++++++++-- examples/basic-window.lisp | 16 ++-- examples/fragment-shader.lisp | 18 ++--- 3 files changed, 152 insertions(+), 24 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index 975348f..3858949 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -21,9 +21,10 @@ get-monitor-work-area def-monitor-callback *window* + window-hint create-window destroy-window - with-window + with-windows with-init-window window-should-close-p set-window-should-close @@ -220,7 +221,10 @@ def-joystick-callback (unwind-protect (progn ,@body) (%glfw:terminate)))) -(import-export %glfw:get-monitors %glfw:get-primary-monitor %glfw:get-monitor-position %glfw:get-monitor-workarea %glfw:get-monitor-physical-size %glfw:get-monitor-content-scale %glfw:get-monitor-name %glfw:set-monitor-callback %glfw:get-video-modes %glfw:get-video-mode %glfw:set-gamma %glfw:get-gamma-ramp %glfw:set-gamma-ramp %glfw:terminate) +(import-export %glfw:default-window-hints %glfw:get-monitors %glfw:get-primary-monitor %glfw:get-monitor-position + %glfw:get-monitor-workarea %glfw:get-monitor-physical-size %glfw:get-monitor-content-scale + %glfw:get-monitor-name %glfw:set-monitor-callback %glfw:get-video-modes %glfw:get-video-mode + %glfw:set-gamma %glfw:get-gamma-ramp %glfw:set-gamma-ramp %glfw:terminate) (defun get-monitor-work-area (monitor) "Inconsistent name of get-monitor-workarea. old-version used this name" @@ -235,9 +239,115 @@ def-joystick-callback (defvar *window* nil "The window that is currently the default for this library. Can be set through MAKE-CONTEXT-CURRENT.") +(deftype window-hint-boolean-input () + '(member :resizable :visible :decorated :focused :auto-iconify :floating :maximized + :center-cursor :transparent-framebuffer focus-on-show scale-to-monitor + :stereo :srgb-capable :double-buffer :opengl-forward-compat :opengl-debug-context + :cocoa-retina-framebuffer :graphics-switching)) +(deftype window-hint-integer-input () + '(member :red-bits :green-bits :blue-bits :alpha-bits :depth-bits :stencil-bits + :accum-red-bits :accum-green-bits :accum-blue-bits :accum-alpha-bits + :aux-buffers :samples :refresh-rate)) +(deftype window-hint-string-input () + '(member :cocoa-frame-name :x11-class-name :x11-instance-name)) +(deftype window-hint-other-input () + '(member :context-version-major :context-version-minor + :client-api + :context-creation-api + :context-robustness + :context-release-behavior + :opengl-profile)) + +(defun window-hint-default (target) + (ecase target + ((:resizable :visible :decorated :focused :auto-iconify :center-cursor :focus-on-show + :doublebuffer :cocoa-retina-framebuffer) t) + ((:floating :maximized :transparent-framebuffer :scale-to-monitor :stereo :srgb-capable + :opengl-forward-compat :opengl-debug-context :cocoa-graphics-switching) nil) + ((:red-bits :green-bits :blue-bits :alpha-bits :stencil-bits) 8) + (:depth-bits 24) + ((:accum-red-bits :accum-green-bits :accum-blue-bits :accum-alpha-bits :aux-buffers + :samples :context-version-minor) 0) + ((:refresh-rate) :dont-care) + (:client-api :opengl-api) + (:context-creation-api :native-context-api) + (:context-version-major 1) + (:context-robustness :no-robustness) + (:context-release-behavior :any-release-behavior) + (:opengl-profile :opengl-any-profile) + ((:cocoa-frame-name :x11-class-name :x11-instance-name) ""))) + +(defun window-hint (target value) + (when (eq value :default) (setf value (window-hint-default target))) + (typecase target + (window-hint-boolean-input + (%glfw:window-hint target + (cffi:convert-to-foreign (the boolean value) + :boolean))) + (window-hint-integer-input + (%glfw:window-hint target + (if (eq :dont-care value) + (cffi:convert-to-foreign -1 + :int) + (cffi:convert-to-foreign (the (integer 0) value) + :int)))) + (window-hint-string-input + (%glfw:window-hint-string target + (cffi:convert-to-foreign (the string value) + :string))) + (window-hint-other-input + (%glfw:window-hint target + (cffi:convert-to-foreign value + (case (the window-hint-other-input target) + (:client-api '%glfw::opengl-api) + (:context-creation-api '%glfw::context-creation) + (:context-robustness '%glfw::robustness) + (:context-release-behavior '%glfw::release-behavior) + (:opengl-profile '%glfw::opengl-profile) + ((:context-version-major :context-version-minor) :int))))) + (t (error "~a is not supported for window hint." target))) + value) + +(defmacro create-window (&rest init-bindings + &key (width 0) (height 0) (title "") + (monitor (cffi:null-pointer)) (shared (cffi:null-pointer)) + resizable visible decorated focused auto-iconify floating + maximized center-cursor transparent-framebuffer focus-on-show scale-to-monitor + red-bits green-bits blue-bits alpha-bits depth-bits stencil-bits + accum-red-bits accum-green-bits accum-blue-bits accum-alpha-bits aux-buffers + samples refresh-rate stereo srgb-capable doublebuffer client-api + context-creation-api context-version-major context-version-minor + context-robustness context-release-behavior opengl-forward-compat + opengl-debug-context opengl-profile + cocoa-retina-framebuffer cocoa-frame-name cocoa-graphics-switching + x11-class-name x11-instance-name) + (declare (ignorable + monitor shared + resizable visible decorated focused auto-iconify floating + maximized center-cursor transparent-framebuffer focus-on-show scale-to-monitor + red-bits green-bits blue-bits alpha-bits depth-bits stencil-bits + accum-red-bits accum-green-bits accum-blue-bits accum-alpha-bits aux-buffers + samples refresh-rate stereo srgb-capable doublebuffer client-api + context-creation-api context-version-major context-version-minor + context-robustness context-release-behavior opengl-forward-compat + opengl-debug-context opengl-profile + cocoa-retina-framebuffer cocoa-frame-name cocoa-graphics-switching + x11-class-name x11-instance-name)) + `(progn + ,@(loop :for (target value) :on init-bindings :by #'cddr + :unless (member target '(:width :height :title :monitor :shared)) + :collect `(window-hint ,(intern (string-upcase (symbol-name target)) :keyword) + ,value)) + (let ((win (%glfw:create-window ,width ,height ,title + ,monitor ,shared))) + (when (cffi:null-pointer-p win) + (error "Error: Can't create window.")) + win))) + +#| (defun create-window (&key (width 0) (height 0) - title + (title "") (monitor (cffi:null-pointer)) (shared (cffi:null-pointer)) ;; Hints @@ -336,12 +446,14 @@ SHARED: The window whose context to share resources with." (if (eq client-api :no-api) (setf *window* window) (make-context-current window))))) +|# (defun destroy-window (&optional (window *window*)) (when window (%glfw:destroy-window window)) (when (eq window *window*) (setf *window* nil))) +#| (defmacro with-window ((&rest window-keys) &body body) "Convenience macro for using windows." `(unwind-protect @@ -349,11 +461,25 @@ SHARED: The window whose context to share resources with." (create-window ,@window-keys) ,@body) (destroy-window))) +|# + +(defmacro with-windows ((&rest bindings) &body body) + "make windows (with-windows ((w0 ~~hints~~) (w1 ~~hints~~)) body)" + `(destructuring-bind ,(mapcar #'first bindings) + (list ,@(mapcar (lambda (bind) + `(create-window ,@bind)) + (mapcar #'cdr bindings))) + (unwind-protect + (progn ,@body) + (progn ,@(mapcar (lambda (window) + `(destroy-window ,window)) + (mapcar #'car bindings)))))) + (defmacro with-init-window ((&rest window-keys) &body body) "Convenience macro for setting up GLFW and opening a window." `(with-init () - (with-window ,window-keys ,@body))) + (with-windows ((*window* ,@window-keys)) ,@body))) (defun window-should-close-p (&optional (window *window*)) (%glfw:window-should-close-p window)) @@ -560,11 +686,13 @@ SHARED: The window whose context to share resources with." (%glfw:set-cursor-position window x y)) (defun create-cursor (image xhot yhot) - (cond ((null image) (%glfw:create-cursor (cffi:null-pointer) xhot yhot)) - (t (with-image-pointer ((pointer image)) (%glfw:create-cursor pointer xhot yhot))))) + (with-image-pointer ((pointer image)) (%glfw:create-cursor pointer xhot yhot))) (defun set-cursor (cursor &optional (window *window*)) - (%glfw:set-cursor window cursor)) + (%glfw:set-cursor window + (if (null cursor) + (cffi:null-pointer) + cursor))) (defmacro def-key-callback (name (window key scancode action mod-keys) &body body) `(%glfw:define-glfw-callback ,name diff --git a/examples/basic-window.lisp b/examples/basic-window.lisp index db35717..0aeee60 100644 --- a/examples/basic-window.lisp +++ b/examples/basic-window.lisp @@ -4,18 +4,18 @@ (export '(basic-window-example)) -(def-key-callback quit-on-escape (window key scancode action mod-keys) +(def-key-callback basic-quit-on-escape (window key scancode action mod-keys) (declare (ignore window scancode mod-keys)) (when (and (eq key :escape) (eq action :press)) (set-window-should-close))) -(defun render () +(defun basic-render () (gl:clear :color-buffer) (gl:with-pushed-matrix (gl:color 1 1 1) (gl:rect -25 -25 25 25))) -(defun set-viewport (width height) +(defun basic-set-viewport (width height) (gl:viewport 0 0 width height) (gl:matrix-mode :projection) (gl:load-identity) @@ -23,20 +23,20 @@ (gl:matrix-mode :modelview) (gl:load-identity)) -(def-window-size-callback update-viewport (window w h) +(def-window-size-callback basic-update-viewport (window w h) (declare (ignore window)) - (set-viewport w h)) + (basic-set-viewport w h)) (defun basic-window-example () ;; Graphics calls on OS X must occur in the main thread (with-body-in-main-thread () (with-init-window (:title "Window test" :width 600 :height 400) (setf %gl:*gl-get-proc-address* #'get-proc-address) - (set-key-callback 'quit-on-escape) - (set-window-size-callback 'update-viewport) + (set-key-callback 'basic-quit-on-escape) + (set-window-size-callback 'basic-update-viewport) (gl:clear-color 0 0 0 0) (set-viewport 600 400) (loop until (window-should-close-p) - do (render) + do (basic-render) do (swap-buffers) do (poll-events))))) diff --git a/examples/fragment-shader.lisp b/examples/fragment-shader.lisp index f7aa788..f5fea13 100644 --- a/examples/fragment-shader.lisp +++ b/examples/fragment-shader.lisp @@ -44,7 +44,7 @@ void main() (defvar *shader-time* 0) -(defun render () +(defun shader-render () (gl:clear :color-buffer) ;; Update our time variable in the shader @@ -114,12 +114,12 @@ void main() ;; Standard window setup below this line ;; ------------------------------------- -(def-key-callback quit-on-escape (window key scancode action mod-keys) +(def-key-callback shader-quit-on-escape (window key scancode action mod-keys) (declare (ignore window scancode mod-keys)) (when (and (eq key :escape) (eq action :press)) (set-window-should-close))) -(defun set-viewport (width height) +(defun shader-set-viewport (width height) ;; Black background (gl:clear-color 0.2 0.2 0.2 0.2) @@ -137,25 +137,25 @@ void main() (gl:matrix-mode :modelview) (gl:load-identity)) -(def-window-size-callback update-viewport (window w h) +(def-window-size-callback shader-update-viewport (window w h) (declare (ignore window)) - (set-viewport w h)) + (shader-set-viewport w h)) (defun fragment-shader-example () ;; Graphics calls on OS X must occur in the main thread (with-body-in-main-thread () (with-init-window (:title "OpenGL test" :width 600 :height 400) - (set-key-callback 'quit-on-escape) + (set-key-callback 'shader-quit-on-escape) ;; Callback for window resize events - (set-window-size-callback 'update-viewport) - (set-viewport 800 400) + (set-window-size-callback 'shader-update-viewport) + (shader-set-viewport 800 400) ;; Compile our shaders and use the program (setup-shader) ;; Our render-loop (loop until (window-should-close-p) - do (render) + do (shader-render) do (swap-buffers) do (poll-events))))) From 592d8bd8bd78df2bec9e9766d394d0bd248ef46b Mon Sep 17 00:00:00 2001 From: togekawa555 Date: Sat, 7 May 2022 00:04:26 +0900 Subject: [PATCH 31/31] cleaning comments --- cl-glfw3.lisp | 2 -- glfw-bindings.lisp | 86 ++++++++++++++-------------------------------- 2 files changed, 26 insertions(+), 62 deletions(-) diff --git a/cl-glfw3.lisp b/cl-glfw3.lisp index 3858949..17e5245 100644 --- a/cl-glfw3.lisp +++ b/cl-glfw3.lisp @@ -735,7 +735,6 @@ SHARED: The window whose context to share resources with." ((,window :pointer) (,x :double) (,y :double)) ,@body)) -;;added ;;must: support function (defmacro def-drop-callback (name (window number-of-pathes pathes) &body body) `(%glfw::define-glfw-drop-callback ,name @@ -777,7 +776,6 @@ SHARED: The window whose context to share resources with." %glfw:get-joystick-name %glfw:get-joystick-guid %glfw:joystick-is-gamepad-p %glfw:update-gamepad-mappings %glfw:get-gamepad-name %glfw:get-gamepad-state %glfw:get-timer-value %glfw:get-timer-frequency) -;;added (deftype joystick-id () '(integer 0 15)) ;;;; ## Clipboard diff --git a/glfw-bindings.lisp b/glfw-bindings.lisp index 28ff20e..b772aaa 100644 --- a/glfw-bindings.lisp +++ b/glfw-bindings.lisp @@ -241,10 +241,8 @@ then call callback-function as lambda function." ,@actual-body)) ,(first (first args)) ;;window ,(first (second args)) ;;counter - (loop :for i :from 0 :below ,(first (second args)) :collect ;;pathes - (pathname (cffi:mem-aref ,(first (third args)) :string i))))))) - - + (mapcar #'pathname + (c-array->list ,(first (third args)) ,(first (second args)) :string)))))) (defun c-array->list (array count &optional (type :pointer)) (loop for i below count collect (mem-aref array type i))) @@ -263,7 +261,6 @@ then call callback-function as lambda function." :repeat) ;;; # Gamepad axes -;;added (defcenum (gamepad-axes) (:left-x 0) (:left-y 1) @@ -273,7 +270,6 @@ then call callback-function as lambda function." (:right-trigger 5) (:last 5)) -;;added ;;; # Gamepad buttons (defcenum (gamepad-buttons) (:a 0) @@ -297,7 +293,6 @@ then call callback-function as lambda function." (:square 2) (:triangle 3)) -;;added ;;; # joystick hat states (defbitfield (hat) (:centered #x0000) @@ -454,7 +449,6 @@ then call callback-function as lambda function." (:right-super 347) (:menu 348)) -;;added caps-lock#x10 num-lock#x20 ;;; # Modifier key flags (defbitfield (mod-keys) :shift @@ -478,7 +472,6 @@ then call callback-function as lambda function." (:left 0) (:right 1)) -;;added ;;Standard cursor shapes (defcenum (cursor-shape) (:arrow #x00036001) @@ -507,13 +500,13 @@ then call callback-function as lambda function." (:resizable #X00020003) (:visible #X00020004) (:decorated #X00020005) - (:auto-iconify #x00020006) ;added - (:floating #x00020007) ;added - (:maximized #x00020008) ;added - (:center-cursor #x00020009) ;added - (:transparent-framebuffer #x0002000a) ;added - (:hovered #x0002000b) ;added - (:focus-on-show #x0002000c) ;added + (:auto-iconify #x00020006) + (:floating #x00020007) + (:maximized #x00020008) + (:center-cursor #x00020009) + (:transparent-framebuffer #x0002000a) + (:hovered #x0002000b) + (:focus-on-show #x0002000c) (:red-bits #X00021001) (:green-bits #X00021002) (:blue-bits #X00021003) @@ -529,7 +522,7 @@ then call callback-function as lambda function." (:samples #X0002100d) (:srgb-capable #X0002100E) (:refresh-rate #X0002100F) - (:doublebuffer #x00021010) ;added + (:doublebuffer #x00021010) (:client-api #X00022001) (:context-version-major #x00022002) (:context-version-minor #x00022003) @@ -538,15 +531,15 @@ then call callback-function as lambda function." (:opengl-forward-compat #x00022006) (:opengl-debug-context #x00022007) (:opengl-profile #X00022008) - (:context-release-behavior #x00022009) ;added - (:context-no-error #x0002200a) ;added - (:context-creation-api #x0002200b) ;added - (:scale-to-monitor #x0002200c) ;added - (:cocoa-retina-framebuffer #x00023001) ;added - (:cocoa-frame-name #x00023002) ;added - (:cocoa-graphics-switching #x00023003) ;added - (:x11-class-name #x00024001) ;added - (:x11-instance-name #x00024002) ;added + (:context-release-behavior #x00022009) + (:context-no-error #x0002200a) + (:context-creation-api #x0002200b) + (:scale-to-monitor #x0002200c) + (:cocoa-retina-framebuffer #x00023001) + (:cocoa-frame-name #x00023002) + (:cocoa-graphics-switching #x00023003) + (:x11-class-name #x00024001) + (:x11-instance-name #x00024002) ) ;;window attributes for set-window-attributes @@ -597,7 +590,6 @@ then call callback-function as lambda function." (:cursor #X00033001) (:sticky-keys #X00033002) (:sticky-mouse-buttons #x00033003) - ;;added (:lock-key-mods #x00033004) (:raw-mouse-motion #x00033005)) @@ -628,20 +620,18 @@ then call callback-function as lambda function." (blue :pointer) (size :unsigned-int)) -;;added (defcstruct image (width :int) (height :int) (pixels (:pointer :uchar))) -;;added (defcstruct gamepad-state (buttons (:pointer :char)) (axes (:pointer :float))) (defctype window :pointer) (defctype monitor :pointer) -;;added + (defctype cursor :pointer) ;; vulkan handles @@ -717,10 +707,9 @@ Returns the previous error callback." (defcfun ("glfwGetMonitorName" get-monitor-name) :string (monitor monitor)) -;;added (defcfun ("glfwSetMonitorUserPointer" set-monitor-user-pointer) :void (monitor monitor) (pointer :pointer)) -;;added + (defcfun ("glfwGetMonitorUserPointer" get-monitor-user-pointer) :pointer (monitor monitor)) @@ -781,7 +770,7 @@ Returns previously set callback." (defcfun ("glfwSetWindowTitle" set-window-title) :void (window window) (title :string)) -;;added + (defcfun ("glfwSetWindowIcon" set-window-icon) :void (window window) (image-count :int) (images (:pointer (:struct image)))) @@ -811,7 +800,7 @@ Returns previously set callback." (defcfun ("glfwSetWindowAspectRatio" set-window-aspect-ratio) :void (window window) (width :int) (height :int)) -;;added + (defun get-window-frame-size (window) "returns size (left top right bottom) of frame size." (with-foreign-objects ((left :int) (top :int) (right :int) (bottom :int)) @@ -843,7 +832,6 @@ Returns previously set callback." (defcfun ("glfwRestoreWindow" restore-window) :void (window window)) -;;added (defcfun ("glfwMaximizeWindow" maximize-window) :void (window window)) @@ -853,11 +841,10 @@ Returns previously set callback." (defcfun ("glfwHideWindow" hide-window) :void (window window)) -;;added + (defcfun ("glfwFocusWindow" focus-window) :void (window window)) -;;added (defcfun ("glfwRequestWindowAttention" request-window-attention) :void (window window)) @@ -918,7 +905,6 @@ Returns previously set callback." Returns previously set callback." (window window) (iconify-fun :pointer)) -;;added (defcfun ("glfwSetWindowMaximizeCallback" set-window-maximize-callback) :pointer "MAXIMIZE-FUN is a callback of type 'void (* GLFWwindowmaximizefun)(GLFWwindow*,int)'. Returns previously set callback." @@ -929,7 +915,6 @@ Returns previously set callback." Returns previously set callback." (window window) (framebuffer-size-fun :pointer)) -;;added (defcfun ("glfwSetWindowContentScaleCallback" set-window-content-scale-callback) :pointer "CONTENTS-SCALE-FUN is a callback of type 'void (* GLFWwindowContentsScalefun)(GLFWwindow*,float,float)'. Returns previously set callback." @@ -940,7 +925,7 @@ Returns previously set callback." (defcfun ("glfwWaitEvents" wait-events) (float-traps-masked :void)) -;;added trapps-masked? +;; trapps-masked? (defcfun ("glfwWaitEventsTimeout" wait-events-timeout) :void (timeout :double)) @@ -958,13 +943,11 @@ Returns previously set callback." else value is true or false" (window window) (mode input-mode) (value :int)) -;;added (defcfun ("glfwRawMouseMotionSupported" raw-mouse-motion-supported-p) :int) -;;added (defcfun ("glfwGetKeyName" get-key-name) :string (key key) (scancode :int)) -;;added + (defcfun ("glfwGetKeyScancode" get-key-scancode) :int (key key)) @@ -984,19 +967,15 @@ Returns previously set callback." (defcfun ("glfwSetCursorPos" set-cursor-position) :void (window window) (x :double) (y :double)) -;;added (defcfun ("glfwCreateCursor" create-cursor) cursor (image (:pointer (:struct image))) (xhot :int) (yhot :int)) -;;added (defcfun ("glfwCreateStandardCursor" create-standard-cursor) cursor (shape cursor-shape)) -;;added (defcfun ("glfwDestroyCursor" destroy-cursor) :void (cursor cursor)) -;;added (defcfun ("glfwSetCursor" set-cursor) :void (window window) (cursor cursor)) @@ -1010,7 +989,6 @@ Returns previously set callback." Returns previously set callback." (window window) (char-fun :pointer)) -;;added (defcfun ("glfwSetCharModsCallback" set-char-mods-callback) :pointer "CHAR-MODS-FUN is a callback of type 'void (* GLFWCharModsfun)(GLFWwindow*,pointer)'. Returns previously set callback." @@ -1037,7 +1015,6 @@ Returns previously set callback." (window window) (SCROLL-FUN :pointer)) ;;;; ### files -;;added (defcfun ("glfwSetDropCallback" set-drop-callback) :pointer "DROP-FUN is a callback of type 'void (* GLFWdropfun)(GLFWwindow*,int path_count,struct char** path_names)'. Returns previously set callback." @@ -1065,7 +1042,6 @@ Returns previously set callback." (mem-ref count :int) 'key-action))) -;;added (defun get-joystick-hats (joystick) "Returns list of values for direction of the joystick." (with-foreign-object (count :int) @@ -1078,37 +1054,29 @@ Returns previously set callback." (defcfun ("glfwGetJoystickName" get-joystick-name) :string (joystick :int));jid -;;added (defcfun ("glfwGetJoystickGUID" get-joystick-guid) :string (joystick :int)) -;;added (defcfun ("glfwSetJoystickUserPointer" set-joystick-user-pointer) :void (joystick :int) (pointer :pointer)) -;;added (defcfun ("glfwGetJoystickUserPointer" get-joystick-user-pointer) :pointer (joystick :int)) -;;added (defcfun ("glfwJoystickIsGamepad" joystick-is-gamepad-p) :boolean (joystick :int)) -;;added (defcfun ("glfwSetJoystickCallback" set-joystick-callback) :pointer "JOYSTICK-FUN is a callback of type 'void (* GLFWjoystickfun)(int joystick,int event)'. Returns previously set callback." (JOYSTICK-FUN :pointer)) -;;added (defcfun ("glfwUpdateGamepadMappings" update-gamepad-mappings) :boolean (string :string)) -;;added (defcfun ("glfwGetGamepadName" get-gamepad-name) :string (joystick :int)) -;;added (defcfun ("glfwGetGamepadState" get-gamepad-state) :boolean (joystick :int) (gamepad-state (:pointer (:struct gamepad-state)))) @@ -1125,10 +1093,8 @@ Returns previously set callback." (defcfun ("glfwSetTime" set-time) :void (time :double)) -;;added (defcfun ("glfwGetTimerValue" get-timer-value) :uint64) -;;added (defcfun ("glfwGetTimerFrequency" get-timer-frequency) :uint64) ;;;; ### Context