module Goal.Simulation.Plot ( module Goal.Simulation.Plot , mainGUI , initGUI ) where -- Imports -- -- Goal -- import Goal.Core hiding (on,set) import Goal.Simulation.Mealy -- Chart -- import Graphics.Rendering.Cairo as X hiding (lineTo,moveTo,x) import Graphics.UI.Gtk -- Unqualified -- import Data.IORef import System.Clock --- Processes --- chainWindow :: Int -> Mealy x [x] chainWindow n = accumulateMealy [] $ proc (x,xs) -> do let xs' = take n $ x:xs returnA -< (xs',xs') trajectoryWindow :: Double -> Mealy (Double,x) [(Double,x)] trajectoryWindow tivl = accumulateMealy [] $ proc ((t,x),xts) -> do let xts' = takeWhile (\(t',_) -> t - t' < tivl) $ (t,x):xts returnA -< (xts',xts') --- Animations --- --- IO --- data AnimationPost a = AP DrawingArea (Maybe Int) (IORef (Maybe (Renderable a))) (IORef TimeSpec) changeFramerate :: Maybe Int -> AnimationPost a -> AnimationPost a changeFramerate fps (AP da _ rnblrf tmrf) = AP da fps rnblrf tmrf postRenderable :: AnimationPost a -> Renderable a -> IO () -- | Posts a renderable for animation. Note that this delays the calling thread until both -- the image has been drawn and the frames per second interval has been passed. Also note -- that this function is not in the business of frame skipping. (Although if I were to -- use the difference information in both directions, it could be). postRenderable (AP da Nothing rnblrf _) rnbl = do writeIORef rnblrf . Just $ rnbl postGUISync $ widgetQueueDraw da postRenderable (AP da (Just fps) rnblrf tmrf) rnbl = do writeIORef rnblrf . Just $ rnbl postGUISync $ widgetQueueDraw da t0 <- readIORef tmrf t1 <- getTime Monotonic let diff = recip (fromIntegral fps) - fromIntegral (nsec t1 - nsec t0) / (10^9) threadDelay (round $ 10^6 * diff) writeIORef tmrf =<< getTime Monotonic newAnimationPost :: Double -> Maybe Int -> IO (AnimationPost a) -- | Creates a new animation post, along with a window which can react to key -- presses and within which the images will be drawn. newAnimationPost art fps = do tmrf <- newIORef =<< getTime Monotonic rnblrf <- newIORef Nothing win <- windowNew afrm <- aspectFrameNew 0.5 0.5 . Just $ realToFrac art da <- drawingAreaNew void . (da `on` exposeEvent) . liftIO $ do rnbl <- readIORef rnblrf when (isJust rnbl) $ do void $ updateCanvas (fromJust rnbl) da return () return True {- (win `on` keyPressEvent) $ do ky <- eventKeyVal case keyToChar ky of Just cr -> liftIO $ print "BAM!" return True -} set afrm [ containerChild := da ] set win [ containerChild := afrm ] widgetShowAll win void $ onDestroy win mainQuit return $ AP da fps rnblrf tmrf