basis/ui/cocoa/cocoa.factor

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