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.private words.symbol ;
  13 IN: ui.backend.cocoa
  14
  15 TUPLE: window-handle view window ;
  16
  17 C: <window-handle> window-handle
  18
  19 SINGLETON: cocoa-ui-backend
  20
  21 CONSTANT: attrib-table H{
  22     { double-buffered { $ NSOpenGLPFADoubleBuffer } }
  23     { stereo { $ NSOpenGLPFAStereo } }
  24     { offscreen { $ NSOpenGLPFAOffScreen } }
  25     { fullscreen { $ NSOpenGLPFAFullScreen } }
  26     { windowed { $ NSOpenGLPFAWindow } }
  27     { accelerated { $ NSOpenGLPFAAccelerated } }
  28     { software-rendered {
  29           $ NSOpenGLPFARendererID
  30           $ kCGLRendererGenericFloatID }
  31     }
  32     { backing-store { $ NSOpenGLPFABackingStore } }
  33     { multisampled { $ NSOpenGLPFAMultisample } }
  34     { supersampled { $ NSOpenGLPFASupersample } }
  35     { sample-alpha { $ NSOpenGLPFASampleAlpha } }
  36     { color-float { $ NSOpenGLPFAColorFloat } }
  37     { color-bits { $ NSOpenGLPFAColorSize } }
  38     { alpha-bits { $ NSOpenGLPFAAlphaSize } }
  39     { accum-bits { $ NSOpenGLPFAAccumSize } }
  40     { depth-bits { $ NSOpenGLPFADepthSize } }
  41     { stencil-bits { $ NSOpenGLPFAStencilSize } }
  42     { aux-buffers { $ NSOpenGLPFAAuxBuffers } }
  43     { sample-buffers { $ NSOpenGLPFASampleBuffers } }
  44     { samples { $ NSOpenGLPFASamples } }
  45 }
  46
  47 M: cocoa-ui-backend (make-pixel-format)
  48     nip { } attrib-table pixel-format-attributes>int-array
  49     NSOpenGLPixelFormat -> alloc swap -> initWithAttributes: ;
  50
  51 M: cocoa-ui-backend (free-pixel-format)
  52     handle>> -> release ;
  53
  54 TUPLE: pasteboard handle ;
  55
  56 C: <pasteboard> pasteboard
  57
  58 M: pasteboard clipboard-contents
  59     handle>> pasteboard-string ;
  60
  61 M: pasteboard set-clipboard-contents
  62     handle>> set-pasteboard-string ;
  63
  64 : init-clipboard ( -- )
  65     NSPasteboard -> generalPasteboard <pasteboard>
  66     clipboard set-global
  67     <clipboard> selection set-global ;
  68
  69 : world>NSRect ( world -- NSRect )
  70     [ 0 0 ] dip dim>> first2 <CGRect> ;
  71
  72 : auto-position ( window loc -- )
  73     ! Note: if this is the initial window, the length of the windows
  74     ! vector should be 1, since (open-window) calls auto-position
  75     ! after register-window.
  76     dup { 0 0 } = [
  77         drop
  78         worlds get-global length 1 <= [ -> center ] [
  79             worlds get-global last second window-loc>>
  80             dupd first2 <CGPoint> -> cascadeTopLeftFromPoint:
  81             -> setFrameTopLeftPoint:
  82         ] if
  83     ] [ first2 <CGPoint> -> setFrameTopLeftPoint: ] if ;
  84
  85 M: cocoa-ui-backend set-title ( string world -- )
  86     handle>> window>> swap <NSString> -> setTitle: ;
  87
  88 : enter-fullscreen ( world -- )
  89     handle>> view>>
  90     NSScreen -> mainScreen
  91     f -> enterFullScreenMode:withOptions:
  92     drop ;
  93
  94 : exit-fullscreen ( world -- )
  95     handle>>
  96     [ view>> f -> exitFullScreenModeWithOptions: ]
  97     [ [ window>> ] [ view>> ] bi -> makeFirstResponder: drop ] bi ;
  98
  99 M: cocoa-ui-backend (set-fullscreen) ( world ? -- )
 100     [ enter-fullscreen ] [ exit-fullscreen ] if ;
 101
 102 M: cocoa-ui-backend (fullscreen?) ( world -- ? )
 103     handle>> view>> -> isInFullScreenMode zero? not ;
 104
 105 ! XXX: Until someone tests OSX with a tiling window manager,
 106 ! dialog-window is the same as normal-title-window
 107 CONSTANT: window-control>styleMask
 108     H{
 109         { close-button $ NSClosableWindowMask }
 110         { minimize-button $ NSMiniaturizableWindowMask }
 111         { maximize-button 0 }
 112         { resize-handles $ NSResizableWindowMask }
 113         { small-title-bar flags{ NSTitledWindowMask NSUtilityWindowMask } }
 114         { textured-background $ NSTexturedBackgroundWindowMask }
 115         { normal-title-bar $ NSTitledWindowMask }
 116         { dialog-window $ NSTitledWindowMask }
 117     }
 118
 119 : world>styleMask ( world -- n )
 120     window-controls>> window-control>styleMask symbols>flags ;
 121
 122 : make-context-transparent ( view -- )
 123     -> openGLContext
 124     0 int <ref> NSOpenGLCPSurfaceOpacity -> setValues:forParameter: ;
 125
 126 M:: cocoa-ui-backend (open-window) ( world -- )
 127     world [ [ dim>> ] dip <FactorView> ]
 128     with-world-pixel-format :> view
 129     world window-controls>> textured-background swap member-eq?
 130     [ view make-context-transparent ] when
 131     view world [ world>NSRect ] [ world>styleMask ] bi <ViewWindow> :> window
 132     view -> release
 133     world view register-window
 134     window world window-loc>> auto-position
 135     world window save-position
 136     window install-window-delegate
 137     view window <window-handle> world handle<<
 138     window f -> makeKeyAndOrderFront:
 139     t world active?<< ;
 140
 141 M: cocoa-ui-backend (close-window) ( handle -- )
 142     [
 143         view>> dup -> isInFullScreenMode zero?
 144         [ drop ]
 145         [ f -> exitFullScreenModeWithOptions: ] if
 146     ] [ window>> -> release ] bi ;
 147
 148 M: cocoa-ui-backend (grab-input) ( handle -- )
 149     0 CGAssociateMouseAndMouseCursorPosition drop
 150     CGMainDisplayID CGDisplayHideCursor drop
 151     window>> -> frame CGRect>rect rect-center
 152     NSScreen -> screens 0 -> objectAtIndex: -> frame CGRect-h
 153     [ drop first ] [ swap second - ] 2bi <CGPoint>
 154     [ GetCurrentButtonState zero? not ] [ yield ] while
 155     CGWarpMouseCursorPosition drop ;
 156
 157 M: cocoa-ui-backend (ungrab-input) ( handle -- )
 158     drop
 159     CGMainDisplayID CGDisplayShowCursor drop
 160     1 CGAssociateMouseAndMouseCursorPosition drop ;
 161
 162 M: cocoa-ui-backend close-window ( gadget -- )
 163     find-world [
 164         handle>> [
 165             window>> -> close
 166         ] when*
 167     ] when* ;
 168
 169 M: cocoa-ui-backend raise-window* ( world -- )
 170     handle>> [
 171         window>> dup f -> orderFront: -> makeKeyWindow
 172         NSApp 1 -> activateIgnoringOtherApps:
 173     ] when* ;
 174
 175 M: window-handle select-gl-context ( handle -- )
 176     view>> -> openGLContext -> makeCurrentContext ;
 177
 178 M: window-handle flush-gl-context ( handle -- )
 179     view>> -> openGLContext -> flushBuffer ;
 180
 181 M: cocoa-ui-backend beep ( -- )
 182     NSBeep ;
 183
 184 M: cocoa-ui-backend resize-window
 185     [ handle>> window>> ] [ first2 ] bi* <CGSize> -> setContentSize: ;
 186
 187 M: cocoa-ui-backend system-alert
 188     NSAlert -> alloc -> init -> autorelease [
 189         {
 190             [ swap <NSString> -> setInformativeText: ]
 191             [ swap <NSString> -> setMessageText: ]
 192             [ "OK" <NSString> -> addButtonWithTitle: drop ]
 193             [ -> runModal drop ]
 194         } cleave
 195     ] [ 2drop ] if* ;
 196
 197 <CLASS: FactorApplicationDelegate < NSObject
 198
 199     METHOD: void applicationDidUpdate: id obj [ reset-thread-timer ] ;
 200
 201     METHOD: char applicationShouldTerminateAfterLastWindowClosed: id app [
 202         ui-stop-after-last-window? get 1 0 ?
 203     ] ;
 204 ;CLASS>
 205
 206 : install-app-delegate ( -- )
 207     NSApp FactorApplicationDelegate install-delegate ;
 208
 209 SYMBOL: cocoa-startup-hook
 210
 211 cocoa-startup-hook [
 212     [ "MiniFactor.nib" load-nib install-app-delegate ]
 213 ] initialize
 214
 215 M: cocoa-ui-backend (with-ui)
 216     "UI" assert.app [
 217         init-clipboard
 218         cocoa-startup-hook get call( -- )
 219         start-ui
 220         stop-io-thread
 221         init-thread-timer
 222         reset-thread-timer
 223         NSApp -> run
 224     ] with-cocoa ;
 225
 226 cocoa-ui-backend ui-backend set-global
 227
 228 M: cocoa-ui-backend ui-backend-available?
 229     running.app? ;