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 ;
17 TUPLE: window-handle < handle view window ;
18 TUPLE: offscreen-handle < handle context buffer ;
20 C: <window-handle> window-handle
21 C: <offscreen-handle> offscreen-handle
23 SINGLETON: cocoa-ui-backend
25 PIXEL-FORMAT-ATTRIBUTE-TABLE: NSOpenGLPFA { } H{
26 { double-buffered { $ NSOpenGLPFADoubleBuffer } }
27 { stereo { $ NSOpenGLPFAStereo } }
28 { offscreen { $ NSOpenGLPFAOffScreen } }
29 { fullscreen { $ NSOpenGLPFAFullScreen } }
30 { windowed { $ NSOpenGLPFAWindow } }
31 { accelerated { $ NSOpenGLPFAAccelerated } }
32 { software-rendered { $ NSOpenGLPFARendererID $ 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 >NSOpenGLPFA-int-array
50 NSOpenGLPixelFormat -> alloc swap -> initWithAttributes: ;
52 M: cocoa-ui-backend (free-pixel-format)
55 M: cocoa-ui-backend (pixel-format-attribute)
56 [ handle>> ] [ >NSOpenGLPFA ] bi*
60 { int } [ swap 0 -> getValues:forAttribute:forVirtualScreen: ]
64 TUPLE: pasteboard handle ;
66 C: <pasteboard> pasteboard
68 M: pasteboard clipboard-contents
69 handle>> pasteboard-string ;
71 M: pasteboard set-clipboard-contents
72 handle>> set-pasteboard-string ;
74 : init-clipboard ( -- )
75 NSPasteboard -> generalPasteboard <pasteboard>
77 <clipboard> selection set-global ;
79 : world>NSRect ( world -- NSRect )
80 [ 0 0 ] dip dim>> first2 <CGRect> ;
82 : auto-position ( window loc -- )
83 #! Note: if this is the initial window, the length of the windows
84 #! vector should be 1, since (open-window) calls auto-position
85 #! after register-window.
88 ui-windows get-global length 1 <= [ -> center ] [
89 ui-windows get-global last second window-loc>>
90 dupd first2 <CGPoint> -> cascadeTopLeftFromPoint:
91 -> setFrameTopLeftPoint:
93 ] [ first2 <CGPoint> -> setFrameTopLeftPoint: ] if ;
95 M: cocoa-ui-backend set-title ( string world -- )
96 handle>> window>> swap <NSString> -> setTitle: ;
98 : enter-fullscreen ( world -- )
100 NSScreen -> mainScreen
101 f -> enterFullScreenMode:withOptions:
104 : exit-fullscreen ( world -- )
106 [ view>> f -> exitFullScreenModeWithOptions: ]
107 [ [ window>> ] [ view>> ] bi -> makeFirstResponder: drop ] bi ;
109 M: cocoa-ui-backend (set-fullscreen) ( world ? -- )
110 [ enter-fullscreen ] [ exit-fullscreen ] if ;
112 M: cocoa-ui-backend (fullscreen?) ( world -- ? )
113 handle>> view>> -> isInFullScreenMode zero? not ;
115 ! XXX: Until someone tests OSX with a tiling window manager,
116 ! dialog-window is the same as normal-title-window
117 CONSTANT: window-control>styleMask
119 { close-button $ NSClosableWindowMask }
120 { minimize-button $ NSMiniaturizableWindowMask }
121 { maximize-button 0 }
122 { resize-handles $ NSResizableWindowMask }
123 { small-title-bar $[ NSTitledWindowMask NSUtilityWindowMask bitor ] }
124 { textured-background $ NSTexturedBackgroundWindowMask }
125 { normal-title-bar $ NSTitledWindowMask }
126 { dialog-window $ NSTitledWindowMask }
129 : world>styleMask ( world -- n )
130 window-controls>> window-control>styleMask symbols>flags ;
132 : make-context-transparent ( view -- )
134 0 int <ref> NSOpenGLCPSurfaceOpacity -> setValues:forParameter: ;
136 M:: cocoa-ui-backend (open-window) ( world -- )
137 world [ [ dim>> ] dip <FactorView> ]
138 with-world-pixel-format :> view
139 world window-controls>> textured-background swap member-eq?
140 [ view make-context-transparent ] when
141 view world [ world>NSRect ] [ world>styleMask ] bi <ViewWindow> :> window
143 world view register-window
144 window world window-loc>> auto-position
145 world window save-position
146 window install-window-delegate
147 view window <window-handle> world handle<<
148 window f -> makeKeyAndOrderFront: ;
150 M: cocoa-ui-backend (close-window) ( handle -- )
152 view>> dup -> isInFullScreenMode zero?
154 [ f -> exitFullScreenModeWithOptions: ] if
155 ] [ window>> -> release ] bi ;
157 M: cocoa-ui-backend (grab-input) ( handle -- )
158 0 CGAssociateMouseAndMouseCursorPosition drop
159 CGMainDisplayID CGDisplayHideCursor drop
160 window>> -> frame CGRect>rect rect-center
161 NSScreen -> screens 0 -> objectAtIndex: -> frame CGRect-h
162 [ drop first ] [ swap second - ] 2bi <CGPoint>
163 [ GetCurrentButtonState zero? not ] [ yield ] while
164 CGWarpMouseCursorPosition drop ;
166 M: cocoa-ui-backend (ungrab-input) ( handle -- )
168 CGMainDisplayID CGDisplayShowCursor drop
169 1 CGAssociateMouseAndMouseCursorPosition drop ;
171 M: cocoa-ui-backend close-window ( gadget -- )
178 M: cocoa-ui-backend raise-window* ( world -- )
180 window>> dup f -> orderFront: -> makeKeyWindow
181 NSApp 1 -> activateIgnoringOtherApps:
184 : pixel-size ( pixel-format -- size )
185 color-bits (pixel-format-attribute) -3 shift ;
187 : offscreen-buffer ( world pixel-format -- alien w h pitch )
188 [ dim>> first2 ] [ pixel-size ] bi*
189 { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ;
191 :: gadget-offscreen-context ( world -- context buffer )
194 NSOpenGLContext -> alloc pf handle>> f -> initWithFormat:shareContext:
195 dup world pf offscreen-buffer
196 4 npick [ -> setOffScreen:width:height:rowbytes: ] dip
197 ] with-world-pixel-format ;
199 M: cocoa-ui-backend (open-offscreen-buffer) ( world -- )
200 dup gadget-offscreen-context <offscreen-handle> >>handle drop ;
202 M: cocoa-ui-backend (close-offscreen-buffer) ( handle -- )
203 [ context>> -> release ]
204 [ buffer>> free ] bi ;
206 GENERIC: (gl-context) ( handle -- context )
207 M: window-handle (gl-context) view>> -> openGLContext ;
208 M: offscreen-handle (gl-context) context>> ;
210 M: handle select-gl-context ( handle -- )
211 (gl-context) -> makeCurrentContext ;
213 M: handle flush-gl-context ( handle -- )
214 (gl-context) -> flushBuffer ;
216 M: cocoa-ui-backend offscreen-pixels ( world -- alien w h )
217 [ handle>> buffer>> ] [ dim>> first2 neg ] bi ;
219 M: cocoa-ui-backend beep ( -- )
222 M: cocoa-ui-backend resize-window [ handle>> window>> ] [ first2 ] bi* <CGSize> -> setContentSize: ;
224 M: cocoa-ui-backend system-alert
225 NSAlert -> alloc -> init -> autorelease [
227 [ swap <NSString> -> setInformativeText: ]
228 [ swap <NSString> -> setMessageText: ]
229 [ "OK" <NSString> -> addButtonWithTitle: drop ]
234 CLASS: FactorApplicationDelegate < NSObject
236 METHOD: void applicationDidUpdate: id obj
237 [ reset-thread-timer ]
240 : install-app-delegate ( -- )
241 NSApp FactorApplicationDelegate install-delegate ;
243 SYMBOL: cocoa-startup-hook
246 [ "MiniFactor.nib" load-nib install-app-delegate ]
249 M: cocoa-ui-backend (with-ui)
253 cocoa-startup-hook get call( -- )
262 cocoa-ui-backend ui-backend set-global
264 M: cocoa-ui-backend ui-backend-available?