Control cleanup with a new list gadget

diff --git a/library/ui/gadgets/books.factor b/library/ui/gadgets/books.factor
index 3351d644af0e81b9ebba8463b122e31df72214d9..cde10a442b7e2a41028e12d0f418e30cf5b97c9d 100644 (file)
--- a/library/ui/gadgets/books.factor
+++ b/library/ui/gadgets/books.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-books
-USING: gadgets gadgets-controls gadgets-panes gadgets-scrolling
+USING: gadgets gadgets-panes gadgets-scrolling
 kernel sequences models ;
 
 TUPLE: book ;
@@ -9,7 +9,7 @@ TUPLE: book ;
 : hide-all ( book -- ) gadget-children [ hide-gadget ] each ;
 
 : current-page ( book -- gadget )
-    [ control-model model-value ] keep nth-gadget ;
+    [ control-value ] keep nth-gadget ;
 
 M: book model-changed ( book -- )
     dup hide-all
@@ -18,9 +18,8 @@ M: book model-changed ( book -- )
     request-focus ;
 
 C: book ( pages -- book )
-    dup 0 <model> delegate>control
+    dup 0 <model> <gadget> delegate>control
     [ add-gadgets ] keep
-    dup dup set-control-self
     dup model-changed ;
 
 M: book pref-dim* gadget-children pref-dims max-dim ;

diff --git a/library/ui/gadgets/buttons.factor b/library/ui/gadgets/buttons.factor
index 963bc217613083c73e8c3bd9d5fdfe02beeef943..ab51994440ef19274de8df75bbea3ffc84d12620 100644 (file)
--- a/library/ui/gadgets/buttons.factor
+++ b/library/ui/gadgets/buttons.factor
@@ -1,7 +1,7 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-buttons
-USING: gadgets gadgets-borders gadgets-controls gadgets-labels
+USING: gadgets gadgets-borders gadgets-labels
 gadgets-theme generic io kernel math models namespaces sequences
 strings styles threads words ;
 

diff --git a/library/ui/gadgets/controls.factor b/library/ui/gadgets/controls.factor
index cb1c45de0aa0a74c757e382db4458a9d214c53bf..1dbfddebb2c0f2a362033c417c17da9a41225b4f 100644 (file)
--- a/library/ui/gadgets/controls.factor
+++ b/library/ui/gadgets/controls.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: gadgets-controls
-USING: gadgets kernel models ;
+IN: gadgets
+USING: kernel models ;
 
 TUPLE: control self model quot ;
 
@@ -11,17 +11,21 @@ C: control ( model gadget quot -- gadget )
     [ set-gadget-delegate ] keep
     [ set-control-model ] keep ;
 
+: control-value ( control -- value ) control-model model-value ;
+
 M: control graft*
-    dup control-self over control-model add-connection
+    control-self dup dup control-model add-connection
     model-changed ;
 
 M: control ungraft*
-    dup control-self swap control-model remove-connection ;
+    control-self dup control-model remove-connection ;
 
 M: control model-changed
-    [ control-model model-value ] keep
-    [ dup control-self swap control-quot call ] keep
-    control-self relayout ;
+    control-self
+    [ control-value ] keep
+    [ dup control-quot call ] keep
+    relayout ;
 
-: delegate>control ( gadget model -- )
-    <gadget> [ 2drop ] <control> swap set-gadget-delegate ;
+: delegate>control ( gadget model underlying -- )
+    [ 2drop ] <control> over set-gadget-delegate
+    dup set-control-self ;

diff --git a/library/ui/gadgets/labels.factor b/library/ui/gadgets/labels.factor
index 530e9b07fe27171a0c7bed9f020d18624598c96a..6799f24ef426982f26e71a5a563f2b5478400a85 100644 (file)
--- a/library/ui/gadgets/labels.factor
+++ b/library/ui/gadgets/labels.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-labels
-USING: arrays freetype gadgets gadgets-controls gadgets-theme
+USING: arrays freetype gadgets gadgets-theme
 generic hashtables io kernel math namespaces opengl sequences
 styles ;
 

diff --git a/library/ui/gadgets/lists.factor b/library/ui/gadgets/lists.factor
new file mode 100644 (file)
index 0000000..c5b788f
--- /dev/null
+++ b/library/ui/gadgets/lists.factor
@@ -0,0 +1,48 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: gadgets-lists
+USING: gadgets kernel sequences models opengl math ;
+
+TUPLE: list index quot color ;
+
+C: list ( model quot -- gadget )
+    [ set-list-quot ] keep
+    0 over set-list-index
+    { 0.8 0.8 1.0 1.0 } over set-list-color
+    dup rot <pile> 1 over set-pack-fill delegate>control ;
+
+M: list model-changed
+    dup clear-gadget
+    dup control-value over list-quot map
+    swap add-gadgets ;
+
+M: list draw-gadget*
+    dup list-color gl-color
+    dup list-index swap gadget-children 2dup bounds-check? [
+        nth rect-bounds swap [ gl-fill-rect ] with-translation
+    ] [
+        2drop
+    ] if ;
+
+M: list focusable-child* drop t ;
+
+: select-index ( n list -- )
+    dup control-value empty? [
+        2drop
+    ] [
+        [ control-value length rem ] keep
+        [ set-list-index ] keep
+        relayout-1
+    ] if ;
+
+: select-prev ( list -- )
+    dup list-index 1- swap select-index ;
+
+: select-next ( list -- )
+    dup list-index 1+ swap select-index ;
+
+\ list H{
+    { T{ button-down } [ request-focus ] }
+    { T{ key-down f f "UP" } [ select-prev ] }
+    { T{ key-down f f "DOWN" } [ select-next ] }
+} set-gestures

diff --git a/library/ui/gadgets/panes.factor b/library/ui/gadgets/panes.factor
index 651fee3d1520685b414fef7597d5faeffb6ba82a..7aaf64faaaa0ea7c458a5fcb557ea320c69a1459 100644 (file)
--- a/library/ui/gadgets/panes.factor
+++ b/library/ui/gadgets/panes.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-panes
-USING: gadgets gadgets-buttons gadgets-controls gadgets-labels
+USING: gadgets gadgets-buttons gadgets-labels
 gadgets-scrolling gadgets-theme generic hashtables io kernel
 namespaces sequences ;
 

diff --git a/library/ui/load.factor b/library/ui/load.factor
index 93d9ef905fdb482004fead298c68d0661530b364..e56f78114663ecf35b5a363566762036b3223638 100644 (file)
--- a/library/ui/load.factor
+++ b/library/ui/load.factor
@@ -28,6 +28,7 @@ PROVIDE: library/ui {
     "gadgets/panes.factor"
     "gadgets/books.factor"
     "gadgets/outliner.factor"
+    "gadgets/lists.factor"
     "text/document.factor"
     "text/elements.factor"
     "text/editor.factor"

diff --git a/library/ui/text/commands.factor b/library/ui/text/commands.factor
index 2510bffc3e617b4183b59cb7d53b14e4139178e9..ffad2edf7b1d89a30e6603e2aa1d0ff22a99d3fb 100644 (file)
--- a/library/ui/text/commands.factor
+++ b/library/ui/text/commands.factor
@@ -1,8 +1,7 @@
 ! Copyright (C) 2006 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-text
-USING: gadgets gadgets-controls kernel models namespaces
-sequences ;
+USING: gadgets kernel models namespaces sequences ;
 
 : editor-extend-selection ( editor -- )
     dup request-focus

diff --git a/library/ui/text/editor.factor b/library/ui/text/editor.factor
index 285f36b1ca5fa77f5b453497e8778c18fbeac8a9..f48d30644a8812f899d7c2c4f3f8b55abc4c4790 100644 (file)
--- a/library/ui/text/editor.factor
+++ b/library/ui/text/editor.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-text
 USING: arrays errors freetype gadgets gadgets-borders
-gadgets-buttons gadgets-controls gadgets-frames gadgets-labels
+gadgets-buttons gadgets-frames gadgets-labels
 gadgets-scrolling gadgets-theme io kernel math models namespaces
 opengl sequences strings styles ;
 
@@ -21,8 +21,7 @@ TUPLE: loc-monitor editor ;
     dup <loc> swap set-editor-mark ;
 
 C: editor ( -- editor )
-    dup <document> delegate>control
-    dup dup set-control-self
+    dup <document> <gadget> delegate>control
     dup init-editor-locs
     dup editor-theme ;
 
@@ -63,10 +62,7 @@ M: editor model-changed
 : change-caret&mark ( editor quot -- )
     over >r change-caret r> mark>caret ; inline
 
-: editor-lines ( editor -- seq )
-    control-model model-value ;
-
-: editor-line ( n editor -- str ) editor-lines nth ;
+: editor-line ( n editor -- str ) control-value nth ;
 
 : editor-font* ( editor -- font ) editor-font lookup-font ;
 
@@ -164,7 +160,7 @@ M: loc-monitor model-changed
 : visible-lines ( editor -- seq )
     \ first-visible-line get
     \ last-visible-line get
-    rot editor-lines <slice> ;
+    rot control-value <slice> ;
 
 : draw-lines ( -- )
     GL_MODELVIEW [
@@ -203,10 +199,10 @@ M: editor draw-gadget*
     [ draw-selection draw-lines draw-caret ] with-editor ;
 
 : editor-height ( editor -- n )
-    [ editor-lines length ] keep line>y ;
+    [ control-value length ] keep line>y ;
 
 : editor-width ( editor -- n )
-    0 swap dup editor-font* swap editor-lines
+    0 swap dup editor-font* swap control-value
     [ string-width max ] each-with ;
 
 M: editor pref-dim*

diff --git a/library/ui/text/field.factor b/library/ui/text/field.factor
index 22d7376cd8fe1e5b77496d0f42147cee69b8af42..43fa1a057a1a78e222e3c9edb0f71b716fb757de 100644 (file)
--- a/library/ui/text/field.factor
+++ b/library/ui/text/field.factor
@@ -1,8 +1,7 @@
 ! Copyright (C) 2006 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-text
-USING: gadgets gadgets-controls generic kernel models sequences
-gadgets-theme ;
+USING: gadgets generic kernel models sequences gadgets-theme ;
 
 TUPLE: field model ;
 

diff --git a/library/ui/text/interactor.factor b/library/ui/text/interactor.factor
index 72ef48828c8032059d9a08f603ca2516ee058c6f..79023a19c86fdee7d76fe46ec5e8c1fdc7a494dd 100644 (file)
--- a/library/ui/text/interactor.factor
+++ b/library/ui/text/interactor.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-text
-USING: arrays definitions gadgets gadgets-controls gadgets-panes
+USING: arrays definitions gadgets gadgets-panes
 generic hashtables help io kernel namespaces prettyprint styles
 threads sequences vectors definitions parser words strings ;
 

diff --git a/library/ui/tools/tools.factor b/library/ui/tools/tools.factor
index cc278836cd4a2e21e9a91b260a255260949e63cf..bffae8d3b52b95672767b9adf7aec2abd8c15261 100644 (file)
--- a/library/ui/tools/tools.factor
+++ b/library/ui/tools/tools.factor
@@ -4,7 +4,7 @@ IN: gadgets-messages
 DEFER: messages
 
 IN: gadgets-workspace
-USING: gadgets gadgets-books gadgets-controls gadgets-workspace
+USING: gadgets gadgets-books gadgets-workspace
 generic kernel models scratchpad sequences syntax
 gadgets-messages ;
 

diff --git a/library/ui/tools/workspace.factor b/library/ui/tools/workspace.factor
index 1aa2d79e6c6fa5719435f045c820e7f7de26b473..d6e2e899c377b617c5f61b658d28afa5ebce0e7c 100644 (file)
--- a/library/ui/tools/workspace.factor
+++ b/library/ui/tools/workspace.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-workspace
 USING: help arrays compiler gadgets gadgets-books
-gadgets-browser gadgets-buttons gadgets-controls
+gadgets-browser gadgets-buttons
 gadgets-dataflow gadgets-frames gadgets-grids gadgets-help
 gadgets-listener gadgets-presentations gadgets-walker
 gadgets-workspace generic kernel math modules scratchpad