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 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 ;
  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     [
  59         first
  60         { int } [ swap 0 -> getValues:forAttribute:forVirtualScreen: ]
  61         with-out-parameters
  62     ] if-empty ;
  63
  64 TUPLE: pasteboard handle ;
  65
  66 C: <pasteboard> pasteboard
  67
  68 M: pasteboard clipboard-contents
  69     handle>> pasteboard-string ;
  70
  71 M: pasteboard set-clipboard-contents
  72     handle>> set-pasteboard-string ;
  73
  74 : init-clipboard ( -- )
  75     NSPasteboard -> generalPasteboard <pasteboard>
  76     clipboard set-global
  77     <clipboard> selection set-global ;
  78
  79 : world>NSRect ( world -- NSRect )
  80     [ 0 0 ] dip dim>> first2 <CGRect> ;
  81
  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.
  86     dup { 0 0 } = [
  87         drop
  88         ui-windows get-global length 1 <= [ -> center ] [
  89             ui-windows get-global last second window-loc>>
  90             dupd first2 <CGPoint> -> cascadeTopLeftFromPoint:
  91             -> setFrameTopLeftPoint:
  92         ] if
  93     ] [ first2 <CGPoint> -> setFrameTopLeftPoint: ] if ;
  94
  95 M: cocoa-ui-backend set-title ( string world -- )
  96     handle>> window>> swap <NSString> -> setTitle: ;
  97
  98 : enter-fullscreen ( world -- )
  99     handle>> view>>
 100     NSScreen -> mainScreen
 101     f -> enterFullScreenMode:withOptions:
 102     drop ;
 103
 104 : exit-fullscreen ( world -- )
 105     handle>>
 106     [ view>> f -> exitFullScreenModeWithOptions: ]
 107     [ [ window>> ] [ view>> ] bi -> makeFirstResponder: drop ] bi ;
 108
 109 M: cocoa-ui-backend (set-fullscreen) ( world ? -- )
 110     [ enter-fullscreen ] [ exit-fullscreen ] if ;
 111
 112 M: cocoa-ui-backend (fullscreen?) ( world -- ? )
 113     handle>> view>> -> isInFullScreenMode zero? not ;
 114
 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
 118     H{
 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 }
 127     }
 128
 129 : world>styleMask ( world -- n )
 130     window-controls>> window-control>styleMask symbols>flags ;
 131
 132 : make-context-transparent ( view -- )
 133     -> openGLContext
 134     0 int <ref> NSOpenGLCPSurfaceOpacity -> setValues:forParameter: ;
 135
 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
 142     view -> release
 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: ;
 149
 150 M: cocoa-ui-backend (close-window) ( handle -- )
 151     [
 152         view>> dup -> isInFullScreenMode zero?
 153         [ drop ]
 154         [ f -> exitFullScreenModeWithOptions: ] if
 155     ] [ window>> -> release ] bi ;
 156
 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 ;
 165
 166 M: cocoa-ui-backend (ungrab-input) ( handle -- )
 167     drop
 168     CGMainDisplayID CGDisplayShowCursor drop
 169     1 CGAssociateMouseAndMouseCursorPosition drop ;
 170
 171 M: cocoa-ui-backend close-window ( gadget -- )
 172     find-world [
 173         handle>> [
 174             window>> -> close
 175         ] when*
 176     ] when* ;
 177
 178 M: cocoa-ui-backend raise-window* ( world -- )
 179     handle>> [
 180         window>> dup f -> orderFront: -> makeKeyWindow
 181         NSApp 1 -> activateIgnoringOtherApps:
 182     ] when* ;
 183
 184 : pixel-size ( pixel-format -- size )
 185     color-bits (pixel-format-attribute) -3 shift ;
 186
 187 : offscreen-buffer ( world pixel-format -- alien w h pitch )
 188     [ dim>> first2 ] [ pixel-size ] bi*
 189     { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ;
 190
 191 :: gadget-offscreen-context ( world -- context buffer )
 192     world [
 193         nip :> pf
 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 ;
 198
 199 M: cocoa-ui-backend (open-offscreen-buffer) ( world -- )
 200     dup gadget-offscreen-context <offscreen-handle> >>handle drop ;
 201
 202 M: cocoa-ui-backend (close-offscreen-buffer) ( handle -- )
 203     [ context>> -> release ]
 204     [ buffer>> free ] bi ;
 205
 206 GENERIC: (gl-context) ( handle -- context )
 207 M: window-handle (gl-context) view>> -> openGLContext ;
 208 M: offscreen-handle (gl-context) context>> ;
 209
 210 M: handle select-gl-context ( handle -- )
 211     (gl-context) -> makeCurrentContext ;
 212
 213 M: handle flush-gl-context ( handle -- )
 214     (gl-context) -> flushBuffer ;
 215
 216 M: cocoa-ui-backend offscreen-pixels ( world -- alien w h )
 217     [ handle>> buffer>> ] [ dim>> first2 neg ] bi ;
 218
 219 M: cocoa-ui-backend beep ( -- )
 220     NSBeep ;
 221
 222 M: cocoa-ui-backend resize-window [ handle>> window>> ] [ first2 ] bi* <CGSize> -> setContentSize: ;
 223
 224 M: cocoa-ui-backend system-alert
 225     NSAlert -> alloc -> init -> autorelease [
 226         {
 227             [ swap <NSString> -> setInformativeText: ]
 228             [ swap <NSString> -> setMessageText: ]
 229             [ "OK" <NSString> -> addButtonWithTitle: drop ]
 230             [ -> runModal drop ]
 231         } cleave
 232     ] [ 2drop ] if* ;
 233
 234 CLASS: FactorApplicationDelegate < NSObject
 235     METHOD: void applicationDidUpdate: id obj [ reset-thread-timer ] ;
 236 ;
 237
 238 : install-app-delegate ( -- )
 239     NSApp FactorApplicationDelegate install-delegate ;
 240
 241 SYMBOL: cocoa-startup-hook
 242
 243 cocoa-startup-hook [
 244     [ "MiniFactor.nib" load-nib install-app-delegate ]
 245 ] initialize
 246
 247 M: cocoa-ui-backend (with-ui)
 248     "UI" assert.app [
 249         [
 250             init-clipboard
 251             cocoa-startup-hook get call( -- )
 252             start-ui
 253             stop-io-thread
 254             init-thread-timer
 255             reset-thread-timer
 256             NSApp -> run
 257         ] ui-running
 258     ] with-cocoa ;
 259
 260 cocoa-ui-backend ui-backend set-global
 261
 262 M: cocoa-ui-backend ui-backend-available?
 263     running.app? ;