From c33701fc1c6cc18faf8ff5e02245ab94877b1f54 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Sat, 23 Jul 2022 10:56:19 -0500 Subject: [change] generic add/drop unit; [add] impls for menu class --- gui/menus.lisp | 11 ++++++++--- src/wheelwork.lisp | 7 +++++-- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/gui/menus.lisp b/gui/menus.lisp index 1c4166c..2a2e938 100644 --- a/gui/menus.lisp +++ b/gui/menus.lisp @@ -32,16 +32,22 @@ (def-menu-accessors x y width height)) +(defmethod add-unit :after ((menu menu)) + (dolist (o (menu-options menu)) + (add-unit o))) + +(defmethod drop-unit :before ((menu menu)) + (dolist (o (menu-options menu)) + (drop-unit o))) + (defgeneric add-menu-option (menu option)) (defmethod add-menu-option ((menu menu) option) (setf (unit-region option) (unit-region menu)) - (add-unit option) (setf (menu-options menu) (nconc (menu-options menu) (list option)))) (defun remove-menu-option (menu option) (when (member option (menu-options menu)) - (drop-unit option) (setf (unit-region option) *application*) (setf (menu-options menu) (delete option (menu-options menu))))) @@ -66,7 +72,6 @@ (on-mousewheel (vs horiz vert) (let ((oh (vscroller-options-height vs)) (h (height vs))) - (format t "oh: ~a h: ~a scroll:~a ~%" oh h (vert-scroll vs)) (setf (vert-scroll vs) (clamp 0 (+ (vert-scroll vs) (* vert (scroll-speed vs))) diff --git a/src/wheelwork.lisp b/src/wheelwork.lisp index e411c52..154adaa 100644 --- a/src/wheelwork.lisp +++ b/src/wheelwork.lisp @@ -5,13 +5,16 @@ (defvar *application* nil "current application") -(defun add-unit (unit) +(defgeneric add-unit (unit)) + +(defmethod add-unit ((unit unit)) "Adds a unit to the display." (assert *application*) (push unit (application-scene *application*)) (setf (unit-in-scene-p unit) t)) -(defun drop-unit (unit) +(defgeneric drop-unit (unit)) +(defmethod drop-unit ((unit unit)) "A removes a unit from the display." (assert *application*) (setf (application-scene *application*) -- cgit v1.2.3