[Openmcl-devel] Can anyone get mouse up events in the Windows/Cocotron version of ccl?

Michael Minerva minerva at agentsheets.com
Thu Sep 2 23:40:10 UTC 2010


I have been unable to get mouse up events on the windows version of the ide, and I was wondering if anyone has found a workaround for this?  It seems that this is not a cocotron issue because I made a cocotron project that receives both mouse up and mouse down events with no problem using objective c.  The following code illustrates the problem pretty well.  In OSX the  code will display a window and when you click you get both mouse up and mouse down events (as well as drags if you drag), but on the windows/cocotron ide you only get the mouse down and drag events.  Has anyone else experienced this?  Anyone know what is going on here?  

(defclass MOUSE-EVENT-WINDOW (ns:ns-window)
  ((lui-window :accessor lui-window :initarg :lui-window))
  (:metaclass ns:+ns-object))

(objc:defmethod (#/mouseUp: :void) ((Self mouse-event-window) Event)
  (call-next-method event)
  (print "mouseup!"))

(objc:defmethod (#/mouseDown: :void) ((Self mouse-event-window) Event)
  (call-next-method event)
  (print "mousedown!"))

(objc:defmethod (#/mouseDragged: :void) ((Self mouse-event-window) Event)
  (call-next-method event)
  (print "mouse dragged!"))

(defmacro IN-MAIN-THREAD (() &body body)
  (let ((thunk (gensym))
        (done (gensym))
        (result (gensym)))
    `(let ((,done nil)
           (,result nil))
       (flet ((,thunk ()
                (setq ,result (multiple-value-list (progn , at body))
                      ,done t)))
         (gui::execute-in-gui #',thunk)
         (process-wait "Main thread" #'(lambda () ,done))
         (values-list ,result)))))

(defun up-event-test ()
  (ns:with-ns-rect (Frame 50 50 500 500)
  (let ((window (make-instance 'mouse-event-window
                                 ;:lui-window self
                  :with-content-rect Frame
                  :style-mask #$NSTitledWindowMask
                  :backing #$NSBackingStoreBuffered
                  :defer #$YES
                  )))
    (in-main-thread ()         
    (#/orderFront: window nil)))))

(up-event-test)


More information about the Openmcl-devel mailing list