summaryrefslogtreecommitdiff
path: root/demo/more
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-09-15 11:18:20 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-09-15 11:18:20 -0400
commitcbf9a437d79ca88f901d97c4d8881f7d4e711d2d (patch)
tree0ac2b69d65bddef052bbc62443b262cb5a230b4b /demo/more
parentaf108dfe039a25905becdd58e6bd609e6e8cc6be (diff)
Selection working, but switching it on isn't
Diffstat (limited to 'demo/more')
-rw-r--r--demo/more/dbgrid.urs3
-rw-r--r--demo/more/grid.ur39
-rw-r--r--demo/more/grid.urs5
-rw-r--r--demo/more/grid1.ur6
4 files changed, 44 insertions, 9 deletions
diff --git a/demo/more/dbgrid.urs b/demo/more/dbgrid.urs
index e715542b..404d0f62 100644
--- a/demo/more/dbgrid.urs
+++ b/demo/more/dbgrid.urs
@@ -110,4 +110,7 @@ functor Make(M : sig
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
diff --git a/demo/more/grid.ur b/demo/more/grid.ur
index 7e593791..56230c8e 100644
--- a/demo/more/grid.ur
+++ b/demo/more/grid.ur
@@ -48,18 +48,24 @@ functor Make(M : sig
[_] 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 @@ functor Make(M : sig
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 @@ functor Make(M : sig
[_] 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 @@ functor Make(M : sig
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 @@ functor Make(M : sig
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
diff --git a/demo/more/grid.urs b/demo/more/grid.urs
index a3fd76cc..51ec79c2 100644
--- a/demo/more/grid.urs
+++ b/demo/more/grid.urs
@@ -39,7 +39,10 @@ functor Make(M : sig
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
diff --git a/demo/more/grid1.ur b/demo/more/grid1.ur
index edd5858d..bad193bb 100644
--- a/demo/more/grid1.ur
+++ b/demo/more/grid1.ur
@@ -53,7 +53,7 @@ open Make(struct
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 @@ open Make(struct
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>