More 4DNav fixes

extra/4DNav/4DNav.factor

@@ -3,6 +3,7 @@
 USING: kernel 
 namespaces
 accessors
+assocs
 make
 math
 math.functions
@@ -16,6 +17,7 @@ colors
 colors.constants
 prettyprint
 vars
+call
 quotations
 io
 io.directories
@@ -27,8 +29,6 @@ ui.gadgets.panes
        ui.gadgets
        ui.traverse
        ui.gadgets.borders
-       ui.gadgets.handler
-       ui.gadgets.slate
        ui.gadgets.frames
        ui.gadgets.tracks
        ui.gadgets.labels
@@ -53,6 +53,7 @@ adsoda
 adsoda.tools
 ;
 QUALIFIED-WITH: ui.pens.solid s
+QUALIFIED-WITH: ui.gadgets.wrappers w
 
 
 IN: 4DNav
@@ -392,6 +393,13 @@ USE: ui.gadgets.labeled.private
         add-gadget
         menu-quick-views add-gadget ; 
 
+TUPLE: handler < w:wrapper table ;
+
+: <handler> ( child -- handler ) handler w:new-wrapper ;
+
+M: handler handle-gesture ( gesture gadget -- ? )
+   tuck table>> at dup [ call( gadget -- ) f ] [ 2drop t ] if ;
+
 : add-keyboard-delegate ( obj -- obj )
  <handler>
 {

extra/4DNav/file-chooser/file-chooser.factor

@@ -24,7 +24,6 @@ ui.gadgets.panes
 ui.gadgets.scrollers
 prettyprint
 combinators
-rewrite-closures
 accessors
 values
 tools.walker
@@ -67,7 +66,7 @@ file-chooser H{
      [ directory? ] bi or ]  filter
 ;
 
-: update-filelist-model ( file-chooser -- file-chooser )
+: update-filelist-model ( file-chooser -- )
     [ list-of-files ] [ model>> ] bi set-model ;
 
 : init-filelist-model ( file-chooser -- file-chooser )
@@ -86,7 +85,7 @@ file-chooser H{
 : fc-go-home ( file-chooser -- )
     [ home ] (fc-go) ;
 
-: fc-change-directory ( file-chooser file -- file-chooser )
+: fc-change-directory ( file-chooser file -- )
     dupd [ path>> value>> normalize-path ] [ name>> ] bi* 
     append-path over path>> set-model    
     update-filelist-model

extra/4DNav/turtle/turtle.factor

@@ -10,9 +10,9 @@ IN: 4DNav.turtle
 
 VAR: self
 
-: with-self ( quot obj -- ) [ >self call ] with-scope ;
+: with-self ( quot obj -- ) [ >self call ] with-scope ; inline
 
-: save-self ( quot -- ) self> [ self> clone >self call ] dip >self ;
+: save-self ( quot -- ) self> [ self> clone >self call ] dip >self ; inline
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

extra/ui/gadgets/handler/authors.txt

@@ -1 +0,0 @@
-Eduardo Cavazos

extra/ui/gadgets/handler/handler.factor

@@ -1,11 +0,0 @@
-
-USING: kernel assocs ui.gestures ui.gadgets.wrappers accessors ;
-
-IN: ui.gadgets.handler
-
-TUPLE: handler < wrapper table ;
-
-: <handler> ( child -- handler ) handler new-wrapper ;
-
-M: handler handle-gesture ( gesture gadget -- ? )
-   tuck table>> at dup [ call f ] [ 2drop t ] if ;

extra/ui/gadgets/slate/authors.txt

@@ -1 +0,0 @@
-Eduardo Cavazos

extra/ui/gadgets/slate/slate-docs.factor

@@ -1,13 +0,0 @@
-! Copyright (C) 2009 Eduardo Cavazos
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax multiline ;
-IN: ui.gadgets.slate
-
-ARTICLE: "ui.gadgets.slate" "Slate gadget"
-{ $description "A gadget with an 'action' slot which should be set to a callable."}
-{ $heading "Example" }
-{ $code <" USING: processing.shapes ui.gadgets.slate ui.gadgets.panes ;
-[ { { 10 10 } { 50 30 } { 10 50 } } polygon fill-mode ] <slate>
-gadget."> } ;
-
-ABOUT: "ui.gadgets.slate"

extra/ui/gadgets/slate/slate.factor

@@ -1,124 +0,0 @@
-! Copyright (C) 2009 Eduardo Cavazos
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces opengl ui.render ui.gadgets accessors ;
-
-IN: ui.gadgets.slate
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-TUPLE: slate < gadget action pdim graft ungraft ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: init-slate ( slate -- slate )
-  [ ]         >>action
-  { 200 200 } >>pdim
-  [ ]         >>graft
-  [ ]         >>ungraft ;
-
-: <slate> ( action -- slate )
-  slate new
-    init-slate
-    swap >>action ;
-
-M: slate pref-dim* ( slate -- dim ) pdim>> ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-USING: combinators arrays sequences math
-       opengl.gl ui.gadgets.worlds ;
-
-: width ( rect -- w ) dim>> first ;
-: height ( rect -- h ) dim>> second ;
-
-: screen-y* ( gadget -- loc )
-  {
-    [ find-world height ]
-    [ screen-loc second ]
-    [ height ]
-  }
-  cleave
-  + - ;
-
-: screen-loc* ( gadget -- loc )
-  {
-    [ screen-loc first ]
-    [ screen-y* ]
-  }
-  cleave
-  2array ;
-
-: setup-viewport ( gadget -- gadget )
-  dup
-  {
-    [ screen-loc* ]
-    [ dim>>       ]
-  }
-  cleave
-  gl-viewport ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: default-coordinate-system ( gadget -- gadget )
-  dup
-  {
-    [ drop 0 ]
-    [ width 1 - ]
-    [ height 1 - ]
-    [ drop 0 ]
-  }
-  cleave
-  -1 1
-  glOrtho ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-M: slate graft*   ( slate -- ) graft>>   call ;
-M: slate ungraft* ( slate -- ) ungraft>> call ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-GENERIC: establish-coordinate-system ( gadget -- gadget )
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-M: slate establish-coordinate-system ( slate -- slate )
-   default-coordinate-system ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-GENERIC: draw-slate ( slate -- slate )
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-M: slate draw-slate ( slate -- slate ) dup action>> call ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-M: slate draw-gadget* ( slate -- )
-
-   GL_PROJECTION glMatrixMode glPushMatrix glLoadIdentity
-
-   establish-coordinate-system
-
-   GL_MODELVIEW glMatrixMode glPushMatrix glLoadIdentity 
-
-   setup-viewport
-
-   draw-slate
-
-   GL_PROJECTION glMatrixMode glPopMatrix glLoadIdentity
-   GL_MODELVIEW  glMatrixMode glPopMatrix glLoadIdentity
-
-   dup
-   find-world
-   ! The world coordinate system is a little wacky:
-   dup { [ drop 0 ] [ width ] [ height ] [ drop 0 ] } cleave -1 1 glOrtho
-   setup-viewport
-   drop
-   drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!