From 3a1441d0b486ee17f565fb3f04381ec5089ca9cf Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 27 Feb 2005 21:00:55 +0000
Subject: [PATCH] pane gadget, clipping work

---
 examples/gadget-test.factor                   |  21 +-
 library/bootstrap/boot-stage2.factor          |   8 +-
 library/bootstrap/init-stage2.factor          |   2 +-
 library/bootstrap/primitives.factor           |   4 +-
 library/ui/console.factor                     | 394 ------------------
 library/ui/dialogs.factor                     |   2 +-
 library/ui/{fields.factor => editors.factor}  |  97 +++--
 library/ui/layouts.factor                     |  18 +-
 library/ui/paint.factor                       |   2 +-
 library/ui/panes.factor                       |  74 ++++
 .../ui/{viewports.factor => scrolling.factor} |  16 +-
 library/ui/world.factor                       |  28 +-
 12 files changed, 180 insertions(+), 486 deletions(-)
 delete mode 100644 library/ui/console.factor
 rename library/ui/{fields.factor => editors.factor} (67%)
 create mode 100644 library/ui/panes.factor
 rename library/ui/{viewports.factor => scrolling.factor} (84%)

diff --git a/examples/gadget-test.factor b/examples/gadget-test.factor
index f0d6f7e208..1d9e32259f 100644
--- a/examples/gadget-test.factor
+++ b/examples/gadget-test.factor
@@ -15,7 +15,7 @@
 ! "examples/text-demo.factor" run-file
 
 IN: text-demo
-USING: unparser ;
+USING: listener threads unparser ;
 USE: streams
 USE: sdl
 USE: sdl-event
@@ -49,20 +49,19 @@ USE: words
     <line> <gadget> dup moving-actions ;
 
 : junk
-    <default-pile>
-    50 [
-        [ unparse <label> over add-gadget ] keep
-    ] repeat ;
+    <pane>
+    dup [
+        [
+            print-banner
+            listener
+        ] in-thread
+    ] with-stream ;
 
-: scroller
-    junk <viewport> dup <slider>
-    <default-shelf> 
-    [ tuck add-gadget add-gadget ] keep ;
 
 : make-shapes ( -- )
     f world get set-gadget-children
     
-    0 default-gap <pile> "pile" set
+    0 default-gap 0 <pile> "pile" set
 !    <default-shelf> "shelf" set
 !    "Close" [ "dialog" get world get remove-gadget ] <button> "shelf" get add-gadget
 !    "New Rectangle" [ drop 100 100 100 100 <funny-rect> dup [ 255 255 0 ] background set-paint-property world get add-gadget ] <button> "shelf" get add-gadget
@@ -74,7 +73,7 @@ USE: words
 !    "Welcome to Factor " version cat2 <label> "pile" get add-gadget
 !    "A field."  <field> "pile" get add-gadget
 !    "Another field."  <field> "pile" get add-gadget
-    scroller "pile" get add-gadget
+    junk <scroller> "pile" get add-gadget
 
     "pile" get bevel-border dup "dialog" set ! dup  
 ! moving-actions
diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor
index 777209cd58..5b20bb76c8 100644
--- a/library/bootstrap/boot-stage2.factor
+++ b/library/bootstrap/boot-stage2.factor
@@ -167,8 +167,6 @@ cpu "x86" = "mini" get not and [
         "/library/compiler/x86/generator.factor"
         "/library/compiler/x86/fixnum.factor"
 
-        "/library/ui/line-editor.factor"
-        "/library/ui/console.factor"
         "/library/ui/shapes.factor"
         "/library/ui/gadgets.factor"
         "/library/ui/paint.factor"
@@ -178,11 +176,13 @@ cpu "x86" = "mini" get not and [
         "/library/ui/world.factor"
         "/library/ui/labels.factor"
         "/library/ui/buttons.factor"
-        "/library/ui/fields.factor"
+        "/library/ui/line-editor.factor"
+        "/library/ui/editors.factor"
         "/library/ui/halo.factor"
         "/library/ui/dialogs.factor"
         "/library/ui/events.factor"
-        "/library/ui/viewports.factor"
+        "/library/ui/scrolling.factor"
+        "/library/ui/panes.factor"
     ] [
         dup print
         run-resource
diff --git a/library/bootstrap/init-stage2.factor b/library/bootstrap/init-stage2.factor
index 24157d9b43..d02d17a88b 100644
--- a/library/bootstrap/init-stage2.factor
+++ b/library/bootstrap/init-stage2.factor
@@ -13,7 +13,7 @@ words unparser kernel-internals console assembler memory ;
     "smart-terminal" on
     "verbose-compile" on
     "compile" on
-    os "win32" = "sdl" "ansi" ? "shell" set ;
+    os "win32" = "ui" "ansi" ? "shell" set ;
 
 : warm-boot ( -- )
     #! A fully bootstrapped image has this as the boot
diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index 51bdf651e3..88beecdb1d 100644
--- a/library/bootstrap/primitives.factor
+++ b/library/bootstrap/primitives.factor
@@ -193,8 +193,8 @@ vocabularies get [
     [ "<tuple>" "kernel-internals"            [ [ number ] [ tuple ] ] ]
     [ "begin-scan" "memory"                   [ [ ] [ ] ] ]
     [ "next-object" "memory"                  [ [ ] [ object ] ] ]
-    [ "end-scan" "memory"                     [ [ ] [ object ] ] ]
-    [ "size" "memory"                         [ [ ] [ object ] ] ]
+    [ "end-scan" "memory"                     [ [ ] [ ] ] ]
+    [ "size" "memory"                         [ [ object ] [ fixnum ] ] ]
 ] [                                           
     3unlist >r create >r 1 + r> 2dup swap f define r>
     dup string? [
diff --git a/library/ui/console.factor b/library/ui/console.factor
deleted file mode 100644
index e07ce5438c..0000000000
--- a/library/ui/console.factor
+++ /dev/null
@@ -1,394 +0,0 @@
-! :folding=indent:collapseFolds=1:
-
-! $Id$
-!
-! Copyright (C) 2004, 2005 Slava Pestov.
-! 
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-! A graphical console.
-!
-! To run this code, bootstrap Factor like so:
-!
-! ./f boot.image.le32
-!     -libraries:sdl:name=libSDL.so
-!     -libraries:sdl-gfx:name=libSDL_gfx.
-!
-! (But all on one line)
-!
-! Then, start Factor as usual (./f factor.image) and enter this
-! at the listener:
-!
-! USE: shells
-! sdl
-
-IN: console
-USE: generic
-USE: vectors
-USE: sdl
-USE: sdl-event
-USE: sdl-gfx
-USE: sdl-video
-USE: namespaces
-USE: math
-USE: kernel
-USE: strings
-USE: alien
-USE: sdl-keyboard
-USE: streams
-USE: prettyprint
-USE: listener
-USE: threads
-USE: stdio
-USE: errors
-USE: line-editor
-USE: hashtables
-USE: lists
-USE: sdl-ttf
-USE: prettyprint
-
-#! A namespace holding console state.
-SYMBOL: console
-#! A vector. New lines are pushed on the end.
-SYMBOL: lines
-#! An integer. Line at top of screen.
-SYMBOL: first-line
-#! Current X co-ordinate.
-SYMBOL: x
-#! Current Y co-ordinate.
-SYMBOL: y
-#! A string buffer.
-SYMBOL: output-line
-#! A line editor object.
-SYMBOL: input-line
-#! A TTF_Font* value.
-SYMBOL: console-font
-#! Font height.
-SYMBOL: line-height
-#! If this is on, the console will be redrawn on the next event
-#! refresh cycle.
-SYMBOL: redraw-console
-
-#! The font size is hardcoded here.
-: char-width 8 ;
-
-! Scrolling
-: visible-lines ( -- n ) height get line-height get /i ;
-: total-lines ( -- n ) lines get vector-length ;
-: available-lines ( -- ) total-lines first-line get - ;
-
-: fix-first-line ( line -- line )
-    total-lines visible-lines - 1 + min 0 max ;
-
-: change-first-line ( quot -- )
-    first-line get
-    swap call fix-first-line
-    first-line set ; inline
-
-: line-scroll-up   ( -- ) [ 1 - ] change-first-line ;
-: line-scroll-down ( -- ) [ 1 + ] change-first-line ;
-: page-scroll-up   ( -- ) [ visible-lines - ] change-first-line ;
-: page-scroll-down ( -- ) [ visible-lines + ] change-first-line ;
-
-: scroll-to-bottom ( -- )
-    total-lines fix-first-line first-line set ;
-
-! Rendering
-: background white ;
-: foreground black ;
-: cursor     red   ;
-
-: next-line ( -- )
-    0 x set  line-height get y [ + ] change ;
-
-: draw-line ( str -- )
-    >r x get y get console-font get r>
-    foreground 3unlist make-color draw-string
-    x [ + ] change ;
-
-: clear-display ( -- )
-    surface get 0 0 width get height get background rgb boxColor ;
-
-: draw-lines ( -- )
-    visible-lines available-lines min [
-        dup first-line get +
-        lines get vector-nth draw-line
-        next-line
-    ] repeat ;
-
-: blink-interval 500 ;
-
-: draw-cursor ( x -- )
-    surface get
-    swap
-    y get
-    over 1 +
-    y get line-height get +
-    cursor rgb boxColor ;
-
-: draw-current ( -- )
-    output-line get sbuf>str draw-line ;
-
-: caret-x ( -- x )
-    x get input-line get [
-        console-font get caret get line-text get str-head
-        size-string drop +
-    ] bind ;
-
-: draw-input ( -- )
-    caret-x >r
-    input-line get [ line-text get ] bind draw-line
-    r> draw-cursor ;
-
-: scrollbar-width 16 ;
-: scroll-y ( line -- y ) total-lines 1 + / height get * ;
-: scrollbar-top ( -- y ) first-line get scroll-y ;
-: scrollbar-bottom ( -- y ) first-line get visible-lines + scroll-y ;
-
-: draw-scrollbar ( -- )
-    surface get
-    width get scrollbar-width -
-    scrollbar-top
-    width get
-    scrollbar-bottom
-    black rgb boxColor ;
-
-: draw-console ( -- )
-    [
-        0 x set
-        0 y set
-        clear-display
-        draw-lines
-        height get y get - line-height get >= [
-            draw-current
-            draw-input
-        ] when
-        draw-scrollbar
-    ] with-surface ;
-
-: empty-buffer ( sbuf -- str )
-    dup sbuf>str 0 rot set-sbuf-length ;
-
-: add-line ( text -- )
-    lines get vector-push scroll-to-bottom ;
-
-: console-write ( text -- )
-    "\n" split1 [
-        swap output-line get sbuf-append
-        output-line get empty-buffer add-line
-    ] when*
-    output-line get sbuf-append ;
-
-! The console stream
-
-! Restoring this continuation with a string on the stack returns
-! to the caller of stream-readln.
-SYMBOL: input-continuation
-
-TUPLE: console-stream console redraw-continuation ;
-
-M: console-stream stream-flush ( stream -- )
-    stream-auto-flush ;
-
-M: console-stream stream-auto-flush ( stream -- )
-    console-stream-console [ redraw-console on ] bind ;
-
-M: console-stream stream-readln ( stream -- line )
-    [
-        swap [
-            console-stream-console
-            [ input-continuation set ] bind
-        ] keep
-        dup console-stream-redraw-continuation dup [
-            call
-        ] [
-            drop f
-        ] ifte
-    ] callcc1 nip ;
-
-M: console-stream stream-write-attr ( string style stream -- )
-    nip console-stream-console [ console-write ] bind ;
-
-M: console-stream stream-close ( stream -- ) drop ;
-
-! Event handling
-SYMBOL: event
-
-: valid-char? 1 255 between? ;
-
-: return-key
-     input-line get [
-         commit-history
-         line-text get
-         line-clear
-     ] bind
-     dup console-write "\n" console-write
-     input-continuation get call ;
-
-GENERIC: handle-event ( event -- ? )
-
-SYMBOL: keymap
-
-{{
-    [[ [ "RETURN" ] [ return-key ] ]]
-    [[ [ "BACKSPACE" ] [ input-line get [ backspace ] bind ] ]]
-    [[ [ "LEFT" ] [ input-line get [ left ] bind ] ]]
-    [[ [ "RIGHT" ] [ input-line get [ right ] bind ] ]]
-    [[ [ "UP" ] [ input-line get [ history-prev ] bind ] ]]
-    [[ [ "SHIFT" "DOWN" ] [ line-scroll-down ] ]]
-    [[ [ "SHIFT" "UP" ] [ line-scroll-up ] ]]
-    [[ [ "PAGEDOWN" ] [ page-scroll-down ] ]]
-    [[ [ "PAGEUP" ] [ page-scroll-up ] ]]
-    [[ [ "DOWN" ] [ input-line get [ history-next ] bind ] ]]
-    [[ [ "CTRL" "k" ] [ input-line get [ line-clear ] bind ] ]]
-}} keymap set
-
-: input-key? ( event -- ? )
-    #! Is this a keystroke that potentially inserts input, or
-    #! does it have modifiers?
-    keyboard-event-unicode valid-char? ;
-
-: user-input ( char -- )
-    input-line get [ insert-char ] bind  scroll-to-bottom ;
-
-M: key-down-event handle-event ( event -- ? )
-    dup keyboard-event>binding keymap get hash [
-        call redraw-console on
-    ] [
-        dup input-key? [
-            keyboard-event-unicode user-input redraw-console on
-        ] [
-            drop
-        ] ifte
-    ] ?ifte t ;
-
-! The y co-ordinate of the start of the drag.
-SYMBOL: drag-start-y
-! The first line at the time
-SYMBOL: drag-start-line
-
-: scrollbar-click ( y -- )
-    dup scrollbar-top < [
-        drop page-scroll-up redraw-console on
-    ] [
-        dup scrollbar-bottom > [
-            drop page-scroll-down redraw-console on
-        ] [
-            drag-start-y set
-            first-line get drag-start-line set
-        ] ifte
-    ] ifte ;
-
-M: button-down-event handle-event ( event -- ? )
-    dup button-event-x width get scrollbar-width - >= [
-        button-event-y scrollbar-click
-    ] [
-        drop
-    ] ifte t ;
-
-M: button-up-event handle-event ( event -- ? )
-    drop
-    drag-start-y off
-    drag-start-line off t ;
-
-M: motion-event handle-event ( event -- ? )
-    drag-start-y get [
-        motion-event-y drag-start-y get -
-        height get / total-lines * drag-start-line get +
-        >fixnum fix-first-line first-line set
-        redraw-console on
-    ] [
-        drop
-    ] ifte t ;
-
-M: resize-event handle-event ( event -- ? )
-    dup resize-event-w swap resize-event-h
-    0 SDL_HWSURFACE SDL_RESIZABLE bitor init-screen
-    scroll-to-bottom
-    redraw-console on t ;
-
-M: quit-event handle-event ( event -- ? )
-    drop f ;
-
-M: alien handle-event ( event -- ? )
-    drop t ;
-
-: check-event ( -- ? )
-    #! Check if there is a pending event.
-    #! Return if we should continue or stop.
-    event get dup SDL_PollEvent [
-        handle-event [ check-event ] [ f ] ifte
-    ] [
-        drop t
-    ] ifte ;
-
-: set-console-font ( font ptsize )
-    cons dup console-font set
-    lookup-font TTF_FontHeight line-height set ;
-
-: init-console ( -- )
-    TTF_Init
-    "/fonts/VeraMono.ttf" 14 set-console-font
-    <event> event set
-    0 first-line set
-    80 <vector> lines set
-    <line-editor> input-line set
-    80 <sbuf> output-line set
-    1 SDL_EnableUNICODE drop
-    SDL_DEFAULT_REPEAT_DELAY SDL_DEFAULT_REPEAT_INTERVAL
-    SDL_EnableKeyRepeat drop ;
-
-: console-loop ( -- )
-    redraw-console get [ draw-console redraw-console off ] when
-    yield check-event [ console-loop ] when ;
-
-: console-quit ( -- )
-    input-continuation get [ f swap call ] when*
-    SDL_Quit ;
-
-SYMBOL: escape-continuation
-
-IN: shells
-
-: sdl ( -- )
-    <namespace> [
-        640 480 0 SDL_HWSURFACE SDL_RESIZABLE bitor init-screen
-        init-console
-    ] extend console set
-
-    [
-        escape-continuation set
-
-        [
-            console get swap <console-stream>
-            [ print-banner listener ] with-stream
-            SDL_Quit
-            ( return from start-console word )
-            escape-continuation get call
-        ] callcc0
-
-        console get [
-            redraw-console on
-            console-loop
-            console-quit
-        ] bind
-    ] callcc0 ;
diff --git a/library/ui/dialogs.factor b/library/ui/dialogs.factor
index a494f4f059..293d57a63e 100644
--- a/library/ui/dialogs.factor
+++ b/library/ui/dialogs.factor
@@ -35,7 +35,7 @@ C: dialog ( content -- gadget )
     [ dialog-actions ] keep ;
 
 : <prompt> ( prompt -- gadget )
-    0 default-gap <pile>
+    0 default-gap 0 <pile>
     [ >r <label> r> add-gadget ] keep
     [ >r "" <field> r> add-gadget ] keep ;
 
diff --git a/library/ui/fields.factor b/library/ui/editors.factor
similarity index 67%
rename from library/ui/fields.factor
rename to library/ui/editors.factor
index 72cf4822b7..6b6a731c97 100644
--- a/library/ui/fields.factor
+++ b/library/ui/editors.factor
@@ -4,6 +4,9 @@ IN: gadgets
 USING: generic kernel lists math namespaces sdl line-editor
 strings ;
 
+! An editor gadget wraps a line editor object and passes
+! gestures to the line editor.
+
 TUPLE: editor line caret delegate ;
 
 : editor-text ( editor -- text )
@@ -12,16 +15,6 @@ TUPLE: editor line caret delegate ;
 : set-editor-text ( text editor -- )
     editor-line [ set-line-text ] bind ;
 
-: <caret> ( -- caret )
-    0 0 0 0 <plain-rect> <gadget>
-    dup red background set-paint-property ;
-
-C: editor ( text -- )
-    0 0 0 0 <line> <gadget> over set-editor-delegate
-    [ <line-editor> swap set-editor-line ] keep
-    [ <caret> swap set-editor-caret ] keep
-    [ set-editor-text ] keep ;
-
 : focus-editor ( editor -- )
     dup editor-caret over add-gadget
     dup blue foreground set-paint-property relayout ;
@@ -30,8 +23,10 @@ C: editor ( text -- )
     dup editor-caret unparent
     dup black foreground set-paint-property relayout ;
 
-: offset>x ( offset str -- x )
-    str-head font get swap size-string drop ;
+: with-editor ( editor quot -- )
+    #! Execute a quotation in the line editor scope, then
+    #! update the display.
+    swap [ editor-line swap bind ] keep relayout ; inline
 
 : run-char-widths ( str -- wlist )
     #! List of x co-ordinates of each character.
@@ -52,12 +47,49 @@ C: editor ( text -- )
 : x>offset ( x str -- offset )
     0 -rot run-char-widths (x>offset) ;
 
+: set-caret-x ( x editor -- )
+    #! Move the caret to a clicked location.
+    [ line-text get x>offset caret set ] with-editor ;
+
+: click-editor ( editor -- )
+    my-hand
+    2dup relative shape-x pick set-caret-x
+    request-focus ;
+
+: editor-gestures ( -- hash )
+    {{
+        [[ [ gain-focus ] [ focus-editor ] ]]
+        [[ [ lose-focus ] [ unfocus-editor ] ]]
+        [[ [ button-down 1 ] [ click-editor ] ]]
+        [[ [ "BACKSPACE" ] [ [ backspace ] with-editor ] ]]
+        [[ [ "LEFT" ] [ [ left ] with-editor ] ]]
+        [[ [ "RIGHT" ] [ [ right ] with-editor ] ]]
+        [[ [ "CTRL" "k" ] [ [ line-clear ] with-editor ] ]]
+    }} ;
+
+: <caret> ( -- caret )
+    0 0 0 0 <plain-rect> <gadget>
+    dup red background set-paint-property ;
+
+C: editor ( text -- )
+    0 0 0 0 <line> <gadget> over set-editor-delegate
+    [ <line-editor> swap set-editor-line ] keep
+    [ <caret> swap set-editor-caret ] keep
+    [ set-editor-text ] keep
+    [ editor-gestures swap set-gadget-gestures ] keep ;
+
+: offset>x ( offset str -- x )
+    str-head font get swap size-string drop ;
+
 : caret-pos ( editor -- x y )
     editor-line [ caret get line-text get ] bind offset>x 0 ;
 
 : caret-size ( editor -- w h )
     0 swap shape-h ;
 
+M: editor user-input* ( ch field -- ? )
+    [ insert-char ] with-editor t ;
+
 M: editor layout* ( field -- )
     dup [ editor-text dup shape-w swap shape-h ] keep
     resize-gadget
@@ -67,41 +99,6 @@ M: editor layout* ( field -- )
 M: editor draw-shape ( label -- )
     dup [ editor-text draw-shape ] with-trans ;
 
-TUPLE: field active? editor delegate ;
-
-: with-editor ( editor quot -- )
-    swap [ editor-line swap bind ] keep relayout ; inline
-
-: set-caret-x ( x editor -- )
-    #! Move the caret to a clicked location.
-    [ line-text get x>offset caret set ] with-editor ;
-
-: click-editor ( editor -- )
-    my-hand
-    2dup relative shape-x pick set-caret-x
-    request-focus ;
-
-: field-border ( gadget -- border )
-    bevel-border dup f bevel-up? set-paint-property ;
-
-M: field user-input* ( ch field -- ? )
-    field-editor [ insert-char ] with-editor t ;
-
-: field-gestures ( -- hash )
-    {{
-        [[ [ gain-focus ] [ field-editor focus-editor ] ]]
-        [[ [ lose-focus ] [ field-editor unfocus-editor ] ]]
-        [[ [ button-down 1 ] [ field-editor click-editor ] ]]
-        [[ [ "BACKSPACE" ] [ field-editor [ backspace ] with-editor ] ]]
-        [[ [ "LEFT" ] [ field-editor [ left ] with-editor ] ]]
-        [[ [ "RIGHT" ] [ field-editor [ right ] with-editor ] ]]
-        [[ [ "CTRL" "k" ] [ field-editor [ line-clear ] with-editor ] ]]
-    }} ;
-
-C: field ( text -- field )
-    #! Note that we want the editor's parent to be the field,
-    #! not the border.
-    [ f field-border swap set-field-delegate ] keep
-    [ >r <editor> dup r> set-field-editor ] keep
-    [ add-gadget ] keep
-    [ field-gestures swap set-gadget-gestures ] keep ;
+: <field> ( text -- field )
+    #! A field is just a stand-alone editor with a border.
+    <editor> bevel-border dup f bevel-up? set-paint-property  ;
diff --git a/library/ui/layouts.factor b/library/ui/layouts.factor
index 33c23cb5cf..4e67832696 100644
--- a/library/ui/layouts.factor
+++ b/library/ui/layouts.factor
@@ -24,15 +24,19 @@ M: gadget layout* drop ;
 : default-gap 3 ;
 
 ! A pile is a box that lays out its contents vertically.
-TUPLE: pile align gap delegate ;
+TUPLE: pile align gap fill delegate ;
 
-C: pile ( align gap -- pile )
-    <empty-gadget> over set-pile-delegate
+C: pile ( align gap fill -- pile )
+    #! align: 0 left aligns, 1/2 center, 1 right.
+    #! gap: between each child.
+    #! fill: 0 leaves default width, 1 fills to pile width.
+    [ <empty-gadget> swap set-pile-delegate ] keep
+    [ set-pile-fill ] keep
     [ set-pile-gap ] keep
     [ set-pile-align ] keep ;
 
-: <default-pile> ( -- pile )
-    1/2 default-gap <pile> ;
+: <default-pile> 1/2 default-gap 0 <pile> ;
+: <line-pile> 0 0 1 <pile> ;
 
 : horizontal-layout ( gadget y box -- )
     pick shape-w over shape-w swap - swap pile-align * >fixnum
@@ -57,8 +61,8 @@ C: shelf ( align gap -- shelf )
     pick shape-h over shape-h swap - swap shelf-align * >fixnum
     rot move-gadget ;
 
-: <default-shelf> ( -- shelf )
-    1/2 default-gap <shelf> ;
+: <default-shelf> 1/2 default-gap <shelf> ;
+: <line-shelf> 0 0 <shelf> ;
 
 M: shelf layout* ( pile -- )
     dup shelf-gap over gadget-children run-widths >r >r
diff --git a/library/ui/paint.factor b/library/ui/paint.factor
index c6332b96cc..2285c08267 100644
--- a/library/ui/paint.factor
+++ b/library/ui/paint.factor
@@ -151,7 +151,7 @@ SYMBOL: clip
     ] intersect* ;
 
 : clip-rect ( x1 x2 y1 y2 -- rect )
-    over - >r >r over - r> swap r> <rectangle> ;
+    over - 1 + >r >r over - 1 + r> swap r> <rectangle> ;
 
 : intersect ( gadget rect -- rect )
     #! The first gadget's rectangle is relative co-ordinates,
diff --git a/library/ui/panes.factor b/library/ui/panes.factor
new file mode 100644
index 0000000000..573cb2c2ad
--- /dev/null
+++ b/library/ui/panes.factor
@@ -0,0 +1,74 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: gadgets
+USING: kernel line-editor lists namespaces streams strings
+threads ;
+
+! A pane is an area that can display text.
+
+! output: pile
+! current: label
+! input: editor
+TUPLE: pane output current input continuation delegate ;
+
+: add-output 2dup set-pane-output add-gadget ;
+: add-input 2dup set-pane-input add-gadget ;
+
+: <active-line> ( current input -- line )
+    <line-shelf> [ tuck add-gadget add-gadget ] keep ;
+
+: pane-paint ( pane -- )
+    [[ "Monospaced" 12 ]] font set-paint-property ;
+
+: pane-return ( pane -- )
+    [
+        pane-input [
+            commit-history line-text get line-clear
+        ] with-editor
+    ] keep
+    2dup stream-write "\n" over stream-write
+    pane-continuation call ;
+ 
+: pane-actions ( line -- )
+    dup
+    [ pane-input click-editor ] [ button-down 1 ] set-action
+    [ pane-return ] [ "RETURN" ] set-action ;
+
+C: pane ( -- pane )
+    <line-pile> over set-pane-delegate
+    <line-pile> over add-output
+    "" <label> dup pick set-pane-current >r
+    "" <editor> dup pick set-pane-input r>
+    <active-line> over add-gadget
+    dup pane-paint
+    dup pane-actions ;
+
+: add-line ( text pane -- )
+    >r <label> r> pane-output add-gadget ;
+
+: pane-write-1 ( text pane -- )
+    pane-current [ label-text swap cat2 ] keep set-label-text ;
+
+: pane-terpri ( pane -- )
+    dup pane-current dup label-text rot add-line
+    "" over set-label-text relayout ;
+
+: pane-write ( pane list -- )
+    2dup car swap pane-write-1
+    cdr dup [
+        over pane-terpri pane-write
+    ] [
+        2drop
+    ] ifte ;
+
+! Panes are streams.
+M: pane stream-flush ( stream -- ) relayout ;
+M: pane stream-auto-flush ( stream -- ) relayout ;
+
+M: pane stream-readln ( stream -- line )
+    [ swap set-pane-continuation (yield) ] callcc1 nip ;
+
+M: pane stream-write-attr ( string style stream -- )
+    nip swap "\n" split pane-write ;
+
+M: pane stream-close ( stream -- ) drop ;
diff --git a/library/ui/viewports.factor b/library/ui/scrolling.factor
similarity index 84%
rename from library/ui/viewports.factor
rename to library/ui/scrolling.factor
index 99601ca651..aaf7a4f2a3 100644
--- a/library/ui/viewports.factor
+++ b/library/ui/scrolling.factor
@@ -10,7 +10,7 @@ C: viewport ( content -- viewport )
     [ add-gadget ] keep
     0 over set-viewport-x
     0 over set-viewport-y
-    200 200 pick resize-gadget ;
+    640 480 pick resize-gadget ;
 
 M: viewport layout* ( viewport -- )
     dup gadget-children [
@@ -70,7 +70,7 @@ C: slider ( viewport -- slider )
     [ set-slider-viewport ] keep
     [
         f bevel-border dup f bevel-up? set-paint-property
-        slider-size 200 pick resize-gadget
+        slider-size 480 pick resize-gadget
         swap set-slider-delegate
     ] keep
     [ <thumb> swap add-thumb ] keep
@@ -95,3 +95,15 @@ M: slider layout* ( slider -- )
     dup slider-viewport layout*
     dup shape-w over thumb-height pick slider-thumb resize-gadget
     0 over thumb-y rot slider-thumb move-gadget ;
+
+TUPLE: scroller viewport slider delegate ;
+
+: add-viewport 2dup set-scroller-viewport add-gadget ;
+: add-slider 2dup set-scroller-slider add-gadget ;
+
+C: scroller ( gadget -- scroller )
+    #! Wrap a scrolling pane around the gadget.
+    [ <default-shelf> swap set-scroller-delegate ] keep
+    [ >r <viewport> r> add-viewport ] keep
+    [ dup scroller-viewport <slider> swap add-slider ] keep ;
+
diff --git a/library/ui/world.factor b/library/ui/world.factor
index ac526c016b..de71ef3d8c 100644
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -66,19 +66,6 @@ DEFER: handle-event
 : title ( -- str )
     "Factor " version cat2 ;
 
-: start-world ( -- )
-    #! Start the Factor graphics subsystem with the given screen
-    #! dimensions.
-    t world get set-world-running?
-    world get shape-w world get shape-h 0 SDL_RESIZABLE
-    [
-        0 x set 0 y set [
-            0 0 width get height get <rectangle> clip set
-            title dup SDL_WM_SetCaption
-            <event> run-world
-        ] with-screen
-    ] with-scope ;
-
 global [
     <world> world set
     1024 768 world get resize-gadget
@@ -91,3 +78,18 @@ global [
         [[ font       [[ "Sans Serif" 16 ]] ]]
     }} world get set-gadget-paint
 ] bind
+
+IN: shells
+
+: ui ( -- )
+    #! Start the Factor graphics subsystem with the given screen
+    #! dimensions.
+    t world get set-world-running?
+    world get shape-w world get shape-h 0 SDL_RESIZABLE
+    [
+        0 x set 0 y set [
+            0 0 width get height get <rectangle> clip set
+            title dup SDL_WM_SetCaption
+            <event> run-world
+        ] with-screen
+    ] with-scope ;