Snake.hs

module BB.Examples.Snake
where

import Reactive.Banana
import Reactive.Banana.Frameworks

import Graphics.Ogre.HOgre
import Graphics.Ogre.Types
import OIS.Types

import Reactive.Banana.BOGRE

import BB.Util.Vec


snake :: IO ()
snake = runGame myGame

-- init the world and return the FRP network
initWorld :: Frameworks t => HookedBogreSystem t -> SceneManager -> IO (SceneNode, SceneNode)
initWorld bs smgr = do
        -- create a light
        l <- sceneManager_createLight_SceneManagerPcharP smgr "MainLight"
        light_setPosition_LightPfloatfloatfloat l 0 0 500
        
        -- default camera
        cam <- sceneManager_getCamera smgr "PlayerCam"
        camera_setPosition_CameraPfloatfloatfloat cam 0 0 1000
        
        -- create first head and target
        head0 <- liftIO $ addEntity bs "ogrehead.mesh"
        target <- liftIO $ addEntity bs "ogrehead.mesh"
        
        return (head0, target)


myGame :: Frameworks t => GameBuilder t
myGame bs smgr = do
        -- init the world
        (head0, target)<- liftIO $ initWorld bs smgr
        
        -- keyboard control
        let speed = 200
        let velB = stepper (0,0,0) ((scale speed) <$> (
                        ((0,1,0)  <$ (getKeyDownE bs KC_UP))         `union`
                        ((0,-1,0) <$ (getKeyDownE bs KC_DOWN))       `union`
                        ((-1,0,0) <$ (getKeyDownE bs KC_LEFT))       `union`
                        ((1,0,0)  <$ (getKeyDownE bs KC_RIGHT))      `union`
                        ((0,0,-1) <$ (getKeyDownE bs KC_G))          `union`
                        ((0,0,1)  <$ (getKeyDownE bs KC_B))
                ))
        let head0PosB = velocityToPositionB bs (0,0,0) velB
        setPosB bs head0 head0PosB
        
        -- random bounded positions for target
        randomVec3 <- getRandomVec3B
        let randomTargetPosB = ((sub (boxWidthH,boxWidthH,boxWidthH)) . (scale boxWidth)) <$> randomVec3 where
                boxWidthH = 150
                boxWidth = 2*boxWidthH
                
        
        -- target position changes on collision
        initTargetPos <- initial randomTargetPosB
        targetHitE <- sphereCollisionsE bs 40 head0 target
        let targetPosB = stepper initTargetPos (randomTargetPosB <@ targetHitE) where
        setPosB bs target targetPosB
        
        -- dynamically add heads
        newHeadE <- createNodeOnE bs ("ogrehead.mesh" <$ targetHitE)
        -- delay heads
        let headCountB = accumB 1 ((+1) <$ newHeadE)
        let headsDelaysE = (((,) . (*0.2))  <$> headCountB) <@> newHeadE
        delayedB <- getDynamicDelayedPosBs bs head0PosB headsDelaysE
        setDynamicPosBs bs delayedB
        
        -- stop on escape key
        let escE = getKeyDownE bs KC_ESCAPE
        reactimate $ (stopBogre bs) <$ escE
        return ()