{- ObjectBehavior.hs; Mun Hon Cheong (mhch295@cse.unsw.edu.au) 2005 Game objects modelled in Yampa -} module ObjectBehavior ( aicube, camera, ) where import qualified Random import AFRP import AFRPUtilities import AFRPGeometry import List (find) import Maybe (fromJust) import Parser import Object import Camera import Matrix import MD3 import IdentityList ------------------------------------------------------------------------------- -- Just a waypoint wayPoint :: (Double,Double,Double) -> ILKey -> Object wayPoint xyz key = constant ObjOutput { ooObsObjState = OOSWayPoint xyz, ooKillReq = noEvent, ooSpawnReq = noEvent, ooSendMessage = noEvent } ------------------------------------------------------------------------------- -- The ray fired by the player ray :: (Double,Double,Double) -> (Double,Double,Double) -> ILKey -> ILKey -> Object ray (x,y,z) (vx,vy,vz) firedfrom id = proc oi -> do let clippedPos = oiCollisionPos oi let grounded = oiOnLand oi timeout <- after 0.25 () -< () cl <- (iPre False) <<< identity -< grounded let (vvx,vvy,vvz) = normalise $ vectorSub end start clip <- (iPre start) <<< (arr not0) -< clippedPos ucx <- integral -< 7500*vvx ucy <- integral -< 7500*vvy ucz <- integral -< 7500*vvz clipev <- edge -< cl returnA -< ObjOutput { ooObsObjState = OOSRay {rayStart = start, rayEnd = clip, rayUC = vectorAdd start (ucx,ucy,ucz), clipped = cl, firedFrom = firedfrom}, ooKillReq = timeout, ooSpawnReq = noEvent, ooSendMessage = clipev `tag` [(firedfrom,(id,Coord clip))] } where (start,end) = firePos (x,y,z) (vx,vy,vz) (vwx,vwy,vwz) = normalise $ vectorSub end start init = (vectorAdd start (vwx,vwy,vwz)) not0 c | c /= (0,0,0) = c | otherwise = (x,y,z) ------------------------------------------------------------------------------- -- The projectile fired by the enemy projectile :: (Vec3,Vec3) -> ILKey -> ILKey -> Object projectile ((sx,sy,sz),(vx,vy,vz)) firedfrom id = proc oi -> do let clippedPos = oiCollisionPos oi let grounded = oiOnLand oi let hits = oiHit oi hit <- identity -< hits cl <- (iPre False) <<< identity -< grounded clipEv <- edge -< cl x <- imIntegral sx-< 1500*vx y <- imIntegral sy-< 1500*vy z <- imIntegral sz-< 1500*vz oldpos <- iPre (sx,sy,sz) <<< identity -< (x,y,z) hitEv <- edge -< (isEvent clipEv || isEvent hit) returnA -< ObjOutput { ooObsObjState = OOSProjectile { projectileOldPos = oldpos, projectileNewPos = (x,y,z), firedFrom = firedfrom}, ooKillReq = hitEv, ooSpawnReq = noEvent, ooSendMessage = noEvent } ------------------------------------------------------------------------------- -- The player object camera :: Camera -> [(String,AnimState,AnimState)] -> [(ILKey,Message)] -> ILKey -> Object camera cam modelAnims imsgs id = proc oi -> do let gi = oiGameInput oi let clippedcam = oiCollision oi let grounded = oiOnLand oi let msgs = oiMessage oi pPos <- ptrPos -< gi forwardVel <- movementKS 400 -< gi strafeVel <- strafeKS 400 -< gi trigger <- lbp -< gi rtrigger <- rbp -< gi dt <- getDt -< gi -- update the camera cam1 <- (iPre cam) <<< (arr setView) -< (pPos,clippedcam) cam2 <- moves -< (forwardVel*dt,cam1) cam3 <- strafes -< (strafeVel*dt,cam2) yVel <- fallingp -< (grounded,gi) cam4 <- (arr dropCam) -< (cam3,yVel) -- hold on to the messages we have received -- until the right trigger is pressed -- the waypoint messages held will be used rec (msgn,msgi) <- (iPre ([],[]))<<< identity -< case (isEvent rtrigger) of True -> ([],msgn) False -> ((getMsg0 msgs msgn),msgn) -- a hit event hitEv <- iPre (noEvent) <<< identity -< oiHit oi -- decrement the helth by 3 every time the player gets hit rec currentHealth <- (iPre 100) <<< identity -< case (isEvent hitEv) of True -> currentHealth - (realToFrac((length (fromEvent hitEv))*3)) False -> currentHealth -- get the coords let coords = reverse $ map getCoordFromMsg (msgi) -- get the animation for the model we are using let modelAnim = (findModelAnim "klesk" modelAnims) msges <- (iPre noEvent) <<< identity -< msgs -- increment the player's score rec kills <- (iPre 0) <<< identity -< kills + (length (findKills (event2List msges))) -- trigger an event which prints the waypoints (rev,msgi2) <- (iPre (noEvent,[])) <<< identity -< (rtrigger,msgi) ccam <- (iPre cam) <<< identity -< clippedcam returnA -< ObjOutput { ooSpawnReq = -- left click fires a ray (trigger `tag` [(ray (cpos cam1) (viewPos cam1) id)]), {- `lMerge` -- right click spawns an enemy ( just for debugging) (rtrigger `tag` case (reverse $ map getCoordFromMsg msgi) of [] -> [] wps -> [aicube (vectorAdd (head wps) (0,90,0)) (20,45,20) (tail wps) "klesk" modelAnim]), -} ooObsObjState = OOSCamera {newCam = cam4, oldCam = cam1, health = currentHealth, ammo = 100, score = kills, cood = case (isEvent rev) of True -> reverse $ map getCoordFromMsg (msgi2) _ -> []}, ooKillReq = noEvent, ooSendMessage = -- send a response to an enemy request case (event2List msges) of [] -> noEvent _ -> (Event ()) `tag` (case (findEnemies (event2List msges)) of [] ->[] _ -> [toTargetPosition id (cpos ccam) (head (findEnemies (event2List msges)))]) } --extract a list from an event event2List :: Event [a] -> [a] event2List ev | isEvent ev = fromEvent ev | otherwise = [] -- finds the animations of a model when given a name findModelAnim :: String -> [(String,AnimState,AnimState)] -> (AnimState,AnimState) findModelAnim name anims = (ua,la) where (nm,ua,la) = fromJust $ find (\(x,y,z)->(x==name)) anims -- finds waypoint messages getMsg0 :: (Event [(ILKey,Message)]) -> [(ILKey,Message)] -> [(ILKey,Message)] getMsg0 (ev) ls = case (isEvent ev) of True -> case ((findCoords (fromEvent ev))++ls) of x -> x _ -> ls -- find kill messages findKills :: [(ILKey,Message)] -> [ILKey] findKills ((k,EnemyDown):kmsgs) = k:(findKills kmsgs) findKills ((k,_):kmsgs) = (findKills kmsgs) findKills [] = [] -- find enemy request findEnemies :: [(ILKey,Message)] -> [ILKey] findEnemies ((k,PlayerLockedOn):kmsgs) = k:(findEnemies kmsgs) findEnemies ((k,_):kmsgs) = (findEnemies kmsgs) findEnemies [] = [] -- response from the player to an enemy request toTargetPosition :: ILKey -> Vec3 -> ILKey -> (ILKey,(ILKey,Message)) toTargetPosition id position contact = (contact,(id,TargetPosition position)) -- find coord messages findCoords :: [(ILKey,Message)] -> [(ILKey,Message)] findCoords ((k,Coord x):kmsgs) = (k, Coord x):(findCoords kmsgs) findCoords ((k,_):kmsgs) = (findCoords kmsgs) findCoords [] = [] -- creates a waypoint from a message createWPFromMsg :: (ILKey,Message) -> (ILKey -> Object) createWPFromMsg (key,(Coord xyz)) = wayPoint xyz -- extracts a tuple of Doubles fromm a coord message getCoordFromMsg :: (ILKey,Message) -> Vec3 getCoordFromMsg (key,(Coord xyz)) = xyz ------------------------------------------------------------------------------- -- The ai object -- teleportation disabled aicube :: (Double,Double,Double) -> (Double,Double,Double) -> [(Double,Double,Double)]-> String -> (AnimState,AnimState)-> ILKey -> Object aicube (x,y,z) size waypoints modelname (ua,la) id = proc oi -> do let gi = oiGameInput oi t <- getT -< gi let hitList = oiHit oi let enemySighted = oiVisibleObjs oi let clippedPos = oiCollisionPos oi -- keep track of who has hit the ai hitSource <- iPre Nothing <<< identity -< case (isEvent hitList) of True -> getFire (snd (head (fromEvent hitList))) _ -> Nothing -- generate an event when we have been hit for the first time hitev1 <- edge -< (hitSource /= Nothing) -- decrement the helth in reponse to hit events rec currentHealth <- (iPre 100) <<< identity -< case (isEvent hitList) of True -> currentHealth - (3) False -> currentHealth hitev <- edge -< (currentHealth <= 0) rec isDead <- (iPre False) <<< identity -< case (isEvent hitev) of True -> True _ -> isDead -- enemy sighted enemyS <- (iPre noEvent) <<< edge -< (isEvent enemySighted) && (isDead == False) -- keep track of the last enemy that was sighted rec enemy <- (iPre noEvent) <<< identity -< case (isEvent enemySighted) of True -> enemySighted False -> enemy -- keep track of the position of the last enemy that -- was sighted rec targ <- (iPre (0,0,0)) <<< identity -< case (isEvent enemySighted) of True -> (cpos (oldCam (snd (head (fromEvent enemySighted))))) False -> targ msgs <- (iPre noEvent) <<< identity -< oiMessage oi -- a response has been recieved from the player msgReceived <- edge -< case (isEvent msgs) && (isDead == False) of True -> case (getTargetPosition (fromEvent msgs)) of Just _ -> True _ -> False _ -> False -- respond to the first attack from the player respond2Attack <- edge -< case (isEvent msgs) && (isDead == False) of True -> case (getTargetPosition2 (fromEvent msgs)) of Just _ -> True _ -> False _ -> False -- we have just lost sight of the target targetLost1 <- (iPre noEvent) <<< edge -< (isNoEvent enemySighted) && (isNoEvent msgReceived) -- repeated send a message to the player when we have lost -- sight of the target targetLost <- rSwitch (constant noEvent)-< ((), (enemyS `tag` (constant noEvent)) `lMerge` (targetLost1 `tag` (repeatedly (0.5) (Event())))) -- switch behaviors in response to events rec (newPos,oldPos, angle,pitch,attack,(upperIdx,lowerIdx)) <- drSwitch (followWayPoints (x,y,z) waypoints) -< ((oi,uEndEv,lEndEv), (enemyS `tag`(turnToFaceTarget (oldPos,angle)))`lMerge` -- msgReceived `tag`(turnToFaceTarget -- (fromJust (getTargetPosition (fromEvent msgs)),0)) `lMerge` respond2Attack`tag`(turnToFaceTarget (oldPos,angle)) `lMerge` hitev `tag` playDead oldPos angle) -- update the animations (uEndEv ,upperState) <- updateAnimSF ua -< (t, upperIdx) (lEndEv ,lowerState) <- updateAnimSF la -< (t, lowerIdx) -- a special effect when we teleport --f <- rSwitch (constant 1) -< ((0.01), msgReceived `tag` (imIntegral 0)) let f = 1 returnA -< ObjOutput { ooObsObjState = OOSAICube {oosNewCubePos = newPos, oosOldCubePos = oldPos, oosCubeSize = size, oosCubeAngle = angle, oosCubePitch = pitch, upperAnim = upperState, lowerAnim = lowerState, health = currentHealth, target = targ, fade = f, modelName = modelname}, ooKillReq = noEvent, ooSpawnReq = attack `tag` [projectile (getMuzzlePoint (oldPos,targ)) id], ooSendMessage = -- when the ai has died notify the player hitev `tag` ( case isDead of False -> [(fromJust hitSource,(id,EnemyDown))] _ -> []) `lMerge` -- request information from the player -- when we have lost sight of the player targetLost1 `tag` [(fst (head (fromEvent enemy)),(id,PlayerLockedOn))] `lMerge` -- request information from the player -- when we have been hit hitev1 `tag` [(fromJust hitSource,(id,PlayerLockedOn2))] } -- get the id of the object that fired the ray getFire :: ObsObjState -> Maybe ILKey getFire obj | isRay obj = Just (firedFrom obj) | otherwise = Nothing getDistance :: Vec3 -> Vec3 -> Double getDistance (x,y,z) (x2,y2,z2) = sqrt (((x-x2)^2) + ((y-y2)^2) + ((z-z2)^2)) getTargetPosition :: [(ILKey,Message)] -> Maybe Vec3 getTargetPosition ((k,TargetPosition pos):rest) = Just pos getTargetPosition (_:rest) = getTargetPosition rest getTargetPosition [] = Nothing getTargetPosition2 :: [(ILKey,Message)] -> Maybe Vec3 getTargetPosition2 ((k,TargetPosition2 pos):rest) = Just pos getTargetPosition2 (_:rest) = getTargetPosition2 rest getTargetPosition2 [] = Nothing -- gosh calculating the muzzle point is such a pain. -- The muzzle point is no longer accurate now that ive -- changed the model getMuzzlePoint :: (Vec3,Vec3) -> (Vec3,Vec3) getMuzzlePoint ((x,y,z),(ox,oy,oz)) = let (x3,y3,z3) = normalise $ (vectorSub (ox,oy+45,oz) (x,y,z)) (x7,y7,z7) = normalise $ (vectorSub (ox,0,oz) (x,0,z)) (x4,y4,z4) = normalise $ crossProd (x3,0,z3) (0,1,0) (x5,y5,z5) = (x+(x7*(-18.55))+(x4*(9.6)),y+4,z+(z7*(-18.55))+(z4*(9.6))) (x12,y12,z12) = normalise $ (vectorSub (ox,oy-5,oz) (x,y,z)) (x6,y6,z6) = vectorAdd (x5,y5,z5) (x12*42,y12*42,z12*42) (x9,y9,z9) = normalise $ (vectorSub (x6,y6,z6) (x5,y5,z5)) (x10,y10,z10) = normalise $ crossProd (x9,y9,z9) (0,1,0) (x13,y13,z13) = normalise $ crossProd (x9,y9,z9) (x10,y10,z10) muzzlePoint = vectorAdd (x6,y6,z6) (x13*(-9.5),y13*(-9.5),z13*(-9.5)) muzzleEnd = vectorAdd (x5,y5,z5) (x13*(-9.5),y13*(-9.5),z13*(-9.5)) fireVec = normalise $ (vectorSub muzzlePoint muzzleEnd ) in (muzzlePoint,fireVec) -- we use a discreet version of the gravity function -- for the AI falling :: SF (Bool,GameInput,Double) Double falling = proc (land,gi,dt) -> do rec pos <- (iPre 0) <<< identity -< case land of True -> (-0.5) False -> (pos - (6*200*dt)) returnA -< pos -- turn to face a target turnToFaceTarget :: (Vec3,Double) -> SF (ObjInput,Event(),Event()) (Vec3,Vec3,Double,Double,Event(),(Int,Int)) turnToFaceTarget (currentPos, initialAngle) = proc (oi,ev1,ev2) -> do let gi = oiGameInput oi let clippedPos = oiCollisionPos oi let grounded = oiOnLand oi dt <- getDt -< gi rec count <- (iPre 0) <<< identity -< count + 1 (ox1,oy1,oz1) <- (iPre currentPos) <<< identity -< clippedPos -- we have to wait a while after teleporting before using the -- clippedPos otherwise we get clipped between the position before -- teleporting and the position we want to teleport to (ox,oy,oz) <- identity -< case (count > 3 && (ox1,oy1,oz1) /= currentPos ) of True -> (ox1,oy1,oz1) _ -> currentPos yVel <- (iPre 0) <<< falling -< (grounded,gi,dt) let enemySighted = oiVisibleObjs oi -- the angle we want to turn to rec targetAnglei <- (iPre initialAngle) <<< identity -< case (isEvent enemySighted) of True -> getAngle ((ox,oy,oz), (cpos (oldCam (snd (head (fromEvent enemySighted)))))) _ -> targetAnglei rec -- adjust the angle so that the difference between -- our angle and the target angle is minimised let targetAngle = case (abs (angle - targetAnglei) < abs (angle - (targetAnglei + 360))) of True -> targetAnglei False -> targetAnglei + 360 -- the angular velocity let angularV = case (True) of True -> case (abs (angle - targetAngle) > 2) of True -> case (angle < targetAngle) of True -> 270 _ -> -270 False -> (targetAngle -angle) False -> 0 -- integrate angle <- (initialAngle+) ^<< integral -< angularV -- if we get close enough to the angle we want to be in -- then play the stand animation instead of the turn animation let legState = case (abs (angle - targetAngle) < 2) of True -> idleLegs _ -> turn -- switch to the legsidle animation after the turn animation -- has finished switch2idle <- edge -< ((legState == idleLegs) && (isEvent ev2)) turning <- edge -< (legState == turn) legsAnim <- drSwitch (constant stand) -< ((), turning `tag` (constant turn) `lMerge` switch2idle `tag` (constant idleLegs)) -- get the target pitch rec targetPitch <- (iPre 0) <<< identity -< case (isEvent enemySighted) of True -> getVertAngle ((ox,oy,oz), vectorAdd (cpos (oldCam (snd (head (fromEvent enemySighted))))) (0,-5,0)) _ -> targetPitch -- again integrate towards the target pitch rec let angularVP = case (abs (pitch - targetPitch) > 2) of True -> case (targetPitch < pitch) of True -> -90 _ -> 90 False -> (targetPitch -pitch) pitch <- (0+) ^<< integral -< angularVP -- the atttack is synchornised to the attack animation attack <- (iPre noEvent) <<< edge -< (isEvent ev1) -- if we are attacking then the animation -- for the torso is attack, otherwise we -- are standing torsoAnim <- (iPre stand) <<< identity -< case ((abs (pitch - targetPitch) < 6) && (abs (angle - targetAngle) < 6) && isEvent enemySighted) of True -> attack1 False -> stand returnA -< ((ox,oy+yVel,oz), (ox,oy,oz), angle, pitch, attack, (torsoAnim,legsAnim)) -- gets the AI to move along a set of waypoints followWayPoints :: Vec3 -> [Vec3] -> SF (ObjInput,Event(),Event()) (Vec3,Vec3,Double,Double,Event(),(Int,Int)) followWayPoints (x,y,z) waypoints = proc (oi,ev1,ev2) -> do let gi = oiGameInput oi let clippedPos = oiCollisionPos oi let grounded = oiOnLand oi (ox,oy,oz) <- (iPre (x,y,z)) <<< identity -< clippedPos t <- getT -< gi dt <- getDt -< gi yVel <- (iPre 0) <<< falling -< (grounded,gi,dt) rec -- cycle through the waypoints wps <- (iPre (cycle waypoints)) <<< identity -< wpl -- get the 2 waypoints we are moving between let [wp1,wp2] = take 2 wps -- step towards the waypoint let (pastWp,(dx,dy,dz)) = stepdist wp1 wp2 (ox,oy,oz) 100 dt -- generate an event when we are past the target waypoint pastEv <- edge -< pastWp let angle = getAngle ((ox,oy,oz),(ox+dx,oy+yVel,oz+dz)) let newPos = (ox+dx,oy+yVel,oz+dz) (notturning,largeEnough,turnAngle) <- rSwitch (constant (True,False,(getAngle((x,y,z),head waypoints))))-< ((oi,ev1,ev2), pastEv `tag` (turnToNextWp angle (getAngle (newPos,wp2)))) -- if the angle we want to turn to is not large enough -- then we continue walking, otherwise we stop and turn let wpl = case (pastWp) of True -> case (not largeEnough) of True -> (tail wps) _ -> case notturning of True -> (tail wps) -- preserve the waypoint -- when we are turning _ -> wps _ -> wps -- if the angle is not large enough or -- we are not turning then use "angle" -- if we are turning then use "turnangle" let holdAngle = case (not largeEnough) of True -> angle _ -> case notturning of False -> turnAngle _ -> angle -- set the leg animation based on whether we -- are turning and whether the angle we are turning -- to is large enough let legAnim = case (not largeEnough) of True -> walk _ -> case (notturning) of True -> walk _ -> turn returnA -< (newPos,(ox,oy,oz),holdAngle,0,noEvent,(stand,legAnim)) -- gets the AI to turn to face a waypoint turnToNextWp :: Double -> Double -> SF (ObjInput,Event(),Event()) (Bool,Bool,Double) turnToNextWp currentangle nextAngle = proc (oi,uev,lev) -> do let targetAngle = case (abs (currentangle - nextAngle) < abs (currentangle - (nextAngle + 360))) of True -> nextAngle False -> nextAngle + 360 rec let angularV = case (abs (angle - targetAngle) > 3) of True -> case (angle < targetAngle) of True -> 360 _ -> -360 False -> (targetAngle -angle) angle <- (currentangle+) ^<< integral -< angularV let legState = case (abs (angle - targetAngle) < 3) of True -> idleLegs _ -> turn switch2idle <- (iPre noEvent) <<< edge -< (legState == idleLegs && isEvent lev) ret <- rSwitch (constant False) -< ((),switch2idle `tag` (constant True)) returnA -< (ret ,(abs (currentangle - targetAngle) > 30) ,angle) -- moves the player toward a waypoint stepdist :: Vec3-> Vec3 -> Vec3 -> Double -> Double -> (Bool,Vec3) stepdist (wx1,wy1,wz1) (wx2,wy2,wz2) (x,y,z) vel dt = let (dx,dy,dz) = normalise $ vectorSub (wx1,0,wz1) (x,0,z) distance = sqrt (((x-wx1)*(x-wx1))+((z-wz1)*(z-wz1))) remvel = distance*(distance/(vel*dt)) in case (distance > (vel*dt)) of True -> (False,(dx*vel*dt,0,dz*vel*dt)) False -> (True,(dx*remvel,0,dz*remvel)) -- plays the dead animation playDead :: Vec3 -> Double -> SF (ObjInput,Event(),Event()) (Vec3,Vec3,Double,Double,Event(),(Int,Int)) playDead start angle = proc (oi,ev1,ev2) -> do ev <- notYet -< ev1 death <- drSwitch (constant death1) -< ((), ev `tag` (constant dead1)) returnA -< (start,start,angle,0,noEvent,(death,death)) -- gets the horizontal orientation getAngle :: (Vec3,Vec3) -> Double getAngle ((x,y,z),(vx,vy,vz)) = let angle = acos $ dotProd (normalise $ vectorSub (vx,0,vz) (x,0,z)) (1,0,0) in case (vz > z ) of False -> (angle*180/pi) True -> (360 - (angle*180/pi)) -- gets the angle from the vector (0,1,0) getVertAngle :: (Vec3,Vec3) -> Double getVertAngle ((x,y,z),(vx,vy,vz)) = let angle1 = acos $ dotProd (normalise $ vectorSub (vx,vy,vz) (x,y,z)) (0,1,0) in ((angle1*180/pi)-90) -- a signal function to update the animations updateAnimSF :: AnimState -> SF (Double,Int) (Event (),AnimState) updateAnimSF iAnim = proc (time,animIndex) -> do rec (hasLooped,anim2) <- (iPre (False,iAnim)) <<< arr updateAnim -< (animIndex,time,anim2) returnA -< (case hasLooped of True -> case (animIndex == dead1) of True -> (noEvent,anim2) False -> (Event (),anim2) False -> (noEvent ,anim2)) ----------------------------------------------------------------------------------- -- player input -- a signal function to move the camera along the view vector moves :: SF (Double,Camera) Camera moves = proc (speed,cam) -> do let (x,y,z) = (cpos cam) (vpx,vpy,vpz) = (viewPos cam) strafevec = normalise (crossProd (vectorSub(viewPos cam)(cpos cam)) (upVec cam)) (vx,vy,vz)= normalise (crossProd (upVec cam) strafevec) newx = (vx*speed) newz = (vz*speed) newvx = (vx*speed) newvz = (vz*speed) returnA -< Camera {cpos = (x+newx,y,z+newz), viewPos = (vpx+newvx,vpy,vpz+newvz), upVec = (upVec cam)} -- strafes the camera strafes :: SF (Double,Camera) Camera strafes = proc (speed,cam) -> do let (sx,sy,sz) = normalise (crossProd (vectorSub(viewPos cam)(cpos cam)) (upVec cam)) (x,y,z) = (cpos cam) (vx,vy,vz) = (viewPos cam) newx = (sx*speed) newz = (sz*speed) newvx = (sx*speed) newvz = (sz*speed) returnA -< Camera {cpos=(x+newx,y,z+newz), viewPos=(vx+newvx, vy, vz+newvz), upVec=(upVec cam)} -- movementKS and strafeKS are used so that -- we can move and strafe at the same time movementKS :: Double -> SF GameInput Double movementKS speed = proc gi -> do key <- keyStat -< gi rec v <- (iPre 0)<<< identity -< nextSpeed key v returnA -< v where nextSpeed key v | key == Event ('w',True) = speed | key == Event ('s',True) = -speed | (key == Event ('w',False) || key == Event ('s',False)) = 0 | otherwise = v strafeKS :: Double -> SF GameInput Double strafeKS speed = proc gi -> do key <- keyStat -< gi rec v <- (iPre 0)<<< identity -< nextSpeed key v returnA -< v where nextSpeed key v | key == Event ('d',True) = speed | key == Event ('a',True) = -speed | (key == Event ('d',False) || key == Event ('a',False)) = 0 | otherwise = v -- gravity function for the player fallingp :: SF (Bool,GameInput) Double fallingp = proc (land,gi) -> do key <- keyStat -< gi jumpVel<- arr jump2Vel -< key == Event ('e',True) jumping <- arr bool2Ev -< key == Event ('e',True) && (land == True) landed <- edge -< (land == True) rec middleOfJump <- iPre False <<< identity-< case (middleOfJump == False && key == Event ('e',True) && land == True) of True -> True False -> case (land == True) of True -> False False -> middleOfJump notlanded <- edge -< (land == False && middleOfJump == False) pos <- drSwitch (falling' (-200 :: Double) (0 :: Double)) -< ((), (jumping `tag` falling' (-200 :: Double) (40 :: Double)) `lMerge` (landed `tag` constant(-0.05)) `lMerge` (notlanded `tag` falling' (-200 :: Double) (0 :: Double))) returnA -< pos falling' :: Double -> Double -> SF () Double falling' grav init = proc () -> do vel <- integral -< grav pos <- integral -< (vel+init) returnA -< pos bool2Ev :: Bool -> Event() bool2Ev b | b = Event() | otherwise = noEvent jump2Vel :: Bool -> Double jump2Vel b | b == True = 40 | otherwise = 0