Ignore:
Timestamp:
Aug 31, 2009, 12:18:17 PM (10 years ago)
Author:
cater
Message:

Extensive reorganisation, with unified handling of modifiers with keys and with mouse. Plenty still to do ...

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/examples/cocoa/easygui/views.lisp

    r12405 r12721  
    3030; ----------------------------------------------------------------------
    3131
    32 (eval-when (:compile-toplevel :execute)
    33   (declaim (optimize (speed 0) (space 0) (compilation-speed 0) (safety 3) (debug 3))))
    34 
    3532(defmacro running-on-this-thread ((&key (waitp t)) &rest body)
    3633;; The purpose of this trivial macro is to mark places where it is thought possible that
     
    4138
    4239(defparameter *screen-flipped* nil
    43 "When NIL, window positions are taken as referring to their bottom right,
     40"When NIL, window positions are taken as referring to their bottom left,
    4441as per Cocoa's native coordinate system.
    4542When non-NIL, window positions are taken to refer to their top left,
     
    131128;;; Such classes include STATIC-TEXT-VIEW ... for now
    132129;;;
     130;;; Some view classes inherit from 'text-coloring-mixin'
     131;;; Such classes include ...
     132;;;
     133;;; Some view classes inherit from 'fonting-mixin'
     134;;; Such classes include ...
     135;;;
     136;;; Some view classes inherit from 'mouse-updownabout-mixin'
     137;;; Such classes include ...
     138;;;
     139;;; Some view classes inherit from 'mouse-tracking-mixin'
     140;;; Such classes include ...
     141
     142
     143
     144;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     145;;; Mixins dealing with text string and numeric equivalents
    133146
    134147(defclass value-mixin () ())
     
    138151(defclass numeric-value-mixin (value-mixin) ())
    139152
    140 (defclass action-view-mixin ()
    141   ((action :initarg :action)
    142    (enabled :accessor dialog-item-enabled-p :initarg :dialog-item-enabled-p :initform t)))
    143 
    144 (defclass decline-menu-mixin () ())
     153(defclass view-text-mixin ()
     154     ((text :initarg :text :initarg :dialog-item-text)))
     155
     156(defclass view-text-via-stringvalue-mixin (view-text-mixin string-value-mixin)
     157     ())
     158
     159(defclass view-text-via-title-mixin (view-text-mixin)
     160     ((text :initarg :title)))
    145161
    146162(macrolet ((def-type-accessor (class lisp-type cocoa-reader cocoa-writer
     
    160176    :new-value-form (coerce new-value 'double-float)))
    161177
    162 (defclass view-text-mixin ()
    163      ((text :initarg :text :initarg :dialog-item-text)))
    164 
    165 (defclass view-text-via-stringvalue-mixin (view-text-mixin string-value-mixin)
    166      ())
    167 
    168 (defclass view-text-via-title-mixin (view-text-mixin)
    169      ((text :initarg :title)))
    170 
    171178(defmethod view-text ((view view-text-via-stringvalue-mixin))
    172179  (string-value-of view))
     
    186193    (setf (view-text view) (slot-value view 'text))))
    187194
     195
     196
     197;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     198;;; Mixins dealing with mouse sensitivity (1)
     199
     200(defclass action-view-mixin ()
     201  ((action :initarg :action)
     202   (enabled :accessor dialog-item-enabled-p :initarg :dialog-item-enabled-p :initform t)))
     203
     204(defclass decline-menu-mixin () ())
     205
     206(defmethod set-dialog-item-enabled-p ((view action-view-mixin) value)
     207  (unless (eq (not value) (not (dialog-item-enabled-p view)))
     208    (setf (dialog-item-enabled-p view) value)
     209    (dcc (#/setEnabled: (cocoa-ref view) (if value #$YES #$NO)))))
     210
     211(defmethod initialize-view :after ((view action-view-mixin))
     212  (when (and (slot-boundp view 'action) (slot-value view 'action))
     213    (setf (action view) (slot-value view 'action)))
     214  (unless (dialog-item-enabled-p view)
     215    (dcc (#/setEnabled: (cocoa-ref view) #$NO))))
     216
     217
     218
     219;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     220;;; Mixins dealing with text properties - font, foreground and background colors, editability
     221
    188222(defclass text-coloring-mixin () ())
    189223
     
    191225
    192226(defclass editable-mixin () ())
     227
     228(defclass background-coloring-mixin ()
     229  ((drawsbackground     :initform t :initarg :draws-background)))
     230
     231(defmethod initialize-view :after ((view background-coloring-mixin))
     232  (dcc (#/setDrawsBackground: (cocoa-ref view) (slot-value view 'drawsbackground)))
     233  (when (and (cocoa-ref view) (slot-boundp view 'background))
     234      (dcc (#/setBackgroundColor: (cocoa-ref view) (slot-value view 'background)))))
    193235
    194236(defmethod editable-p ((view editable-mixin))
     
    199241  (dcc (#/setEditable: (cocoa-ref view) editable-p))
    200242  editable-p)
     243
     244
     245
     246;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     247;;; Mixin dealing with selection: Possibly obsolete?
    201248
    202249(defclass one-selection-mixin () ())
     
    213260               (ns:ns-range-length range)))))
    214261
     262
     263
     264;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     265;;; Mixin for content views: window, box, perhaps others.
     266
    215267(defclass content-view-mixin ()
    216268  ((content-view)
    217269   (flipped :initarg :flipped :initform *screen-flipped*)))
    218 
    219 (defclass contained-view (view)
    220   ((flipped :initarg :flipped)))
    221270
    222271(defmethod initialize-view :after ((view content-view-mixin))
     
    229278            (slot-value containee 'parent) view))))
    230279
     280(defmethod (setf content-view) (new-content-view (view content-view-mixin))
     281  (setf (slot-value view 'content-view) new-content-view)
     282  (dcc (#/setContentView: (cocoa-ref view) (cocoa-ref new-content-view)))
     283  new-content-view)
     284
     285
     286
     287;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     288;;; Mixin for views that can respond to mouse entry, exit, and movement
     289
     290(defclass mouse-tracking-mixin ()
     291  ((mouse-target :reader view-mouse-target :initform nil)
     292   (mouse-enter :accessor view-mouse-enter :initarg :mouse-enter :initform nil)
     293   (mouse-exit :accessor view-mouse-exit :initarg :mouse-exit :initform nil)
     294   (mouse-move :accessor view-mouse-move :initarg :mouse-move :initform nil)))
     295
     296(defclass easygui-mouse-target (ns:ns-object)
     297  ((view :initarg :view :reader mouse-target-view :initform nil))
     298  (:metaclass ns:+ns-object))
     299
     300(defmethod initialize-view :after ((view mouse-tracking-mixin))
     301  (let ((cocoaview (cocoa-ref view)))
     302   (when cocoaview
     303      (let ((target (make-instance 'easygui-mouse-target :view view)))
     304        (setf (slot-value view 'mouse-target) target)
     305        (dcc (#/retain target))
     306        (dcc (#/addTrackingRect:owner:userData:assumeInside:
     307         cocoaview
     308         (dcc (#/bounds cocoaview))
     309         target
     310         ccl:+null-ptr+
     311         #$NO))))))
     312
     313(objc:define-objc-method ((:void :mouse-entered (:id event)) easygui-mouse-target)
     314  (let* ((view (mouse-target-view self))
     315         (fn (view-mouse-enter view)))
     316    (when fn (funcall fn view :event event :allow-other-keys t))))
     317
     318(objc:define-objc-method ((:void :mouse-exited (:id event)) easygui-mouse-target)
     319  (let* ((view (mouse-target-view self))
     320         (fn (view-mouse-exit view)))
     321    (when fn (funcall fn view :event event :allow-other-keys t))))
     322
     323(objc:define-objc-method ((:void :mouse-move (:id event)) easygui-mouse-target)
     324  (let* ((view (mouse-target-view self))
     325         (fn (view-mouse-move view)))
     326    (when fn (funcall fn view :event event :allow-other-keys t))))
     327
     328
     329
     330;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     331;;; Class for the sort of view that is contained by a content view.
     332
     333(defclass contained-view (view)
     334  ((flipped :initarg :flipped)))
     335
    231336(defmethod content-view ((view content-view-mixin))
    232337  (assert (eql (cocoa-ref (slot-value view 'content-view))
    233338               (dcc (#/contentView (cocoa-ref view)))))
    234339  (slot-value view 'content-view))
    235 
    236 (defmethod (setf content-view) (new-content-view (view content-view-mixin))
    237   (setf (slot-value view 'content-view) new-content-view)
    238   (dcc (#/setContentView: (cocoa-ref view) (cocoa-ref new-content-view)))
    239   new-content-view)
    240 
    241 (defmethod set-dialog-item-enabled-p ((view action-view-mixin) value)
    242   (unless (eq (not value) (not (dialog-item-enabled-p view)))
    243     (setf (dialog-item-enabled-p view) value)
    244     (dcc (#/setEnabled: (cocoa-ref view) (if value #$YES #$NO)))))
    245 
    246 (defclass background-coloring-mixin ()
    247   ((drawsbackground     :initform t :initarg :draws-background)))
    248 
    249 (defmethod initialize-view :after ((view background-coloring-mixin))
    250   (dcc (#/setDrawsBackground: (cocoa-ref view) (slot-value view 'drawsbackground)))
    251   (when (and (cocoa-ref view) (slot-boundp view 'background))
    252       (dcc (#/setBackgroundColor: (cocoa-ref view) (slot-value view 'background)))))
    253340
    254341;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
    271358      (font :reader view-font :initarg :font :initarg :view-font :initform nil)
    272359      (specifically :reader view-specifically :initarg :specifically :initform nil)
    273       (mouse-target :reader view-mouse-target :initform nil)
    274360      ;; Next three not yet operative
    275361      (tip :initarg :tip :reader view-tip :initform nil)
    276       (tiptag :initform nil)
    277       (mouse-enter :accessor view-mouse-enter :initarg :mouse-enter :initform nil)
    278       (mouse-exit :accessor view-mouse-exit :initarg :mouse-exit :initform nil)
    279       (mouse-move :accessor view-mouse-move :initarg :mouse-move :initform nil)))
     362      (tiptag :initform nil)))
    280363
    281364(defclass window (content-view-mixin view-text-via-title-mixin view)
     
    295378  (:default-initargs :specifically 'cocoa-contained-view))
    296379
     380;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     381;;;
     382
    297383(defmethod clear-page ((view view))
    298384  (let* ((cview (cocoa-ref view))
     
    306392  (clear-page (content-view window)))
    307393
    308 (defclass static-text-view (view view-text-via-stringvalue-mixin action-view-mixin text-coloring-mixin text-fonting-mixin background-coloring-mixin)
     394;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     395;;;
     396
     397(defclass static-text-view (view view-text-via-stringvalue-mixin action-view-mixin text-coloring-mixin text-fonting-mixin background-coloring-mixin mouse-tracking-mixin)
    309398  ((mousedown           :initform nil :initarg :mouse-down    :accessor static-text-view-mouse-down)
    310399   (mouseup             :initform nil :initarg :mouse-up      :accessor static-text-view-mouse-up)
     
    314403                                ;; XXX: requires NSTextView, but this is an
    315404                                ;; NSTextField:
    316                                 #+not-yet one-selection-mixin)
     405                                #+not-yet one-selection-mixin
     406                                mouse-tracking-mixin)
    317407     ((input-locked-p :initform nil :initarg :input-locked-p
    318408                      :reader text-input-locked-p)))
     
    320410(defclass password-input-view (text-input-view)
    321411     ())
     412
     413;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     414;;;
    322415
    323416(defclass push-button-view (view view-text-via-title-mixin action-view-mixin decline-menu-mixin)
     
    325418                        :reader default-button-p)
    326419      (bezelstyle       :reader bezel-style        :initarg :bezel-style      :initform :rounded)))
     420
     421;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     422;;;
    327423
    328424(defclass form-view (view)
     
    335431     ())
    336432
     433;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     434;;;
     435
    337436(defclass box-view (content-view-mixin view-text-via-title-mixin view) ())
    338437
    339 (defclass drawing-view (view)
     438;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     439;;;
     440
     441(defclass drawing-view (view mouse-tracking-mixin)
    340442     (
    341443      ;; TODO: make this a mixin
     
    347449      (mousedragged        :initform nil :initarg :mouse-dragged :accessor drawing-view-mouse-dragged)
    348450      (draw-fn             :initform nil :initarg :draw-fn :accessor draw-fn)))
     451
     452;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     453;;;
    349454
    350455(defclass slider-view (view numeric-value-mixin action-view-mixin)
     
    396501(defmacro define-tooltip-accessor (cocoa-class)
    397502  `(progn
    398      #|
    399503     (objc:defmethod #/view:stringForToolTip:point:userData:
    400504                     ((view ,cocoa-class)
     
    404508       (declare (ignorable tag point userdata))
    405509       (ccl::%make-nsstring (or (calculate-ns-tooltip view) "")))
    406      |#
    407510     (objc:defmethod #/toolTip ((view ,cocoa-class))
    408511       (ccl::%make-nsstring (or (calculate-ns-tooltip view) "")))))
     
    512615
    513616;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    514 ;;; Targets for mouse-enter, mouse-exit and mouse-moved handling
    515 
    516 (defclass easygui-mouse-target (ns:ns-object)
    517   ((view :initarg :view :reader mouse-target-view :initform nil))
    518   (:metaclass ns:+ns-object))
    519 
    520 (objc:define-objc-method ((:void :mouse-entered (:id event)) easygui-mouse-target)
    521   (let* ((view (mouse-target-view self))
    522          (fn (view-mouse-enter view)))
    523     (when fn (funcall fn view :event event :allow-other-keys t))))
    524 
    525 (objc:define-objc-method ((:void :mouse-exited (:id event)) easygui-mouse-target)
    526   (let* ((view (mouse-target-view self))
    527          (fn (view-mouse-exit view)))
    528     (when fn (funcall fn view :event event :allow-other-keys t))))
    529 
    530 (objc:define-objc-method ((:void :mouse-move (:id event)) easygui-mouse-target)
    531   (let* ((view (mouse-target-view self))
    532          (fn (view-mouse-move view)))
    533     (when fn (funcall fn view :event event :allow-other-keys t))))
    534 
    535 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    536617;;; view initialization:
    537618
     
    545626  "Initializes the view using the class-to-ns-class map both as constraint
    546627on valid values of the :SPECIFICALLY initarg, and as source of default value.
    547 Also attaches contextual menu if there is one, and sets up mouse tracking
    548 rectangle if the view has any non-NIL mouse-enter, mouse-exit or mouse-move."
     628Also attaches contextual menu if there is one."
    549629  (when (slot-boundp view 'ref)
    550630    (return-from initialize-view nil))
     
    581661          (dcc (#/setMenu: cocoaview (slot-value menu 'ns-menu))))
    582662         (t (warn "Ignoring contextmenu value ~s for view ~s" menu view)))))
    583    (when (and cocoaview (slot-value view 'tip))
    584      (setf (slot-value view 'tiptag)
    585            (dcc (#/addToolTipRect:owner:userData: cocoaview (#/bounds cocoaview) cocoaview ccl:+null-ptr+))))
    586    (when (and cocoaview (or (slot-value view 'mouse-enter) (slot-value view 'mouse-exit) (slot-value view 'mouse-move)))
    587       (let ((target (make-instance 'easygui-mouse-target :view view)))
    588         (dcc (#/retain target))
    589         (dcc (#/addTrackingRect:owner:userData:assumeInside:
    590          cocoaview
    591          (dcc (#/bounds cocoaview))
    592          target
    593          ccl:+null-ptr+
    594          #$YES))))))
    595     #| OS X Leopard should allow this but ... it didn't when I said VIEW not COCOAVIEW ...:
    596      (area (make-instance 'ns:ns-tracking-area
    597                     :with-rect (dcc (#/bounds cocoaview))
    598                     :options (logior #$NSTrackingMouseEnteredAndExited
    599                                      #$NSTrackingActiveInKeyWindow
    600                                      #$NSTrackingInVisibleRect)
    601                     :owner cocoaview
    602                     :userInfo nil)))
    603         (dcc (#/addTrackingArea: cocoaview area))))
    604     |#
     663   (when (and cocoaview
     664              (slot-value view 'tip)
     665              (dcc (#/respondsToSelector: cocoaview (\@selector #/bounds))))
     666     (let ((bounds (#/bounds cocoaview)))
     667       (setf (slot-value view 'tiptag)
     668             (dcc (#/addToolTipRect:owner:userData: cocoaview bounds cocoaview ccl:+null-ptr+)))))))
    605669
    606670(defun screen-height nil
     
    675739  (setf (slot-value (cocoa-ref view) 'easygui-view) view))
    676740
    677 (defmethod initialize-view :after ((view action-view-mixin))
    678   (when (and (slot-boundp view 'action) (slot-value view 'action))
    679     (setf (action view) (slot-value view 'action)))
    680   (unless (dialog-item-enabled-p view)
    681     (dcc (#/setEnabled: (cocoa-ref view) #$NO))))
    682 
    683741(defparameter *bezelstyle-alist*
    684742  `((:round                    . #.#$NSRoundedBezelStyle)
     
    933991
    934992(objc:define-objc-method ((:<BOOL> :window-should-close (:id sender)) cocoa-window)
    935   (declare (optimize (safety 0))) ; CCL v1.3 checks a faulty type declaration otherwise
    936993  (declare (ignore sender))  ; The cocoa-window has been set up as its own delegate. Naughty?
    937994  (if (window-may-close (easygui-window-of self)) #$YES #$NO))
     
    9831040(define-useful-mouse-event-handling-routines cocoa-mouseable-text-field)
    9841041
     1042;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     1043;; Around methods for VIEW provide bindings for *modifier-key-pattern* for all kinds of views,
     1044;; allowing for Shift-Key-P and friends.
     1045;; Primary methods do nothing, but may be overridden by user code.
     1046
     1047;(defmethod mouse-down :around ((view view) &key cocoa-event location button click-count delta)
     1048;  (declare (ignorable cocoa-event location button click-count delta))
     1049;  (let ((*cocoa-event* cocoa-event)
     1050;        (*modifier-key-pattern* (dcc (#/modifierFlags cocoa-event))))
     1051;    (call-next-method)))
     1052 
     1053(defmethod mouse-down ((view view) &key cocoa-event location button click-count delta)
     1054  (declare (ignorable view cocoa-event location button click-count delta))
     1055  nil)
     1056 
     1057;(defmethod mouse-up :around ((view view) &key cocoa-event location button click-count delta)
     1058;  (declare (ignorable cocoa-event location button click-count delta))
     1059;  (let ((*cocoa-event* cocoa-event)
     1060;        (*modifier-key-pattern* (dcc (#/modifierFlags cocoa-event))))
     1061;    (call-next-method)))
     1062 
     1063(defmethod mouse-up ((view view) &key cocoa-event location button click-count delta)
     1064  (declare (ignorable view cocoa-event location button click-count delta))
     1065  nil)
     1066
     1067;(defmethod mouse-dragged :around ((view view) &key cocoa-event location button click-count delta)
     1068;  (declare (ignorable cocoa-event location button click-count delta))
     1069;  (let ((*cocoa-event* cocoa-event)
     1070;        (*modifier-key-pattern* (dcc (#/modifierFlags cocoa-event))))
     1071;    (call-next-method)))
     1072 
     1073(defmethod mouse-dragged ((view view) &key cocoa-event location button click-count delta)
     1074  (declare (ignorable view cocoa-event location button click-count delta))
     1075  nil)
     1076 
     1077;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     1078;; Primary methods for DRAWING-VIEW. What now is the point?
     1079
    9851080(defmethod mouse-down ((view drawing-view) &key cocoa-event location button click-count delta)
    986   (let ((mousefn (drawing-view-mouse-down view)) (*cocoa-event* cocoa-event))
     1081  (let ((mousefn (drawing-view-mouse-down view))
     1082        (*cocoa-event* cocoa-event)
     1083        (*modifier-key-pattern* (dcc (#/modifierFlags cocoa-event))))
    9871084    (when mousefn
    9881085      (funcall mousefn view
     
    9951092
    9961093(defmethod mouse-up ((view drawing-view) &key cocoa-event location button click-count delta)
    997   (let ((mousefn (drawing-view-mouse-up view)) (*cocoa-event* cocoa-event))
     1094  (let ((mousefn (drawing-view-mouse-up view))
     1095        (*cocoa-event* cocoa-event)
     1096        (*modifier-key-pattern* (dcc (#/modifierFlags cocoa-event))))
    9981097    (when mousefn
    9991098      (funcall mousefn view
     
    10061105
    10071106(defmethod mouse-dragged ((view drawing-view) &key cocoa-event location button click-count delta)
    1008   (let ((mousefn (drawing-view-mouse-dragged view)) (*cocoa-event* cocoa-event))
     1107  (let ((mousefn (drawing-view-mouse-dragged view))
     1108        (*cocoa-event* cocoa-event)
     1109        (*modifier-key-pattern* (dcc (#/modifierFlags cocoa-event))))
    10091110    (when mousefn
    10101111      (funcall mousefn view
     
    10161117               :delta delta))))
    10171118
     1119;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     1120;; Primary methods for STATIC-TEXT-VIEW. What now is the point?
     1121
    10181122(defmethod mouse-down ((view static-text-view) &key cocoa-event location button click-count delta)
    1019   (let ((mousefn (static-text-view-mouse-down view)) (*cocoa-event* cocoa-event))
     1123  (let ((mousefn (static-text-view-mouse-down view))
     1124        (*cocoa-event* cocoa-event)
     1125        (*modifier-key-pattern* (dcc (#/modifierFlags cocoa-event))))
    10201126    (when mousefn
    10211127      (funcall mousefn view
     
    10281134
    10291135(defmethod mouse-up ((view static-text-view) &key cocoa-event location button click-count delta)
    1030   (let ((mousefn (static-text-view-mouse-up view)) (*cocoa-event* cocoa-event))
     1136  (let ((mousefn (static-text-view-mouse-up view))
     1137        (*cocoa-event* cocoa-event)
     1138        (*modifier-key-pattern* (dcc (#/modifierFlags cocoa-event))))
    10311139    (when mousefn
    10321140      (funcall mousefn view
     
    10391147
    10401148(defmethod mouse-dragged ((view static-text-view) &key cocoa-event location button click-count delta)
    1041   (let ((mousefn (static-text-view-mouse-dragged view)) (*cocoa-event* cocoa-event))
     1149  (let ((mousefn (static-text-view-mouse-dragged view))
     1150        (*cocoa-event* cocoa-event)
     1151        (*modifier-key-pattern* (dcc (#/modifierFlags cocoa-event))))
    10421152    (when mousefn
    10431153      (funcall mousefn view
     
    14091519             (ns-nullstring (ccl::%make-nsstring "")))
    14101520        (flet ((linkup (leaf action) ;; Modelled on code in easygui/action-targets.lisp
    1411                  (let ((target (make-instance 'generic-easygui-target :handler (or action #'(lambda () nil)))))
     1521                 (let ((target (make-instance 'generic-easygui-target :handler (or action #'(lambda () nil)) :shooter leaf)))
    14121522                   (dcc (#/setTarget: leaf target))
    14131523                   (dcc (#/setAction: leaf (\@selector #/activateAction))))))
     
    15001610(defmethod view-key-event-handler ((view window) char)
    15011611  (declare (ignorable char))
    1502   #| (format t "~&Window ~s got ~:[~;Control-~]~:[~;Alt-~]~:[~;Command-~]~:[~;Shift-~]~s~%"
    1503             view (control-key-p) (alt-key-p) (command-key-p) (shift-key-p) char))
    1504   |#
    15051612  nil)
    15061613
    15071614(objc:define-objc-method ((:void :key-down (:id event)) cocoa-window)
    1508   (let ((*cocoa-event* event))
     1615  (let ((*cocoa-event* event)
     1616        (*modifier-key-pattern* (#/modifierFlags event)))
    15091617    (view-key-event-handler
    15101618     (easygui-window-of self)
     
    15121620
    15131621(defun shift-key-p nil
    1514   (and *cocoa-event*
    1515        (not (zerop (logand (dcc (#/modifierFlags *cocoa-event*)) #$NSShiftKeyMask)))))
     1622  (not (zerop (logand *modifier-key-pattern* (key-mask :shift)))))
    15161623
    15171624(defun control-key-p nil
    1518   (and *cocoa-event*
    1519        (not (zerop (logand (dcc (#/modifierFlags *cocoa-event*)) (key-mask :control))))))
     1625  (not (zerop (logand *modifier-key-pattern* (key-mask :control)))))
    15201626
    15211627(defun alt-key-p nil
    1522   (and *cocoa-event*
    1523        (not (zerop (logand (dcc (#/modifierFlags *cocoa-event*)) (key-mask :alt))))))
     1628  (not (zerop (logand *modifier-key-pattern* (key-mask :alt)))))
    15241629
    15251630(defun command-key-p nil
    1526   (and *cocoa-event*
    1527        (not (zerop (logand (dcc (#/modifierFlags *cocoa-event*)) (key-mask :command))))))
     1631  (not (zerop (logand *modifier-key-pattern* (key-mask :command)))))
     1632
     1633(defmacro with-modifier-key-information (parameterless-function)
     1634;; NOT TESTED YET!
     1635"Wraps the function into a context where control-key-p &c will get their current values.
     1636To be used primarily when placing a call to a function in another process."
     1637  (let ((gvar (gensym)))
     1638    `(let ((,gvar *modifier-key-pattern*))
     1639       (function (lambda nil
     1640                   (let ((*modifier-key-pattern* ,gvar))
     1641                     (funcall ,parameterless-function)))))))
    15281642
    15291643(defun view-mouse-position (view)
     
    15311645         (mouselocation (dcc (#/mouseLocationOutsideOfEventStream w)))
    15321646         (cview (if (typep view 'window) (content-view view) view))
    1533          (nspt (dcc (#/convertPoint:fromView: (cocoa-ref cview) mouselocation nil))))
     1647         (nspt (dcc (#/convertPoint:fromView: (cocoa-ref cview) mouselocation NIL))))
    15341648    ;; todo: check point is inside bounds, lest negative coords
    15351649    (point (ns:ns-point-x nspt) (ns:ns-point-y nspt))))
Note: See TracChangeset for help on using the changeset viewer.