[Haskell-cafe] FRP for game programming / artifical life simulation

Duane Johnson duane.johnson at gmail.com
Thu Apr 22 21:57:54 EDT 2010


This is really good stuff, Luke.  I am interested in learning more,  
especially in seeing examples or actual game code that implement the  
more common parts of a game.  I build a game ("silkworm") in Haskell  
that was one of my first Haskell programs.  The code was not pretty,  
and I always felt there was a better way.  It seems you are on to a  
better way.

When you're ready, I'll be watching for the announcement ;)

Regards,
Duane Johnson

On Apr 21, 2010, at 6:39 PM, Luke Palmer wrote:

> On Wed, Apr 21, 2010 at 4:47 PM, Ben Christy <ben.christy at gmail.com>  
> wrote:
>> I have an interest in both game programming and artificial life. I  
>> have
>> recently stumbled on Haskell and would like to take a stab at  
>> programming a
>> simple game using FRP such as YAMPA or Reactive but I am stuck. I  
>> am not
>> certain which one I should choose. It seems that Reactive is more  
>> active but
>> is it suitable for game programming. Also has anyone attempted to  
>> implement
>> neural networks using FRP if so again which of these two approaches  
>> to FRP
>> would you suggest?
>
> I am in the process of writing a game using FRP.  I haven't followed
> reactive in a while, but last I checked it had some rather annoying
> issues, such as joinE (monad join on events) not working and an open
> space leak.  So we are using a Yampa-like approach, but not
> specifically Yampa.  However most of the game logic is *not* in AFRP
> ("arrowized" FRP) style, it is just there to give a nice foundation
> and top level game loop, playing much the same role as IO does in many
> Haskell programs (but it is implemented purely!).
>
> The workhorse of our game has so far been "generalized differentials".
> While not entirely rigorous, they have provided a very nice framework
> in which to express our thoughts and designs, and are very good at
> "highly dynamic" situations which appear in games.  For example, with
> arrows it is painful to maintain a list of moving actors such that can
> be added and removed.  With differentials this is quite natural.
>
> I haven't published the differential library yet, I am waiting until
> we have used them enough to discover essential techniques and find a
> nice bases for primitives.  But I will give a sketch here.  Let the
> types be your guide, as I am implementing from memory without a
> compiler :-P
>
>> import qualified Data.Accessor.Basic as Acc
>> import Data.VectorSpace
>> import Control.Comonad
>
> A differential is implemented as a function that takes a timestep and
> returns an update function.  Don't expose the D constructor; step is
> okay to expose, it's kind of a generalized "linear approximation".
>
>> newtype D a = D { step :: Double -> a -> a }
>
>> instance Monoid (D a) where
>>    mempty = D (const id)
>>    mappend da db = D (\dt -> step da dt . step db dt)
>
> Given a differential for a component of a value, we can construct a
> differential for that value.
>
>> accessor :: Acc.T s a -> D a -> D s
>> accessor acc da = D (Acc.modify acc . step da)
>
> Given a differential for each component of a tuple, we can find the
> differential for the tuple.
>
>> product :: D a -> D b -> D (a, b)
>> product da db = D (\dt (x,y) -> (step da dt x, step db dt y))
>
> A differential can depend on the current value.
>
>> dependent :: (a -> D a) -> D a
>> dependent f = D (\dt x -> step (f x) dt x)
>
> Vectors can be treated directly as differentials over themselves.
>
>> vector :: (VectorSpace v, Scalar v ~ Double) => v -> D v
>> vector v = D (\dt x -> x ^+^ dt *^ v)
>
> Impulses allow non-continuous "burst" changes, such as adding/removing
> an element from a list of actors. This is the only function that bugs
> me.  Incorrectly using it you can determine the framerate, which is
> supposed be hidden.  But if used correctly; i.e. only trigger them on
> passing conditions, they can be quite handy.  But my eyes and ears are
> open for alternatives.
>
>> impulse :: (a -> a) -> D a
>> impulse f = D (const f)
>
> If we can can find the differential for an element of some comonad
> given its context, we can find the differential for the whole
> structure.  (Our "game world" is a comonad, that's why this is in
> here)
>
>> comonad :: (Comonad w) => (w a -> D a) -> D (w a)
>> comonad f = D (\dt -> let h w = step (f w) dt (extract w) in extend  
>> h)
>
> I add new primitives at the drop of a hat. I would like to find a nice
> combinator basis, but as yet, one hasn't jumped out at me. It might
> require some tweaking of the concept.
>
> The arrow we are using is implemented in terms of differentials:
>
>> data Continuous a b = forall s. Continuous s (s -> a -> (b, D s))
>
>> instance Category Continuous where
>>    id = Continuous () (\() x -> (x, mempty))
>>    Continuous sg0 g . Continuous sf0 f = MkC (sg0,sf0) $ \(sg,sf) x  
>> ->
>>        let !(y, df) = f sf x     -- mind the strict patterns
>>            !(z, dg) = g sg y in
>>        (z, product dg df)
>
> Exercise: implement the Arrow and ArrowLoop instances.
>
> And here is where it comes together.  Integration over generalized
> differentials is a continuous arrow:
>
>> integral :: Continuous (D a) a
>> integral a0 = Continuous a0 (,)
>
> So our game loop looks something like:
>
>> dGameState :: Input -> D GameState
>> dGameState = ... -- built out of simpler Ds of its components
>
>> mainGame = proc input -> do
>>    gameState <- integral initialGameState -< dGameState input
>>    returnA -< drawGameState gameState
>
> This is my first experience with functional game programming, and so
> far I love it!  It makes so much more sense than the imperative
> alternative.  But the techniques are quite new and different as well,
> and sometimes it takes a lot of thinking to figure out how to do
> something that would be obvious for an experienced imperative game
> programmer.  But I consider it a virtue: it's a chance to re-evaluate
> all the nonsense we've built up over the years and pioneer the field
> all over again.
>
> I hope this helps.  If you go with a different approach, please write
> about it!
>
> Luke
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20100422/17daba0f/attachment.html


More information about the Haskell-Cafe mailing list