changeset 940:e2be476673f2

Selection working, but switching it on isn't
author Adam Chlipala <adamc@hcoop.net>
date Tue, 15 Sep 2009 11:18:20 -0400 (2009-09-15)
parents 38a376dc7401
children b8d7a47b8e0c
files demo/more/dbgrid.urs demo/more/grid.ur demo/more/grid.urs demo/more/grid1.ur
diffstat 4 files changed, 44 insertions(+), 9 deletions(-) [+]
line wrap: on
line diff
--- a/demo/more/dbgrid.urs	Tue Sep 15 10:50:49 2009 -0400
+++ b/demo/more/dbgrid.urs	Tue Sep 15 11:18:20 2009 -0400
@@ -110,4 +110,7 @@
     val grid : transaction grid
     val sync : grid -> transaction unit
     val render : grid -> xbody
+
+    val showSelection : grid -> source bool
+    val selection : grid -> signal (list ($(M.key ++ M.row)))
 end
--- a/demo/more/grid.ur	Tue Sep 15 10:50:49 2009 -0400
+++ b/demo/more/grid.ur	Tue Sep 15 11:18:20 2009 -0400
@@ -48,18 +48,24 @@
                                      [_] M.folder cols M.cols)
                                (@@Folder.mp [_] [_] M.folder)
 
+    type grid = {Cols : $(map fst M.cols),
+                 Rows : Dlist.dlist {Row : source M.row,
+                                     Cols : source ($(map snd M.cols)),
+                                     Updating : source bool,
+                                     Selected : source bool},
+                 Selection : source bool}
+
     fun addRow cols rows row =
         rowS <- source row;
         cols <- makeAll cols row;
         colsS <- source cols;
         ud <- source False;
+        sd <- source False;
         Monad.ignore (Dlist.append rows {Row = rowS,
                                          Cols = colsS,
-                                         Updating = ud})
+                                         Updating = ud,
+                                         Selected = sd})
 
-    type grid = {Cols : $(map fst M.cols),
-                 Rows : Dlist.dlist {Row : source M.row, Cols : source ($(map snd M.cols)), Updating : source bool}}
- 
     val createMetas = Monad.mapR [colMeta M.row] [fst]
                            (fn [nm :: Name] [p :: (Type * Type)] meta => meta.Initialize)
                            [_] M.folder M.cols
@@ -67,9 +73,10 @@
     val grid =
         cols <- createMetas;
         rows <- Dlist.create;
-        return {Cols = cols, Rows = rows}
+        sel <- source False;
+        return {Cols = cols, Rows = rows, Selection = sel}
 
-    fun sync {Cols = cols, Rows = rows} =
+    fun sync {Cols = cols, Rows = rows, ...} =
         Dlist.clear rows;
         init <- rpc M.list;
         List.app (addRow cols rows) init
@@ -85,7 +92,7 @@
                    [_] M.folder grid.Cols M.cols}
         </tr>
 
-        {Dlist.render (fn {Row = rowS, Cols = colsS, Updating = ud} pos =>
+        {Dlist.render (fn {Row = rowS, Cols = colsS, Updating = ud, Selected = sd} pos =>
                           let
                               val delete =
                                   Dlist.delete pos;
@@ -135,6 +142,14 @@
                           in
                               <xml><tr class={tr}>
                                 <td>
+                                  <dyn signal={b <- signal grid.Selection;
+                                               return (if not b then
+                                                           <xml><ccheckbox source={sd}/></xml>
+                                                       else
+                                                           <xml>No</xml>)}/>
+                                </td>
+
+                                <td>
                                   <dyn signal={b <- signal ud;
                                                return (if b then
                                                            <xml><button value="Save" onclick={save}/></xml>
@@ -197,4 +212,14 @@
                                            addRow grid.Cols grid.Rows row}/>
           <button value="Refresh" onclick={sync grid}/>
     </xml>
+
+    fun showSelection grid = grid.Selection
+
+    fun selection grid = Dlist.foldl (fn {Row = rowS, Selected = sd, ...} ls =>
+                                         sd <- signal sd;
+                                         if sd then
+                                             row <- signal rowS;
+                                             return (row :: ls)
+                                         else
+                                             return ls) [] grid.Rows
 end
--- a/demo/more/grid.urs	Tue Sep 15 10:50:49 2009 -0400
+++ b/demo/more/grid.urs	Tue Sep 15 11:18:20 2009 -0400
@@ -39,7 +39,10 @@
     val grid : transaction grid
     val sync : grid -> transaction unit
     val render : grid -> xbody
-                           
+
+    val showSelection : grid -> source bool
+    val selection : grid -> signal (list M.row)
+
     style tabl
     style tr
     style th
--- a/demo/more/grid1.ur	Tue Sep 15 10:50:49 2009 -0400
+++ b/demo/more/grid1.ur	Tue Sep 15 11:18:20 2009 -0400
@@ -53,7 +53,7 @@
                                        Display = txt},
                                 Dummy2 = {Initial = (),
                                           Step = fn _ _ => (),
-                                          Display = fn _ => <xml>-</xml>},
+                                          Display = fn _ => <xml/>},
                                 And = {Initial = True,
                                        Step = fn r b => r.C && b,
                                        Display = txt}}
@@ -61,11 +61,15 @@
 
 fun main () =
     grid <- grid;
+    set (showSelection grid) True;
     return <xml>
       <head>
         <link rel="stylesheet" type="text/css" href="../../grid.css"/>
       </head>
       <body onload={sync grid}>
         {render grid}
+        <hr/>
+        Selection: <dyn signal={ls <- selection grid;
+                                return (List.mapX (fn r => <xml>{[r.Id]}; </xml>) ls)}/>
       </body>
     </xml>