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

Finish locking, but it's not yet tested rigorously.

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>
adam@1784	8 <li onmousedown={fn _ => set draggingItem (Some itemSource)}
adam@1784	9 onmouseup={fn _ => set draggingItem None}
adam@1784	10 onmouseover={fn _ => di <- get draggingItem;
adam@1784	11 case di of
adam@1784	12 None => return ()
adam@1784	13 \| Some di => original <- get di;
adam@1784	14 movedOver <- get itemSource;
adam@1784	15 set di movedOver;
adam@1784	16 set itemSource original;
adam@1784	17 set draggingItem (Some itemSource)}>
adamc@918	18 <dyn signal={Monad.mp cdata (signal itemSource)}/>
adamc@916	19 </li></xml>) itemSources}
adamc@916	20 </ul>
adamc@916	21 </xml>
adamc@916	22
adamc@916	23 fun main () =
adamc@916	24 bears <- draggableList "Bears" ("Pooh" :: "Paddington" :: "Rupert" :: "Edward" :: []);
adamc@916	25 beers <- draggableList "Beers" ("Budvar" :: "Delirium Tremens" :: "Deuchars" :: []);
adamc@916	26 boars <- draggableList "Boars" ("Sus scrofa scrofa"
adamc@916	27 :: "Sus scrofa ussuricus"
adamc@916	28 :: "Sus scrofa cristatus"
adamc@916	29 :: "Sus scrofa taiwanus" :: []);
adamc@917	30 return <xml>
adamc@917	31 <head>
adamc@917	32 <link rel="stylesheet" type="text/css" href="../../dragList.css"/>
adamc@917	33 </head>
adamc@917	34 <body>
adamc@917	35 {bears}
adamc@917	36 {beers}
adamc@917	37 {boars}
adamc@917	38 </body>
adamc@917	39 </xml>

Mercurial > urweb