1 ! Copyright (C) 2006, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types alien.data arrays assocs classes
4 cocoa cocoa.application cocoa.classes cocoa.messages cocoa.nibs
5 cocoa.pasteboard cocoa.runtime cocoa.subclassing cocoa.types
6 cocoa.views cocoa.windows combinators command-line
7 core-foundation core-foundation.run-loop core-graphics
8 core-graphics.types destructors fry generalizations io.thread
9 kernel libc literals locals math math.bitwise math.rectangles
10 memory namespaces sequences threads ui colors ui.backend
11 ui.backend.cocoa.views ui.clipboards ui.gadgets
12 ui.gadgets.worlds ui.pixel-formats ui.pixel-formats.private
13 ui.private words.symbol ;
16 TUPLE: window-handle view window ;
18 C: <window-handle> window-handle
20 SINGLETON: cocoa-ui-backend
22 CONSTANT: attrib-table H{
23 { double-buffered { $ NSOpenGLPFADoubleBuffer } }
24 { stereo { $ NSOpenGLPFAStereo } }
25 { offscreen { $ NSOpenGLPFAOffScreen } }
26 { fullscreen { $ NSOpenGLPFAFullScreen } }
27 { windowed { $ NSOpenGLPFAWindow } }
28 { accelerated { $ NSOpenGLPFAAccelerated } }
30 $ NSOpenGLPFARendererID
31 $ kCGLRendererGenericFloatID }
33 { backing-store { $ NSOpenGLPFABackingStore } }
34 { multisampled { $ NSOpenGLPFAMultisample } }
35 { supersampled { $ NSOpenGLPFASupersample } }
36 { sample-alpha { $ NSOpenGLPFASampleAlpha } }
37 { color-float { $ NSOpenGLPFAColorFloat } }
38 { color-bits { $ NSOpenGLPFAColorSize } }
39 { alpha-bits { $ NSOpenGLPFAAlphaSize } }
40 { accum-bits { $ NSOpenGLPFAAccumSize } }
41 { depth-bits { $ NSOpenGLPFADepthSize } }
42 { stencil-bits { $ NSOpenGLPFAStencilSize } }
43 { aux-buffers { $ NSOpenGLPFAAuxBuffers } }
44 { sample-buffers { $ NSOpenGLPFASampleBuffers } }
45 { samples { $ NSOpenGLPFASamples } }
48 M: cocoa-ui-backend (make-pixel-format)
49 nip { } attrib-table pixel-format-attributes>int-array
50 NSOpenGLPixelFormat -> alloc swap -> initWithAttributes: ;
52 M: cocoa-ui-backend (free-pixel-format)
55 TUPLE: pasteboard handle ;
57 C: <pasteboard> pasteboard
59 M: pasteboard clipboard-contents
60 handle>> pasteboard-string ;
62 M: pasteboard set-clipboard-contents
63 handle>> set-pasteboard-string ;
65 : init-clipboard ( -- )
66 NSPasteboard -> generalPasteboard <pasteboard>
68 <clipboard> selection set-global ;
70 : world>NSRect ( world -- NSRect )
71 [ 0 0 ] dip dim>> first2 <CGRect> ;
73 : auto-position ( window loc -- )
74 ! Note: if this is the initial window, the length of the windows
75 ! vector should be 1, since (open-window) calls auto-position
76 ! after register-window.
79 worlds get-global length 1 <= [ -> center ] [
80 worlds get-global last second window-loc>>
81 dupd first2 <CGPoint> -> cascadeTopLeftFromPoint:
82 -> setFrameTopLeftPoint:
84 ] [ first2 <CGPoint> -> setFrameTopLeftPoint: ] if ;
86 M: cocoa-ui-backend set-title ( string world -- )
87 handle>> window>> swap <NSString> -> setTitle: ;
89 : enter-fullscreen ( world -- )
91 NSScreen -> mainScreen
92 f -> enterFullScreenMode:withOptions:
95 : exit-fullscreen ( world -- )
97 [ view>> f -> exitFullScreenModeWithOptions: ]
98 [ [ window>> ] [ view>> ] bi -> makeFirstResponder: drop ] bi ;
100 M: cocoa-ui-backend (set-fullscreen) ( world ? -- )
101 [ enter-fullscreen ] [ exit-fullscreen ] if ;
103 M: cocoa-ui-backend (fullscreen?) ( world -- ? )
104 handle>> view>> -> isInFullScreenMode zero? not ;
106 ! XXX: Until someone tests OSX with a tiling window manager,
107 ! dialog-window is the same as normal-title-window
108 CONSTANT: window-control>styleMask
110 { close-button $ NSClosableWindowMask }
111 { minimize-button $ NSMiniaturizableWindowMask }
112 { maximize-button 0 }
113 { resize-handles $ NSResizableWindowMask }
114 { small-title-bar flags{ NSTitledWindowMask NSUtilityWindowMask } }
115 { textured-background $ NSTexturedBackgroundWindowMask }
116 { normal-title-bar $ NSTitledWindowMask }
117 { dialog-window $ NSTitledWindowMask }
120 : world>styleMask ( world -- n )
121 window-controls>> window-control>styleMask symbols>flags ;
123 : make-context-transparent ( view -- )
125 0 int <ref> NSOpenGLCPSurfaceOpacity -> setValues:forParameter: ;
127 M:: cocoa-ui-backend (open-window) ( world -- )
128 world [ [ dim>> ] dip <FactorView> ]
129 with-world-pixel-format :> view
130 world window-controls>> textured-background swap member-eq?
131 [ view make-context-transparent ] when
132 view world [ world>NSRect ] [ world>styleMask ] bi <ViewWindow> :> window
134 world view register-window
135 window world window-loc>> auto-position
136 world window save-position
137 window install-window-delegate
138 view window <window-handle> world handle<<
139 window f -> makeKeyAndOrderFront:
142 M: cocoa-ui-backend (close-window) ( handle -- )
144 view>> dup -> isInFullScreenMode zero?
146 [ f -> exitFullScreenModeWithOptions: ] if
147 ] [ window>> -> release ] bi ;
149 M: cocoa-ui-backend (grab-input) ( handle -- )
150 0 CGAssociateMouseAndMouseCursorPosition drop
151 CGMainDisplayID CGDisplayHideCursor drop
152 window>> -> frame CGRect>rect rect-center
153 NSScreen -> screens 0 -> objectAtIndex: -> frame CGRect-h
154 [ drop first ] [ swap second - ] 2bi <CGPoint>
155 [ GetCurrentButtonState zero? not ] [ yield ] while
156 CGWarpMouseCursorPosition drop ;
158 M: cocoa-ui-backend (ungrab-input) ( handle -- )
160 CGMainDisplayID CGDisplayShowCursor drop
161 1 CGAssociateMouseAndMouseCursorPosition drop ;
163 M: cocoa-ui-backend close-window ( gadget -- )
170 M: cocoa-ui-backend raise-window* ( world -- )
172 window>> dup f -> orderFront: -> makeKeyWindow
173 NSApp 1 -> activateIgnoringOtherApps:
176 M: window-handle select-gl-context ( handle -- )
177 view>> -> openGLContext -> makeCurrentContext ;
179 M: window-handle flush-gl-context ( handle -- )
180 view>> -> openGLContext -> flushBuffer ;
182 M: cocoa-ui-backend beep ( -- )
185 M: cocoa-ui-backend resize-window
186 [ handle>> window>> ] [ first2 ] bi* <CGSize> -> setContentSize: ;
188 M: cocoa-ui-backend system-alert
189 NSAlert -> alloc -> init -> autorelease [
191 [ swap <NSString> -> setInformativeText: ]
192 [ swap <NSString> -> setMessageText: ]
193 [ "OK" <NSString> -> addButtonWithTitle: drop ]
198 <CLASS: FactorApplicationDelegate < NSObject
200 METHOD: void applicationDidUpdate: id obj [ reset-thread-timer ] ;
202 METHOD: char applicationShouldTerminateAfterLastWindowClosed: id app [
203 ui-stop-after-last-window? get 1 0 ?
207 : install-app-delegate ( -- )
208 NSApp FactorApplicationDelegate install-delegate ;
210 SYMBOL: cocoa-startup-hook
213 [ "MiniFactor.nib" load-nib install-app-delegate ]
216 M: cocoa-ui-backend (with-ui)
219 cocoa-startup-hook get call( -- )
227 cocoa-ui-backend ui-backend set-global
229 M: cocoa-ui-backend ui-backend-available?