Update 4DNav for new_ui

extra/4DNav/4DNav.factor

@@ -13,6 +13,7 @@ sequences
 combinators
 continuations
 colors
+colors.constants
 prettyprint
 vars
 quotations
@@ -28,23 +29,19 @@ ui.gadgets.panes
        ui.gadgets.borders
        ui.gadgets.handler
        ui.gadgets.slate
-       ui.gadgets.theme
        ui.gadgets.frames
        ui.gadgets.tracks
        ui.gadgets.labels
-       ui.gadgets.labelled       
+       ui.gadgets.labeled       
        ui.gadgets.lists
        ui.gadgets.buttons
        ui.gadgets.packs
        ui.gadgets.grids
        ui.gestures
-       ui.tools.workspace
        ui.gadgets.scrollers
 splitting
 vectors
 math.vectors
-rewrite-closures
-self
 values
 4DNav.turtle
 4DNav.window3D
@@ -55,6 +52,8 @@ fry
 adsoda
 adsoda.tools
 ;
+QUALIFIED-WITH: ui.pens.solid s
+
 
 IN: 4DNav
 VALUE: selected-file
@@ -74,10 +73,13 @@ VAR: present-space
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-! replacement of namespaces.lib
+! namespace utilities
     
 : make* ( seq -- seq ) [ dup quotation? [ call ] [ ] if ] map ;
 
+: closed-quot ( quot -- quot )
+  namestack swap '[ namestack [ _ set-namestack @ ] dip set-namestack ] ;
+
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! waiting for deep-cleave-quots
 
@@ -131,11 +133,11 @@ VAR: present-space
 : model-projection-chooser ( -- gadget )
    observer3d> projection-mode>>
    { { 1 "perspective" } { 0 "orthogonal" } } 
-   <toggle-buttons> ;
+   <radio-buttons> ;
 
 : collision-detection-chooser ( -- gadget )
    observer3d> collision-mode>>
-   { { t "on" } { f "off" }  } <toggle-buttons> ;
+   { { t "on" } { f "off" }  } <radio-buttons> ;
 
 : model-projection ( x -- space ) 
     present-space>  swap space-project ;
@@ -184,8 +186,11 @@ VAR: present-space
 ! menu
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+USE: ui.gadgets.labeled.private
+
 : menu-rotations-4D ( -- gadget )
-    <frame>
+    3 3 <frame>
+        { 1 1 } >>filled-cell
          <pile> 1 >>fill
           "XY +" [ drop rotation-step 4D-Rxy rotation-4D ] 
                 button* add-gadget
@@ -225,7 +230,8 @@ VAR: present-space
 ;
 
 : menu-translations-4D ( -- gadget )
-    <frame> 
+    3 3 <frame> 
+        { 1 1 } >>filled-cell
         <pile> 1 >>fill
             <shelf> 1 >>fill  
                 "X+" [ drop {  1 0 0 0 } translation-step v*n 
@@ -325,12 +331,13 @@ VAR: present-space
     [ ".xml" tail? ] filter 
     [ append-path ] with map
     [ <run-file-button> add-gadget ] each
-    swap <labelled-gadget> ;
+    swap <labeled-gadget> ;
 
 ! -----------------------------------------------------
 
 : menu-rotations-3D ( -- gadget )
-    <frame>
+    3 3 <frame>
+        { 1 1 } >>filled-cell
         "Turn\n left"  [ rotation-step  turn-left  ] 
             camera-button   @left grid-add     
         "Turn\n right" [ rotation-step turn-right ] 
@@ -348,7 +355,8 @@ VAR: present-space
 ;
 
 : menu-translations-3D ( -- gadget )
-    <frame>
+    3 3 <frame>
+        { 1 1 } >>filled-cell
         "left\n(alt)"        [ translation-step  strafe-left  ]
             camera-button @left grid-add  
         "right\n(alt)"       [ translation-step  strafe-right ]
@@ -477,8 +485,7 @@ M: space adsoda-display-model
     { 0 1 } <track>
         menu-bar f track-add
         <list-runner>  
-            <limited-scroller>  
+            <scroller>
-            { 200 400 } >>max-dim
         f track-add
         <shelf>
             "Projection mode : " <label> add-gadget
@@ -492,17 +499,17 @@ M: space adsoda-display-model
         <pile>
             0.5 >>align    
             menu-4D add-gadget 
-            light-purple solid-interior
+            COLOR: purple s:<solid> >>interior
-            "4D movements" <labelled-gadget>
+            "4D movements" <labeled-gadget>
         f track-add
         <pile>
             0.5 >>align
             { 2 2 } >>gap
             menu-3D add-gadget
-            light-purple solid-interior 
+            COLOR: purple s:<solid> >>interior
-            "Camera 3D" <labelled-gadget>
+            "Camera 3D" <labeled-gadget>
         f track-add      
-        gray solid-interior
+        COLOR: gray s:<solid> >>interior
  ;
  
 : viewer-windows* ( --  )

extra/4DNav/camera/camera.factor

@@ -1,5 +1,4 @@
-USING: kernel namespaces math.vectors opengl 4DNav.turtle 
+USING: kernel namespaces math.vectors opengl 4DNav.turtle  ;
-self ;
 
 IN: 4DNav.camera
 

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

@@ -139,9 +139,9 @@ file-chooser H{
     f track-add
     <shelf> 
         over [  swap fc-go-parent ] curry  "go up" 
-            swap <bevel-button> add-gadget
+            swap <border-button> add-gadget
         over [  swap fc-go-home ] curry  "go home" 
-            swap <bevel-button> add-gadget
+            swap <border-button> add-gadget
     !    over [ swap fc-ok-action ] curry "OK" 
     !    swap <bevel-button> add-gadget
     !    [ drop ]  "Cancel" swap <bevel-button> add-gadget

extra/4DNav/turtle/turtle.factor

@@ -2,10 +2,18 @@ USING: kernel math arrays math.vectors math.matrices
 namespaces make
 math.constants math.functions
 math.vectors
-splitting grouping self math.trig
+splitting grouping math.trig
-  sequences accessors 4DNav.deep models ;
+  sequences accessors 4DNav.deep models vars ;
 IN: 4DNav.turtle
 
+! replacement of self
+
+VAR: self
+
+: with-self ( quot obj -- ) [ >self call ] with-scope ;
+
+: save-self ( quot -- ) self> [ self> clone >self call ] dip >self ;
+
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 TUPLE: turtle pos ori ;

extra/4DNav/window3D/window3D.factor

@@ -28,7 +28,7 @@ IN: 4DNav.window3D
 TUPLE: window3D  < gadget observer ; 
 
 : <window3D>  ( model observer -- gadget )
-    window3D  new-gadget 
+    window3D  new
     swap 2dup 
     projection-mode>> add-connection
     2dup 

extra/ui/gadgets/lists/lists.factor

@@ -4,8 +4,7 @@ USING: accessors math.vectors classes.tuple math.rectangles colors
 kernel sequences models opengl math math.order namespaces
 ui.commands ui.gestures ui.render ui.gadgets
 ui.gadgets.labels ui.gadgets.scrollers
-ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.packs
+ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.packs ;
-ui.gadgets.theme ;
 IN: ui.gadgets.lists
 
 TUPLE: list < pack index presenter color hook ;
@@ -14,7 +13,7 @@ TUPLE: list < pack index presenter color hook ;
     selection-color >>color ; inline
 
 : <list> ( hook presenter model -- gadget )
-    list new-gadget
+    list new
         { 0 1 } >>orientation
         1 >>fill
         0 >>index

extra/ui/gadgets/slate/slate.factor

@@ -14,7 +14,6 @@ TUPLE: slate < gadget action pdim graft ungraft ;
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : init-slate ( slate -- slate )
-  init-gadget
   [ ]         >>action
   { 200 200 } >>pdim
   [ ]         >>graft
@@ -29,9 +28,12 @@ M: slate pref-dim* ( slate -- dim ) pdim>> ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-USING: combinators arrays sequences math math.geometry
+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 ]

unmaintained/rewrite-closures/rewrite-closures.factor

@@ -1,27 +0,0 @@
-
-USING: kernel parser math quotations namespaces sequences macros fry ;
-
-IN: rewrite-closures
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: [set-parameters] ( seq -- quot ) reverse [ [ set ] curry ] map concat ;
-
-MACRO: set-parameters ( seq -- quot ) [set-parameters] ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: parametric-quot ( parameters quot -- quot ) '[ _ set-parameters _ call ] ;
-
-: scoped-quot ( quot -- quot ) '[ _ with-scope ] ;
-
-: closed-quot ( quot -- quot )
-  namestack swap '[ namestack [ _ set-namestack @ ] dip set-namestack ] ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: lambda ( parameters quot -- quot ) parametric-quot scoped-quot closed-quot ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: C[ \ ] [ >quotation ] parse-literal \ closed-quot parsed ; parsing

unmaintained/rewrite-closures/summary.txt

@@ -1 +0,0 @@
-Closures implemented via quotation rewriting

unmaintained/rewrite-closures/tags.txt

@@ -1 +0,0 @@
-extensions

unmaintained/self/authors.txt

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

unmaintained/self/self.factor

@@ -1,10 +0,0 @@
-
-USING: kernel namespaces vars ;
-
-IN: self
-
-VAR: self
-
-: with-self ( quot obj -- ) [ >self call ] with-scope ;
-
-: save-self ( quot -- ) self> [ self> clone >self call ] dip >self ;

unmaintained/self/slots/slots.factor

@@ -1,27 +0,0 @@
-
-USING: kernel words lexer parser sequences accessors self ;
-
-IN: self.slots
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: define-self-slot-reader ( slot -- )
-  [ "->" append current-vocab create dup set-word ]
-  [ ">>" append search [ self> ] swap suffix      ] bi
-  (( -- value )) define-declared ;
-
-: define-self-slot-writer ( slot -- )
-  [ "->" prepend current-vocab create dup set-word ]
-  [ ">>" prepend search [ self> swap ] swap suffix [ drop ] append ] bi
-  (( value -- )) define-declared ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: define-self-slot-accessors ( class -- )
-  "slots" word-prop
-  [ name>> ] map
-  [ [ define-self-slot-reader ] [ define-self-slot-writer ] bi ] each ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: SELF-SLOTS: scan-word define-self-slot-accessors ; parsing

unmaintained/slate/authors.txt

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