goal-simulation-0.1: Goal/Simulation/Plot.hs

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