]> gitweb.factorcode.org Git - factor.git/blob - basis/ui/backend/cocoa/cocoa.factor
Resolved merge.
[factor.git] / basis / ui / backend / cocoa / cocoa.factor
1 ! Copyright (C) 2006, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types arrays assocs classes cocoa
4 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.rectangles memory
10 namespaces sequences specialized-arrays.int threads ui
11 ui.backend ui.backend.cocoa.views ui.clipboards ui.gadgets
12 ui.gadgets.worlds ui.pixel-formats ui.pixel-formats.private
13 ui.private words.symbol ;
14 IN: ui.backend.cocoa
15
16 TUPLE: handle ;
17 TUPLE: window-handle < handle view window ;
18 TUPLE: offscreen-handle < handle context buffer ;
19
20 C: <window-handle> window-handle
21 C: <offscreen-handle> offscreen-handle
22
23 SINGLETON: cocoa-ui-backend
24
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 } }
46 }
47
48 M: cocoa-ui-backend (make-pixel-format)
49     nip >NSOpenGLPFA-int-array
50     NSOpenGLPixelFormat -> alloc swap -> initWithAttributes: ;
51
52 M: cocoa-ui-backend (free-pixel-format)
53     handle>> -> release ;
54
55 M: cocoa-ui-backend (pixel-format-attribute)
56     [ handle>> ] [ >NSOpenGLPFA ] bi*
57     [ drop f ]
58     [ first 0 <int> [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] keep *int ]
59     if-empty ;
60
61 TUPLE: pasteboard handle ;
62
63 C: <pasteboard> pasteboard
64
65 M: pasteboard clipboard-contents
66     handle>> pasteboard-string ;
67
68 M: pasteboard set-clipboard-contents
69     handle>> set-pasteboard-string ;
70
71 : init-clipboard ( -- )
72     NSPasteboard -> generalPasteboard <pasteboard>
73     clipboard set-global
74     <clipboard> selection set-global ;
75
76 : world>NSRect ( world -- NSRect )
77     [ 0 0 ] dip dim>> first2 <CGRect> ;
78
79 : auto-position ( window loc -- )
80     #! Note: if this is the initial window, the length of the windows
81     #! vector should be 1, since (open-window) calls auto-position
82     #! after register-window.
83     dup { 0 0 } = [
84         drop
85         windows get length 1 <= [ -> center ] [
86             windows get last second window-loc>>
87             dupd first2 <CGPoint> -> cascadeTopLeftFromPoint:
88             -> setFrameTopLeftPoint:
89         ] if
90     ] [ first2 <CGPoint> -> setFrameTopLeftPoint: ] if ;
91
92 M: cocoa-ui-backend set-title ( string world -- )
93     handle>> window>> swap <NSString> -> setTitle: ;
94
95 : enter-fullscreen ( world -- )
96     handle>> view>>
97     NSScreen -> mainScreen
98     f -> enterFullScreenMode:withOptions:
99     drop ;
100
101 : exit-fullscreen ( world -- )
102     handle>>
103     [ view>> f -> exitFullScreenModeWithOptions: ] 
104     [ [ window>> ] [ view>> ] bi -> makeFirstResponder: drop ] bi ;
105
106 M: cocoa-ui-backend (set-fullscreen) ( world ? -- )
107     [ enter-fullscreen ] [ exit-fullscreen ] if ;
108
109 M: cocoa-ui-backend (fullscreen?) ( world -- ? )
110     handle>> view>> -> isInFullScreenMode zero? not ;
111
112 M:: cocoa-ui-backend (open-window) ( world -- )
113     world [ [ dim>> ] dip <FactorView> ]
114     with-world-pixel-format :> view
115     view world world>NSRect <ViewWindow> :> window
116     view -> release
117     world view register-window
118     window world window-loc>> auto-position
119     world window save-position
120     window install-window-delegate
121     view window <window-handle> world (>>handle)
122     window f -> makeKeyAndOrderFront: ;
123
124 M: cocoa-ui-backend (close-window) ( handle -- )
125     [
126         view>> dup -> isInFullScreenMode zero?
127         [ drop ]
128         [ f -> exitFullScreenModeWithOptions: ] if
129     ] [ window>> -> release ] bi ;
130
131 M: cocoa-ui-backend (grab-input) ( handle -- )
132     0 CGAssociateMouseAndMouseCursorPosition drop
133     CGMainDisplayID CGDisplayHideCursor drop
134     window>> -> frame CGRect>rect rect-center
135     NSScreen -> screens 0 -> objectAtIndex: -> frame CGRect-h
136     [ drop first ] [ swap second - ] 2bi <CGPoint>
137     [ GetCurrentButtonState zero? not ] [ yield ] while
138     CGWarpMouseCursorPosition drop ;
139
140 M: cocoa-ui-backend (ungrab-input) ( handle -- )
141     drop
142     CGMainDisplayID CGDisplayShowCursor drop
143     1 CGAssociateMouseAndMouseCursorPosition drop ;
144
145 M: cocoa-ui-backend close-window ( gadget -- )
146     find-world [
147         handle>> [
148             window>> f -> performClose:
149         ] when*
150     ] when* ;
151
152 M: cocoa-ui-backend raise-window* ( world -- )
153     handle>> [
154         window>> dup f -> orderFront: -> makeKeyWindow
155         NSApp 1 -> activateIgnoringOtherApps:
156     ] when* ;
157
158 : pixel-size ( pixel-format -- size )
159     color-bits pixel-format-attribute -3 shift ;
160
161 : offscreen-buffer ( world pixel-format -- alien w h pitch )
162     [ dim>> first2 ] [ pixel-size ] bi*
163     { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ;
164
165 :: gadget-offscreen-context ( world -- context buffer )
166     world [
167         nip :> pf
168         NSOpenGLContext -> alloc pf handle>> f -> initWithFormat:shareContext:
169         dup world pf offscreen-buffer
170         4 npick [ -> setOffScreen:width:height:rowbytes: ] dip
171     ] with-world-pixel-format ;
172
173 M: cocoa-ui-backend (open-offscreen-buffer) ( world -- )
174     dup gadget-offscreen-context <offscreen-handle> >>handle drop ;
175
176 M: cocoa-ui-backend (close-offscreen-buffer) ( handle -- )
177     [ context>> -> release ]
178     [ buffer>> free ] bi ;
179
180 GENERIC: (gl-context) ( handle -- context )
181 M: window-handle (gl-context) view>> -> openGLContext ;
182 M: offscreen-handle (gl-context) context>> ;
183
184 M: handle select-gl-context ( handle -- )
185     (gl-context) -> makeCurrentContext ;
186
187 M: handle flush-gl-context ( handle -- )
188     (gl-context) -> flushBuffer ;
189
190 M: cocoa-ui-backend offscreen-pixels ( world -- alien w h )
191     [ handle>> buffer>> ] [ dim>> first2 neg ] bi ;
192
193 M: cocoa-ui-backend beep ( -- )
194     NSBeep ;
195
196 CLASS: {
197     { +superclass+ "NSObject" }
198     { +name+ "FactorApplicationDelegate" }
199 }
200
201 {  "applicationDidUpdate:" "void" { "id" "SEL" "id" }
202     [ 3drop reset-run-loop ]
203 } ;
204
205 : install-app-delegate ( -- )
206     NSApp FactorApplicationDelegate install-delegate ;
207
208 SYMBOL: cocoa-init-hook
209
210 cocoa-init-hook [
211     [ "MiniFactor.nib" load-nib install-app-delegate ]
212 ] initialize
213
214 M: cocoa-ui-backend (with-ui)
215     "UI" assert.app [
216         [
217             init-clipboard
218             cocoa-init-hook get call( -- )
219             start-ui
220             f io-thread-running? set-global
221             init-thread-timer
222             reset-run-loop
223             NSApp -> run
224         ] ui-running
225     ] with-cocoa ;
226
227 cocoa-ui-backend ui-backend set-global
228
229 [ running.app? "ui.tools" "listener" ? ] main-vocab-hook set-global