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