Added menu demo

sdl3.asd

@@ -278,5 +278,16 @@
 		  ((:file "package")
 		   (:file "01open-file-dialog")
 		   (:file "02open-file-dialog-multi")
-		   (:file "03open-folder-dialog"))))))
+		   (:file "03open-folder-dialog")))
+		 (:module "menu"
+		  :components
+		  ((:file "package")
+		   (:file "01system-menu")
+		   (:file "02screen-menu")
+		   (:file "03advanced/package")
+		   (:file "03advanced/menu-model")
+		   (:file "03advanced/menu-controller")
+		   (:file "03advanced/sdl3-renderer")
+		   (:file "03advanced/action-handlers")
+		   (:file "03advanced/screen-menu-classes"))))))
   :description "test function here")

src/keyboard/type.lisp

@@ -350,7 +350,7 @@
   (:insert #x40000049)
   (:home #x4000004a)
   (:pageup #x4000004b)
-  (:end #x4000004)
+  (:end #x4000004d)
   (:pagedown #x4000004e)
   (:right #x4000004f)
   (:left #x40000050)

src/main/wrap.lisp

@@ -9,8 +9,11 @@
 name -> callback name
 aragc -> argument count
 argv -> list of argument"
-  `(cffi:defcallback ,name :int ((,argc :int) (,argv (:pointer :string)))
-     ,@body))
+  `(progn
+     (defun ,name (,argc ,argv)
+       ,@body)
+     (cffi:defcallback ,name :int ((,argc :int) (,argv (:pointer :string)))
+       (funcall (symbol-function ',name) ,argc ,argv))))
 (export 'defmain-fun)
 
 (defun run-app (callback &rest args)
@@ -43,20 +46,28 @@ appstate -> a place where the app can optionally store a pointer for future use.
 aragc -> the standard ANSI C main's argc; number of elements in argv.
 argv -> the standard ANSI C main's argv; array of command line arguments.
 "
-  `(cffi:defcallback ,name app-result ((appstate (:pointer :pointer))
-				       (,argc :int)
-				       (,argv (:pointer :string)))
-     (declare (ignore appstate))
-     ,@body))
+  `(progn
+     (defun ,name (appstate ,argc ,argv)
+       (declare (ignore appstate))
+       ,@body)
+     (cffi:defcallback ,name app-result ((appstate (:pointer :pointer))
+                                          (,argc :int)
+                                          (,argv (:pointer :string)))
+       (declare (ignore appstate))
+       (funcall (symbol-function ',name) appstate ,argc ,argv))))
 (export 'def-app-init)
 
 (defmacro def-app-iterate (name () &body body)
   "ret[app-result]
 appstate an optional pointer, provided by the app in SDL_AppInit.
 "
-  `(cffi:defcallback ,name app-result ((appstate :pointer))
-     (declare (ignore appstate))
-     ,@body))
+  `(progn
+     (defun ,name (appstate)
+       (declare (ignore appstate))
+       ,@body)
+     (cffi:defcallback ,name app-result ((appstate :pointer))
+       (declare (ignore appstate))
+       (funcall (symbol-function ',name) appstate))))
 (export 'def-app-iterate)
 
 (defmacro def-app-event (name (event-type pevent) &body body)
@@ -65,25 +76,33 @@ app-state -> an optional pointer, provided by the app in SDL_AppInit.
 event -> the new event for the app to examine.
 event-type -> sdl event
 "
-  (let ((event-type-val (gensym)))
-    `(cffi:defcallback ,name app-result ((appstate :pointer) (,pevent (:pointer (:union event))))
-       (declare (ignore appstate))
-       (cffi:with-foreign-slots (((,event-type-val type))
-				 ,pevent
-				 (:union event))
-	 (let ((,event-type (cffi:foreign-enum-keyword 'event-type ,event-type-val)))
-	   ,@body)))))
-(export 'def-app-event)
+      (let ((event-type-val (gensym)))
+        `(progn
+           (defun ,name (appstate ,pevent)
+             (declare (ignore appstate))
+             (cffi:with-foreign-slots (((,event-type-val type))
+                                       ,pevent
+                                       (:union event))
+               (let ((,event-type (cffi:foreign-enum-keyword 'event-type ,event-type-val)))
+                 ,@body)))
+           (cffi:defcallback ,name app-result ((appstate :pointer) (,pevent (:pointer (:union event))))
+             (declare (ignore appstate))
+             (funcall (symbol-function ',name) appstate ,pevent)))))
+    (export 'def-app-event)
 
 
 (defmacro def-app-quit (name (result) &body body)
   "ret[void]
 app-state -> an optional pointer, provided by the app in SDL_AppInit. 
 result -> the result code that terminated the app (success or failure).
 "
-  `(cffi:defcallback ,name :void ((appstate :pointer) (,result app-result))
-     (declare (ignore appstate))
-     ,@body))
+  `(progn
+     (defun ,name (appstate ,result)
+       (declare (ignore appstate))
+       ,@body)
+     (cffi:defcallback ,name :void ((appstate :pointer) (,result app-result))
+       (declare (ignore appstate))
+       (funcall (symbol-function ',name) appstate ,result))))
 (export 'def-app-quit)
 
 (defun enter-app-main-callbacks (appinit appiter appevent appquit &rest args)

test/menu/01system-menu.lisp

@@ -0,0 +1,62 @@
+(in-package :sdl3.demo.menu)
+
+(defparameter *window-system* nil)
+(defparameter *renderer-system* nil)
+
+;;; Right mouse button number in SDL3
+(defconstant +button-right+ 3)
+
+(sdl3:def-app-init system-menu-init (argc argv)
+  (declare (ignore argc argv))
+  (sdl3:set-app-metadata "Example System Menu" "1.0" "com.example.menu")
+  (when (not (sdl3:init :video))
+    (format t "~a~%" (sdl3:get-error))
+    (return-from system-menu-init :failure))
+  (multiple-value-bind (rst window renderer)
+      (sdl3:create-window-and-renderer
+       "System Menu — right-click to open" 640 200 0)
+    (if (not rst)
+        (progn
+          (format t "~a~%" (sdl3:get-error))
+          (return-from system-menu-init :failure))
+        (setf *window-system*   window
+              *renderer-system* renderer)))
+  :continue)
+
+(sdl3:def-app-iterate system-menu-iterate ()
+  (sdl3:set-render-draw-color *renderer-system* 30 30 30 255)
+  (sdl3:render-clear *renderer-system*)
+  (sdl3:set-render-draw-color *renderer-system* 200 200 200 255)
+  (sdl3:render-debug-text *renderer-system* 160.0 92.0 "Right-click anywhere to open the system menu.")
+  (sdl3:render-present *renderer-system*)
+  :continue)
+
+(sdl3:def-app-event system-menu-event (type event)
+  (declare (ignore type))
+  (let ((ev (sdl3:event-unmarshal event)))
+    (typecase ev
+      (sdl3:quit-event :success)
+      (sdl3:mouse-button-event
+       (when (and (slot-value ev 'sdl3:%down)
+                  (= (slot-value ev 'sdl3:%button) +button-right+))
+         (let ((menu-x (round (slot-value ev 'sdl3:%x)))
+           (menu-y (round (slot-value ev 'sdl3:%y))))
+           (unless (sdl3:show-window-system-menu *window-system* menu-x menu-y)
+             (format t "show-window-system-menu failed: ~a~%" (sdl3:get-error)))))
+       :continue)
+      (t :continue))))
+
+(sdl3:def-app-quit system-menu-quit (result)
+  (declare (ignore result))
+      (sdl3:destroy-renderer *renderer-system*)
+      (sdl3:destroy-window *window-system*)
+  (sdl3:pump-events)
+  (sdl3:quit-sub-system :video)
+  (sdl3:quit))
+
+(defun do-system-menu-demo ()
+  (sdl3:enter-app-main-callbacks
+   'system-menu-init
+   'system-menu-iterate
+   'system-menu-event
+   'system-menu-quit))