aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-07-23 10:56:19 -0500
committerColin Okay <colin@cicadas.surf>2022-07-23 10:56:19 -0500
commitc33701fc1c6cc18faf8ff5e02245ab94877b1f54 (patch)
treeb7f369932134a47fb915247ba62c49eed5c0f33d
parent8fc1317f0c3c32e3d75b17260b9b0c3ed810fd76 (diff)
[change] generic add/drop unit; [add] impls for menu class
-rw-r--r--gui/menus.lisp11
-rw-r--r--src/wheelwork.lisp7
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*)