diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor index 28838a900e..26fcdbfea2 100644 --- a/library/ui/gadgets.factor +++ b/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 ) diff --git a/library/ui/listener.factor b/library/ui/listener.factor index edcb015dd9..af60dc39ab 100644 --- a/library/ui/listener.factor +++ b/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 diff --git a/library/ui/load.factor b/library/ui/load.factor index b8329ec92b..d4e64fc953 100644 --- a/library/ui/load.factor +++ b/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" ] [ diff --git a/library/ui/mindmap.factor b/library/ui/mindmap.factor deleted file mode 100644 index 83000ad052..0000000000 --- a/library/ui/mindmap.factor +++ /dev/null @@ -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: - -: add-mindmap-node ( mindmap -- ) - dup mindmap-node node-gadget 2array - [ 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 ] [ ] if ; - -: mindmap-children ( seq left? right? -- gadget ) - rot [ >r 2dup r> mindmap-child ] map 2nip - @{ 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 ) - 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 ; - -: ( label -- gadget ) - "+"