diff options
author | Colin Okay <colin@cicadas.surf> | 2022-07-23 10:44:40 -0500 |
---|---|---|
committer | Colin Okay <colin@cicadas.surf> | 2022-07-23 10:44:40 -0500 |
commit | 8fc1317f0c3c32e3d75b17260b9b0c3ed810fd76 (patch) | |
tree | aae56cef22eb9e1b4a3e0a6a6ad159b355a7a8cc /src | |
parent | 00841605110612f6e7f3bbfc054ceff980bf25be (diff) |
[add] menu basics and [example]
Diffstat (limited to 'src')
-rw-r--r-- | src/region.lisp | 32 | ||||
-rw-r--r-- | src/wheelwork.lisp | 2 |
2 files changed, 34 insertions, 0 deletions
diff --git a/src/region.lisp b/src/region.lisp index 2355db6..4f22763 100644 --- a/src/region.lisp +++ b/src/region.lisp @@ -4,3 +4,35 @@ (defclass/std region () ((left bottom top right :with :std 0))) + +(defmethod width ((region region)) + (- (region-right region) (region-left region))) + +(defmethod (setf width) (newval (region region)) + (with-slots (left right) region + (setf right (+ left newval)))) + +(defmethod height ((region region)) + (- (region-top region) (region-bottom region))) + +(defmethod (setf height) (newval (region region)) + (with-slots (top bottom) region + (setf top (+ bottom newval)))) + +(defmethod x ((r region)) + (region-left r)) + +(defmethod (setf x) (newval (region region)) + (let ((width (width region))) ;;get before change + (with-slots (left right) + (setf left newval + right (+ newval width))))) + +(defmethod y ((r region)) + (region-bottom r)) + +(defmethod (setf y) (newval (region region)) + (let ((height (height region))) ;;get before change + (with-slots (top bottom) region + (setf bottom newval + top (+ newval height))))) diff --git a/src/wheelwork.lisp b/src/wheelwork.lisp index 4a20553..e411c52 100644 --- a/src/wheelwork.lisp +++ b/src/wheelwork.lisp @@ -6,11 +6,13 @@ "current application") (defun add-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) + "A removes a unit from the display." (assert *application*) (setf (application-scene *application*) (delete unit (application-scene *application*))) |