1 ! Copyright (C) 2006, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors math arrays assocs cocoa cocoa.application
4 command-line kernel memory namespaces cocoa.messages
5 cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
6 cocoa.windows cocoa.classes sequences system
7 ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
8 ui.cocoa.views core-foundation threads math.geometry.rect fry
9 libc generalizations alien.c-types cocoa.views combinators ;
13 TUPLE: window-handle < handle view window ;
14 TUPLE: offscreen-handle < handle context buffer ;
16 C: <window-handle> window-handle
17 C: <offscreen-handle> offscreen-handle
19 SINGLETON: cocoa-ui-backend
21 M: cocoa-ui-backend do-events ( -- )
22 [ NSApp '[ _ do-event ] loop ui-wait ] with-autorelease-pool ;
24 TUPLE: pasteboard handle ;
26 C: <pasteboard> pasteboard
28 M: pasteboard clipboard-contents
29 handle>> pasteboard-string ;
31 M: pasteboard set-clipboard-contents
32 handle>> set-pasteboard-string ;
34 : init-clipboard ( -- )
35 NSPasteboard -> generalPasteboard <pasteboard>
37 <clipboard> selection set-global ;
39 : world>NSRect ( world -- NSRect )
40 [ window-loc>> ] [ dim>> ] bi [ first2 ] bi@ <NSRect> ;
42 : gadget-window ( world -- )
44 2dup swap world>NSRect <ViewWindow>
45 [ [ -> release ] [ install-window-delegate ] bi* ]
46 [ <window-handle> ] 2bi
49 M: cocoa-ui-backend set-title ( string world -- )
50 handle>> window>> swap <NSString> -> setTitle: ;
52 : enter-fullscreen ( world -- )
54 NSScreen -> mainScreen
55 f -> enterFullScreenMode:withOptions:
58 : exit-fullscreen ( world -- )
59 handle>> view>> f -> exitFullScreenModeWithOptions: ;
61 M: cocoa-ui-backend set-fullscreen* ( ? world -- )
62 swap [ enter-fullscreen ] [ exit-fullscreen ] if ;
64 M: cocoa-ui-backend fullscreen* ( world -- ? )
65 handle>> view>> -> isInFullScreenMode zero? not ;
67 : auto-position ( world -- )
68 dup window-loc>> { 0 0 } = [
69 handle>> window>> -> center
74 M: cocoa-ui-backend (open-window) ( world -- )
77 handle>> window>> f -> makeKeyAndOrderFront: ;
79 M: cocoa-ui-backend (close-window) ( handle -- )
82 M: cocoa-ui-backend close-window ( gadget -- )
85 window>> f -> performClose:
89 M: cocoa-ui-backend raise-window* ( world -- )
91 window>> dup f -> orderFront: -> makeKeyWindow
92 NSApp 1 -> activateIgnoringOtherApps:
95 : pixel-size ( pixel-format -- size )
96 0 <int> [ NSOpenGLPFAColorSize 0 -> getValues:forAttribute:forVirtualScreen: ]
99 : offscreen-buffer ( world pixel-format -- alien w h pitch )
100 [ dim>> first2 ] [ pixel-size ] bi*
101 { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ;
103 : gadget-offscreen-context ( world -- context buffer )
104 NSOpenGLPFAOffScreen 1array <PixelFormat>
105 [ nip NSOpenGLContext -> alloc swap f -> initWithFormat:shareContext: dup ]
106 [ offscreen-buffer ] 2bi
107 4 npick [ -> setOffScreen:width:height:rowbytes: ] dip ;
109 M: cocoa-ui-backend (open-offscreen-buffer) ( world -- )
110 dup gadget-offscreen-context <offscreen-handle> >>handle drop ;
112 M: cocoa-ui-backend (close-offscreen-buffer) ( handle -- )
113 [ context>> -> release ]
114 [ buffer>> free ] bi ;
116 GENERIC: (gl-context) ( handle -- context )
117 M: window-handle (gl-context) view>> -> openGLContext ;
118 M: offscreen-handle (gl-context) context>> ;
120 M: handle select-gl-context ( handle -- )
121 (gl-context) -> makeCurrentContext ;
123 M: handle flush-gl-context ( handle -- )
124 (gl-context) -> flushBuffer ;
126 M: offscreen-handle offscreen-pixels ( handle -- alien )
129 M: cocoa-ui-backend beep ( -- )
133 { +superclass+ "NSObject" }
134 { +name+ "FactorApplicationDelegate" }
137 { "applicationDidFinishLaunching:" "void" { "id" "SEL" "id" }
141 : install-app-delegate ( -- )
142 NSApp FactorApplicationDelegate install-delegate ;
144 SYMBOL: cocoa-init-hook
146 cocoa-init-hook global [
147 [ "MiniFactor.nib" load-nib install-app-delegate ] or
150 M: cocoa-ui-backend ui
154 cocoa-init-hook get call
160 cocoa-ui-backend ui-backend set-global
162 [ running.app? "ui" "listener" ? ] main-vocab-hook set-global