aboutsummaryrefslogtreecommitdiffhomepage
path: root/demo
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-09-08 10:18:19 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-09-08 10:18:19 -0400
commitd07c91bf275874a5f6f13af5f338def78eea7ae0 (patch)
tree700a022259cb238d022c76cb0b6c30fb44985aed /demo
parent815c52605cdba3c95d7e4e6fd3f1eddf0939bc6a (diff)
dragList almost kinda works
Diffstat (limited to 'demo')
-rw-r--r--demo/more/dragList.ur33
-rw-r--r--demo/more/dragList.urp4
-rw-r--r--demo/more/dragList.urs1
3 files changed, 38 insertions, 0 deletions
diff --git a/demo/more/dragList.ur b/demo/more/dragList.ur
new file mode 100644
index 00000000..ddb50e82
--- /dev/null
+++ b/demo/more/dragList.ur
@@ -0,0 +1,33 @@
+fun draggableList title items =
+ itemSources <- List.mapM source items;
+ draggingItem <- source None;
+ return <xml>
+ <h2>Great {[title]}</h2>
+ <ul>
+ {List.mapX (fn itemSource => <xml>
+ <li onmousedown={set draggingItem (Some itemSource)}
+ onmouseup={set draggingItem None}
+ onmouseover={di <- get draggingItem;
+ case di of
+ None => return ()
+ | Some di => item1 <- get di;
+ item2 <- get itemSource;
+ set di item2;
+ set itemSource item1}>
+ <dyn signal={s <- signal itemSource; return <xml>{[s]}</xml>}/>
+ </li></xml>) itemSources}
+ </ul>
+ </xml>
+
+fun main () =
+ bears <- draggableList "Bears" ("Pooh" :: "Paddington" :: "Rupert" :: "Edward" :: []);
+ beers <- draggableList "Beers" ("Budvar" :: "Delirium Tremens" :: "Deuchars" :: []);
+ boars <- draggableList "Boars" ("Sus scrofa scrofa"
+ :: "Sus scrofa ussuricus"
+ :: "Sus scrofa cristatus"
+ :: "Sus scrofa taiwanus" :: []);
+ return <xml><body>
+ {bears}
+ {beers}
+ {boars}
+ </body></xml>
diff --git a/demo/more/dragList.urp b/demo/more/dragList.urp
new file mode 100644
index 00000000..56fb9cce
--- /dev/null
+++ b/demo/more/dragList.urp
@@ -0,0 +1,4 @@
+debug
+
+$/list
+dragList
diff --git a/demo/more/dragList.urs b/demo/more/dragList.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/demo/more/dragList.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page