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