Small MD & MI Examples
Ken Dickey
Ken.Dickey at allvantage.com
Fri Nov 19 16:09:45 UTC 2004
> Can you provide an example ? I was always sceptical about multidispatch.
Alexandre,
I don't expect you to be able to read the following Common Lisp examples (from
CLIM, Common Lisp Interface Manager, code) but they are fairly small examples
from production code.
Just put on your squiggly glasses and think Smalltalk. ;^)
===========
;; EXAMPLE: Multiple Dispatch (Dispatch on 2nd Argument)
;; Dispatch on Button X Event
;; When we enter the push button's region, arm it.
(defmethod handle-event ( (pane ellipse-push-button)
(event pointer-enter-event) ) ;; @@@
(with-slots (armed) pane
(unless armed
(let ( (pointer (pointer-event-pointer event)) )
(if (and (pointer-button-state pointer)
(not (zerop (pointer-button-state pointer)))))
(progn
(setf armed :active)
(with-sheet-medium (medium pane)
(highlight-button pane medium)))
(setf armed t)))
(armed-callback pane (gadget-client pane) (gadget-id pane)))))
;; When we leave the push button's region, disarm it.
(defmethod handle-event ( (pane ellipse-push-button)
(event pointer-exit-event) ) ;; @@@
(with-slots (armed) pane
(when armed
(when (prog1 (eq armed :active) (setf armed nil))
(with-sheet-medium (medium pane)
(highlight-button pane medium)))
(disarmed-callback pane (gadget-client pane) (gadget-id pane)))))
===========
;;EXAMPLE: Multiple Inheritance (fine grained)
;; Reuse small Parts/Components
;;; SIMPLE-SLIDER
(defclass simple-slider
(range-gadget-mixin ; provides min & max
value-gadget ; provides gadget-value
leaf-pane ; provides drawing surface
space-requirement-mixin)
((tick-length :initform 5 :initarg :tick-length)
(tick-number :initform 5 :initarg :tick-number)))
(defmethod handle-event ( (pane simple-slider)
(event pointer-motion-event) )
(when (logtest (pointer-button-state (pointer-event-pointer event))
+pointer-left-button+)
;; User is trying to drag. Change the value.
(let* ( (x (pointer-event-x event))
(width (bounding-rectangle-width pane))
(min-value (gadget-min-value pane))
(max-value (gadget-max-value pane))
(value (+ min-value
(* (/ (float x) width)
(- max-value min-value)))) )
(setf (gadget-value pane) value :invoke-callback t))))
===========
Cheers,
-KenD
More information about the Squeak-dev
mailing list
|