[Fencommits] fenfire-hs: use current mouse location as input to FRP test

[Benja Fallenstein]

Tue Feb 20 18:05:37 EET 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * use current mouse location as input to FRP test
diff -rN -u old-fenfire-hs/FRP.fhs new-fenfire-hs/FRP.fhs
--- old-fenfire-hs/FRP.fhs	2007-02-20 18:05:48.000000000 +0200
+++ new-fenfire-hs/FRP.fhs	2007-02-20 18:05:48.000000000 +0200
@@ -21,20 +21,37 @@
 
 import Utils
 
-import Graphics.Rendering.Cairo
-import Graphics.UI.Gtk
+import Control.Applicative
 
 import Data.IORef
 
-newtype SF i o = SF { runSF :: TimeDiff -> i -> (o, SF i o) }
+import Graphics.Rendering.Cairo
+import Graphics.UI.Gtk
 
-data Input = Input { mouseX :: Double, mouseY :: Double, mouseClick :: Bool }
+newtype SF i o = SF { runSF :: TimeDiff -> i -> (o, SF i o) }
 
-test :: SF () (Render ())
-test = f 0 where
-    f i = SF $ \t () -> (ren (i+t), f (i+t))
-    ren i = do save; setSourceRGBA 0 0 0 1
-               arc 100 100 50 (3*i) (3*i+2); stroke; restore
+instance Functor (SF i) where
+    fmap f sf = SF $ \t i -> let (o, sf') = runSF sf t i in (f o, fmap f sf')
+    
+instance Applicative (SF i) where
+    pure x  = SF $ \_ _ -> (x, pure x)
+    f <*> a = SF $ \t i -> let (fv, f') = runSF f t i
+                               (av, a') = runSF a t i in (fv av, f' <*> a')
+                               
+input :: SF i i
+input = SF $ \_ i -> (i, input)
+
+data Input = Input { mouseX :: Double, mouseY :: Double }
+
+timeSF :: SF a Double
+timeSF = f 0 where
+    f x = SF $ \t _ -> (x + t, f $ x + t)
+
+test :: SF Input (Render ())
+test = liftA2 (\i t -> do 
+    save; setSourceRGBA 0 0 0 1
+    arc (mouseX i) (mouseY i) 50 (3*t) (3*t+2); stroke; restore) input timeSF
+    
     
 main = do
     initGUI
@@ -47,11 +64,14 @@
     
     time0 <- getTime
     ref <- newIORef (time0, test)
+    mouse <- newIORef (100, 100)
     
     onExpose canvas $ \(Expose {}) -> do
-        (time, sf) <- readIORef ref
         time' <- getTime
-        let (ren, sf') = runSF sf (time' - time) ()
+        (x,y) <- readIORef mouse
+    
+        (time, sf) <- readIORef ref
+        let (ren, sf') = runSF sf (time' - time) (Input x y)
         writeIORef ref (time', sf')
 
         drawable <- drawingAreaGetDrawWindow canvas
@@ -60,6 +80,10 @@
         widgetQueueDraw canvas
         return True
         
+    onMotionNotify canvas False $ \e -> case e of
+        Motion { eventX=x, eventY=y } -> writeIORef mouse (x,y) >> return False
+        _                             -> return False
+        
     onDestroy window mainQuit
     widgetShowAll window
     mainGUI