extra/ui/cocoa/views/views.factor

   1 ! Copyright (C) 2006, 2007 Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien arrays assocs cocoa kernel math cocoa.messages
   4 cocoa.subclassing cocoa.classes cocoa.views cocoa.application
   5 cocoa.pasteboard cocoa.types cocoa.windows sequences ui
   6 ui.gadgets ui.gadgets.worlds ui.gestures core-foundation ;
   7 IN: ui.cocoa.views
   8
   9 : send-mouse-moved ( view event -- )
  10     over >r mouse-location r> window move-hand fire-motion ;
  11
  12 : button ( event -- n )
  13     #! Cocoa -> Factor UI button mapping
  14     -> buttonNumber H{ { 0 1 } { 2 2 } { 1 3 } } at ;
  15
  16 : modifiers
  17     {
  18         { S+ HEX: 20000 }
  19         { C+ HEX: 40000 }
  20         { A+ HEX: 80000 }
  21         { M+ HEX: 100000 }
  22     } ;
  23
  24 : key-codes
  25     H{
  26         { 71 "CLEAR" }
  27         { 36 "RET" }
  28         { 76 "ENTER" }
  29         { 53 "ESC" }
  30         { 48 "TAB" }
  31         { 51 "BACKSPACE" }
  32         { 115 "HOME" }
  33         { 117 "DELETE" }
  34         { 119 "END" }
  35         { 122 "F1" }
  36         { 120 "F2" }
  37         { 99 "F3" }
  38         { 118 "F4" }
  39         { 96 "F5" }
  40         { 97 "F6" }
  41         { 98 "F7" }
  42         { 100 "F8" }
  43         { 123 "LEFT" }
  44         { 124 "RIGHT" }
  45         { 125 "DOWN" }
  46         { 126 "UP" }
  47         { 116 "PAGE_UP" }
  48         { 121 "PAGE_DOWN" }
  49     } ;
  50
  51 : key-code ( event -- string ? )
  52     dup -> keyCode key-codes at
  53     [ t ] [ -> charactersIgnoringModifiers CF>string f ] ?if ;
  54
  55 : event-modifiers ( event -- modifiers )
  56     -> modifierFlags modifiers modifier ;
  57
  58 : key-event>gesture ( event -- modifiers keycode action? )
  59     dup event-modifiers swap key-code ;
  60
  61 : send-key-event ( view event quot -- ? )
  62     >r key-event>gesture r> call swap window-focus
  63     send-gesture ; inline
  64
  65 : send-user-input ( view string -- )
  66     CF>string swap window-focus user-input ;
  67
  68 : interpret-key-event ( view event -- )
  69     NSArray swap -> arrayWithObject: -> interpretKeyEvents: ;
  70
  71 : send-key-down-event ( view event -- )
  72     2dup [ <key-down> ] send-key-event
  73     [ interpret-key-event ] [ 2drop ] if ;
  74
  75 : send-key-up-event ( view event -- )
  76     [ <key-up> ] send-key-event drop ;
  77
  78 : mouse-event>gesture ( event -- modifiers button )
  79     dup event-modifiers swap button ;
  80
  81 : send-button-down$ ( view event -- )
  82     [ mouse-event>gesture <button-down> ] 2keep
  83     mouse-location rot window send-button-down ;
  84
  85 : send-button-up$ ( view event -- )
  86     [ mouse-event>gesture <button-up> ] 2keep
  87     mouse-location rot window send-button-up ;
  88
  89 : send-wheel$ ( view event -- )
  90     over >r
  91     dup -> deltaX sgn neg over -> deltaY sgn neg 2array -rot
  92     mouse-location
  93     r> window send-wheel ;
  94
  95 : send-action$ ( view event gesture -- junk )
  96     >r drop window r> send-action f ;
  97
  98 : add-resize-observer ( observer object -- )
  99     >r "updateFactorGadgetSize:"
 100     "NSViewFrameDidChangeNotification" <NSString>
 101     r> add-observer ;
 102
 103 : string-or-nil? ( NSString -- ? )
 104     [ CF>string NSStringPboardType = ] [ t ] if* ;
 105
 106 : valid-service? ( gadget send-type return-type -- ? )
 107     over string-or-nil? over string-or-nil? and [
 108         drop [ gadget-selection? ] [ drop t ] if
 109     ] [
 110         3drop f
 111     ] if ;
 112
 113 : NSRect>rect ( NSRect world -- rect )
 114     >r dup NSRect-x over NSRect-y r>
 115     rect-dim second swap - 2array
 116     over NSRect-w rot NSRect-h 2array
 117     <rect> ;
 118
 119 : rect>NSRect ( rect world -- NSRect )
 120     over rect-loc first2 rot rect-dim second swap -
 121     rot rect-dim first2 <NSRect> ;
 122
 123 CLASS: {
 124     { +superclass+ "NSOpenGLView" }
 125     { +name+ "FactorView" }
 126     { +protocols+ { "NSTextInput" } }
 127 }
 128 ! Events
 129 { "acceptsFirstMouse:" "bool" { "id" "SEL" "id" }
 130     [ 3drop 1 ]
 131 }
 132
 133 { "mouseEntered:" "void" { "id" "SEL" "id" }
 134     [ [ nip send-mouse-moved ] ui-try ]
 135 }
 136
 137 { "mouseExited:" "void" { "id" "SEL" "id" }
 138     [ [ 3drop forget-rollover ] ui-try ]
 139 }
 140
 141 { "mouseMoved:" "void" { "id" "SEL" "id" }
 142     [ [ nip send-mouse-moved ] ui-try ]
 143 }
 144
 145 { "mouseDragged:" "void" { "id" "SEL" "id" }
 146     [ [ nip send-mouse-moved ] ui-try ]
 147 }
 148
 149 { "rightMouseDragged:" "void" { "id" "SEL" "id" }
 150     [ [ nip send-mouse-moved ] ui-try ]
 151 }
 152
 153 { "otherMouseDragged:" "void" { "id" "SEL" "id" }
 154     [ [ nip send-mouse-moved ] ui-try ]
 155 }
 156
 157 { "mouseDown:" "void" { "id" "SEL" "id" }
 158     [ [ nip send-button-down$ ] ui-try ]
 159 }
 160
 161 { "mouseUp:" "void" { "id" "SEL" "id" }
 162     [ [ nip send-button-up$ ] ui-try ]
 163 }
 164
 165 { "rightMouseDown:" "void" { "id" "SEL" "id" }
 166     [ [ nip send-button-down$ ] ui-try ]
 167 }
 168
 169 { "rightMouseUp:" "void" { "id" "SEL" "id" }
 170     [ [ nip send-button-up$ ] ui-try ]
 171 }
 172
 173 { "otherMouseDown:" "void" { "id" "SEL" "id" }
 174     [ [ nip send-button-down$ ] ui-try ]
 175 }
 176
 177 { "otherMouseUp:" "void" { "id" "SEL" "id" }
 178     [ [ nip send-button-up$ ] ui-try ]
 179 }
 180
 181 { "scrollWheel:" "void" { "id" "SEL" "id" }
 182     [ [ nip send-wheel$ ] ui-try ]
 183 }
 184
 185 { "keyDown:" "void" { "id" "SEL" "id" }
 186     [ [ nip send-key-down-event ] ui-try ]
 187 }
 188
 189 { "keyUp:" "void" { "id" "SEL" "id" }
 190     [ [ nip send-key-up-event ] ui-try ]
 191 }
 192
 193 { "cut:" "id" { "id" "SEL" "id" }
 194     [ [ nip T{ cut-action } send-action$ ] ui-try ]
 195 }
 196
 197 { "copy:" "id" { "id" "SEL" "id" }
 198     [ [ nip T{ copy-action } send-action$ ] ui-try ]
 199 }
 200
 201 { "paste:" "id" { "id" "SEL" "id" }
 202     [ [ nip T{ paste-action } send-action$ ] ui-try ]
 203 }
 204
 205 { "delete:" "id" { "id" "SEL" "id" }
 206     [ [ nip T{ delete-action } send-action$ ] ui-try ]
 207 }
 208
 209 { "selectAll:" "id" { "id" "SEL" "id" }
 210     [ [ nip T{ select-all-action } send-action$ ] ui-try ]
 211 }
 212
 213 { "acceptsFirstResponder" "bool" { "id" "SEL" }
 214     [ 2drop 1 ]
 215 }
 216
 217 ! Services
 218 { "validRequestorForSendType:returnType:" "id" { "id" "SEL" "id" "id" }
 219     [
 220         ! We return either self or nil
 221         >r >r over window-focus r> r>
 222         valid-service? [ drop ] [ 2drop f ] if
 223     ]
 224 }
 225
 226 { "writeSelectionToPasteboard:types:" "bool" { "id" "SEL" "id" "id" }
 227     [
 228         CF>string-array NSStringPboardType swap member? [
 229             >r drop window-focus gadget-selection dup [
 230                 r> set-pasteboard-string t
 231             ] [
 232                 r> 2drop f
 233             ] if
 234         ] [
 235             3drop f
 236         ] if
 237     ]
 238 }
 239
 240 { "readSelectionFromPasteboard:" "bool" { "id" "SEL" "id" }
 241     [
 242         pasteboard-string dup [
 243             >r drop window-focus r> swap user-input t
 244         ] [
 245             3drop f
 246         ] if
 247     ]
 248 }
 249
 250 ! Text input
 251 { "insertText:" "void" { "id" "SEL" "id" }
 252     [ [ nip send-user-input ] ui-try ]
 253 }
 254
 255 { "hasMarkedText" "bool" { "id" "SEL" }
 256     [ 2drop 0 ]
 257 }
 258
 259 { "markedRange" "NSRange" { "id" "SEL" }
 260     [ 2drop 0 0 <NSRange> ]
 261 }
 262
 263 { "selectedRange" "NSRange" { "id" "SEL" }
 264     [ 2drop 0 0 <NSRange> ]
 265 }
 266
 267 { "setMarkedText:selectedRange:" "void" { "id" "SEL" "id" "NSRange" }
 268     [ 2drop 2drop ]
 269 }
 270
 271 { "unmarkText" "void" { "id" "SEL" }
 272     [ 2drop ]
 273 }
 274
 275 { "validAttributesForMarkedText" "id" { "id" "SEL" }
 276     [ 2drop NSArray -> array ]
 277 }
 278
 279 { "attributedSubstringFromRange:" "id" { "id" "SEL" "NSRange" }
 280     [ 3drop f ]
 281 }
 282
 283 { "characterIndexForPoint:" "uint" { "id" "SEL" "NSPoint" }
 284     [ 3drop 0 ]
 285 }
 286
 287 { "firstRectForCharacterRange:" "NSRect" { "id" "SEL" "NSRange" }
 288     [ 3drop 0 0 0 0 <NSRect> ]
 289 }
 290
 291 { "conversationIdentifier" "long" { "id" "SEL" }
 292     [ drop alien-address ]
 293 }
 294
 295 ! Initialization
 296 { "updateFactorGadgetSize:" "void" { "id" "SEL" "id" }
 297     [
 298         [
 299             2drop dup view-dim swap window set-gadget-dim
 300             ui-step
 301         ] ui-try
 302     ]
 303 }
 304
 305 { "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" }
 306     [
 307         rot drop
 308         SUPER-> initWithFrame:pixelFormat:
 309         dup dup add-resize-observer
 310     ]
 311 }
 312
 313 { "dealloc" "void" { "id" "SEL" }
 314     [
 315         drop
 316         dup window stop-world
 317         dup unregister-window
 318         dup remove-observer
 319         SUPER-> dealloc
 320     ]
 321 } ;
 322
 323 : <FactorView> ( world -- view )
 324     FactorView over rect-dim <GLView> [ register-window ] keep ;
 325
 326 CLASS: {
 327     { +superclass+ "NSObject" }
 328     { +name+ "FactorWindowDelegate" }
 329 }
 330
 331 { "windowDidMove:" "void" { "id" "SEL" "id" }
 332     [
 333         2nip -> object
 334         dup window-content-rect NSRect-x-y 2array
 335         swap -> contentView window set-world-loc
 336     ]
 337 }
 338
 339 { "windowDidBecomeKey:" "void" { "id" "SEL" "id" }
 340     [
 341         2nip -> object -> contentView window focus-world
 342     ]
 343 }
 344
 345 { "windowDidResignKey:" "void" { "id" "SEL" "id" }
 346     [
 347         forget-rollover
 348         2nip -> object -> contentView window unfocus-world
 349     ]
 350 } ;
 351
 352 : install-window-delegate ( window -- )
 353     FactorWindowDelegate install-delegate ;