2008-03-19 15:25:53 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2006, 2008 Slava Pestov.
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-10 21:32:17 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: accessors math arrays cocoa cocoa.application
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								command-line kernel memory namespaces cocoa.messages
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								cocoa.windows cocoa.classes cocoa.application sequences system
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-11 21:31:15 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								ui.cocoa.views core-foundation threads math.geometry.rect ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: ui.cocoa
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-19 15:25:53 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: handle view window ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								C: <handle> handle
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-02 20:44:01 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								SINGLETON: cocoa-ui-backend
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-08 17:58:13 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cocoa-ui-backend do-events ( -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-08 18:04:14 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-18 20:22:59 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [ NSApp [ do-event ] curry loop ui-wait ] ui-try
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-08 18:04:14 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] with-autorelease-pool ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: pasteboard handle ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								C: <pasteboard> pasteboard
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: pasteboard clipboard-contents
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 19:57:12 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    handle>> pasteboard-string ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: pasteboard set-clipboard-contents
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 19:57:12 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    handle>> set-pasteboard-string ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: init-clipboard ( -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    NSPasteboard -> generalPasteboard <pasteboard>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    clipboard set-global
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <clipboard> selection set-global ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: world>NSRect ( world -- NSRect )
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-10 21:32:17 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup window-loc>> first2 rot rect-dim first2 <NSRect> ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: gadget-window ( world -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        dup <FactorView>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        dup rot world>NSRect <ViewWindow>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        dup install-window-delegate
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        over -> release
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-19 15:25:53 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        <handle>
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 20:02:44 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ] keep (>>handle) ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cocoa-ui-backend set-title ( string world -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 20:02:44 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    handle>> window>> swap <NSString> -> setTitle: ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-09 03:17:24 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: enter-fullscreen ( world -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 20:02:44 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    handle>> view>>
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-19 15:25:53 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    NSScreen -> mainScreen
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    f -> enterFullScreenMode:withOptions:
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    drop ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-09 03:17:24 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: exit-fullscreen ( world -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 20:02:44 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    handle>> view>> f -> exitFullScreenModeWithOptions: ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-09 03:17:24 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-11 02:53:20 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cocoa-ui-backend set-fullscreen* ( ? world -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-09 03:17:24 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    swap [ enter-fullscreen ] [ exit-fullscreen ] if ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-11 02:53:20 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cocoa-ui-backend fullscreen* ( world -- ? )
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 20:02:44 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    handle>> view>> -> isInFullScreenMode zero? not ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-09 03:17:24 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: auto-position ( world -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-10 21:32:17 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup window-loc>> { 0 0 } = [
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 20:02:44 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        handle>> window>> -> center
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        drop
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] if ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-24 15:41:27 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cocoa-ui-backend (open-window) ( world -- )
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup gadget-window
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup auto-position
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 20:02:44 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    handle>> window>> f -> makeKeyAndOrderFront: ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-24 15:41:27 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cocoa-ui-backend (close-window) ( handle -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 19:57:12 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    window>> -> release ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-24 15:41:27 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cocoa-ui-backend close-window ( gadget -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    find-world [
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 20:02:44 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        handle>> [
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 19:57:12 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								            window>> f -> performClose:
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-19 15:25:53 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ] when*
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-24 15:41:27 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] when* ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-21 00:13:31 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cocoa-ui-backend raise-window* ( world -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 20:02:44 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    handle>> [
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 19:57:12 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        window>> dup f -> orderFront: -> makeKeyWindow
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        NSApp 1 -> activateIgnoringOtherApps:
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] when* ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cocoa-ui-backend select-gl-context ( handle -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 19:57:12 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    view>> -> openGLContext -> makeCurrentContext ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cocoa-ui-backend flush-gl-context ( handle -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-01 19:57:12 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    view>> -> openGLContext -> flushBuffer ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-05 23:06:38 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cocoa-ui-backend beep ( -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    NSBeep ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								SYMBOL: cocoa-init-hook
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cocoa-ui-backend ui
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "UI" assert.app [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            init-clipboard
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            cocoa-init-hook get [ call ] when*
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            start-ui
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            finish-launching
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            event-loop
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ] ui-running
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] with-cocoa ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-02 20:44:01 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								cocoa-ui-backend ui-backend set-global
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ running.app? "ui" "listener" ? ] main-vocab-hook set-global
							 |