basis/ui/backend/cocoa/cocoa.factor

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