Make corrections to Automaton.elm.

Fix `compose`, `combine`, and `init'`.

Add `dragForm`.

core-elm/Automaton.elm

@@ -1,6 +1,8 @@
 
 module Automaton where
 
+import Data.List (unzip)
+
 data Automaton a b = Automaton (a -> (b, Automaton a b))
 
 
@@ -9,6 +11,9 @@ data Automaton a b = Automaton (a -> (b, Automaton a b))
 run :: Automaton a b -> Signal a -> Signal b
 run :: OrderedContainer c => Automaton a b -> c a -> c b
 
+step :: a -> Automaton a b -> (b, Automaton a b)
+
+
 (>>>) :: Automaton a b -> Automaton b c -> Automaton a c
 (<<<) :: Automaton b c -> Automaton a b -> Automaton a c
 
@@ -36,29 +41,52 @@ draggable :: Form -> Automaton (Bool,(Int,Int)) Form
 run (Automaton m0) input =
   lift fst $ foldp' (\a (b, Automaton m) -> m a) m0 input
 
-a1 >>> a2 =
+step a (Automaton m) = m a
+
+
+--a1 >>> a2 =
+composeAuto a1 a2 =
   let { Automaton m1 = a1 ; Automaton m2 = a2 } in
   Automaton 
     (\a -> let (b,m1') = m1 a in
-           let (c,m2') = m2 b in (c, Automaton m1' >>> Automaton m2'))
+           let (c,m2') = m2 b in (c, composeAuto m1' m2'))
 
+{--
 a2 <<< a1 = a1 >>> a2
 f  ^>> a  = pure f >>> a
 a  >>^ f  = a >>> pure f
 f  ^<< a  = a >>> pure f
 a  <<^ f  = pure f >>> a
+--}
 
 combine autos =
-  Automaton (\a -> let (bs,autos') = unzip $ map (\m -> m a) autos in
+  Automaton (\a -> let (bs,autos') = unzip $ map (\(Automaton m) -> m a) autos in
                    (bs, combine autos'))
 
 pure  f      = Automaton (\x -> (f x, pure f))
-init  s step = Automaton (\a -> let s'     = step a s in (s', init s' step))
-init' s step = Automaton (\a -> let (b,s') = step a s in (b , init s' step))
+init  s step = Automaton (\a -> let s'     = step a s in (s', init  s' step))
+init' s step = Automaton (\a -> let (b,s') = step a s in (b , init' s' step))
 
 count = init 0 (\_ c -> c + 1)
 
 
+data DragState = Listen | Ignore | DragFrom (Int,Int)
+
+vecSub (x1,y1) (x2,y2) = (x1-x2,y1-y2)
+
+stepDrag (press,pos) (ds,form) =
+  let wrap ds' = (form, (ds',form)) in
+  case ds of
+  { Listen -> wrap (if not press then Listen else
+                    if pos `isWithin` form then DragFrom pos else Ignore)
+  ; Ignore -> wrap (if press then Ignore else Listen)
+  ; DragFrom p0 -> if press then (uncurry move (vecSub pos p0) form, (DragFrom p0, form))
+                            else (let form' = uncurry move (vecSub pos p0) form in
+                                  (form', (Listen,form')))
+  }
+
+dragForm form = init' (Listen,form) stepDrag
+
 
 {--- See the following papers for ideas on how to make this faster: