@@ -1,6 +1,8 @@
11
22module Automaton where
33
4+import Data.List (unzip)
5+
46data Automaton a b = Automaton (a -> (b, Automaton a b))
57
68
@@ -9,6 +11,9 @@ data Automaton a b = Automaton (a -> (b, Automaton a b))
911run :: Automaton a b -> Signal a -> Signal b
1012run :: OrderedContainer c => Automaton a b -> c a -> c b
1113
14+step :: a -> Automaton a b -> (b, Automaton a b)
15+
16+
1217(>>>) :: Automaton a b -> Automaton b c -> Automaton a c
1318(<<<) :: Automaton b c -> Automaton a b -> Automaton a c
1419
@@ -36,29 +41,52 @@ draggable :: Form -> Automaton (Bool,(Int,Int)) Form
3641run (Automaton m0) input =
3742 lift fst $ foldp' (\a (b, Automaton m) -> m a) m0 input
3843
39−a1 >>> a2 =
44+step a (Automaton m) = m a
45+
46+
47+--a1 >>> a2 =
48+composeAuto a1 a2 =
4049 let { Automaton m1 = a1 ; Automaton m2 = a2 } in
4150 Automaton
4251 (\a -> let (b,m1') = m1 a in
43− let (c,m2') = m2 b in (c, Automaton m1' >>> Automaton m2'))
52+ let (c,m2') = m2 b in (c, composeAuto m1' m2'))
4453
54+{--
4555a2 <<< a1 = a1 >>> a2
4656f ^>> a = pure f >>> a
4757a >>^ f = a >>> pure f
4858f ^<< a = a >>> pure f
4959a <<^ f = pure f >>> a
60+--}
5061
5162combine autos =
52− Automaton (\a -> let (bs,autos') = unzip $ map (\m -> m a) autos in
63+ Automaton (\a -> let (bs,autos') = unzip $ map (\(Automaton m) -> m a) autos in
5364 (bs, combine autos'))
5465
5566pure f = Automaton (\x -> (f x, pure f))
56−init s step = Automaton (\a -> let s' = step a s in (s', init s' step))
57−init' s step = Automaton (\a -> let (b,s') = step a s in (b , init s' step))
67+init s step = Automaton (\a -> let s' = step a s in (s', init s' step))
68+init' s step = Automaton (\a -> let (b,s') = step a s in (b , init' s' step))
5869
5970count = init 0 (\_ c -> c + 1)
6071
6172
73+data DragState = Listen | Ignore | DragFrom (Int,Int)
74+
75+vecSub (x1,y1) (x2,y2) = (x1-x2,y1-y2)
76+
77+stepDrag (press,pos) (ds,form) =
78+ let wrap ds' = (form, (ds',form)) in
79+ case ds of
80+ { Listen -> wrap (if not press then Listen else
81+ if pos `isWithin` form then DragFrom pos else Ignore)
82+ ; Ignore -> wrap (if press then Ignore else Listen)
83+ ; DragFrom p0 -> if press then (uncurry move (vecSub pos p0) form, (DragFrom p0, form))
84+ else (let form' = uncurry move (vecSub pos p0) form in
85+ (form', (Listen,form')))
86+ }
87+
88+dragForm form = init' (Listen,form) stepDrag
89+
6290
6391{--- See the following papers for ideas on how to make this faster:
6492