]> gitweb.factorcode.org Git - factor.git/commitdiff
Fix conflict
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Mon, 9 Feb 2009 06:34:00 +0000 (00:34 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Mon, 9 Feb 2009 06:34:00 +0000 (00:34 -0600)
1  2 
basis/cocoa/messages/messages.factor
basis/ui/ui.factor

index 4bcb6e8bed0f268fc72da5fe84f8cba57612e288,60bdde262cb93d4a464853369c56590b58db72b0..89b94b30601d08ee4cf84af2a0ddcd6ce4165675
@@@ -1,11 -1,11 +1,11 @@@
 -! Copyright (C) 2006, 2008 Slava Pestov.
 +! Copyright (C) 2006, 2009 Slava Pestov.
  ! See http://factorcode.org/license.txt for BSD license.
  USING: accessors alien alien.c-types alien.strings arrays assocs
  continuations combinators compiler compiler.alien kernel math
  namespaces make parser quotations sequences strings words
  cocoa.runtime io macros memoize io.encodings.utf8
  effects libc libc.private parser lexer init core-foundation fry
- generalizations specialized-arrays.direct.alien ;
+ generalizations specialized-arrays.direct.alien call ;
  IN: cocoa.messages
  
  : make-sender ( method function -- quot )
@@@ -83,7 -83,7 +83,7 @@@ class-init-hooks global [ H{ } clone o
  
  : (objc-class) ( name word -- class )
      2dup execute dup [ 2nip ] [
-         drop over class-init-hooks get at [ assert-depth ] when*
+         drop over class-init-hooks get at [ call( -- ) ] when*
          2dup execute dup [ 2nip ] [
              2drop "No such class: " prepend throw
          ] if
@@@ -167,19 -167,13 +167,19 @@@ assoc-union alien>objc-types set-globa
          drop "void*"
      ] unless ;
  
 +ERROR: no-objc-type name ;
 +
 +: decode-type ( ch -- ctype )
 +    1string dup objc>alien-types get at
 +    [ ] [ no-objc-type ] ?if ;
 +
  : (parse-objc-type) ( i string -- ctype )
      [ [ 1+ ] dip ] [ nth ] 2bi {
          { [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] }
          { [ dup CHAR: ^ = ] [ 3drop "void*" ] }
          { [ dup CHAR: { = ] [ drop objc-struct-type ] }
          { [ dup CHAR: [ = ] [ 3drop "void*" ] }
 -        [ 2nip 1string objc>alien-types get at ]
 +        [ 2nip decode-type ]
      } cond ;
  
  : parse-objc-type ( string -- ctype ) 0 swap (parse-objc-type) ;
diff --combined basis/ui/ui.factor
index 8c84dd691c8dbd40f526a3963f508c5d91edf87d,78f150987f259f1c9c63937fde38c6142f607e1b..eea608d960da22d2fb092143cf2c2523d9fa1d7f
@@@ -1,10 -1,10 +1,10 @@@
 -! Copyright (C) 2006, 2008 Slava Pestov.
 +! Copyright (C) 2006, 2009 Slava Pestov.
  ! See http://factorcode.org/license.txt for BSD license.
 -USING: arrays assocs io kernel math models namespaces make
 -dlists deques sequences threads sequences words ui.gadgets
 -ui.gadgets.worlds ui.gadgets.tracks ui.gestures ui.backend
 -ui.render continuations init combinators hashtables
 -concurrency.flags sets accessors calendar call ;
 +USING: arrays assocs io kernel math models namespaces make dlists
- deques sequences threads sequences words continuations init
++deques sequences threads sequences words continuations init call
 +combinators hashtables concurrency.flags sets accessors calendar fry
 +ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gadgets.tracks
 +ui.gestures ui.backend ui.render ui.text ui.text.private ;
  IN: ui
  
  ! Assoc mapping aliens to gadgets
@@@ -35,8 -35,8 +35,8 @@@ SYMBOL: window
  
  : focus-gestures ( new old -- )
      drop-prefix <reversed>
 -    T{ lose-focus } swap each-gesture
 -    T{ gain-focus } swap each-gesture ;
 +    lose-focus swap each-gesture
 +    gain-focus swap each-gesture ;
  
  : focus-world ( world -- )
      t >>focused?
@@@ -60,12 -60,9 +60,12 @@@ M: world graft
      [ f >>handle drop ] tri ;
  
  : (ungraft-world) ( world -- )
 -    [ free-fonts ]
 -    [ hand-clicked close-global ]
 -    [ hand-gadget close-global ] tri ;
 +    {
 +        [ handle>> select-gl-context ]
 +        [ fonts>> free-fonts ]
 +        [ hand-clicked close-global ]
 +        [ hand-gadget close-global ]
 +    } cleave ;
  
  M: world ungraft*
      [ (ungraft-world) ]
@@@ -76,6 -73,8 +76,6 @@@
      windows get values
      [ gadget-child swap call ] with find-last nip ; inline
  
 -SYMBOL: ui-hook
 -
  : init-ui ( -- )
      <dlist> \ graft-queue set-global
      <dlist> \ layout-queue set-global
  : restore-world ( world -- )
      dup reset-world restore-gadget ;
  
 -: restore-windows ( -- )
 -    windows get [ values ] keep delete-all
 -    [ restore-world ] each
 -    forget-rollover ;
 -
 -: restore-windows? ( -- ? )
 -    windows get empty? not ;
 -
  : update-hand ( world -- )
      dup hand-world get-global eq?
      [ hand-loc get-global swap move-hand ] [ drop ] if ;
  : redraw-worlds ( seq -- )
      [ dup update-hand draw-world ] each ;
  
 -: notify ( gadget -- )
 -    dup graft-state>>
 -    [ first { f f } { t t } ? >>graft-state ] keep
 -    {
 -        { { f t } [ dup activate-control graft* ] }
 -        { { t f } [ dup deactivate-control ungraft* ] }
 -    } case ;
 -
 -: notify-queued ( -- )
 -    graft-queue [ notify ] slurp-deque ;
 -
  : send-queued-gestures ( -- )
      gesture-queue [ send-queued-gesture notify-queued ] slurp-deque ;
  
              layout-queued
              redraw-worlds
              send-queued-gestures
-         ] assert-depth
+         ] call( -- )
      ] [ ui-error ] recover ;
  
  SYMBOL: ui-thread
@@@ -163,27 -181,30 +163,27 @@@ HOOK: close-window ui-backend ( gadget 
  M: object close-window
      find-world [ ungraft ] when* ;
  
 -: start-ui ( -- )
 -    restore-windows? [
 -        restore-windows
 -    ] [
 -        init-ui ui-hook get call
 -    ] if
 -    notify-ui-thread start-ui-thread ;
 +: start-ui ( quot -- )
 +    call notify-ui-thread start-ui-thread ;
  
  [
      f \ ui-running set-global
      <flag> ui-notify-flag set-global
  ] "ui" add-init-hook
  
 -HOOK: ui ui-backend ( -- )
 +HOOK: (with-ui) ui-backend ( quot -- )
 +
 +: restore-windows ( -- )
 +    [
 +        windows get [ values ] [ delete-all ] bi
 +        [ restore-world ] each
 +        forget-rollover
 +    ] (with-ui) ;
  
 -MAIN: ui
 +: restore-windows? ( -- ? )
 +    windows get empty? not ;
  
  : with-ui ( quot -- )
 -    ui-running? [
 -        call
 -    ] [
 -        f windows set-global
 -        [
 -            ui-hook set
 -            ui
 -        ] with-scope
 -    ] if ;
 +    ui-running? [ call ] [ '[ init-ui @ ] (with-ui) ] if ;
 +
 +HOOK: beep ui-backend ( -- )