basis/ui/backend/cocoa/views/views.factor

   1 ! Copyright (C) 2006, 2010 Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.c-types alien.data alien.strings
   4 arrays assocs cocoa cocoa.application cocoa.classes
   5 cocoa.pasteboard cocoa.runtime cocoa.subclassing cocoa.types
   6 cocoa.views combinators core-foundation.strings core-graphics
   7 core-graphics.types core-text io.encodings.utf8 kernel locals
   8 math math.rectangles namespaces opengl sequences threads
   9 ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures
  10 ui.private ;
  11 IN: ui.backend.cocoa.views
  12
  13 : send-mouse-moved ( view event -- )
  14     [ mouse-location ] [ drop window ] 2bi
  15     [ move-hand fire-motion yield ] [ drop ] if* ;
  16
  17 ! Issue #1453
  18 : button ( event -- n )
  19     ! Cocoa -> Factor UI button mapping
  20     -> buttonNumber {
  21         { 0 [ 1 ] }
  22         { 1 [ 3 ] }
  23         { 2 [ 2 ] }
  24         [ ]
  25     } case ;
  26
  27 CONSTANT: modifiers
  28     {
  29         { S+ 0x20000 }
  30         { C+ 0x40000 }
  31         { A+ 0x100000 }
  32         { M+ 0x80000 }
  33     }
  34
  35 CONSTANT: key-codes
  36     H{
  37         { 71 "CLEAR" }
  38         { 36 "RET" }
  39         { 76 "ENTER" }
  40         { 53 "ESC" }
  41         { 48 "TAB" }
  42         { 51 "BACKSPACE" }
  43         { 115 "HOME" }
  44         { 117 "DELETE" }
  45         { 119 "END" }
  46         { 122 "F1" }
  47         { 120 "F2" }
  48         { 99 "F3" }
  49         { 118 "F4" }
  50         { 96 "F5" }
  51         { 97 "F6" }
  52         { 98 "F7" }
  53         { 100 "F8" }
  54         { 123 "LEFT" }
  55         { 124 "RIGHT" }
  56         { 125 "DOWN" }
  57         { 126 "UP" }
  58         { 116 "PAGE_UP" }
  59         { 121 "PAGE_DOWN" }
  60     }
  61
  62 : key-code ( event -- string ? )
  63     dup -> keyCode key-codes at
  64     [ t ] [ -> charactersIgnoringModifiers CF>string f ] ?if ;
  65
  66 : event-modifiers ( event -- modifiers )
  67     -> modifierFlags modifiers modifier ;
  68
  69 : key-event>gesture ( event -- modifiers keycode action? )
  70     [ event-modifiers ] [ key-code ] bi ;
  71
  72 : send-key-event ( view gesture -- )
  73     swap window [ propagate-key-gesture ] [ drop ] if* ;
  74
  75 : interpret-key-event ( view event -- )
  76     NSArray swap -> arrayWithObject: -> interpretKeyEvents: ;
  77
  78 : send-key-down-event ( view event -- )
  79     [ key-event>gesture <key-down> send-key-event ]
  80     [ interpret-key-event ]
  81     2bi ;
  82
  83 : send-key-up-event ( view event -- )
  84     key-event>gesture <key-up> send-key-event ;
  85
  86 : mouse-event>gesture ( event -- modifiers button )
  87     [ event-modifiers ] [ button ] bi ;
  88
  89 : send-button-down$ ( view event -- )
  90     [ nip mouse-event>gesture <button-down> ]
  91     [ mouse-location ]
  92     [ drop window ]
  93     2tri
  94     [ send-button-down ] [ 2drop ] if* ;
  95
  96 : send-button-up$ ( view event -- )
  97     [ nip mouse-event>gesture <button-up> ]
  98     [ mouse-location ]
  99     [ drop window ]
 100     2tri
 101     [ send-button-up ] [ 2drop ] if* ;
 102
 103 : send-scroll$ ( view event -- )
 104     [ nip [ -> deltaX ] [ -> deltaY ] bi [ neg ] bi@ 2array ]
 105     [ mouse-location ]
 106     [ drop window ]
 107     2tri
 108     [ send-scroll ] [ 2drop ] if* ;
 109
 110 : send-action$ ( view event gesture -- )
 111     [ drop window ] dip over [ send-action ] [ 2drop ] if ;
 112
 113 : add-resize-observer ( observer object -- )
 114     [
 115         "updateFactorGadgetSize:"
 116         "NSViewFrameDidChangeNotification" <NSString>
 117     ] dip add-observer ;
 118
 119 : string-or-nil? ( NSString -- ? )
 120     [ CF>string NSStringPboardType = ] [ t ] if* ;
 121
 122 : valid-service? ( gadget send-type return-type -- ? )
 123     2dup [ string-or-nil? ] [ string-or-nil? ] bi* and
 124     [ drop [ gadget-selection? ] [ drop t ] if ] [ 3drop f ] if ;
 125
 126 : NSRect>rect ( NSRect world -- rect )
 127     [ [ [ CGRect-x ] [ CGRect-y ] bi ] [ dim>> second ] bi* swap - 2array ]
 128     [ drop [ CGRect-w ] [ CGRect-h ] bi 2array ]
 129     2bi <rect> ;
 130
 131 : rect>NSRect ( rect world -- NSRect )
 132     [ [ loc>> first2 ] [ dim>> second ] bi* swap - ]
 133     [ drop dim>> first2 ]
 134     2bi <CGRect> ;
 135
 136 CONSTANT: selector>action H{
 137     { "undo:" undo-action }
 138     { "redo:" redo-action }
 139     { "cut:" cut-action }
 140     { "copy:" copy-action }
 141     { "paste:" paste-action }
 142     { "delete:" delete-action }
 143     { "selectAll:" select-all-action }
 144     { "newDocument:" new-action }
 145     { "openDocument:" open-action }
 146     { "saveDocument:" save-action }
 147     { "saveDocumentAs:" save-as-action }
 148     { "revertDocumentToSaved:" revert-action }
 149 }
 150
 151 : validate-action ( world selector -- ? validated? )
 152     selector>action at
 153     [ swap world-focus parents-handle-gesture? t ] [ drop f f ] if* ;
 154
 155 CLASS: FactorView < NSOpenGLView
 156     COCOA-PROTOCOL: NSTextInput
 157
 158     METHOD: void prepareOpenGL [
 159
 160         self SEL: setWantsBestResolutionOpenGLSurface:
 161         -> respondsToSelector: c-bool> [
 162
 163             self SEL: setWantsBestResolutionOpenGLSurface: 1
 164             void f "objc_msgSend" { id SEL char } alien-invoke
 165
 166             self SEL: backingScaleFactor
 167             double f "objc_msgSend" { id SEL } alien-invoke
 168
 169             dup 1.0 > [
 170                 gl-scale-factor set-global t retina? set-global
 171                 cached-lines get-global clear-assoc
 172             ] [ drop ] if
 173
 174         ] when
 175     ] ;
 176
 177     ! Rendering
 178     METHOD: void drawRect: NSRect rect [ self window [ draw-world ] when* ] ;
 179
 180     ! Events
 181     METHOD: char acceptsFirstMouse: id event [ 0 ] ;
 182
 183     METHOD: void mouseEntered: id event [ self event send-mouse-moved ] ;
 184
 185     METHOD: void mouseExited: id event [ forget-rollover ] ;
 186
 187     METHOD: void mouseMoved: id event [ self event send-mouse-moved ] ;
 188
 189     METHOD: void mouseDragged: id event [ self event send-mouse-moved ] ;
 190
 191     METHOD: void rightMouseDragged: id event [ self event send-mouse-moved ] ;
 192
 193     METHOD: void otherMouseDragged: id event [ self event send-mouse-moved ] ;
 194
 195     METHOD: void mouseDown: id event [ self event send-button-down$ ] ;
 196
 197     METHOD: void mouseUp: id event [ self event send-button-up$ ] ;
 198
 199     METHOD: void rightMouseDown: id event [ self event send-button-down$ ] ;
 200
 201     METHOD: void rightMouseUp: id event [ self event send-button-up$ ] ;
 202
 203     METHOD: void otherMouseDown: id event [ self event send-button-down$ ] ;
 204
 205     METHOD: void otherMouseUp: id event [ self event send-button-up$ ] ;
 206
 207     METHOD: void scrollWheel: id event [ self event send-scroll$ ] ;
 208
 209     METHOD: void keyDown: id event [ self event send-key-down-event ] ;
 210
 211     METHOD: void keyUp: id event [ self event send-key-up-event ] ;
 212
 213     METHOD: char validateUserInterfaceItem: id event
 214     [
 215         self window [
 216             event -> action utf8 alien>string validate-action
 217             [ >c-bool ] [ drop self event SUPER-> validateUserInterfaceItem: ] if
 218         ] [ 0 ] if*
 219     ] ;
 220
 221     METHOD: id undo: id event [ self event undo-action send-action$ f ] ;
 222
 223     METHOD: id redo: id event [ self event redo-action send-action$ f ] ;
 224
 225     METHOD: id cut: id event [ self event cut-action send-action$ f ] ;
 226
 227     METHOD: id copy: id event [ self event copy-action send-action$ f ] ;
 228
 229     METHOD: id paste: id event [ self event paste-action send-action$ f ] ;
 230
 231     METHOD: id delete: id event [ self event delete-action send-action$ f ] ;
 232
 233     METHOD: id selectAll: id event [ self event select-all-action send-action$ f ] ;
 234
 235     METHOD: id newDocument: id event [ self event new-action send-action$ f ] ;
 236
 237     METHOD: id openDocument: id event [ self event open-action send-action$ f ] ;
 238
 239     METHOD: id saveDocument: id event [ self event save-action send-action$ f ] ;
 240
 241     METHOD: id saveDocumentAs: id event [ self event save-as-action send-action$ f ] ;
 242
 243     METHOD: id revertDocumentToSaved: id event [ self event revert-action send-action$ f ] ;
 244
 245     ! Multi-touch gestures
 246     METHOD: void magnifyWithEvent: id event
 247     [
 248         self event
 249         dup -> deltaZ sgn {
 250             {  1 [ zoom-in-action send-action$ ] }
 251             { -1 [ zoom-out-action send-action$ ] }
 252             {  0 [ 2drop ] }
 253         } case
 254     ] ;
 255
 256     METHOD: void swipeWithEvent: id event
 257     [
 258         self event
 259         dup -> deltaX sgn {
 260             {  1 [ left-action send-action$ ] }
 261             { -1 [ right-action send-action$ ] }
 262             {  0
 263                 [
 264                     dup -> deltaY sgn {
 265                         {  1 [ up-action send-action$ ] }
 266                         { -1 [ down-action send-action$ ] }
 267                         {  0 [ 2drop ] }
 268                     } case
 269                 ]
 270             }
 271         } case
 272     ] ;
 273
 274     METHOD: char acceptsFirstResponder [ 1 ] ;
 275
 276     ! Services
 277     METHOD: id validRequestorForSendType: id sendType returnType: id returnType
 278     [
 279         ! We return either self or nil
 280         self window [
 281             world-focus sendType returnType
 282             valid-service? [ self ] [ f ] if
 283         ] [ f ] if*
 284     ] ;
 285
 286     METHOD: char writeSelectionToPasteboard: id pboard types: id types
 287     [
 288         NSStringPboardType types CF>string-array member? [
 289             self window [
 290                 world-focus gadget-selection
 291                 [ pboard set-pasteboard-string 1 ] [ 0 ] if*
 292             ] [ 0 ] if*
 293         ] [ 0 ] if
 294     ] ;
 295
 296     METHOD: char readSelectionFromPasteboard: id pboard
 297     [
 298         self window :> window
 299         window [
 300             pboard pasteboard-string
 301             [ window user-input 1 ] [ 0 ] if*
 302         ] [ 0 ] if
 303     ] ;
 304
 305     ! Text input
 306     METHOD: void insertText: id text
 307     [
 308         self window :> window
 309         window [
 310             text CF>string window user-input
 311         ] when
 312     ] ;
 313
 314     METHOD: char hasMarkedText [ 0 ] ;
 315
 316     METHOD: NSRange markedRange [ 0 0 <NSRange> ] ;
 317
 318     METHOD: NSRange selectedRange [ 0 0 <NSRange> ] ;
 319
 320     METHOD: void setMarkedText: id text selectedRange: NSRange range [ ] ;
 321
 322     METHOD: void unmarkText [ ] ;
 323
 324     METHOD: id validAttributesForMarkedText [ NSArray -> array ] ;
 325
 326     METHOD: id attributedSubstringFromRange: NSRange range [ f ] ;
 327
 328     METHOD: NSUInteger characterIndexForPoint: NSPoint point [ 0 ] ;
 329
 330     METHOD: NSRect firstRectForCharacterRange: NSRange range [ 0 0 0 0 <CGRect> ] ;
 331
 332     METHOD: NSInteger conversationIdentifier [ self alien-address ] ;
 333
 334     ! Initialization
 335     METHOD: void updateFactorGadgetSize: id notification
 336     [
 337         self window :> window
 338         window [
 339             self view-dim window dim<< yield
 340         ] when
 341     ] ;
 342
 343     METHOD: void doCommandBySelector: SEL selector [ ] ;
 344
 345     METHOD: id initWithFrame: NSRect frame pixelFormat: id pixelFormat
 346     [
 347         self frame pixelFormat SUPER-> initWithFrame:pixelFormat:
 348         dup dup add-resize-observer
 349     ] ;
 350
 351     METHOD: char isOpaque [ 0 ] ;
 352
 353     METHOD: void dealloc
 354     [
 355         self remove-observer
 356         self SUPER-> dealloc
 357     ] ;
 358 ;
 359
 360 : sync-refresh-to-screen ( GLView -- )
 361     -> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 int <ref>
 362     CGLSetParameter drop ;
 363
 364 : <FactorView> ( dim pixel-format -- view )
 365     [ FactorView ] 2dip <GLView> [ sync-refresh-to-screen ] keep ;
 366
 367 : save-position ( world window -- )
 368     -> frame CGRect-top-left 2array >>window-loc drop ;
 369
 370 CLASS: FactorWindowDelegate < NSObject
 371
 372     METHOD: void windowDidMove: id notification
 373     [
 374         notification -> object -> contentView window
 375         [ notification -> object save-position ] when*
 376     ] ;
 377
 378     METHOD: void windowDidBecomeKey: id notification
 379     [
 380         notification -> object -> contentView window
 381         [ focus-world ] when*
 382     ] ;
 383
 384     METHOD: void windowDidResignKey: id notification
 385     [
 386         forget-rollover
 387         notification -> object -> contentView :> view
 388         view window :> window
 389         window [
 390             view -> isInFullScreenMode 0 =
 391             [ window unfocus-world ] when
 392         ] when
 393     ] ;
 394
 395     METHOD: char windowShouldClose: id notification [ 1 ] ;
 396
 397     METHOD: void windowWillClose: id notification
 398     [
 399         notification -> object -> contentView
 400         [ window ungraft ] [ unregister-window ] bi
 401     ] ;
 402
 403     METHOD: void windowDidChangeBackingProperties: id notification
 404     [
 405
 406         notification -> object dup SEL: backingScaleFactor
 407         -> respondsToSelector: c-bool> [
 408
 409             SEL: backingScaleFactor
 410             double f "objc_msgSend" { id SEL } alien-invoke
 411
 412             [ [ 1.0 > ] keep f ? gl-scale-factor set-global ]
 413             [ 1.0 > retina? set-global ] bi
 414         ] [ drop ] if
 415     ] ;
 416 ;
 417
 418 : install-window-delegate ( window -- )
 419     FactorWindowDelegate install-delegate ;