Ur/Web: demo/more/dragList.ur annotate

dragList almost kinda works

author	Adam Chlipala <adamc@hcoop.net>
date	Tue, 08 Sep 2009 10:18:19 -0400
parents
children	321a2d6feb40

rev	line source
adamc@916	1 fun draggableList title items =
adamc@916	2 itemSources <- List.mapM source items;
adamc@916	3 draggingItem <- source None;
adamc@916	4 return <xml>
adamc@916	5 <h2>Great {[title]}</h2>
adamc@916	6 <ul>
adamc@916	7 {List.mapX (fn itemSource => <xml>
adamc@916	8 <li onmousedown={set draggingItem (Some itemSource)}
adamc@916	9 onmouseup={set draggingItem None}
adamc@916	10 onmouseover={di <- get draggingItem;
adamc@916	11 case di of
adamc@916	12 None => return ()
adamc@916	13 \| Some di => item1 <- get di;
adamc@916	14 item2 <- get itemSource;
adamc@916	15 set di item2;
adamc@916	16 set itemSource item1}>
adamc@916	17 <dyn signal={s <- signal itemSource; return <xml>{[s]}</xml>}/>
adamc@916	18 </li></xml>) itemSources}
adamc@916	19 </ul>
adamc@916	20 </xml>
adamc@916	21
adamc@916	22 fun main () =
adamc@916	23 bears <- draggableList "Bears" ("Pooh" :: "Paddington" :: "Rupert" :: "Edward" :: []);
adamc@916	24 beers <- draggableList "Beers" ("Budvar" :: "Delirium Tremens" :: "Deuchars" :: []);
adamc@916	25 boars <- draggableList "Boars" ("Sus scrofa scrofa"
adamc@916	26 :: "Sus scrofa ussuricus"
adamc@916	27 :: "Sus scrofa cristatus"
adamc@916	28 :: "Sus scrofa taiwanus" :: []);
adamc@916	29 return <xml><body>
adamc@916	30 {bears}
adamc@916	31 {beers}
adamc@916	32 {boars}
adamc@916	33 </body></xml>

Mercurial > urweb