Changeset 6167


Ignore:
Timestamp:
Apr 8, 2007, 1:40:11 AM (12 years ago)
Author:
gb
Message:

Convert to the new order.
Try to isolate CGFLOAT issues by making the "deltax" and "deltay"
variables SINGLE-FLOATS, which is what the supporting GL code
seems to expect.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/objc-gf/ccl/examples/rubix/rubix.lisp

    r5914 r6167  
    1818  (:metaclass ns:+ns-object))
    1919
    20 (ccl::define-objc-method ((:void prepare-opengl) rubix-opengl-view)
     20(objc:defmethod (#/prepareOpenGL :void) ((self rubix-opengl-view))
    2121  (declare (special *the-origin* *y-axis*))
    2222  (declare (ignore a-rect))
     
    5757  (#_glFlush))
    5858
    59 (ccl::define-objc-method ((:void :draw-rect (:<NSR>ect a-rect)) rubix-opengl-view)
     59(objc:defmethod (#/drawRect: :void) ((self rubix-opengl-view) (a-rect :ns-rect))
    6060  (declare (ignorable a-rect))
    6161  ;; drawing callback
     
    6666;; want to be able to send keystrokes to the rubix cube
    6767#+ignore
    68 (ccl::define-objc-method ((:<BOOL> accepts-first-responder) rubix-opengl-view)
    69   #$YES)
     68(objc:defmethod (#/acceptsFirstResponder :<BOOL>) ((self rubix-opengl-view))
     69  t)
    7070
    7171;; want to be able to click and start dragging (without moving the window)
    72 (ccl::define-objc-method ((:<BOOL> accepts-first-mouse) rubix-opengl-view)
    73   #$YES)
     72(objc:defmethod (#/acceptsFirstMouse: :<BOOL>) ((self rubix-opengl-view)
     73                                                event)
     74  (declare (ignore event))
     75  t)
     76
    7477
    7578(defparameter *rubix-face-snap* 8.0) ; degrees
    7679
    77 (ccl::define-objc-method ((:void :mouse-down the-event) rubix-opengl-view)
     80(objc:defmethod (#/mouseDown: :void) ((self rubix-opengl-view) the-event)
    7881  ;; this makes dragging spin the cube
    79   (cond ((zerop (logand #$NSControlKeyMask (ccl::send the-event 'modifier-flags))) ; not ctrl-click
     82  (cond ((zerop (logand #$NSControlKeyMask (#/modifierFlags the-event))) ; not ctrl-click
    8083         (let ((dragging-p t))
    81            (rlet ((last-loc :<NSP>oint))
    82                  (ccl::send/stret last-loc the-event 'location-in-window)
    83                  (loop while dragging-p do
    84                        (let ((the-event (ccl::send (ccl::send self 'window)
    85                                                    :next-event-matching-mask
    86                                                    (logior #$NSLeftMouseUpMask
    87                                                            #$NSLeftMouseDraggedMask))))
    88                          (rlet ((mouse-loc :<NSP>oint))
    89                                (ccl::send/stret mouse-loc the-event 'location-in-window)
    90                                (cond ((eq #$NSLeftMouseDragged (ccl::send (the ns:ns-event the-event) 'type))
    91                                       (let ((deltax (- (pref mouse-loc :<NSP>oint.x)
    92                                                        (pref last-loc :<NSP>oint.x)))
    93                                             (deltay (- (pref last-loc :<NSP>oint.y)
    94                                                        (pref mouse-loc :<NSP>oint.y)))
    95                                             (vert-rot-axis (cross *y-axis* *camera-pos*)))
    96                                         (setf (pref last-loc :<NSP>oint.x) (pref mouse-loc :<NSP>oint.x)
    97                                               (pref last-loc :<NSP>oint.y) (pref mouse-loc :<NSP>oint.y))
    98                                         (rotate-relative *cube*
    99                                                          (mulquats (axis-angle->quat vert-rot-axis deltay)
    100                                                                    (axis-angle->quat *y-axis* deltax))))
    101                                       (ccl::send self :set-needs-display #$YES))
    102                                      (t
    103                                       (setf dragging-p nil))))))
    104                  (ccl::send self :set-needs-display #$YES))))
    105         (t ;; ctrl-click, do what right-click does... note that once
    106            ;; ctrl-click is done dragging will not require ctrl be held down
     84           (let ((last-loc (#/locationInWindow the-event)))
     85             (loop while dragging-p do
     86                   (let ((the-event (#/nextEventMatchingMask:
     87                                     (#/window self)
     88                                     (logior #$NSLeftMouseUpMask
     89                                             #$NSLeftMouseDraggedMask))))
     90                     (let ((mouse-loc (#/locationInWindow the-event)))
     91                       (cond ((eq #$NSLeftMouseDragged (#/type the-event))
     92                              (let ((deltax (float
     93                                             (- (pref mouse-loc :<NSP>oint.x)
     94                                                (pref last-loc :<NSP>oint.x))
     95                                             0.0f0))
     96                                    (deltay (float
     97                                             (- (pref last-loc :<NSP>oint.y)
     98                                                (pref mouse-loc :<NSP>oint.y))
     99                                             0.0f0))
     100                                    (vert-rot-axis (cross *y-axis* *camera-pos*)))
     101                                (setf (pref last-loc :<NSP>oint.x) (pref mouse-loc :<NSP>oint.x)
     102                                      (pref last-loc :<NSP>oint.y) (pref mouse-loc :<NSP>oint.y))
     103                                (rotate-relative *cube*
     104                                                 (mulquats (axis-angle->quat vert-rot-axis deltay)
     105                                                           (axis-angle->quat *y-axis* deltax))))
     106                              (#/setNeedsDisplay: self t))
     107                             (t
     108                              (setf dragging-p nil))))))
     109             (#/setNeedsDisplay: self t))))
     110        (t;; ctrl-click, do what right-click does... note that once
     111         ;; ctrl-click is done dragging will not require ctrl be held down
    107112
    108113         ;; NOTE THE GRATUITOUS CUT-AND-PASTE, debug the right-mouse-down
    109114         ;; version preferentially and update this one with fixes as needed
    110          (rlet ((first-loc :<NSP>oint)
    111                 (pick-loc :<NSP>oint))
    112                (ccl::send/stret first-loc the-event 'location-in-window)
    113                (ccl::send/stret pick-loc self :convert-point first-loc :from-view nil)
    114                (let ((dragging-p t)
    115                      (reference-snap 0))
    116                  (setf (turning-face *cube*) (render-for-selection
    117                                               *cube*
    118                                               (opengl:unproject (pref pick-loc :<NSP>oint.x)
    119                                                                 (pref pick-loc :<NSP>oint.y)))
    120                        (face-turning-p *cube*) (when (numberp (turning-face *cube*)) t)
    121                        (face-theta *cube*) 0.0)
    122                  (loop while (and dragging-p (face-turning-p *cube*)) do
    123                        (let ((the-event (ccl::send (ccl::send self 'window)
    124                                                    :next-event-matching-mask
    125                                                    (logior #$NSLeftMouseUpMask
    126                                                            #$NSLeftMouseDraggedMask))))
    127                          (rlet ((mouse-loc :<NSP>oint))
    128                                (ccl::send/stret mouse-loc the-event 'location-in-window)
    129                                (cond ((eq #$NSLeftMouseDragged (ccl::send (the ns:ns-event the-event) 'type))
    130                                       (let ((deltax (- (pref mouse-loc :<NSP>oint.x)
    131                                                        (pref first-loc :<NSP>oint.x))))
    132                                         (multiple-value-bind (snap-to snap-dist) (round deltax 90.0)
    133                                                              (cond ((>= *rubix-face-snap* (abs snap-dist)) ; snap
    134                                                                     ;; update cube structure
    135                                                                     (let ((rotations (- snap-to reference-snap)))
    136                                                                       (cond ((zerop rotations) nil)
    137                                                                             ((< 0 rotations)
    138                                                                              (dotimes (i rotations)
    139                                                                                (turnfaceclockwise *cube* (turning-face *cube*)))
    140                                                                              (setf reference-snap snap-to))
    141                                                                             ((> 0 rotations)
    142                                                                              (dotimes (i (abs rotations))
    143                                                                                (turnfacecounterclockwise *cube* (turning-face *cube*)))
    144                                                                              (setf reference-snap snap-to))))
    145                                                                     ;; determine where face will be drawn
    146                                                                     (setf (face-theta *cube*) 0.0))
    147                                                                    (t ; no snap
    148                                                                     (setf (face-theta *cube*) (- deltax (* 90.0 reference-snap))))
    149                                                                    )))
    150                                       (ccl::send self :set-needs-display #$YES))
    151                                      (t
    152                                       (setf (face-turning-p *cube*) nil
    153                                             (turning-face *cube*) nil
    154                                             (face-theta *cube*) nil
    155                                             dragging-p nil))))))
    156                  (ccl::send self :set-needs-display #$YES)))
     115         (let* ((first-loc (#/locationInWindow the-event))
     116                (pick-loc (#/convertPoint:fromView: self first-loc +null-ptr+)))
     117           (let ((dragging-p t)
     118                 (reference-snap 0))
     119             (setf (turning-face *cube*) (render-for-selection
     120                                          *cube*
     121                                          (opengl:unproject (pref pick-loc :<NSP>oint.x)
     122                                                            (pref pick-loc :<NSP>oint.y)))
     123                   (face-turning-p *cube*) (when (numberp (turning-face *cube*)) t)
     124                   (face-theta *cube*) 0.0)
     125             (loop while (and dragging-p (face-turning-p *cube*)) do
     126                   (let ((the-event (#/nextEventMatchingMask:
     127                                               (#/window self)
     128                                               (logior #$NSLeftMouseUpMask
     129                                                       #$NSLeftMouseDraggedMask))))
     130                     (let ((mouse-loc (#/locationInWindow the-event)))
     131                       (cond ((eq #$NSLeftMouseDragged (#/type the-event))
     132                              (let ((deltax (float
     133                                             (- (ns:ns-point-x mouse-loc)
     134                                                (ns:ns-point-x first-loc))
     135                                             0.0f0)))
     136                                (multiple-value-bind (snap-to snap-dist) (round deltax 90.0)
     137                                  (cond ((>= *rubix-face-snap* (abs snap-dist)) ; snap
     138                                         ;; update cube structure
     139                                         (let ((rotations (- snap-to reference-snap)))
     140                                           (cond ((zerop rotations) nil)
     141                                                 ((< 0 rotations)
     142                                                  (dotimes (i rotations)
     143                                                    (turnfaceclockwise *cube* (turning-face *cube*)))
     144                                                  (setf reference-snap snap-to))
     145                                                 ((> 0 rotations)
     146                                                  (dotimes (i (abs rotations))
     147                                                    (turnfacecounterclockwise *cube* (turning-face *cube*)))
     148                                                  (setf reference-snap snap-to))))
     149                                         ;; determine where face will be drawn
     150                                         (setf (face-theta *cube*) 0.0))
     151                                        (t ; no snap
     152                                         (setf (face-theta *cube*) (- deltax (* 90.0 reference-snap))))
     153                                        )))
     154                              (#/setNeedsDisplay: self t))
     155                             (t
     156                              (setf (face-turning-p *cube*) nil
     157                                    (turning-face *cube*) nil
     158                                    (face-theta *cube*) nil
     159                                    dragging-p nil))))))
     160             (#/setNeedsDisplay: self t)))
    157161         )))
    158162
    159 (ccl::define-objc-method ((:void :right-mouse-down the-event) rubix-opengl-view)
     163(objc:defmethod (#/rightMouseDown: :void) ((self rubix-opengl-view) the-event)
    160164  ;; this makes dragging left/right turn a face counterclockwise/clockwise
    161165  ;; ... clicked-on face determines face turned
     
    163167  ;; ... with the snap updating the data structure
    164168  ;; ... releasing the mouse clears rotation angle (face will snap to last position)
    165   (rlet ((first-loc :<NSP>oint)
    166          (pick-loc :<NSP>oint))
    167     (ccl::send/stret first-loc the-event 'location-in-window)
    168     (ccl::send/stret pick-loc self :convert-point first-loc :from-view nil)
     169  (let* ((first-loc (#/locationInWindow the-event))
     170         (pick-loc (#/convertPoint:fromView: self first-loc +null-ptr+)))
    169171    (let ((dragging-p t)
    170172          (reference-snap 0))
    171173      (setf (turning-face *cube*) (render-for-selection
    172                                 *cube*
    173                                 (opengl:unproject (pref pick-loc :<NSP>oint.x)
    174                                                    (pref pick-loc :<NSP>oint.y)))
     174                                  *cube*
     175                                  (opengl:unproject (pref pick-loc :<NSP>oint.x)
     176                                                     (pref pick-loc :<NSP>oint.y)))
    175177            (face-turning-p *cube*) (when (numberp (turning-face *cube*)) t)
    176178            (face-theta *cube*) 0.0)
    177179      (loop while (and dragging-p (face-turning-p *cube*)) do
    178             (let ((the-event (ccl::send (ccl::send self 'window)
    179                                         :next-event-matching-mask
    180                                         (logior #$NSRightMouseUpMask
    181                                                 #$NSRightMouseDraggedMask))))
    182               (rlet ((mouse-loc :<NSP>oint))
    183                 (ccl::send/stret mouse-loc the-event 'location-in-window)
    184                 (cond ((eq #$NSRightMouseDragged (ccl::send (the ns:ns-event the-event) 'type))
    185                        (let ((deltax (- (pref mouse-loc :<NSP>oint.x)
    186                                         (pref first-loc :<NSP>oint.x))))
     180            (let ((the-event (#/nextEventMatchingMask:
     181                              (#/window self)
     182                              (logior #$NSRightMouseUpMask
     183                                      #$NSRightMouseDraggedMask))))
     184              (let ((mouse-loc (#/locationInWindow the-event)))
     185                (cond ((eq #$NSRightMouseDragged (#/type the-event))
     186                       (let ((deltax (float
     187                                      (- (pref mouse-loc :<NSP>oint.x)
     188                                         (pref first-loc :<NSP>oint.x))
     189                                      0.0f0)))
    187190                         (multiple-value-bind (snap-to snap-dist) (round deltax 90.0)
    188191                           (cond ((>= *rubix-face-snap* (abs snap-dist)) ; snap
     
    200203                                  ;; determine where face will be drawn
    201204                                  (setf (face-theta *cube*) 0.0))
    202                                  (t ; no snap
     205                                 (t     ; no snap
    203206                                  (setf (face-theta *cube*) (- deltax (* 90.0 reference-snap))))
    204207                                 )))
    205                        (ccl::send self :set-needs-display #$YES))
     208                       (#/setNeedsDisplay: self t))
    206209                      (t
    207210                       (setf (face-turning-p *cube*) nil
     
    209212                             (face-theta *cube*) nil
    210213                             dragging-p nil))))))
    211       (ccl::send self :set-needs-display #$YES))))
     214      (#/setNeedsDisplay: self t))))
    212215
    213216(defclass rubix-window (ns:ns-window)
     
    223226                                   :width 250
    224227                                   :expandable nil))
    225          (w-content-view (ccl::send w 'content-view)))
    226     ;; Q: why slet here?
    227     (ccl::slet ((w-frame (ccl::send w-content-view 'frame)))
    228       (ccl::slet ((glview-rect (ccl::ns-make-rect
    229                                 (float *aluminum-margin* ccl::+cgfloat-zero+)
    230                                 (float *aluminum-margin* ccl::+cgfloat-zero+)
    231                                 (- (pref w-frame :<NSR>ect.size.width)
    232                                    (* 2 *aluminum-margin*))
    233                                 (- (pref w-frame :<NSR>ect.size.height)
    234                                    *aluminum-margin*))))
     228         (w-content-view (#/contentView w)))
     229    (let ((w-frame (#/frame w-content-view)))
     230      (ns:with-ns-rect (glview-rect *aluminum-margin*
     231                                    *aluminum-margin*
     232                                    (- (pref w-frame :<NSR>ect.size.width)
     233                                       (* 2 *aluminum-margin*))
     234                                    (- (pref w-frame :<NSR>ect.size.height)
     235                                       *aluminum-margin*))
    235236        ;; Q: why make-objc-instance here?
    236         (let ((glview (ccl::send (ccl::send (ccl::@class rubix-opengl-view) 'alloc)
    237                             :init-with-frame glview-rect
     237        (let ((glview (make-instance 'rubix-opengl-view
     238                            :with-frame glview-rect
    238239                            :pixel-format #+ignore
    239                                           (ccl::send (ccl::@class ns-opengl-view)
    240                                                      'default-pixel-format)
     240                                          (#/defaultPixelFormat nsLns-opengl-view)
    241241                                          (opengl:new-pixel-format ;#$NSOpenGLPFADoubleBuffer
    242242                                                                   #$NSOpenGLPFAAccelerated
    243243                                                                   #$NSOpenGLPFAColorSize 32
    244244                                                                   #$NSOpenGLPFADepthSize 32))))
    245           (ccl::send w-content-view :add-subview glview)
     245          (#/addSubview: w-content-view glview)
    246246          w)))))
Note: See TracChangeset for help on using the changeset viewer.