rip out more code

diff --git a/library/ui/load.factor b/library/ui/load.factor
index 364914072a173b7e9ea63b05ccec0890298b052b..40d4d9a2627f8f6c431f2b9202cd23f4ebef5a26 100644 (file)
--- a/library/ui/load.factor
+++ b/library/ui/load.factor
@@ -28,8 +28,8 @@ USING: kernel parser sequences io ;
     "/library/ui/editors.factor"
     "/library/ui/menus.factor"
     "/library/ui/presentations.factor"
-    "/library/ui/tiles.factor"
     "/library/ui/splitters.factor"
+    "/library/ui/panes.factor"
     "/library/ui/init-world.factor"
     "/library/ui/ui.factor"
 ] [

diff --git a/library/ui/panes.factor b/library/ui/panes.factor
new file mode 100644 (file)
index 0000000..bff62ea
--- /dev/null
+++ b/library/ui/panes.factor
@@ -0,0 +1,89 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: gadgets
+USING: generic kernel line-editor listener lists math namespaces
+sequences io strings threads ;
+
+! A pane is an area that can display text.
+
+! output: pile
+! current: shelf
+! input: editor
+TUPLE: pane output active current input continuation ;
+
+: add-output 2dup set-pane-output add-gadget ;
+: add-input 2dup set-pane-input add-gadget ;
+
+: <active-line> ( input current -- line )
+    <line-shelf> [ add-gadget ] keep [ add-gadget ] keep ;
+
+: init-active-line ( pane -- )
+    dup pane-active [ unparent ] when*
+    [ dup pane-input swap pane-current <active-line> ] keep
+    2dup set-pane-active add-gadget ;
+
+: pane-paint ( pane -- )
+    [[ "Monospaced" 12 ]] font set-paint-prop ;
+
+: pop-continuation ( pane -- quot )
+    dup pane-continuation f rot set-pane-continuation ;
+
+: pane-return ( pane -- )
+    [
+        pane-input [
+            commit-history line-text get line-clear
+        ] with-editor
+    ] keep
+    2dup stream-write "\n" over stream-write
+    pop-continuation in-thread drop ;
+ 
+: pane-actions ( line -- )
+    [
+        [[ [ button-down 1 ] [ pane-input click-editor ] ]]
+        [[ [ "RETURN" ] [ pane-return ] ]]
+        [[ [ "UP" ] [ pane-input [ history-prev ] with-editor ] ]]
+        [[ [ "DOWN" ] [ pane-input [ history-next ] with-editor ] ]]
+    ] swap add-actions ;
+
+C: pane ( -- pane )
+    <line-pile> over set-delegate
+    <line-pile> over add-output
+    "" <label> over set-pane-current
+    "" <editor> over set-pane-input
+    dup init-active-line
+    dup pane-paint
+    dup pane-actions ;
+
+: pane-write-1 ( style pane text -- )
+    swap >r <styled-label> r> pane-current add-gadget ;
+
+: pane-terpri ( pane -- )
+    dup pane-current over pane-output add-gadget
+    <line-shelf> over set-pane-current init-active-line ;
+
+: pane-write ( style pane list -- )
+    3dup car pane-write-1 cdr dup
+    [ over pane-terpri pane-write ] [ 3drop ] ifte ;
+
+! Panes are streams.
+M: pane stream-flush ( stream -- ) relayout ;
+M: pane stream-auto-flush ( stream -- ) stream-flush ;
+
+M: pane stream-readln ( stream -- line )
+    [ over set-pane-continuation stop ] callcc1 nip ;
+
+M: pane stream-write-attr ( string style stream -- )
+    [ rot "\n" split pane-write ] keep scroll>bottom ;
+
+M: pane stream-close ( stream -- ) drop ;
+
+: <console> ( -- pane )
+    <pane> dup
+    [ [ clear  print-banner listener ] in-thread ] with-stream
+    <scroller> ;
+
+: console ( -- )
+    #! Open an UI console window.
+    <console> "Listener" <tile> world get [
+        shape-size rect> 3/4 * >rect rot resize-gadget
+    ] 2keep add-gadget ;

diff --git a/library/ui/tiles.factor b/library/ui/tiles.factor
deleted file mode 100644 (file)
index 3acd692..0000000
--- a/library/ui/tiles.factor
+++ /dev/null
@@ -1,81 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: generic kernel math matrices namespaces ;
-
-! A tile is a gadget with a caption. Dragging the caption
-! moves the gadget. The title bar also has buttons for
-! performing various actions.
-TUPLE: tile original ;
-
-: click-rel ( gadget -- point )
-    screen-loc
-    hand [ hand-clicked screen-loc v- ] keep hand-click-rel v- ;
-
-: move-tile ( tile -- )
-    dup click-rel hand screen-loc v+ swap set-gadget-loc ;
-
-: start-resizing ( tile -- )
-    dup shape-dim swap set-tile-original ;
-
-: resize-tile ( tile -- )
-    dup screen-loc hand hand-click-loc v- over tile-original v+
-    over hand relative v+ swap set-gadget-dim ;
- 
-: raise ( gadget -- )
-    dup gadget-parent >r dup unparent r> add-gadget ;
-
-: caption-actions ( caption -- )
-    dup [ raise ] [ button-down 1 ] link-action
-    dup [ drop ] [ button-up 1 ] set-action
-    [ move-tile ] [ drag 1 ] link-action ;
-
-: close-tile [ close-tile ] swap handle-gesture drop ;
-
-: <close-box> ( -- gadget )
-    <check> line-border dup [ close-tile ] button-gestures ;
-
-: caption-content ( text -- gadget )
-    1/2 10 0 <shelf>
-    [ <close-box> swap add-gadget ] keep
-    [ >r <label> r> add-gadget ] keep ;
-
-: <caption> ( text -- caption )
-    caption-content filled-border
-    dup t reverse-video set-paint-prop
-    dup caption-actions ;
-
-: tile-actions ( tile -- )
-    dup [ unparent ] [ close-tile ] set-action
-    dup [ raise ] [ raise ] set-action
-    dup [ move-tile ] [ move-tile ] set-action
-    dup [ resize-tile ] [ resize-tile ] set-action
-    dup [ start-resizing ] [ start-resizing ] set-action
-    [ drop ] [ button-down 1 ] set-action ;
-
-: <resizer> ( -- gadget )
-    <frame>
-    dup [ resize-tile ] [ drag 1 ] link-action
-    dup [ start-resizing ] [ button-down 1 ] link-action
-    0 0 40 10 <plain-rect> <gadget>
-    dup t reverse-video set-paint-prop
-    over add-right ;
-
-: tile-content ( child caption -- pile )
-     <frame>
-     [ >r <caption> r> add-top ] keep
-     [ <resizer> swap add-bottom ] keep
-     [ add-center ] keep ;
-
-C: tile ( child caption -- tile )
-    f line-border over set-delegate
-    [ >r tile-content r> add-gadget ] keep
-    dup tile-actions ;
-
-M: tile pref-size shape-size ;
-
-: tile ( gadget title -- )
-    #! Show the gadget in a new tile.
-    <tile> [
-        world get add-gadget { 100 100 0 }
-    ] keep set-gadget-dim ;