[add] gui package. moved button.lisp into gui

1 files changed, 0 insertions, 113 deletions

diff --git a/src/interactive/button.lisp b/src/interactive/button.lisp
deleted file mode 100644
index 7c94663..0000000
--- a/src/interactive/button.lisp
+++ /dev/null
@@ -1,113 +0,0 @@
-;;;; button.lisp
-
-(in-package #:wheelwork)
-
-(defclass/std button (unit interactive)
-  ((up down :with
-       :std (error "UP and DOWN lots are required")
-       :doc "Any affine renderable unit")
-   (bg :with)
-   (on-press on-release :with :doc "Function accepting the button."))
-  (:documentation "A basic button class. The UP and DOWN slots should
-  be filled with renderable objects having the same size."))
-
-(defhandler button-released
-    (on-mouseup ()
-      (with-slots (up down on-release) target
-        (setf (unit-visiblep up) t
-              (unit-visiblep down) nil)
-        (when on-release
-          (funcall on-release target)))))
-
-(defhandler button-pressed
-    (on-mousedown ()
-      (with-slots (up down on-press) target
-        (setf (unit-visiblep up) nil
-              (unit-visiblep down) t)
-        (when on-press
-          (funcall on-press target)))))
-
-(defmethod (setf closer-mop:slot-value-using-class) :before
-    (newval class (button button) slot)
-  (let ((slot-name
-          (closer-mop:slot-definition-name slot))) 
-    (case slot-name 
-      ((up down bg)
-       (when (slot-boundp button slot-name) 
-         (error "Swapping Button Faces Not Presently Supported"))))))
-
-(defmethod initialize-instance :after ((button button) &key)
-  (add-handler button #'button-pressed)
-  (add-handler button #'button-released)
-  (with-slots (up down bg) button 
-    (when bg
-      (setf (unit-container bg) button
-            (unit-visiblep bg) t))
-    (setf (unit-visiblep down) nil
-          (unit-visiblep up) t
-          (unit-container up) button
-          (unit-container down) button)))
-
-(defmethod cleanup ((button button))
-  (with-slots (up down bg) button
-    (when bg (cleanup bg))
-    (cleanup up)
-    (cleanup down)))
-
-(defmethod render ((button button))
-  (with-slots (up down bg) button
-    (when bg   (render bg))
-    (if (unit-visiblep up)
-        (render up)
-        (render down))))
-
-(macrolet
-    ((def-accessors (&rest accessor-names)
-       (let ((defs 
-               (loop for accessor-name in accessor-names
-                     collect 
-                     `(defmethod ,accessor-name ((button button))
-                        (,accessor-name (button-up button)))
-
-                     collect
-                     `(defmethod (setf ,accessor-name) (newval (button button))
-                        (setf (,accessor-name (button-up button)) newval
-                              (,accessor-name (button-down button)) newval)
-                        (when (button-bg button)
-                          (setf (,accessor-name (button-bg button)) newval))))))
-         `(progn ,@defs))))
-
-  (def-accessors x y scale-x scale-y width height rotation))
-
-(defmethod get-rect ((button button))
-  (get-rect (button-up button)))
-
-(defun make-texture-button (up down &key pressed released)
-  "UP and DOWN should be strings naming assets to use as the up and
-  down images for the button."
-  (make-instance
-   'button
-   :on-press pressed :on-release released
-   :up (make-instance 'image :texture (get-asset up))
-   :down (make-instance 'image :texture (get-asset down))))
-
-(defun make-text-button
-    (font up down
-     &key
-       pressed released
-       down-font
-       (up-color #(1.0 1.0 1.0 1.0))
-       (down-color #(1.0 1.0 1.0 1.0)))
-  (make-instance
-   'button
-   :on-release released :on-press pressed
-   :up (make-instance
-        'text
-        :content up
-        :color up-color
-        :font font)
-   :down (make-instance
-          'text
-          :content down
-          :color down-color
-          :font (or down-font font))))