core/ui/cocoa/view-utils.factor

   1 ! Copyright (C) 2006 Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: objc-classes
   4 DEFER: FactorView
   5
   6 IN: cocoa
   7 USING: arrays gadgets hashtables kernel math namespaces objc
   8 opengl sequences ;
   9
  10 : <GLView> ( class dim -- view )
  11     >r -> alloc 0 0 r> first2 <NSRect>
  12     NSOpenGLView -> defaultPixelFormat
  13     -> initWithFrame:pixelFormat:
  14     dup 1 -> setPostsBoundsChangedNotifications:
  15     dup 1 -> setPostsFrameChangedNotifications: ;
  16
  17 : view-dim ( view -- dim )
  18     -> bounds
  19     dup NSRect-w >fixnum
  20     swap NSRect-h >fixnum 2array ;
  21
  22 : mouse-location ( view event -- loc )
  23     over >r
  24     -> locationInWindow f -> convertPoint:fromView:
  25     dup NSPoint-x swap NSPoint-y
  26     r> -> frame NSRect-h swap - 2array ;
  27
  28 : send-mouse-moved ( view event -- )
  29     over >r mouse-location r> window move-hand fire-motion ;
  30
  31 : button ( event -- n )
  32     #! Cocoa -> Factor UI button mapping
  33     -> buttonNumber H{ { 0 1 } { 2 2 } { 1 3 } } hash ;
  34
  35 : modifiers
  36     {
  37         { S+ HEX: 20000 }
  38         { C+ HEX: 40000 }
  39         { A+ HEX: 80000 }
  40         { M+ HEX: 100000 }
  41     } ;
  42
  43 : key-codes
  44     H{
  45         { 71 "CLEAR" }
  46         { 36 "RETURN" }
  47         { 76 "ENTER" }
  48         { 53 "ESCAPE" }
  49         { 48 "TAB" }
  50         { 51 "BACKSPACE" }
  51         { 115 "HOME" }
  52         { 117 "DELETE" }
  53         { 119 "END" }
  54         { 122 "F1" }
  55         { 120 "F2" }
  56         { 99 "F3" }
  57         { 118 "F4" }
  58         { 96 "F5" }
  59         { 97 "F6" }
  60         { 98 "F7" }
  61         { 100 "F8" }
  62         { 123 "LEFT" }
  63         { 124 "RIGHT" }
  64         { 125 "DOWN" }
  65         { 126 "UP" }
  66         { 116 "PAGE_UP" }
  67         { 121 "PAGE_DOWN" }
  68     } ;
  69
  70 : key-code ( event -- string )
  71     dup -> keyCode key-codes hash
  72     [ ] [ -> charactersIgnoringModifiers CF>string ] ?if ;
  73
  74 : event-modifiers ( event -- modifiers )
  75     -> modifierFlags modifiers modifier ;
  76
  77 : key-event>gesture ( event -- modifiers keycode )
  78     dup event-modifiers swap key-code ;
  79
  80 : send-key-event ( view event quot -- ? )
  81     >r key-event>gesture r> call swap window-focus
  82     send-gesture ; inline
  83
  84 : send-user-input ( view event -- )
  85     -> characters CF>string swap window-focus user-input ;
  86
  87 : send-key-down-event ( view event -- )
  88     2dup [ <key-down> ] send-key-event
  89     [ send-user-input ] [ 2drop ] if ;
  90
  91 : send-key-up-event ( view event -- )
  92     [ <key-up> ] send-key-event drop ;
  93
  94 : mouse-event>gesture ( event -- modifiers button )
  95     dup event-modifiers swap button ;
  96
  97 : send-button-down$ ( view event -- )
  98     [ mouse-event>gesture <button-down> ] 2keep
  99     mouse-location rot window send-button-down ;
 100
 101 : send-button-up$ ( view event -- )
 102     [ mouse-event>gesture <button-up> ] 2keep
 103     mouse-location rot window send-button-up ;
 104
 105 : send-wheel$ ( view event -- )
 106     over >r
 107     dup -> deltaX sgn neg over -> deltaY sgn neg 2array -rot
 108     mouse-location
 109     r> window send-wheel ;
 110
 111 : send-action$ ( view event gesture -- junk )
 112     >r drop window r> send-action f ;
 113
 114 : add-resize-observer ( observer object -- )
 115     >r "updateFactorGadgetSize:"
 116     "NSViewFrameDidChangeNotification" <NSString>
 117     r> add-observer ;
 118
 119 : string-or-nil? ( NSString -- ? )
 120     [ CF>string NSStringPboardType = ] [ t ] if* ;
 121
 122 : valid-service? ( gadget send-type return-type -- ? )
 123     over string-or-nil? over string-or-nil? and [
 124         drop [ gadget-selection? ] [ drop t ] if
 125     ] [
 126         3drop f
 127     ] if ;
 128
 129 "NSOpenGLView" "FactorView" {
 130     ! Events
 131     { "acceptsFirstMouse:" "bool" { "id" "SEL" "id" }
 132         [ 3drop 1 ]
 133     }
 134
 135     { "mouseEntered:" "void" { "id" "SEL" "id" }
 136         [ [ nip send-mouse-moved ] ui-try ]
 137     }
 138
 139     { "mouseExited:" "void" { "id" "SEL" "id" }
 140         [ [ 3drop forget-rollover ] ui-try ]
 141     }
 142
 143     { "mouseMoved:" "void" { "id" "SEL" "id" }
 144         [ [ nip send-mouse-moved ] ui-try ]
 145     }
 146
 147     { "mouseDragged:" "void" { "id" "SEL" "id" }
 148         [ [ nip send-mouse-moved ] ui-try ]
 149     }
 150
 151     { "rightMouseDragged:" "void" { "id" "SEL" "id" }
 152         [ [ nip send-mouse-moved ] ui-try ]
 153     }
 154
 155     { "otherMouseDragged:" "void" { "id" "SEL" "id" }
 156         [ [ nip send-mouse-moved ] ui-try ]
 157     }
 158
 159     { "mouseDown:" "void" { "id" "SEL" "id" }
 160         [ [ nip send-button-down$ ] ui-try ]
 161     }
 162
 163     { "mouseUp:" "void" { "id" "SEL" "id" }
 164         [ [ nip send-button-up$ ] ui-try ]
 165     }
 166
 167     { "rightMouseDown:" "void" { "id" "SEL" "id" }
 168         [ [ nip send-button-down$ ] ui-try ]
 169     }
 170
 171     { "rightMouseUp:" "void" { "id" "SEL" "id" }
 172         [ [ nip send-button-up$ ] ui-try ]
 173     }
 174
 175     { "otherMouseDown:" "void" { "id" "SEL" "id" }
 176         [ [ nip send-button-down$ ] ui-try ]
 177     }
 178
 179     { "otherMouseUp:" "void" { "id" "SEL" "id" }
 180         [ [ nip send-button-up$ ] ui-try ]
 181     }
 182
 183     { "scrollWheel:" "void" { "id" "SEL" "id" }
 184         [ [ nip send-wheel$ ] ui-try ]
 185     }
 186
 187     { "keyDown:" "void" { "id" "SEL" "id" }
 188         [ [ nip send-key-down-event ] ui-try ]
 189     }
 190
 191     { "keyUp:" "void" { "id" "SEL" "id" }
 192         [ [ nip send-key-up-event ] ui-try ]
 193     }
 194
 195     { "cut:" "id" { "id" "SEL" "id" }
 196         [ [ nip T{ cut-action } send-action$ ] ui-try ]
 197     }
 198
 199     { "copy:" "id" { "id" "SEL" "id" }
 200         [ [ nip T{ copy-action } send-action$ ] ui-try ]
 201     }
 202
 203     { "paste:" "id" { "id" "SEL" "id" }
 204         [ [ nip T{ paste-action } send-action$ ] ui-try ]
 205     }
 206
 207     { "delete:" "id" { "id" "SEL" "id" }
 208         [ [ nip T{ delete-action } send-action$ ] ui-try ]
 209     }
 210
 211     { "selectAll:" "id" { "id" "SEL" "id" }
 212         [ [ nip T{ select-all-action } send-action$ ] ui-try ]
 213     }
 214
 215     ! Services
 216     { "validRequestorForSendType:returnType:" "id" { "id" "SEL" "id" "id" }
 217         [
 218             ! We return either self or nil
 219             >r >r over window-focus r> r>
 220             valid-service? [ drop ] [ 2drop f ] if
 221         ]
 222     }
 223
 224     { "writeSelectionToPasteboard:types:" "bool" { "id" "SEL" "id" "id" }
 225         [
 226             CF>string-array NSStringPboardType swap member? [
 227                 >r drop window-focus gadget-selection dup [
 228                     r> set-pasteboard-string t
 229                 ] [
 230                     r> 2drop f
 231                 ] if
 232             ] [
 233                 3drop f
 234             ] if
 235         ]
 236     }
 237
 238     { "readSelectionFromPasteboard:" "bool" { "id" "SEL" "id" }
 239         [
 240             pasteboard-string dup [
 241                 >r drop window-focus r> swap user-input t
 242             ] [
 243                 3drop f
 244             ] if
 245         ]
 246     }
 247
 248     { "updateFactorGadgetSize:" "void" { "id" "SEL" "id" }
 249         [
 250             [
 251                 2drop dup view-dim swap window set-gadget-dim
 252                 ui-step
 253             ] ui-try
 254         ]
 255     }
 256
 257     { "acceptsFirstResponder" "bool" { "id" "SEL" }
 258         [ 2drop 1 ]
 259     }
 260
 261     { "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" }
 262         [
 263             rot drop
 264             SUPER-> initWithFrame:pixelFormat:
 265             dup dup add-resize-observer
 266         ]
 267     }
 268
 269     { "dealloc" "void" { "id" "SEL" }
 270         [
 271             drop
 272             dup window close-world
 273             dup unregister-window
 274             dup remove-observer
 275             SUPER-> dealloc
 276         ]
 277     }
 278 } define-objc-class
 279
 280 : <FactorView> ( world -- view )
 281     FactorView over rect-dim <GLView> [ register-window ] keep ;