working on presentation outliner to replace mindmap

library/ui/gadgets.factor

@@ -74,8 +74,3 @@ M: gadget children-on ( rect/point gadget -- list )
             [ nip pick-up ] [ rot 2drop ] if
         ] with-scope
     ] [ 2drop f ] if ;
-
-! Mind-map/outliner node protocol
-GENERIC: node-gadget ( node -- gadget )
-GENERIC: node-left ( node -- seq )
-GENERIC: node-right ( node -- seq )

library/ui/listener.factor

@@ -33,7 +33,7 @@ C: display ( -- display )
 : present-stack ( seq title display -- )
     [ display-title set-label-text ] keep
     [ display-title relayout ] keep
-    display-pane dup pane-clear [ stack. ] with-stream* ;
+    display-pane [ stack. ] with-pane ;
 
 : ui-listener-hook ( -- )
     datastack-hook get call datastack-display get present-stack

library/ui/load.factor

@@ -25,7 +25,6 @@ USING: kernel parser sequences io ;
     "/library/ui/presentations.factor"
     "/library/ui/books.factor"
     "/library/ui/outliner.factor"
-    "/library/ui/mindmap.factor"
     "/library/ui/listener.factor"
     "/library/ui/ui.factor"
 ] [

library/ui/mindmap.factor

@@ -1,101 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets-mindmap
-USING: arrays gadgets gadgets-buttons gadgets-labels
-gadgets-layouts generic kernel math sequences styles ;
-
-! Mind-map tree-view gadget, like http://freemind.sf.net.
-
-TUPLE: mindmap left node gadget right expanded? left? right? ;
-
-DEFER: <expand-button>
-
-: add-mindmap-node ( mindmap -- )
-    dup mindmap-node node-gadget <expand-button> 2array
-    <shelf> [ add-gadgets ] keep swap
-    2dup add-gadget set-mindmap-gadget ;
-
-: collapse-mindmap ( mindmap -- )
-    f over set-mindmap-expanded?
-    f over set-mindmap-left
-    f over set-mindmap-right
-    dup clear-gadget
-    add-mindmap-node ;
-
-: mindmap-child ( left? right? obj -- gadget )
-    dup [ gadget? ] is? [ 2nip ] [ <mindmap> ] if ;
-
-: mindmap-children ( seq left? right? -- gadget )
-    rot [ >r 2dup r> mindmap-child ] map 2nip
-    <pile> @{ 0 5 0 }@ over set-pack-gap [ add-gadgets ] keep ;
-
-: (expand-left) ( node -- gadget )
-    mindmap-node node-left t f mindmap-children
-    1 over set-pack-align ;
-
-: (expand-right) ( node -- gadget )
-    mindmap-node node-right f t mindmap-children
-    0 over set-pack-align ;
-
-: add-nonempty ( child gadget -- )
-    over gadget-children empty? [ 2drop ] [ add-gadget ] if ;
-
-: if-left ( mindmap quot -- | quot: mindmap -- )
-    >r dup mindmap-left? r> [ drop ] if ; inline
-
-: expand-left ( mindmap -- )
-    [
-        dup (expand-left) swap 2dup
-        add-nonempty set-mindmap-left
-    ] if-left ;
-
-: if-right ( mindmap quot -- | quot: mindmap -- )
-    >r dup mindmap-right? r> [ drop ] if ; inline
-
-: expand-right ( mindmap -- )
-    [
-        dup (expand-right) swap 2dup
-        add-nonempty set-mindmap-right
-    ] if-right ;
-
-: expand-mindmap ( mindmap -- )
-    t over set-mindmap-expanded?
-    dup clear-gadget
-    dup expand-left
-    dup add-mindmap-node
-    expand-right ;
-
-: toggle-mindmap ( mindmap -- )
-    dup mindmap-expanded?
-    [ collapse-mindmap ] [ expand-mindmap ] if ;
-
-C: mindmap ( left? right? node -- gadget )
-    <shelf> over set-delegate
-    1/2 over set-pack-align
-    @{ 50 0 0 }@ over set-pack-gap
-    [ set-mindmap-node ] keep
-    [ set-mindmap-right? ] keep
-    [ set-mindmap-left? ] keep
-    dup collapse-mindmap ;
-
-: draw-arrows ( mindmap child point -- )
-    tuck >r >r >r mindmap-gadget r> @{ 1 1 1 }@ swap v-
-    gadget-point r> gadget-children r> swap
-    [ swap gadget-point ] map-with gray draw-fanout ;
-
-: draw-left-arrows ( mindmap -- )
-    [ dup mindmap-left { 1 1/2 1/2 } draw-arrows ] if-left ;
-
-: draw-right-arrows ( mindmap -- )
-    [ dup mindmap-right { 0 1/2 1/2 } draw-arrows ] if-right ;
-
-M: mindmap draw-gadget* ( mindmap -- )
-    dup delegate draw-gadget*
-    dup mindmap-expanded? [
-        dup draw-left-arrows dup draw-right-arrows
-    ] when drop ;
-
-: find-mindmap [ mindmap? ] find-parent ;
-
-: <expand-button> ( label -- gadget )
-    "+" <label> [ find-mindmap toggle-mindmap ] <roll-button> ;

library/ui/panes.factor

@@ -30,7 +30,8 @@ TUPLE: pane output active current input continuation scrolls? ;
     dup pane-continuation f rot set-pane-continuation ;
 
 : pane-eval ( string pane -- )
-    pop-continuation [ continue-with ] in-thread 2drop ;
+    pop-continuation dup
+    [ [ continue-with ] in-thread ] when 2drop ;
 
 SYMBOL: structured-input
 
@@ -133,3 +134,8 @@ M: pane stream-close ( pane -- ) drop ;
     #! Execute the quotation with output to an output-only pane.
     f f <pane> world-theme over set-gadget-paint
     [ swap with-stream ] keep ; inline
+
+: with-pane ( pane quot -- )
+    #! Clear the pane and run the quotation in a scope with
+    #! stdio set to the pane.
+    >r dup pane-clear r> with-stream* ; inline

library/ui/ui.factor

@@ -5,19 +5,6 @@ USING: gadgets-layouts gadgets-listener generic help io kernel
 listener lists math memory namespaces prettyprint sdl sequences
 shells styles threads words ;
 
-: world-theme
-    {{
-        [[ background @{ 255 255 255 }@ ]]
-        [[ rollover-bg @{ 236 230 232 }@ ]]
-        [[ bevel-1 { 160 160 160 }@ ]]
-        [[ bevel-2 @{ 232 232 232 }@ ]]
-        [[ foreground @{ 0 0 0 }@ ]]
-        [[ reverse-video f ]]
-        [[ font "Monospaced" ]]
-        [[ font-size 12 ]]
-        [[ font-style plain ]]
-    }} ;
-
 : init-world
     ttf-init
     global [

library/ui/world.factor

@@ -3,7 +3,7 @@
 IN: gadgets
 USING: alien arrays errors gadgets-layouts generic io kernel
 lists math memory namespaces prettyprint sdl sequences sequences
-strings threads ;
+strings styles threads ;
 
 ! The world gadget is the top level gadget that all (visible)
 ! gadgets are contained in. The current world is stored in the
@@ -67,3 +67,16 @@ DEFER: handle-event
 
 : start-world ( -- )
     world get t over set-world-running? relayout ;
+
+: world-theme
+    {{
+        [[ background @{ 255 255 255 }@ ]]
+        [[ rollover-bg @{ 236 230 232 }@ ]]
+        [[ bevel-1 { 160 160 160 }@ ]]
+        [[ bevel-2 @{ 232 232 232 }@ ]]
+        [[ foreground @{ 0 0 0 }@ ]]
+        [[ reverse-video f ]]
+        [[ font "Monospaced" ]]
+        [[ font-size 12 ]]
+        [[ font-style plain ]]
+    }} ;