{-# LANGUAGE Arrows, FlexibleInstances #-} module ObjectBehaviour -- (ball, ballInPossession, player, playerAI, game) where import Debug.Trace import GHC.Exts import Data.List import Data.Maybe import Control.Monad (guard) import Graphics.UI.SDL (Pixel) import FRP.Yampa import FRP.Yampa.Utilities import FRP.Yampa.Geometry import FRP.Yampa.Point2 import Data.FSM import Physics import Object import Parser import Command import Message import PlayerFSM import BallFSM import GameFSM import States import Helper import Global import BasicTypes import AI import Rules -- ************************************************************************* -- -- Object: Ball -- -- ************************************************************************* fly :: Param -> ObjId -> ObjId -> Time -> Position3 -> Velocity3 -> Acceleration3 -> Collisions -> SF ObjInput (ObjOutput, Event (Param, ObjId, ObjId, Time, Position3, Velocity3, Acceleration3, Collisions)) fly param me lpInit t0 p0 v0 acc initColls = proc (ObjInput {oiGameInput = gi@(te, (t1,_)), oiMessages = (mi, colls), oiGameState = vss}) -> do -- models basic physics of a ball in free flight (speed, gravity, friction) -- if ball is longer in free flight (either because it went out of bounds (tbd) or -- because the ball is taken up and controlled by a player), the SF kills itself -- and respawns as a corresponding SF v <- (v0 ^+^) ^<< integral -< acc p <- (p0 .+^) ^<< integral -< v bounced <- edge -< point3Z p + pEps param < pGround param stopped <- edge -< sameDirection param (project v) (project acc) -- drop redundant collisions (collisions, cNext) <- ballCollisionSF initColls -< colls let ms = map (\(BallMessage msg) -> msg) $ filter isBallMessage mi let mcs = #if DEBUG_MODE trace ("Ball (Free): " ++ show (ms ++ collisions)) #endif (ms ++ collisions) (bs@(st,stParam), msOut') <- freeBallSF (BPWho lpInit t0) -< ((BPWho me t1, vss), (Event mcs)) let lp = lastPlayer bs let msOut = #if DEBUG_MODE trace ("Ball (Free) messages: " ++ show msOut' ++ show (lineCrossedMsgs param t1 (content st) p lpInit vss)) #endif (msOut' ++ lineCrossedMsgs param t1 (content st) p lpInit vss) gainedControl <- edge -< content st `elem` [BSControlled, BSControlledGoalie] outOfPlay <- edge -< content st == BSOutOfPlay let goalieHasGained = content st == BSControlledGoalie returnA -< (ObjOutput (OOSBall p v (isEvent bounced && vector3Z v < (-5)) ((content st), stParam)) (gainedControl `merge` outOfPlay) ( -- what about cNext?? (gainedControl `tag` [snd3 $ mkBallInPossession param me (fetchPlayer stParam) t1 goalieHasGained lp (p .-^ vector3 (-2) (-2) 0) v colls]) `merge` (outOfPlay `tag` [let BPOutOfPlay team oop pos _ = stParam in ballOutOfPlay param me lp team oop pos]) ) msOut, tag (merge bounced stopped) $ let z = max (point3Z p) (pGround param) vz = if z == pGround param then (-0.7) * vector3Z v else vector3Z v (vx, vy) = event (vector3X v, vector3Y v) (const (0,0)) stopped in (param, me, lp, t1, (Point3 (point3X p) (point3Y p) z), vector3 vx vy vz, acc, initColls)) where fetchPlayer (BPWho p _) = p oopPos (BPOutOfPlay _ _ pos _) = pos ball :: (Param, ObjId, ObjId, Time, Position3, Velocity3, Acceleration3, Collisions) -> SF ObjInput ObjOutput ball (param, me, lpInit, t0, pos, v, acc, initColls) = dSwitch (fly param me lpInit t0 pos v acc initColls) ball ballInPossession :: Param -> ObjId -> ObjId -> Time -> Bool -> ObjId -> Collisions-> SF ObjInput ObjOutput ballInPossession param me player t0 goalieHasGained lpInit initColls = {-# SCC "ballIP" #-} proc (ObjInput {oiGameInput = gi@(te, (t1,_)), oiMessages = (mi, colls), oiGameState = vss}) -> do -- drop redundant collisions (collisions, cNext) <- ballCollisionSF initColls -< colls let ms = map (\(BallMessage msg) -> msg) $ filter isBallMessage mi let mcs = #if DEBUG_MODE trace ("Ball (Poss): " ++ show (ms ++ collisions)) #endif (ms ++ collisions) (bs@(st,stParam), ems) <- (controlledBallSF goalieHasGained) (BPWho player t0) -< ((BPWho me t1, vss), (Event mcs)) currPlayer <- iPre player -< fetchPlayer stParam let Just playerVS = getObjVS currPlayer vss -- ball is either on the left or right foot of the player, ball position will be -- adjusted accordingly let foot = case vsOnFoot playerVS of LeftFoot -> -(pi / 4) RightFoot -> pi / 4 _ -> 0 -- position and velocity of the ball are taken from the player's -- respective values let p = vsPos playerVS .-^ fromPolar3 (foot + pi + vsDir playerVS) 2.1 0 let v = vsVel playerVS lostPossession <- edge -< content st == BSFree outOfPlay <- edge -< content st == BSOutOfPlay returnA -< ObjOutput (OOSBall p v False ((content st), stParam)) (lostPossession `merge` outOfPlay) ( (lostPossession `tag` [snd3 $ mkBall (param, me, currPlayer, t1, p, (fetchVel stParam), (makeBreakVector (fetchVel stParam)), cNext)]) `merge` (outOfPlay `tag` [let BPOutOfPlay team oop pos _ = stParam in ballOutOfPlay param me currPlayer team oop pos]) ) (ems ++ lineCrossedMsgs param t1 (content st) p currPlayer vss) where fetchPlayer (BPWho who _) = who makeBreakVector vel = let vel2 = project vel (theta, rho) = toPolar (vector2X vel2) (vector2Y vel2) (theta', rho') = (normTheta (theta + pi), 3) vel2' = fromPolar theta' rho' in vector3 (vector2X vel2') (vector2Y vel2') (-10) fetchVel (BPInit vel _) = vel fetchVel _ = zeroVel lineCrossedMsgs :: Param -> Time -> BallState -> (Point3 Double) -> ObjId -> [VisibleState] -> [Message] lineCrossedMsgs param t st pos lastPlayer vss = -- checks if ball crossed base, side or goal line and sends a corresponding -- message to the game object let gameId = vsObjId $ fetchGameVS vss x = point3X pos y = point3Y pos xBase = if x <= (pPitchWidth param) / 2 then 0 else pPitchWidth param yBase = if y <= 0 then 0 else (pPitchLength param) teamThrowingIn = otherTeam . vsTeam $ fetchVS vss lastPlayer goalTeam = if y < 0 then Home else Away in if st `elem` [BSOutOfPlay, BSControlledOOP, BSChallenged] then [] else if x < 0 || x > pPitchWidth param then [(gameId, GameMessage (GTSideOut, GPTeamPosition teamThrowingIn (Point2 x y) t True))] else if (y < 0 || y > pPitchLength param) && ((x < (pPitchWidth param - pGoalWidth param) / 2) || (x > (pPitchWidth param + pGoalWidth param) / 2)) then [(gameId, GameMessage (GTBaseOut, GPTeamPosition teamThrowingIn (Point2 xBase yBase) t True))] else if (y < 0 || y > pPitchLength param) && ((x >= (pPitchWidth param - pGoalWidth param) / 2) && (x <= (pPitchWidth param + pGoalWidth param) / 2)) then [(gameId, GameMessage (GTGoal, GPTeamPosition goalTeam (Point2 0 0) t True))] else [(gameId, GameMessage (GTBallInPlay, GPTeamPosition teamThrowingIn (Point2 0 0) t True))] ballOutOfPlay :: Param -> ObjId -> ObjId -> Team -> OutOfPlay -> Position2 -> SF ObjInput ObjOutput ballOutOfPlay param me lpInit team oopType pos = {-# SCC "ballOOP" #-} proc (ObjInput {oiGameInput = gi@(_, (t1,_)), oiMessages = (mi, colls), oiGameState = vss}) -> do -- -- what this does: -- -- a.) as long as the ball is out of play, it's position is either the corresponding out-of-play spot -- -- (kick off-, corner-positon or side-line position as long as not taken up by player), or -- -- behind and above the player's head if it's a throw-in and the ball has been taken up by -- -- a player (then the position changes when the player turns around) -- -- b.) when the ball goes in play again, the SF kills itself and respawns as a -- -- ball-SF -- let ms = map (\(BallMessage msg) -> msg) $ filter isBallMessage mi -- let mcs = trace ("Ball (Poss): " ++ show (ms ++ collisions)) (ms ++ collisions) -- ((st,stParam), ems) <- controlledBallSF (BPWho player) -< ((BPWho me, vss), (Event mcs)) -- drop redundant collisions (collisions, cNext) <- ballCollisionSF [] -< colls let ms = map (\(BallMessage msg) -> msg) $ filter isBallMessage mi let mcs = #if DEBUG_MODE trace ("Ball (Poss): " ++ show (ms ++ collisions)) #endif (ms ++ collisions) (bs@(st,stParam), ems) <- outOfPlayBallSF (BPOutOfPlay team oopType pos lpInit) -< ((BPWho me t1, vss), (Event mcs)) let lp = lastPlayer bs let Just playerVS = getObjVS lp vss controlled <- taggedEdge -< (content st == BSControlledOOP, 2.5) posZ <- hold 0 -< controlled -- position is above and behind player let posAdjust = if (content st) == BSControlledOOP then vsPos playerVS .-^ fromPolar3 (vsDir playerVS) 3 (-posZ) else pos .+! posZ backInPlay <- edge -< not $ content st `elem` [BSOutOfPlay, BSControlledOOP, BSChallenged] returnA -< ObjOutput (OOSBall posAdjust zeroVel False ((content st), stParam)) backInPlay (backInPlay `tag` [snd3 $ mkBall (param, me, lp, t1, posAdjust, fetchVel stParam, makeBreakVector (fetchVel stParam), cNext)]) ems -- ************************************************************************* -- -- Object: PlayerAI (controlled by AI) -- -- ************************************************************************* playerAI :: Param -> ObjId -> Time -> Position2 -> Velocity3 -> Angle -> Bool -> Bool -> TeamInfo -> PlayerInfo -> BasicState -> OnFoot -> TacticalState -> Object playerAI param me t0 p0 v0 angle0 sel des ti pi pbsInit foot initState = proc (ObjInput {oiMessages = (mi, colls), oiGameState = vss, oiGameInput = (_,(t1,_))}) -> do let commands = [] let tms = #if DEBUG_MODE trace ("Tactical " ++ show me ++ ": " ++ show (convertTms mi)) #endif (convertTms mi) rec pdDefault <- iPre p0 -< pd --projectP pos ((st, stParam@(TacticalStateParam maybePd vd kicked plId ovrwtDir _ timeOfPossession)), msOut) <- tacticalPlayerSF param initState angle0 -< ((t1, me, vss, commands), Event tms) let isDesignated = elem (TPTDesignateReceiver, tspNull) tms let isSwitchControl = elem (TPTSwitchControl, tspNull) tms -- desired position comes either from tactical fsm (if tactical transition yielded -- new pd) or default pd that is usually the last player position let pd = fromMaybe pdDefault maybePd let msLocal = map snd $ filter ((me ==) . fst) $ filter (isPhysicalPlayerMessage . snd) msOut let msOther = filter (\(id, m) -> not ((id == me) && isPhysicalPlayerMessage m)) msOut results@(ObjOutput oop@OOSPlayer{oosPos = pos, oosVel = vel, oosDir = angle, oosBasicState = (oosBS, oosBSP)} kill spawn msgs) <- playerCore param me t0 p0 v0 sel des ti pi pbsInit -< (pd, False, ovrwtDir, t1, commands, (msLocal ++ mi, colls), vss) let rm = ooMessages results let oos = (ooObsObjState results) { oosTacticalState = (content st, stParam), oosDesignated = isDesignated } returnA -< results { ooMessages = msOther ++ rm, ooObsObjState = oos, ooKillReq = if isSwitchControl then Event () else NoEvent, ooSpawnReq = if isSwitchControl then Event [ player param me t0 (projectP pos) vel angle False False ti pi (fst $ oosBasicState oop) (oosOnFoot oop) (if content st == TSWaitingForKickOff then TSNonAIKickingOff else TSNonAI) ] else NoEvent } -- ************************************************************************* -- -- Object: Player (controlled by human) -- -- ************************************************************************* convertTms mi = (sortWith fst (map (\(PlayerMessage (TacticalPlayerMessage tm)) -> tm) $ filter isTacticalPlayerMessage mi)) messageForNearestPlayer param npId myTeam myPos mc vss = (npId, if cmdTakeOver mc then tm (TPTSwitchControl, tspNull) else if cmdMoveForward mc then tm (TPTMoveTo, TacticalStateParam (Just $ posNp .+^ vector2 0 adjust) Nothing False Nothing Nothing Nothing Nothing) else if cmdMoveBackward mc then tm (TPTMoveTo, TacticalStateParam (Just $ posNp .+^ vector2 0 ((-1)*adjust)) Nothing False Nothing Nothing Nothing Nothing) else if cmdMoveLeft mc then tm (TPTMoveTo, TacticalStateParam (Just $ posNp .+^ vector2 adjust 0) Nothing False Nothing Nothing Nothing Nothing) else if cmdMoveRight mc then tm (TPTMoveTo, TacticalStateParam (Just $ posNp .+^ vector2 ((-1)*adjust) 0) Nothing False Nothing Nothing Nothing Nothing) else if cmdMoveToGoal mc then tm (TPTMoveTo, TacticalStateParam (Just goalPos) Nothing False Nothing Nothing Nothing Nothing) else if cmdMoveToMe mc then tm (TPTMoveTo, TacticalStateParam (Just myPos) Nothing False Nothing Nothing Nothing Nothing) else tm (TPTDesignateReceiver, tspNull)) where posNp = projectP . vsPos $ fetchVS vss npId adjust = if myTeam == Home then -20 else 20 goalPos = if myTeam == Home then awayGoalCenter param else homeGoalCenter param messageForTeamMate me myTeam myPos mc vss = do kickType <- getKickType mc bc <- fetchBallCarrier vss guard $ vsTeam bc == myTeam let hisPos = projectP $ vsPos bc -- return (vsObjId bc, tm (TPTKickTowards, -- (TacticalStateParam Nothing (Just $ (myPos .-. hisPos) ^+! 0) False (Just me) -- Nothing (Just kickType) Nothing))) return (vsObjId bc, pm (PPTLoseMe, BSPPass 1 kickType (Just me))) getKickType mc = if cmdFlipMeLow mc then Just RTLow else if cmdFlipMeHigh mc then Just RTHigh else Nothing player :: Param -> ObjId -> Time -> Position2 -> Velocity3 -> Angle -> Bool -> Bool -> TeamInfo -> PlayerInfo -> BasicState -> OnFoot -> TacticalState -> Object player param me t0 p0 v0 angle0 sel des ti pi pbsInit foot initState = proc (ObjInput {oiGameInput = gi@(_,(t1,incoming)), oiGameState = vss, oiMessages = (mi, colls)}) -> do -- desired position is current mouse position (pd, commands) <- playerInput param -< gi -- mark designated receiver let myTeam = fst3 ti let npId = nearestAIPlayer myTeam vss pd let tms = #if DEBUG_MODE trace ("Tactical " ++ show me ++ ": " ++ show (convertTms mi)) #endif (convertTms mi) let comMsgs = concatMap comToMsg commands rec pos' <- iPre p0 -< projectP pos oosBS' <- iPre pbsInit -< oosBS let markMsg = messageForNearestPlayer param npId myTeam pos' commands vss let teamMateMsg = messageForTeamMate me myTeam pos' commands vss ((st,stParam), _) <- tacticalNonAiSF initState -< ((t1, me, vss, commands), Event tms) let running = content st /= TSNonAIKickingOff -- player commands will be ignored before kickoff let pdAdjusted = if not running then p0 -- .+^ (vector2 (-0.0000001) 0) -- only look, don't walk when preparing for throw in else if oosBS' == PBSPrepareThrowIn then lookTo pos' pd else pd let angleAdjusted = if not running then Just angle0 else Nothing results@(ObjOutput oop@OOSPlayer{oosPos = pos, oosVel = vel, oosDir = angle, oosBasicState = (oosBS, oosBSP), oosTacticalState = (oosTS, oosTSP)} kill spawn msgs) <- playerCore param me t0 p0 v0 sel des ti pi pbsInit -< (pdAdjusted, not (null comMsgs), angleAdjusted, t1, commands, (mi ++ comMsgs, colls), vss) let (switchAI, newAI) = if cmdTakeOver commands then (Event (), --playerAI :: Param -> ObjId -> Time -> Position2 -> Velocity3 -> Angle -> Bool -- -> Bool -> TeamInfo -> PlayerInfo -> BasicState -> TacticalState -> Object Event [playerAI param me t0 (projectP pos) vel angle False False ti pi oosBS (oosOnFoot oop) (if content st == TSNonAIKickingOff then TSWaitingForKickOff else if piPlayerRole pi == Goalie then TSTendingGoal else TSHoldingPosition)]) else (NoEvent, NoEvent) let oos = (ooObsObjState results) { oosTacticalState = (content st, stParam) } returnA -< results {ooMessages = maybeToList teamMateMsg ++ markMsg:msgs, ooObsObjState = oos, ooKillReq = switchAI, ooSpawnReq = newAI} -- ************************************************************************* -- -- Core player logic, used by both AI- and user controlled player -- -- ************************************************************************* bouncePower f vss = foldl' (^+^) (vector2 0 0) . map (project . f . fetchVS vss) playerCore :: Param -> ObjId -> Time -> Position2 -> Velocity3 -> Bool -> Bool -> TeamInfo -> PlayerInfo -> BasicState -> SF (Point2 Double, Bool, Maybe Angle, Time, [Command], ([MessageBody], Collisions), [VisibleState]) ObjOutput playerCore param me t0 p0 v0 sel des ti pi pbsInit = proc (pd, kicked, ovrwtDir, t1, commands, (mi, collsIn), vss) -> do -- desired position is current mouse position let pCollsIn = filter (isPlayer . fetchVS vss) collsIn -- check for new collisions; every new collision will be fed to the basicPlayerFSM, -- the subset of new player collisions is needed for the bouncing logic allCollisions <- playerCollisionSF [] -< collsIn pCollisions <- playerCollisionSF [] -< pCollsIn -- save the time of the last player collision pCollided <- taggedEdge -< (not (null pCollisions), t1) pCollTime <- hold t0 -< pCollided -- a collision only slows a player down for a given time -- after that, the usual motion logic starts again let inPlayerCollision = not (null pCollsIn) && t1 - pCollTime < pBouncingTime param -- during a collision, the total acc and vel of all the players involved -- are evenly divided between the "colliders"; this replaced the -- usual acc and vel for the time of the collision let adjust = 1 / (1 + fromIntegral (length pCollsIn)) let accBounce = adjust *^ bouncePower vsAcc vss (me:pCollsIn) let velBounce = adjust *^ bouncePower vsVel vss (me:pCollsIn) toggled <- edge -< cmdToggleFoot commands rec let ad = ((20 *^ (pd .-. p)) ^-^ (10 *^ v)) -- Desired acceleration let acc = if inPlayerCollision then accBounce else limit (piPlayerAccMax pi) ad v <- integral >>> arr ((limit (piPlayerSpeedMax pi)) . ((project v0) ^+^)) -< residualAcc param acc v (piPlayerSpeedMax pi) p <- integral >>> arr (p0 .+^) -< if inPlayerCollision then velBounce else v let dirV = pd .-. p let dir = atan2 (vector2Y dirV) (vector2X dirV) let pms = map (\(PlayerMessage (PhysicalPlayerMessage pm)) -> pm) $ filter isPhysicalPlayerMessage mi let mcs = #if DEBUG_MODE trace ("Player " ++ show me ++ ": " ++ show (pms ++ allCollisions)) #endif (pms ++ allCollisions) ((st,stParam), ems) <- basicPlayerSF pbsInit t0 -< ((t1, me, vss), (Event mcs)) let ems' = #if DEBUG_MODE trace ("Messages Player " ++ show me ++ ": " ++ show ems) #endif ems -- toggle between left and right foot possGained <- edge -< content st == PBSInPossession let initialFoot = possGained `tag` leftOrRightFoot p dirV (vsPos $ fetchBallVS vss) (foot, _) <- accumHoldBy switcher (NoFoot, False) -< myjoin initialFoot toggled returnA -< ObjOutput { ooObsObjState = OOSPlayer (Point3 (point2X p) (point2Y p) 0) (vector3 (vector2X v) (vector2Y v) 0) (vector3 (vector2X acc) (vector2Y acc) 0) kicked sel des 2 ti pi (fromMaybe dir ovrwtDir) ((content st), stParam) (TSNonAI, tspNull) foot, ooKillReq = noEvent, ooSpawnReq = noEvent, ooMessages = ems' } leftOrRightFoot pPlayer dirPlayer pBall = if isLeftFrom dirPlayer (projectP pBall .-. pPlayer) then LeftFoot else RightFoot myjoin (Event NoFoot) _ = NoEvent myjoin (Event x) NoEvent = Event (x, False) myjoin NoEvent (Event ()) = Event (undefined, True) myjoin NoEvent NoEvent = NoEvent myjoin _ _ = NoEvent switchFoot NoFoot = NoFoot switchFoot RightFoot = LeftFoot switchFoot LeftFoot = RightFoot switcher (oldF, _) (newF, False) = (newF, False) switcher (oldF, _) (_, True) = (switchFoot oldF, False) fetchBall ((VSBall oid _ _ _ _):xs) = oid fetchBall (_:xs) = fetchBall xs -- ************************************************************************* -- -- Object: Game -- -- ************************************************************************* --runRulesOnEvent :: Facts -> [VisibleState] -> RuleBase -> RuleBase -> TimerEvent -> [(ObjId, MessageBody)] runRulesOnEvent facts vss trb_home trb_away te = runRules tps facts vss (if team == Home then trb_home else trb_away) where team = if te == TimerCalculateHomeAI then Home else Away tps = map vsObjId $ teamPlayers team vss game :: Param -> ObjId -> Team -> Int -> Int -> Time -> Object game param me initialAttacker scoreHome scoreAway t0 = proc (ObjInput {oiGameInput = gi@(te, (t1,_)), oiGameState = vss, oiMessages = (mi, _)}) -> do commands <- gameKeysSF -< gi let gms = #if DEBUG_MODE trace ("Game: " ++ show (map (\(GameMessage gm) -> gm) $ filter isGameMessage mi)) #endif (map (\(GameMessage gm) -> gm) $ filter isGameMessage mi) rec freezeAttacker <- iPre initialAttacker -< attacker let comMsgs = if cmdQuit commands then [(GTQuit, GPTeamPosition freezeAttacker (Point2 0 0) t1 True)] else if cmdFreeze commands then [(GTFreeze, GPTeamPosition freezeAttacker (Point2 0 0) t1 False)] else [] -- process only first message, and keep rest for later -- important since the result of every game message should be -- processed outside the reactimate loop -- ACHTUNG!!! Das passt nicht, weil die Ball In Play-Meldungen ja jedes Mal kommen! -- let (now, later) = safePartition $ comMsgs ++ gms -- ((st, stParam@(GPTeamPosition attacker _ _)), msOut) <- gameSF param (GPTeamPosition initialAttacker (Point2 0 0) 0) -< (vss, Event now) ((st, stParam@(GPTeamPosition attacker _ _ _)), msOut) <- gameSF param (GPTeamPosition initialAttacker (Point2 0 0) t0 True) -< (vss, Event (comMsgs ++ gms)) let teamAtMove = if fromEvent te == TimerCalculateHomeAI then Home else Away let semNet = deriveFacts param t1 attacker teamAtMove vss let msg = event [] (runRulesOnEvent semNet vss (pRuleBaseHome param) (pRuleBaseAway param)) te returnA -< ObjOutput { ooObsObjState = OOSGame t1 -- time (scoreHome, scoreAway) -- score (content st, stParam) attacker (Point3 0 0 0), ooKillReq = noEvent, ooSpawnReq = noEvent, ooMessages = msOut ++ msg -- ++ (map (\x -> (me, GameMessage x)) later) } safePartition [] = ([], []) safePartition [a] = ([a], []) safePartition (a:as) = ([a], as) -- ************************************************************************* -- -- Convenient maker functions -- -- ************************************************************************* mkBall :: (Param, ObjId, ObjId, Time, Position3, Velocity3, Acceleration3, Collisions) -> (ObjId, SF ObjInput ObjOutput, ObjOutput) mkBall (param, me, lp, t0, pos, v, acc, initColls) = (me, ball (param, me, lp, t0, pos, v, acc, initColls), ObjOutput (OOSBall pos v False (BSFree, undefined)) NoEvent NoEvent []) mkBallInPossession :: Param -> ObjId -> ObjId -> Time -> Bool -> ObjId -> Position3 -> Velocity3 -> Collisions -> (ObjId, SF ObjInput ObjOutput, ObjOutput) mkBallInPossession param me player t0 goalieHasGained lp pos v initColls = (me, ballInPossession param me player t0 goalieHasGained lp initColls, ObjOutput (OOSBall pos v False (BSControlled, BPWho player t0)) NoEvent NoEvent []) -- ************************************************************************* -- -- Various helper functions -- -- ************************************************************************* residualAcc :: Param -> Acceleration2 -> Velocity2 -> Double -> Acceleration2 residualAcc param acc vel maxV = let accTheta = vector2Theta acc accRho = vector2Rho acc velTheta = vector2Theta vel velRho = vector2Rho vel in if (velRho + pEps param >= maxV) && (acc `sameDirAs` vel) then fromPolar (normTheta $ if acc `isLeftFrom` vel then velTheta + pi else velTheta - pi) -- (accRho * abs (sin (accTheta - accRho))) -- häh??? (accRho * abs (sin (accTheta - velTheta))) else acc ballCollisionSF :: Collisions -> SF Collisions ([BallMessage], Collisions) ballCollisionSF init = proc c1 -> do c2 <- iPre init -< c1 let cNext = c1 \\ c2 let newColls = map (\c -> (BTCollisionB, BPWho c (-1))) cNext returnA -< (newColls, cNext) playerCollisionSF :: Collisions -> SF Collisions [PhysicalPlayerMessage] playerCollisionSF init = proc c1 -> do c2 <- iPre init -< c1 let newColls = map (\c -> (PPTCollisionP, BSPWhoAndWhen c 0)) $ c1 \\ c2 returnA -< newColls tupelize :: [(a, b)] -> c -> [(a, (b, c))] tupelize [] _ = [] tupelize ((x,y):xs) z = (x,(y,z)):tupelize xs z taggedEdge :: SF (Bool, a) (Event a) taggedEdge = proc (bool, a) -> do e <- edge -< bool returnA -< tag e a