Hello awesome people! I'm new to Haskell, still studying (almost finished) "<stron

Correction. Hopefully my maths are right. <div class="snippet-clipboard-content no

Help to dive in,about sodiumfrp/sodium

Comments (38)

geraldus commented on August 10, 2024

Oh, I'm sorry, I was so inattentive! kill defined right within main's do block!

from sodium.

geraldus commented on August 10, 2024

Oh, guys, please help :)

from sodium.

the-real-blackh commented on August 10, 2024

Hello! I'm glad you found 'kill'. Do you want some help with something else? We don't have an IRC channel.

from sodium.

geraldus commented on August 10, 2024

Yes, I try to understand the pattern itself, so I understood that first I create a dummy event stream:

(et, pushT) <- sync newEvent

Then I need somehow feed the stream with values, right? For example I need a loop where I catch system time, and make new event with timestamp occur? But is it OK with this in mind:

Sodium/others: Events and behaviour state changes are ordered. Time is just another behaviour.

So I have troubles with implementing or in other words describing entire process as a function.

For falling ball I need two behaviors for position and speed, acceleration is constant, and time is behavior also. And I need to describe a switch in future to have a bouncing ball. So how should I describe entire process in Haskell code?

P.S. Sorry, it looks like this is not best place to post such question, doesn't it?

from sodium.

the-real-blackh commented on August 10, 2024

I'm quite happy for you to post here.

Yes, that's right. You'll need some I/O code that feeds the event with time. To make the ball bounce, you won't need to use switch. There are several ways to do it.

There's one thing that's a little tricky: if your time is sent at regular intervals (e.g. once per animation frame), then the instant when the ball hits the ground is between those times. One way to deal with that - if you are ready for it to be a little more difficult - is to write some code at the I/O level to handle alarms.

So, a falling ball would be something like this (I have not tried compiling this):

import Control.Applicative
import FRP.Sodium

t <- hold 0 et             -- turn time into a behaviour
let acc = pure (-100)    -- I have no idea what this should be
t0_init <- sample time
t0 <- hold t0_init never     -- change this when we add bounce
v0 <- hold 0 never           -- velocity at t0: change this when we add bounce
y0 <- hold 100 never       -- change this when we add bounce
let dt = liftA2 subtract t0 t      -- can also be written: subtract <$> t0 <*> t
let vel = liftA3 (\acc v0 dt -> v0 + acc * dt) acc v0 dt
  -- note: We can't base y on 'vel' because vel only tells us the velocity now.
  -- To integrate velocity we would need to know more information than that.
  -- Maybe you can think of some solution.
let y = liftA3 (\acc y0 dt -> y0 + v0 * dt + acc * dt^2) acc y0 dt

Then to listen to y so you can draw it...

kill <- listen (value y) $ \y -> print y

Make sure 'kill' doesn't get garbage collected.

Here's a simple bounce:

{-# LANGUAGE RecursiveDo #-}      -- Needed so 'rec' will work

rec
   ...
   let floor = 0
   let eBounce = filterE (<= floor) $ value y
   y0' <- snapshot (flip const) eBounce y   -- flip const can be written as (\_ y0 -> y0)
   v0' <- snapshot (flip const) eBounce vel
   t0' <- snapshot (flip const) eBounce t

then we change the three holds above to this:

t0 <- hold t0_init t0'
v0 <- hold 0 v0'
y0 <- hold 100 y0'

The problem with this eBounce is that it will happen once the ball has already fallen through the floor. The way to fix that is to implement a system of alarms, where the FRP tells the I/O code what time it wants to be alarmed at.

You can calculate the alarm time by solving the quadratic y0 + v0 * dt + acc * dt^2 == floor

Express the alarm time as a behaviour, then have some I/O code that generates an alarm event when the alarm happens. It will have to send a value to et first, then send a value into the alarm event. eBounce is replaced by the alarm event.

from sodium.

the-real-blackh commented on August 10, 2024

Correction. Hopefully my maths are right.

let vel = liftA2 (\v0 dt -> v0 + acc * dt) v0 dt
  -- note: We can't base y on 'vel' because vel only tells us the velocity now.
  -- To integrate velocity we would need to know more information than that.
  -- Maybe you can think of some solution.
let y = liftA3 (\y0 v0 dt -> y0 + v0 * dt + acc * dt^2) y0 v0 dt

Also I forgot that we have to reverse the velocity when we bounce:

v0' <- snapshot (\_ v -> negate v) eBounce vel

from sodium.

the-real-blackh commented on August 10, 2024

One thing I need to mention is that you can't call 'sync' from inside a listener handler (it will deadlock if you try), so you can't implement your alarms that way. You'll need to use IORefs to pass the alarm time out to the main loop, and have the main loop generate the alarm event.

If you write a simple example, then please send it to me to post on reactiveprogramming.org if you like.

By the way, it is possible to generalize this alarm system. To do this, you merge all pending alarms into a single behaviour and pass that out of your FRP logic. On the input side, you have a single 'eAlarm' event, but you have to guard it for each instance by making sure the alarm time has passed.

from sodium.

geraldus commented on August 10, 2024

Thank you a lot, Stephen! I'll study your example and hopefully post a result tomorrow.

from sodium.

geraldus commented on August 10, 2024

_UPDATED!_
Finally I've back!!! I've tried to do what you said, but after few hours I decided first to implement the simplest thing ever possible – the time behavoiur itself, and finally I've done that!

My final working code is:

import Control.Applicative
import Control.Concurrent
import Data.Time.Clock
import FRP.Sodium
import System.Timeout(timeout)

getCurrentDayTime :: IO Integer
getCurrentDayTime = getCurrentTime >>= (\ x -> return (floor (toRational (utctDayTime x))))

main :: IO ()
main = do
  time <- sync newEvent

  let (timeEvent, pushTime) = time

  cdt <- getCurrentDayTime

  currentTime <- sync $ hold cdt timeEvent

  kill <- sync $ listen (value currentTime) print

  timeout 4000000 $ loop pushTime

  kill

This is quite obvious now! I'll continue and post the final result first of just falling ball, and then bouncing ball!

from sodium.

the-real-blackh commented on August 10, 2024

Great!

from sodium.

geraldus commented on August 10, 2024

OK, now I have working "falling ball" version!

import Control.Applicative
import Control.Monad ( liftM )
import Data.Time.Clock( getCurrentTime )
import Data.Time.Clock.POSIX( utcTimeToPOSIXSeconds )
import FRP.Sodium

getClockTimeMs :: IO Integer
-- | Reads current time from environment as UTCTime and converts it to Integer UTC timestamp
getClockTimeMs = liftM (floor . ((10^6)*) . utcTimeToPOSIXSeconds) getCurrentTime

loop :: (Double -> Reactive b) -> IO ()
-- | Main loop which feeds event stream of time behavior with values as Double
loop pushFn = do
  t <- getClockTimeMs
  sync $ pushFn $ fromInteger t
  loop pushFn

main :: IO ()
main = do

  -- | time is a Reactive, which holds Event stream and a Reactive `push` action, that actually pushes occurance to the stream
  time <- sync newEvent

  -- | Extracting event stream of time and pushing action
  let (timeEvent, pushTime) = time

  -- | Evaluate current timestamp
  cdt <- liftM fromInteger getClockTimeMs

  -- | startTime is a Behaviour with constant value -- startup timestamp
  startTime <- sync $ hold cdt never

  -- | Pushing first value to currentTime event stream
  currentTime <- sync $ hold cdt timeEvent

  -- | deltaTime is a Bahviour, simple difference between current and initial timestamps
  let deltaTime = liftA2 (\s c -> (s - c)/(10**6)) startTime currentTime

  -- | y0, v0, and acc is Behaviours with contant values
  y0 <- sync $ hold (100 :: Double) never
  v0 <- sync $ hold (0 :: Double) never
  acc <- sync $ hold (-9.81 :: Double) never

  -- | Pure function to calculate current object position, falling from some initial height with some initial speed and being influenced by some gravity acceleration at some time passed
  let y' y0' v0' a' t' = y0' + v0'*t' + ((a'/2)*(t'**2))

  -- | y is a Behaviour, which is just application of pure y' function to Behavoiurs, which are Applicatives
  let y = y' <$> y0 <*> v0 <*> acc <*> deltaTime

  kill <- sync $ listen (value y) print
  loop pushTime
  kill

from sodium.

the-real-blackh commented on August 10, 2024

Lovely! You can combine several of your lines together by doing this:

(currentTime, pushTime) <- sync $ newBehavior cdt

Here are two alternative ways you could define startTime:

let startTime = pure cdt

startTime <- sync $ sample currentTime

from sodium.

geraldus commented on August 10, 2024

Good news! I've reached my goal! Now I have bouncing ball working! I'll refactor final code a bit and then post it here! There will be few questions I assume.

from sodium.

geraldus commented on August 10, 2024

And here is my code!

Now I described moment when ball will hit the ground as Behavior and named it as bounceTime, it depends on v0 and y0 and updates only when any of this values updates.
I've also described few pure functions to calculate current position of falling ball, so acc behaviour became useless and I removed it.
Now within the main loop I'm checking current timestamp which should be pushed as next time occurrence, and in the case of ball already reached the ground:

I calculate precise time of hit
velocity of ball at this time
and then I'm pushing new values for t0, v0, and y0.

One thing I'm wondering about: I've "glued" all updates in one sync operation instead of separate sync actions. Is this really matters?

And there is one problem I faced: I have to pass all behaviours and pushing functions to loop function in order to have ability to check values and change behaviours. It's not a big deal, but type signature of loop is a bit frightening. One possible solution I can mention about is to implement some state (with State monad) but maybe there is another better way to do that?

Last question is why we "call" kill as the last action inside main? Is it to prevent kill to be garbage collected?

import Control.Applicative
import Control.Monad ( liftM, when )
import Data.Time.Clock( getCurrentTime )
import Data.Time.Clock.POSIX( utcTimeToPOSIXSeconds )
import FRP.Sodium


-- | Reads current time from environment as UTCTime and converts it to Integer UTC timestamp.
getClockTimeMs :: IO Integer
getClockTimeMs = liftM (floor . ((10^6)*) . utcTimeToPOSIXSeconds) getCurrentTime

-- | Constant gravitational acceleration.
a_free_fall = 9.81

-- | Instantaneous speed of freely falling object with some initial speed at some time.
v' :: Double -> Double -> Double
v' v0 t = v0 - a_free_fall*t

-- | Distance which the object will pass having some average speed at some time.
dist_avg_vel :: Double -> Double -> Double
dist_avg_vel v t = v*t

-- | Distance which the freely falling object (without initial speed) will pass at some time.
dist_free_fall :: Double -> Double
dist_free_fall t = a_free_fall/2*(t**2)

-- | Time (in seconds) which object needs to hit the ground.
fall_time :: Double -> Double -> Double
fall_time y0 v0 = (v0 + sqrt(v0**2 + 2*y0*a_free_fall))/a_free_fall

-- | Pure function to calculate current position of object falling from some initial height
--   with some initial speed and being influenced by gravity acceleration at some time.
y' :: Double -> Double -> Double -> Double
y' y0 v0 t = y0 + dist_avg_vel v0 t - dist_free_fall t

-- | Main loop which feeds occurrences of time and checks the bounce.
loop :: (Double -> Reactive b)
        -> (Double -> Reactive ())
        -> (Behavior Double, Double -> Reactive ())
        -> (Behavior Double, Double -> Reactive ())
        -> Behavior Double
        -> Behavior Double
        -> IO ()
loop pushTime setT (vB, setV) (yB, setY) delta bounce = do
  t <- getClockTimeMs

  -- | Check if ball have already hit the floor. In this case we should
  -- | push new values of initial position and speed of the ball.
  dt <- sync $ sample delta
  b <- sync $ sample bounce
  when (dt >= b) $ sync $ do
       oldV <- sample vB
       oldY <- sample yB
       let newV = negate $ 0.6 * v' oldV b
       setY 0
       setV newV
       setT $ fromInteger t - (b + dt)/(10^6)

  sync $ pushTime $ fromInteger t
  loop pushTime setT (vB, setV) (yB, setY) delta bounce

-- | Helper function which prints the Double with 2 significant digits.
prettyPrint :: Double -> IO ()
prettyPrint = print . (\x -> fromInteger x/100) . round . (100*)

main :: IO ()
main = do
  -- | Evaluate current (first) timestamp.
  startupTimestamp <- liftM fromInteger getClockTimeMs

  -- | Push first value to currentTime event stream.
  (currentTime, pushTime) <- sync $ newBehavior startupTimestamp

  -- | t0, y0, v0, and acc is Behaviours which contain initial timestamp,
  --   position and speed of ball.
  (t0, setT) <- sync $ newBehavior startupTimestamp
  (y0, setY) <- sync $ newBehavior (30.0 :: Double)
  (v0, setV) <- sync $ newBehavior (0.0 :: Double)

  let bounceTime = fall_time <$> y0 <*> v0

  let deltaTime = liftA2 (\s c -> (c - s)/(10**6)) t0 currentTime

  -- | `y` is just an application of pure y' function to behavoiurs,
  --   which are Applicatives, thus it's also a behaviour.
  let y = y' <$> y0 <*> v0 <*> deltaTime

  -- | Prints y position when new value is available.
  kill <- sync $ listen (value y) prettyPrint

  -- | Start pushing time occurrences.
  loop pushTime setT (v0, setV) (y0, setY) deltaTime bounceTime

  kill

As a creator of Sodium can you point possible issues with this code and maybe offer some improvements of it?

Now, when I've become a little bit familiar with Sodium my next step is to use it with GHCJS in my current project. So, I assume there will be some new questions and examples in future.

P.S. Excuse me for possible mistakes and typos, some time it's very difficult for me to explain something in English.

from sodium.

the-real-blackh commented on August 10, 2024

One thing I'm wondering about: I've "glued" all updates in one sync operation instead of separate sync actions. Is this really matters?

It's actually best to keep your reactive logic separate from your I/O code and run it inside one big sync. All your 'newBehavior's, 'newEvent's, and 'listen's would generally be outside of this in the I/O section.

The reason for doing things like this is to "free" you from the world of I/O.

So, in keeping with this philosophy, you could set up an animation timer like this:

t0 <- liftM fromInteger getClockTimeMs
(time, pushTime) <- sync $ newBehavior t0

The "game" would have a type signature like this:

game :: Event Double    -- ^ Time
     -> Event ()    -- ^ Alarm fired
     -> Reactive (Behavior Double, Behavior Double)

The input value is the animation clock. The first returned value is the Y position to draw, and the second is the alarm time.

The main program would continue like this, using the {-# LANGUAGE RecursiveDo #-} pragma at the top of your program:

rec
    (eAlarm, pushEAlarm) <- sync newEvent
    (y, tAlarm) <- sync $ game time eAlarm
    kill <- sync $ listen (value y) print
    let handleAlarms now = do
            ta <- sync $ sample tAlarm
            if ta < now then do
                -- Note: These must be separate transactions (i.e. two sync's) or the event handling will see
                -- an out-of-date time.
                sync $ pushTime ta
                sync $ pushEAlarm ()
                handleAlarms   -- check alarms again, because a new alarm may have been set
            else
                return ()
        forever $ do             -- 'forever' comes from Control.Monad
            t <- liftM fromInteger getClockTimeMs
            handleAlarms t
            sync $ pushTime t
            threadDelay 50000
kill

So the point here is that we have the absolute minimum of logic in this code, and we let the logic all be pure reactive code.

And there is one problem I faced: I have to pass all behaviours and pushing functions to loop function in order to have ability to check values and change behaviours. It's not a big deal, but type signature of loop is a bit frightening. One possible solution I can mention about is to implement some state (with State monad) but maybe there is another better way to do that?

If you use the approach I described above, you should find that the only things you need to pass around are behaviours and events.

The type signatures can be long sometimes, and you might find a ReaderT transformer on top of Reactive is useful. You wouldn't need a State monad, because behaviors and events are all constant values. I have not needed to do this, but I have found that it's sometimes useful to define data structures.

Last question is why we "call" kill as the last action inside main? Is it to prevent kill to be garbage collected?

Yes, the way it's currently implemented, it is actually necessary to do that. If you find that your listeners stop working, this could be the reason.

Now, when I've become a little bit familiar with Sodium my next step is to use it with GHCJS in my current project. So, I assume there will be some new questions and examples in future.

I have been using GHCJS + Sodium to make web-based games. GHCJS is quite difficult to install at the moment, but it works well. I think there are some bugs that cause memory leaks. I am working on those.

from sodium.

the-real-blackh commented on August 10, 2024

I think my code was a bit wrong. This should fix it:

(eAlarm, pushEAlarm) <- sync newEvent
(y, tAlarm) <- sync $ game time eAlarm
kill <- sync $ listen (value y) print
let handleAlarms now = do
        ta <- sync $ sample tAlarm
        if ta < now then do
            -- Note: These must be separate transactions (i.e. two sync's) or the event handling will see
            -- an out-of-date time.
            sync $ pushTime ta
            sync $ pushEAlarm ()
            handleAlarms   -- check alarms again, because a new alarm may have been set
        else
            return ()
forever $ do             -- 'forever' comes from Control.Monad
    t <- liftM fromInteger getClockTimeMs
    handleAlarms t
    sync $ pushTime t
    threadDelay 50000       -- from Control.Concurrent
kill

Now try refactoring your code to work with a loop like this, and you should find that it is very nice code. You will need a 'rec' loop, using {-# LANGUAGE RecursiveDo #-} pragma.

t0, y0 and v0 will be defined using 'hold'

The event passed to hold will be based on a snapshots of eAlarm, e.g.

startupTimestamp <- sample time
t0 <- hold startupTimestamp $ snapshot (flip const) eAlarm time

from sodium.

the-real-blackh commented on August 10, 2024

Fix some other things:

(eAlarm, pushEAlarm) <- sync newEvent
(y, tAlarm) <- sync $ game time eAlarm
kill <- sync $ listen (value y) print
let handleAlarms now = do
        ta <- sync $ sample tAlarm
        if ta <= now then do
            -- Note: These must be separate transactions (i.e. two sync's) or the event handling will see
            -- an out-of-date time.
            sync $ pushTime ta
            sync $ pushEAlarm ()
            handleAlarms now  -- check alarms again, because a new alarm may have been set
          else
            return ()
forever $ do             -- 'forever' comes from Control.Monad
    t <- liftM fromInteger getClockTimeMs
    handleAlarms t
    sync $ pushTime t
    threadDelay 50000       -- from Control.Concurrent
kill

Note that it will get stuck in an infinite loop if eAlarm doesn't cause tAlarm to be recalculated.

from sodium.

geraldus commented on August 10, 2024

Stephen, I still can not understand what you wrote and refactor example code because of my stupidity.
This makes my spirit broken.
Look:

t0 <- liftM fromInteger getClockTimeMs
(time, pushTime) <- sync $ newBehavior t0

time is Behavior, right?

But game wants Event, isn't it?

game :: Event Double    -- ^ Time
     -> Event ()    -- ^ Alarm fired
     -> Reactive (Behavior Double, Behavior Double)

(y, tAlarm) <- sync $ game time eAlarm

How to convert Behavior to Event? In other words what should I pass to game a time behaviour or events of time values occurrences? In first case I have to get values and in the second to listen for events? Right?

In general, I can't understand relation of Events and Behaviors. If I need to create time delta behaviour inside game, I can sample behaviour's current value but how can I fetch value of time from Event?

Then, why pushTime goes before pushEAlarm inside handleAlarms

if ta <= now then do
            sync $ pushTime ta
            sync $ pushEAlarm ()
            handleAlarms now  -- check alarms again, because a new alarm may have been set
else
            return ()

And how to check alarms within game?

Anyway I'll keep trying.

P.S. It definitely would be great to have some kind of Getting started tutorial with simplest examples and common patterns. I think I can do one with your help :)

from sodium.

geraldus commented on August 10, 2024

Moreover, it seems that your example can cause infinite loop when we have non elastic bounce.
When ball stops (e.g. can't bounce anymore), time of next bounce always equals to 0, thus this code should turn into infinite loop:

let handleAlarms now = do
        ta <- sync $ sample tAlarm
        if ta <= now then do
            -- ta is less or equal now, because ball is already on the ground.
            sync $ pushTime ta
            sync $ pushEAlarm ()
            handleAlarms now

Looks like this approach is a bit wrong, we need another way to describe process, right?

from sodium.

geraldus commented on August 10, 2024

OK, I don't sure if this is what you talked about, here is another version:

module FallingBall.Alternative where

import Control.Applicative( (<$>), (<*>), liftA2 )
import Control.Monad( liftM, when, unless )
import Data.Time( UTCTime, getCurrentTime )
import Data.Time.Clock.POSIX( posixSecondsToUTCTime, utcTimeToPOSIXSeconds )
import Data.Time.Clock( diffUTCTime )
import FRP.Sodium

import Main

loop :: (UTCTime -> Reactive ())
        -> (UTCTime -> Reactive ())
        -> Reactive Bool
        -> IO ()
loop pusher controller check = do
     now <- getCurrentTime
     sync $ controller now
     sync $ pusher now
     end <- sync check
     unless end $ loop pusher controller check

fallingBall :: Behavior UTCTime
               -> Double
               -> Double
               -> Reactive( Behavior Double
                          , UTCTime -> Reactive ()
                          , Reactive Bool
                          )
fallingBall bTime v0 y0 = do
    t <- sample bTime
    rT <- newBehavior t
    rV <- newBehavior v0
    rY <- newBehavior y0

    let (bT0, setT0) = rT
        dt = liftA2 (\c s -> realToFrac (diffUTCTime c s)) bTime bT0
        (bV0, setV0) = rV
        (bY0, setY0) = rY
        y = y' <$> bY0 <*> bV0 <*> dt
        -- | Checking if new y0 and v0 are negligible, in this case we assume that the ball has become still. 
        check = do
            v0' <- sample bV0
            y0' <- sample bY0
            return (v0' <= 0.000001 && y0' <= 0.000001)
        -- | Updates v0 and y0 when ball hits the ground
        controller now = do
            t0PS <- liftM utcTimeToPOSIXSeconds $ sample bT0
            y0' <- sample bY0
            v0' <- sample bV0
            let ft = fallTime y0' v0'
                ftPS = t0PS + realToFrac ft
                nowPS = realToFrac $ utcTimeToPOSIXSeconds now
            when (nowPS >= ftPS) $ do
                    let fv = v' v0' ft
                    setT0 $ posixSecondsToUTCTime ftPS
                    setY0 0
                    setV0 $ negate fv*0.7

    return (y, controller, check)

nextFrame :: UTCTime -> UTCTime
nextFrame = posixSecondsToUTCTime . (1/60 + ) . realToFrac . utcTimeToPOSIXSeconds


main :: IO ()
main = do
   let yStart = 10.0
   now <- getCurrentTime
   (bTime, pushTime) <- sync $ newBehavior now
   (y, cnt, chk) <- sync $ fallingBall bTime 0 yStart

   kill <- sync $ listen (value y) $ print . (/100) . fromInteger . round . (100*)

   loop pushTime cnt chk

   kill

This code works and program exits when ball becomes still!

If this fits what you mentioned about the last thing to be done is to sync y value printing with 60Hz.

from sodium.

the-real-blackh commented on August 10, 2024

I made a mistake. Time should be Behavior Double, not Event Double.

You can think of a behaviour as an event with memory, so that it is possible to ask "what is the current value of the behaviour?"

I am trying to push you in the direction of separating the logic from the I/O loop, so that you can start programming pure FRP, instead of having imperative (bad) code mixed in with the functional (good) code. When the bounce happens, your code operates imperatively, and this is not the FRP way of doing things. If you do it imperatively, then FRP is not giving you any benefit.

The problem with the infinite loop is a separate issue. You can figure out a solution to that. Perhaps the easiest thing to do is just to have some threshold for it to detect when it has stopped bouncing.

I'll try to sketch the whole thing out. This will be very rough because I don't have time to test it at the moment:

{-# LANGUAGE RecursiveDo #-}
main = do
    (eAlarm, pushEAlarm) <- sync newEvent
    (y, tAlarm) <- sync $ game time eAlarm
    kill <- sync $ listen (value y) print
    let handleAlarms now = do
            ta <- sync $ sample tAlarm
            if ta <= now then do
                -- Note: These must be separate transactions (i.e. two sync's) or the event handling will see
                -- an out-of-date time.
                sync $ pushTime ta
                sync $ pushEAlarm ()
                handleAlarms now  -- check alarms again, because a new alarm may have been set
              else
                return ()
    forever $ do
        t <- liftM fromInteger getClockTimeMs
        handleAlarms t
        sync $ pushTime t
        threadDelay 50000
    kill

game :: Behavior Double    -- ^ Time
     -> Event ()    -- ^ Alarm fired
     -> Reactive (Behavior Double, Behavior Double)
game time eAlarm = do
  t00 <- sample time
  t0 <- hold t00 $ snapshot (flip const) eAlarm time

  let dt = liftA2 (\t0 t -> t - t0) t0 time

  rec
    y0 <- hold (100 :: Double) $ snapshot (flip const) eAlarm y
    v <- hold (0 :: Double) $ snapshot (\() v -> (-0.6) * v) eAlarm v

    let y = (\dt y0 v -> .. some function ..) <$> dt<*> y0 <*> v

  -- Need to define whenBounce to figure out the time when the bounce will happen
  let tAlarm = whenBounce <$> t0 <*> y0 <*> v

  return (y, tAlarm)

from sodium.

the-real-blackh commented on August 10, 2024

In general, I can't understand relation of Events and Behaviors. If I need to create time delta behaviour inside game, I can sample behaviour's current value but how can I fetch value of time from Event?
Then, why pushTime goes before pushEAlarm inside handleAlarms

Sorry for making that mistake. Time is definitely a behaviour.

The reason why pushTime goes before pushEAlarm is so that when the alarm is handled in the FRP, the time is set to the correct alarm time. We are capturing the new time using 'snapshot' and so we push it first, so that 'snapshot' can pick it up.

Even though there is an infinite loop, I don't think the approach is wrong. This is correct if you are modelling a real ball that bounces faster and faster and faster. Some bounce size threshold that sets the bounce time to 'never' when the bounce gets small enough (some large time e.g. 1e12) would fix it.

from sodium.

geraldus commented on August 10, 2024

@the-real-blackh, Stephen, please have a look at last code I've posted, looks like I almost there. I've also realized synchronizational already, but it is a bit ugly I think.
I'll attentively study your latest comments and show how I tried to synchronize rendering tommorow (It's dead of night now or more pricisly early morning and I have good idea to have a sleep).
I see snapshot and I think it is great! Moreover, I think it would be great to have an acknowledgement of all eight primitives of Sodium, and I think you can help with that, right!? Thanks!
See you!

from sodium.

the-real-blackh commented on August 10, 2024

Have a good sleep!

In my last two messages, I was commenting about your newest code above. Even though you've made the type of fallingBall 'Reactive', you're passing functions out and running them imperatively, so it is still working in an imperative way. 'game' should only have events and behaviours going in and out.

Yes, I'm happy to help about the eight primitives. Let me know what you want me to do.

from sodium.

the-real-blackh commented on August 10, 2024

'game' should only have events and behaviours going in and out.

Constants (such as the acceleration for gravity) are also OK.

from sodium.

geraldus commented on August 10, 2024

Oh, is snapshot an another way to listen or handle events?

from sodium.

the-real-blackh commented on August 10, 2024

snapshot allows you to combine the value of an event with the value of a behaviour sampled when the event fires. 'listen' should only be used on the outputs of the system. It shouldn't be part of the internal logic of your 'game' because it's imperative.

from sodium.

geraldus commented on August 10, 2024

Hmm, I supposed this code should turn into loop, but it is not:

{-# LANGUAGE RecursiveDo #-}
import FRP.Sodium

import Data.Time( UTCTime, getCurrentTime )
import Data.Time.Clock.POSIX( posixSecondsToUTCTime, utcTimeToPOSIXSeconds )
import FRP.Sodium()


timeStep :: Integral a => UTCTime -> a -> UTCTime
timeStep t f = posixSecondsToUTCTime $ realToFrac (utcTimeToPOSIXSeconds t) + 1/(fromIntegral f)

chronos :: Behavior UTCTime -> Int -> Reactive (Behavior UTCTime)
chronos time freq = do
    t <- sample time
    rec
        tStep <- hold t $ snapshot (\_ t' -> timeStep t' freq) justFrame time
        let eFrame = snapshot (\t' f -> if t' >= f then Just () else Nothing) (updates time) tStep
            justFrame = filterJust eFrame

    hold t $ snapshot (flip const) justFrame time      


loop :: (UTCTime -> Reactive ()) -> IO ()
loop push = do
     now <- getCurrentTime
     sync $ push now

main :: IO ()
main = do
   now <- getCurrentTime
   (bTime, pushTime) <- sync $ newBehavior now
   (frames) <- sync $ chronos bTime 60

   kill <- sync $ listen (value frames) print

   loop pushTime

   kill

Please explain why?

from sodium.

the-real-blackh commented on August 10, 2024

'loop' doesn't loop. You could add 'forever' like this:

loop :: (UTCTime -> Reactive ()) -> IO ()
loop push = forever $ do
     now <- getCurrentTime
     sync $ push now

(import Control.Monad)

from sodium.

geraldus commented on August 10, 2024

Oh, oviously! I'm dumbass :)
Did I catch the idea with snapshot?

from sodium.

the-real-blackh commented on August 10, 2024

Yes, you've definitely got the right idea with snapshot. Reading the code, it looks correct and should update 'frames' at the desired time interval. It will use 100% of CPU, though, but if you don't mind that, then great. :)

from sodium.

geraldus commented on August 10, 2024

I actually works with forever. Wow! And what about full CPU usage? How should I prevent that?
Thank you for details :)

I've just checked you're right - I had 100% CPU usage!

from sodium.

the-real-blackh commented on August 10, 2024

I think the easiest way to do this is imperatively:

loop :: (UTCTime -> Reactive ()) -> IO ()
loop push = forever $ do
     now <- getCurrentTime
     sync $ push now
     threadDelay (1000000 / framesPerSecond)

The problem with this is that it'll be a bit irregular (if it's a real video game). One way to make it better would be to calculate the delay time each time round.

from sodium.

geraldus commented on August 10, 2024

{-# LANGUAGE RecursiveDo  #-}
module Main where

import Control.Applicative( (<$>), (<*>), liftA2 )
import Control.Concurrent( threadDelay )
import Control.Monad( forever, liftM, when, unless )
import Control.Monad.State
import Data.Time( NominalDiffTime, UTCTime, getCurrentTime )
import Data.Time.Clock.POSIX( posixSecondsToUTCTime, utcTimeToPOSIXSeconds )
import Data.Time.Clock( diffUTCTime )
import FRP.Sodium
import Text.Printf( printf )


-- | Constant gravitational acceleration.
aFreeFall :: Double
aFreeFall = 9.81

-- | Distance which the object will pass having some average speed at some time.
distFromAvgVelAndTime :: Double -> Double -> Double
distFromAvgVelAndTime v t = v*t

-- | Distance which the freely falling object (without initial speed) will pass at some time.
freeFallDistFromTime :: Double -> Double
freeFallDistFromTime t = aFreeFall/2*(t**2)

-- | Time (in seconds) which object needs to hit the ground.
bounceTimeFromPosAndVel :: Double -> Double -> Double
bounceTimeFromPosAndVel y0 v0
                        | y0 < 0 = 0
                        | y0 <= 1e-12 && v0 <= 1e-12 = 0
                        | otherwise = (v0 + sqrt(v0**2 + 2*y0*aFreeFall))/aFreeFall

-- | Instantaneous speed of freely falling object with some initial speed at some time.
v' :: Double -> Double -> Double
v' v0 t = v0 - aFreeFall*t

-- | Pure function to calculate current position of object falling from some initial height
--   with some initial speed and being influenced by gravity acceleration at some time.
y' :: Double -> Double -> Double -> Double
y' y0 v0 t
   | y0 <= 1e-12 && v0 <= 1e-12 = 0
   | otherwise = y0 + distFromAvgVelAndTime v0 t - freeFallDistFromTime t

timeToFrac :: Fractional a => UTCTime -> a
timeToFrac = realToFrac . utcTimeToPOSIXSeconds

addFracToTime :: RealFrac a => a -> UTCTime -> UTCTime
addFracToTime a t = posixSecondsToUTCTime $ realToFrac (timeToFrac t) + realToFrac a

timeStep :: Integral a => UTCTime -> a -> UTCTime
timeStep t f = posixSecondsToUTCTime $ realToFrac (utcTimeToPOSIXSeconds t) + 1/(fromIntegral f)

nextFrame :: UTCTime -> UTCTime
nextFrame = (flip timeStep) 60

type FrameDelays = [NominalDiffTime]

avgFrameMs :: FrameDelays -> NominalDiffTime
avgFrameMs [] = 0
avgFrameMs fs = sum (map realToFrac fs) / fromIntegral (length fs)

fallingBall :: Behavior UTCTime
            -> Double
            -> Double
            -> Event ()
            -> Reactive ( Behavior String
                        , Behavior UTCTime )
fallingBall utcTime vel pos eBounce = do
    t  <- sample utcTime
    t0 <- hold t $ snapshot (flip const) eBounce utcTime
    let
        dt = liftA2 (\t0' t' -> realToFrac (diffUTCTime t' t0')) t0 utcTime 
    rec
        y0 <- hold pos $ snapshot (flip const) eBounce y
        v0 <- hold vel $ snapshot (\_ v'' -> (-0.6)*v'') eBounce v        
        let y = y' <$> y0 <*> v0 <*> dt
            v = v' <$> v0 <*> dt
            tBounce = bounceTimeFromPosAndVel <$> y0 <*> v0
            render = (printf "%.2f") <$> y
            utcTBounce = addFracToTime <$> tBounce <*> t0
    return (render, utcTBounce)

main :: IO ()
main = do
   let yStart = 10.0
   now <- getCurrentTime
   (bTime, pushTime) <- sync $ newBehavior now
   (eAlarm, pushAlarm) <- sync newEvent

   (frameDelays, pushFrameDelay) <- sync $ newBehavior ([] :: FrameDelays)
   let avgFM = avgFrameMs <$> frameDelays
       addFrameDelay f = do
           cfms <- sync $ sample frameDelays
           sync $ pushFrameDelay $ f : take 9 cfms

   (frames, tAlarm) <- sync $ fallingBall bTime 0 yStart eAlarm   
   kill <- sync $ listen (value frames) putStrLn

   let handleAlarms now' brk = do
       ta <- sync $ sample tAlarm
       when (now' > ta) $ do
            sync $ pushTime ta
            sync $ pushAlarm ()
            when (brk) $ handleAlarms now' False

   forever $ do
       t <- getCurrentTime
       t' <- sync $ sample bTime
       handleAlarms t True
       sync $ pushTime t
       addFrameDelay $ diffUTCTime t t'
       delay <- sync $ sample avgFM
       threadDelay $ round $ 10^6/60 - delay

   kill

I think this is the final version. But I have to implement few new tricks. One of them is second boolean argument of handleAlarm function. As mentioned before without that when ball are close to stop, handleAlarms turns into infinite loop, breaking normal behaviour of the entire system.
I think the way I modeling the process itself is not perfect, but I have not found another way for now. Maybe I'll recall this example later.
But it seems that alarms system is a kind of common pattern, right? :)

from sodium.

the-real-blackh commented on August 10, 2024

Very nice!

Yes, alarms are definitely a common pattern. You can combine multiple alarms with 'min' - or better still, make a new alarm time type and make it a monoid. On the input side, you need to filter out alarms based on the alarm time (because you might be looking at someone else's alarm).

One way I have done this before is to have a monad transformer based on a state monad. In some ways this design is good and in other ways it's not. These are the sorts of things that experience will teach us.

Can I use your code as an example in the sodium distribution?

from sodium.

geraldus commented on August 10, 2024

Of course!

from sodium.

geraldus commented on August 10, 2024

@the-real-blackh, Hi Stephen! How d'you do? :)
Can you give me your email? I'm going to create UI with GHCJS. It's quite simple for now it is just one page with modal window and tabs within it, I assume the way to do that is very close to "channels example" in your presentation. The scheme itself seems to be very obvious and I'll try to replicate it by myself, but I can bet hundred to one I'll need your help! Maybe it's good idea to create new "issue"? What do you think?

from sodium.

the-real-blackh commented on August 10, 2024

Sounds great! My email is [email protected]

from sodium.

Help to dive in about sodium HOT 38 CLOSED

Comments (38)

Related Issues (20)

Recommend Projects

React

Vue.js

Typescript

TensorFlow

Django

Laravel

D3

Recommend Topics

javascript

web

server

Machine learning

Visualization

Game

Recommend Org

Facebook

Microsoft

Google

Alibaba

D3

Tencent