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 math arrays assocs cocoa cocoa.application
   4 command-line kernel memory namespaces cocoa.messages
   5 cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
   6 cocoa.windows cocoa.classes cocoa.nibs sequences ui ui.private
   7 ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
   8 ui.backend.cocoa.views core-foundation core-foundation.run-loop
   9 core-graphics.types threads math.rectangles fry libc
  10 generalizations alien.c-types cocoa.views
  11 combinators io.thread locals ;
  12 IN: ui.backend.cocoa
  13
  14 TUPLE: handle ;
  15 TUPLE: window-handle < handle view window ;
  16 TUPLE: offscreen-handle < handle context buffer ;
  17
  18 C: <window-handle> window-handle
  19 C: <offscreen-handle> offscreen-handle
  20
  21 SINGLETON: cocoa-ui-backend
  22
  23 TUPLE: pasteboard handle ;
  24
  25 C: <pasteboard> pasteboard
  26
  27 M: pasteboard clipboard-contents
  28     handle>> pasteboard-string ;
  29
  30 M: pasteboard set-clipboard-contents
  31     handle>> set-pasteboard-string ;
  32
  33 : init-clipboard ( -- )
  34     NSPasteboard -> generalPasteboard <pasteboard>
  35     clipboard set-global
  36     <clipboard> selection set-global ;
  37
  38 : world>NSRect ( world -- NSRect )
  39     [ 0 0 ] dip dim>> first2 <CGRect> ;
  40
  41 : auto-position ( window loc -- )
  42     dup { 0 0 } = [
  43         drop
  44         windows get [ -> center ] [
  45             peek second window-loc>>
  46             dupd first2 <CGPoint> -> cascadeTopLeftFromPoint:
  47             -> setFrameTopLeftPoint:
  48         ] if-empty
  49     ] [ first2 <CGPoint> -> setFrameTopLeftPoint: ] if ;
  50
  51 M: cocoa-ui-backend set-title ( string world -- )
  52     handle>> window>> swap <NSString> -> setTitle: ;
  53
  54 : enter-fullscreen ( world -- )
  55     handle>> view>>
  56     NSScreen -> mainScreen
  57     f -> enterFullScreenMode:withOptions:
  58     drop ;
  59
  60 : exit-fullscreen ( world -- )
  61     handle>> view>> f -> exitFullScreenModeWithOptions: ;
  62
  63 M: cocoa-ui-backend set-fullscreen* ( ? world -- )
  64     swap [ enter-fullscreen ] [ exit-fullscreen ] if ;
  65
  66 M: cocoa-ui-backend fullscreen* ( world -- ? )
  67     handle>> view>> -> isInFullScreenMode zero? not ;
  68
  69 M:: cocoa-ui-backend (open-window) ( world -- )
  70     world dim>> <FactorView> :> view
  71     view world world>NSRect <ViewWindow> :> window
  72     view -> release
  73     window world window-loc>> auto-position
  74     world view register-window
  75     world window save-position
  76     window install-window-delegate
  77     view window <window-handle> world (>>handle)
  78     window f -> makeKeyAndOrderFront: ;
  79
  80 M: cocoa-ui-backend (close-window) ( handle -- )
  81     window>> -> release ;
  82
  83 M: cocoa-ui-backend close-window ( gadget -- )
  84     find-world [
  85         handle>> [
  86             window>> f -> performClose:
  87         ] when*
  88     ] when* ;
  89
  90 M: cocoa-ui-backend raise-window* ( world -- )
  91     handle>> [
  92         window>> dup f -> orderFront: -> makeKeyWindow
  93         NSApp 1 -> activateIgnoringOtherApps:
  94     ] when* ;
  95
  96 : pixel-size ( pixel-format -- size )
  97     0 <int> [ NSOpenGLPFAColorSize 0 -> getValues:forAttribute:forVirtualScreen: ]
  98     keep *int -3 shift ;
  99
 100 : offscreen-buffer ( world pixel-format -- alien w h pitch )
 101     [ dim>> first2 ] [ pixel-size ] bi*
 102     { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ;
 103
 104 : gadget-offscreen-context ( world -- context buffer )
 105     NSOpenGLPFAOffScreen 1array <PixelFormat>
 106     [ nip NSOpenGLContext -> alloc swap f -> initWithFormat:shareContext: dup ]
 107     [ offscreen-buffer ] 2bi
 108     4 npick [ -> setOffScreen:width:height:rowbytes: ] dip ;
 109
 110 M: cocoa-ui-backend (open-offscreen-buffer) ( world -- )
 111     dup gadget-offscreen-context <offscreen-handle> >>handle drop ;
 112
 113 M: cocoa-ui-backend (close-offscreen-buffer) ( handle -- )
 114     [ context>> -> release ]
 115     [ buffer>> free ] bi ;
 116
 117 GENERIC: (gl-context) ( handle -- context )
 118 M: window-handle (gl-context) view>> -> openGLContext ;
 119 M: offscreen-handle (gl-context) context>> ;
 120
 121 M: handle select-gl-context ( handle -- )
 122     (gl-context) -> makeCurrentContext ;
 123
 124 M: handle flush-gl-context ( handle -- )
 125     (gl-context) -> flushBuffer ;
 126
 127 M: cocoa-ui-backend offscreen-pixels ( world -- alien w h )
 128     [ handle>> buffer>> ] [ dim>> first2 neg ] bi ;
 129
 130 M: cocoa-ui-backend beep ( -- )
 131     NSBeep ;
 132
 133 CLASS: {
 134     { +superclass+ "NSObject" }
 135     { +name+ "FactorApplicationDelegate" }
 136 }
 137
 138 {  "applicationDidUpdate:" "void" { "id" "SEL" "id" }
 139     [ 3drop reset-run-loop ]
 140 } ;
 141
 142 : install-app-delegate ( -- )
 143     NSApp FactorApplicationDelegate install-delegate ;
 144
 145 SYMBOL: cocoa-init-hook
 146
 147 cocoa-init-hook [
 148     [ "MiniFactor.nib" load-nib install-app-delegate ]
 149 ] initialize
 150
 151 M: cocoa-ui-backend (with-ui)
 152     "UI" assert.app [
 153         [
 154             init-clipboard
 155             cocoa-init-hook get call( -- )
 156             start-ui
 157             f io-thread-running? set-global
 158             init-thread-timer
 159             reset-run-loop
 160             NSApp -> run
 161         ] ui-running
 162     ] with-cocoa ;
 163
 164 cocoa-ui-backend ui-backend set-global
 165
 166 [ running.app? "ui.tools" "listener" ? ] main-vocab-hook set-global