1 ! Copyright (C) 2006, 2008 Slava Pestov
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types arrays assocs cocoa kernel
4 math cocoa.messages cocoa.subclassing cocoa.classes cocoa.views
5 cocoa.application cocoa.pasteboard cocoa.types cocoa.windows
6 sequences ui ui.gadgets ui.gadgets.worlds ui.gestures
7 core-foundation threads combinators math.geometry.rect ;
10 : send-mouse-moved ( view event -- )
11 over >r mouse-location r> window move-hand fire-motion ;
13 : button ( event -- n )
14 #! Cocoa -> Factor UI button mapping
15 -> buttonNumber H{ { 0 1 } { 2 2 } { 1 3 } } at ;
52 : key-code ( event -- string ? )
53 dup -> keyCode key-codes at
54 [ t ] [ -> charactersIgnoringModifiers CF>string f ] ?if ;
56 : event-modifiers ( event -- modifiers )
57 -> modifierFlags modifiers modifier ;
59 : key-event>gesture ( event -- modifiers keycode action? )
60 dup event-modifiers swap key-code ;
62 : send-key-event ( view event quot -- ? )
63 >r key-event>gesture r> call swap window-focus
66 : send-user-input ( view string -- )
67 CF>string swap window-focus user-input ;
69 : interpret-key-event ( view event -- )
70 NSArray swap -> arrayWithObject: -> interpretKeyEvents: ;
72 : send-key-down-event ( view event -- )
73 2dup [ <key-down> ] send-key-event
74 [ interpret-key-event ] [ 2drop ] if ;
76 : send-key-up-event ( view event -- )
77 [ <key-up> ] send-key-event drop ;
79 : mouse-event>gesture ( event -- modifiers button )
80 dup event-modifiers swap button ;
82 : send-button-down$ ( view event -- )
83 [ mouse-event>gesture <button-down> ] 2keep
84 mouse-location rot window send-button-down ;
86 : send-button-up$ ( view event -- )
87 [ mouse-event>gesture <button-up> ] 2keep
88 mouse-location rot window send-button-up ;
90 : send-wheel$ ( view event -- )
92 dup -> deltaX sgn neg over -> deltaY sgn neg 2array -rot
94 r> window send-wheel ;
96 : send-action$ ( view event gesture -- junk )
97 >r drop window r> send-action f ;
99 : add-resize-observer ( observer object -- )
100 >r "updateFactorGadgetSize:"
101 "NSViewFrameDidChangeNotification" <NSString>
104 : string-or-nil? ( NSString -- ? )
105 [ CF>string NSStringPboardType = ] [ t ] if* ;
107 : valid-service? ( gadget send-type return-type -- ? )
108 over string-or-nil? over string-or-nil? and [
109 drop [ gadget-selection? ] [ drop t ] if
114 : NSRect>rect ( NSRect world -- rect )
115 >r dup NSRect-x over NSRect-y r>
116 rect-dim second swap - 2array
117 over NSRect-w rot NSRect-h 2array
120 : rect>NSRect ( rect world -- NSRect )
121 over rect-loc first2 rot rect-dim second swap -
122 rot rect-dim first2 <NSRect> ;
125 { +superclass+ "NSOpenGLView" }
126 { +name+ "FactorView" }
127 { +protocols+ { "NSTextInput" } }
131 { "drawRect:" "void" { "id" "SEL" "id" "NSRect" }
132 [ 3drop window relayout-1 ]
136 { "acceptsFirstMouse:" "bool" { "id" "SEL" "id" }
140 { "mouseEntered:" "void" { "id" "SEL" "id" }
141 [ [ nip send-mouse-moved ] ui-try ]
144 { "mouseExited:" "void" { "id" "SEL" "id" }
145 [ [ 3drop forget-rollover ] ui-try ]
148 { "mouseMoved:" "void" { "id" "SEL" "id" }
149 [ [ nip send-mouse-moved ] ui-try ]
152 { "mouseDragged:" "void" { "id" "SEL" "id" }
153 [ [ nip send-mouse-moved ] ui-try ]
156 { "rightMouseDragged:" "void" { "id" "SEL" "id" }
157 [ [ nip send-mouse-moved ] ui-try ]
160 { "otherMouseDragged:" "void" { "id" "SEL" "id" }
161 [ [ nip send-mouse-moved ] ui-try ]
164 { "mouseDown:" "void" { "id" "SEL" "id" }
165 [ [ nip send-button-down$ ] ui-try ]
168 { "mouseUp:" "void" { "id" "SEL" "id" }
169 [ [ nip send-button-up$ ] ui-try ]
172 { "rightMouseDown:" "void" { "id" "SEL" "id" }
173 [ [ nip send-button-down$ ] ui-try ]
176 { "rightMouseUp:" "void" { "id" "SEL" "id" }
177 [ [ nip send-button-up$ ] ui-try ]
180 { "otherMouseDown:" "void" { "id" "SEL" "id" }
181 [ [ nip send-button-down$ ] ui-try ]
184 { "otherMouseUp:" "void" { "id" "SEL" "id" }
185 [ [ nip send-button-up$ ] ui-try ]
188 { "scrollWheel:" "void" { "id" "SEL" "id" }
189 [ [ nip send-wheel$ ] ui-try ]
192 { "keyDown:" "void" { "id" "SEL" "id" }
193 [ [ nip send-key-down-event ] ui-try ]
196 { "keyUp:" "void" { "id" "SEL" "id" }
197 [ [ nip send-key-up-event ] ui-try ]
200 { "cut:" "id" { "id" "SEL" "id" }
201 [ [ nip T{ cut-action } send-action$ ] ui-try ]
204 { "copy:" "id" { "id" "SEL" "id" }
205 [ [ nip T{ copy-action } send-action$ ] ui-try ]
208 { "paste:" "id" { "id" "SEL" "id" }
209 [ [ nip T{ paste-action } send-action$ ] ui-try ]
212 { "delete:" "id" { "id" "SEL" "id" }
213 [ [ nip T{ delete-action } send-action$ ] ui-try ]
216 { "selectAll:" "id" { "id" "SEL" "id" }
217 [ [ nip T{ select-all-action } send-action$ ] ui-try ]
220 ! Multi-touch gestures: this is undocumented.
221 ! http://cocoadex.com/2008/02/nsevent-modifications-swipe-ro.html
222 { "magnifyWithEvent:" "void" { "id" "SEL" "id" }
226 { 1 [ T{ zoom-in-action } send-action$ ] }
227 { -1 [ T{ zoom-out-action } send-action$ ] }
233 { "swipeWithEvent:" "void" { "id" "SEL" "id" }
237 { 1 [ T{ left-action } send-action$ ] }
238 { -1 [ T{ right-action } send-action$ ] }
242 { 1 [ T{ up-action } send-action$ ] }
243 { -1 [ T{ down-action } send-action$ ] }
252 ! "rotateWithEvent:" "void" { "id" "SEL" "id" }}
254 { "acceptsFirstResponder" "bool" { "id" "SEL" }
259 { "validRequestorForSendType:returnType:" "id" { "id" "SEL" "id" "id" }
261 ! We return either self or nil
262 >r >r over window-focus r> r>
263 valid-service? [ drop ] [ 2drop f ] if
267 { "writeSelectionToPasteboard:types:" "bool" { "id" "SEL" "id" "id" }
269 CF>string-array NSStringPboardType swap member? [
270 >r drop window-focus gadget-selection dup [
271 r> set-pasteboard-string t
281 { "readSelectionFromPasteboard:" "bool" { "id" "SEL" "id" }
283 pasteboard-string dup [
284 >r drop window-focus r> swap user-input t
292 { "insertText:" "void" { "id" "SEL" "id" }
293 [ [ nip send-user-input ] ui-try ]
296 { "hasMarkedText" "bool" { "id" "SEL" }
300 { "markedRange" "NSRange" { "id" "SEL" }
301 [ 2drop 0 0 <NSRange> ]
304 { "selectedRange" "NSRange" { "id" "SEL" }
305 [ 2drop 0 0 <NSRange> ]
308 { "setMarkedText:selectedRange:" "void" { "id" "SEL" "id" "NSRange" }
312 { "unmarkText" "void" { "id" "SEL" }
316 { "validAttributesForMarkedText" "id" { "id" "SEL" }
317 [ 2drop NSArray -> array ]
320 { "attributedSubstringFromRange:" "id" { "id" "SEL" "NSRange" }
324 { "characterIndexForPoint:" "uint" { "id" "SEL" "NSPoint" }
328 { "firstRectForCharacterRange:" "NSRect" { "id" "SEL" "NSRange" }
329 [ 3drop 0 0 0 0 <NSRect> ]
332 { "conversationIdentifier" "long" { "id" "SEL" }
333 [ drop alien-address ]
337 { "updateFactorGadgetSize:" "void" { "id" "SEL" "id" }
340 2drop dup view-dim swap window (>>dim) yield
345 { "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" }
348 SUPER-> initWithFrame:pixelFormat:
349 dup dup add-resize-observer
353 { "dealloc" "void" { "id" "SEL" }
356 dup unregister-window
362 : sync-refresh-to-screen ( GLView -- )
363 -> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 <int>
364 CGLSetParameter drop ;
366 : <FactorView> ( world -- view )
367 FactorView over rect-dim <GLView>
368 [ sync-refresh-to-screen ] keep
369 [ register-window ] keep ;
372 { +superclass+ "NSObject" }
373 { +name+ "FactorWindowDelegate" }
376 { "windowDidMove:" "void" { "id" "SEL" "id" }
379 dup window-content-rect NSRect-x-y 2array
380 swap -> contentView window (>>window-loc)
384 { "windowDidBecomeKey:" "void" { "id" "SEL" "id" }
386 2nip -> object -> contentView window focus-world
390 { "windowDidResignKey:" "void" { "id" "SEL" "id" }
393 2nip -> object -> contentView window unfocus-world
397 { "windowShouldClose:" "bool" { "id" "SEL" "id" }
403 { "windowWillClose:" "void" { "id" "SEL" "id" }
405 2nip -> object -> contentView window ungraft
409 : install-window-delegate ( window -- )
410 FactorWindowDelegate install-delegate ;