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 arrays assocs classes cocoa
   4 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.rectangles memory
  10 namespaces sequences specialized-arrays.int threads ui
  11 ui.backend 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     [ first 0 <int> [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] keep *int ]
  59     if-empty ;
  60
  61 TUPLE: pasteboard handle ;
  62
  63 C: <pasteboard> pasteboard
  64
  65 M: pasteboard clipboard-contents
  66     handle>> pasteboard-string ;
  67
  68 M: pasteboard set-clipboard-contents
  69     handle>> set-pasteboard-string ;
  70
  71 : init-clipboard ( -- )
  72     NSPasteboard -> generalPasteboard <pasteboard>
  73     clipboard set-global
  74     <clipboard> selection set-global ;
  75
  76 : world>NSRect ( world -- NSRect )
  77     [ 0 0 ] dip dim>> first2 <CGRect> ;
  78
  79 : auto-position ( window loc -- )
  80     #! Note: if this is the initial window, the length of the windows
  81     #! vector should be 1, since (open-window) calls auto-position
  82     #! after register-window.
  83     dup { 0 0 } = [
  84         drop
  85         windows get length 1 <= [ -> center ] [
  86             windows get peek second window-loc>>
  87             dupd first2 <CGPoint> -> cascadeTopLeftFromPoint:
  88             -> setFrameTopLeftPoint:
  89         ] if
  90     ] [ first2 <CGPoint> -> setFrameTopLeftPoint: ] if ;
  91
  92 M: cocoa-ui-backend set-title ( string world -- )
  93     handle>> window>> swap <NSString> -> setTitle: ;
  94
  95 : enter-fullscreen ( world -- )
  96     handle>> view>>
  97     NSScreen -> mainScreen
  98     f -> enterFullScreenMode:withOptions:
  99     drop ;
 100
 101 : exit-fullscreen ( world -- )
 102     handle>> view>> f -> exitFullScreenModeWithOptions: ;
 103
 104 M: cocoa-ui-backend set-fullscreen* ( ? world -- )
 105     swap [ enter-fullscreen ] [ exit-fullscreen ] if ;
 106
 107 M: cocoa-ui-backend fullscreen* ( world -- ? )
 108     handle>> view>> -> isInFullScreenMode zero? not ;
 109
 110 M:: cocoa-ui-backend (open-window) ( world -- )
 111     world [ [ dim>> ] dip <FactorView> ]
 112     with-world-pixel-format :> view
 113     view world world>NSRect <ViewWindow> :> window
 114     view -> release
 115     world view register-window
 116     window world window-loc>> auto-position
 117     world window save-position
 118     window install-window-delegate
 119     view window <window-handle> world (>>handle)
 120     window f -> makeKeyAndOrderFront: ;
 121
 122 M: cocoa-ui-backend (close-window) ( handle -- )
 123     window>> -> release ;
 124
 125 M: cocoa-ui-backend (grab-input) ( handle -- )
 126     0 CGAssociateMouseAndMouseCursorPosition drop
 127     CGMainDisplayID CGDisplayHideCursor drop
 128     window>> -> frame CGRect>rect rect-center
 129     first2 <CGPoint> CGWarpMouseCursorPosition drop ;
 130
 131 M: cocoa-ui-backend (ungrab-input) ( handle -- )
 132     drop
 133     CGMainDisplayID CGDisplayShowCursor drop
 134     1 CGAssociateMouseAndMouseCursorPosition drop ;
 135
 136 M: cocoa-ui-backend close-window ( gadget -- )
 137     find-world [
 138         handle>> [
 139             window>> f -> performClose:
 140         ] when*
 141     ] when* ;
 142
 143 M: cocoa-ui-backend raise-window* ( world -- )
 144     handle>> [
 145         window>> dup f -> orderFront: -> makeKeyWindow
 146         NSApp 1 -> activateIgnoringOtherApps:
 147     ] when* ;
 148
 149 : pixel-size ( pixel-format -- size )
 150     color-bits pixel-format-attribute -3 shift ;
 151
 152 : offscreen-buffer ( world pixel-format -- alien w h pitch )
 153     [ dim>> first2 ] [ pixel-size ] bi*
 154     { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ;
 155
 156 :: gadget-offscreen-context ( world -- context buffer )
 157     world [
 158         nip :> pf
 159         NSOpenGLContext -> alloc pf handle>> f -> initWithFormat:shareContext:
 160         dup world pf offscreen-buffer
 161         4 npick [ -> setOffScreen:width:height:rowbytes: ] dip
 162     ] with-world-pixel-format ;
 163
 164 M: cocoa-ui-backend (open-offscreen-buffer) ( world -- )
 165     dup gadget-offscreen-context <offscreen-handle> >>handle drop ;
 166
 167 M: cocoa-ui-backend (close-offscreen-buffer) ( handle -- )
 168     [ context>> -> release ]
 169     [ buffer>> free ] bi ;
 170
 171 GENERIC: (gl-context) ( handle -- context )
 172 M: window-handle (gl-context) view>> -> openGLContext ;
 173 M: offscreen-handle (gl-context) context>> ;
 174
 175 M: handle select-gl-context ( handle -- )
 176     (gl-context) -> makeCurrentContext ;
 177
 178 M: handle flush-gl-context ( handle -- )
 179     (gl-context) -> flushBuffer ;
 180
 181 M: cocoa-ui-backend offscreen-pixels ( world -- alien w h )
 182     [ handle>> buffer>> ] [ dim>> first2 neg ] bi ;
 183
 184 M: cocoa-ui-backend beep ( -- )
 185     NSBeep ;
 186
 187 CLASS: {
 188     { +superclass+ "NSObject" }
 189     { +name+ "FactorApplicationDelegate" }
 190 }
 191
 192 {  "applicationDidUpdate:" "void" { "id" "SEL" "id" }
 193     [ 3drop reset-run-loop ]
 194 } ;
 195
 196 : install-app-delegate ( -- )
 197     NSApp FactorApplicationDelegate install-delegate ;
 198
 199 SYMBOL: cocoa-init-hook
 200
 201 cocoa-init-hook [
 202     [ "MiniFactor.nib" load-nib install-app-delegate ]
 203 ] initialize
 204
 205 M: cocoa-ui-backend (with-ui)
 206     "UI" assert.app [
 207         [
 208             init-clipboard
 209             cocoa-init-hook get call( -- )
 210             start-ui
 211             f io-thread-running? set-global
 212             init-thread-timer
 213             reset-run-loop
 214             NSApp -> run
 215         ] ui-running
 216     ] with-cocoa ;
 217
 218 cocoa-ui-backend ui-backend set-global
 219
 220 [ running.app? "ui.tools" "listener" ? ] main-vocab-hook set-global