Just in case... kenny -- http://tilton-technology.com Why Lisp? http://alu.cliki.net/RtL%20Highlight%20Film Your Project Here! http://alu.cliki.net/Industry%20Application ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cello; -*- ;;; ;;; Copyright © 2004 by Kenneth William Tilton. ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal ;;; in the Software without restriction, including without limitation the rights ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;;; copies of the Software, and to permit persons to whom the Software is furnished ;;; to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. (in-package :cello) (defmodel Mouse () ((leftb :initarg :leftb :initform (cv :up) :accessor leftb) (middleb :initarg :middleb :initform (cv :up) :accessor middleb) (rightb :initarg :rightb :initform (cv :up) :accessor rightb))) (defmodel MouseClick (Model Perishable) ((clickwindow :cell nil :initarg :clickwindow :initform nil :reader clickwindow) (osEvent :cell nil :initarg :oSEvent :reader osEvent) (clickee :cell nil :initarg :clickee :reader clickee) (clickeePXY :reader clickeePXY :cell nil :initarg :clickeePXY) (clickCompleted :reader clickCompleted :initform (c? (when (typep (clickwindow self) 'Window) ;; <- acl used to turn windows into (mouseUpEvt (clickwindow self))))) ;; closed-stream instances (clickOver :reader clickOver :initform (c? (when (typep (clickwindow self) 'Window) (unless (^clickCompleted) (when (mouse-over-p (clickee self)) (mousePos (clickwindow self))))))) (inDrag :reader inDrag :initform (c? (when (typep (clickwindow self) 'Window) (unless (^clickCompleted) (when (mouse-over-p (clickee self)) (mousePos (clickwindow self))))))) (clicked :reader clicked :initform (c? (trc nil "clicked?> typeof clickw" (clickwindow self) (type-of (clickwindow self))) (when (typep (clickwindow self) 'Window) (trc nil "clicked?> asking clickcompleted") (bWhen (up (^clickCompleted)) (trc nil "clicked?> asking point-in-box" (evtWhere up) (clickee self) (without-c-dependency (screenbox (clickee self)))) (when (point-in-box (evtWhere up) ;; more precise than mPos (without-c-dependency ;; moving GUI elements? chya (screenbox (clickee self)))) (cons (clickee self) up)))))) ) (:default-initargs :expiration (c? (mouseUpEvt (clickWindow self))))) (defmethod initialize-instance :after ((self MouseClick) &key) (when (typep (clickee self) 'Focus) (unless (control-key-down (evtButtons (osEvent self))) ;; lame debugging enabler; make better (focus-navigate (focus (clickWindow self)) (clickee self)))) (bwhen (ctxt (clickee self)) (do-mouseclick ctxt (clickWindow self) (osEvent self))) (to-be self) ;; unnecessary? 2301kt just moved this from after next line (trc nil "echo click set self clickee" (clickee self)) (bwhen (ctxt (clickee self)) ;; /// looks wrong with do-mouseclick above and now this (set-mouseclick ctxt self)) ) (defmethod do-mouseclick (other w evt) (declare (ignorable other w evt))) (defmethod set-mouseclick (other click) (declare (ignorable other click))) (defmethod set-doubleclick? (other click) (declare (ignorable other click))) (defmethod not-to-be :around ((self MouseClick)) (when (typep (clickWindow self) 'Window) ;; /// why worry about this? (trc nil "echo click clearing self from clickee" (clickee self)) (set-mouseclick (clickee self) nil) ;; do this first? ;; (trc "echo click not-to-be-ing self from clickee" self) (call-next-method) (set-doubleClick? (clickWindow self) self) ;; from Win32 days )) (def-c-echo clicked () (when (and new-value (clickwindow self)) (trc nil "echo clicked calling control-do-action" self new-value) (Control-do-action (car new-value) (cdr new-value)))) ;---------------------------------------- (def-c-echo clickOver () (ctl-handle-over (clickee self) self new-value)) (defmethod ctl-handle-over (self clickStart overInfo) (declare (ignore self clickStart overInfo))) ;;; (defmethod ctl-handle-over :before ((self control) clickStart overInfo) ;;; (declare (ignore clickStart)) ;;; (setf (hilited self) overInfo)) ;; treat as flag: only issue is nil or not ;-----------------------------------------