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