{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE BangPatterns #-} module MainGame.WorldMap where import Affection as A import Algebra.Graph as AG import qualified SDL import NanoVG hiding (V2(..)) import Control.Monad (when, void) import Control.Monad.IO.Class (liftIO) import Control.Monad.State.Strict (evalStateT) import Control.Concurrent.MVar import Control.Concurrent (forkIO) import Data.Map.Strict as Map import qualified Data.Set as S import qualified Data.Text as T import Data.Matrix as M import Data.Ecstasy as E import Data.Maybe import Data.List as L (sortOn, partition, find) import System.Random (randomRIO) import Linear hiding (E) import Foreign.C.Types (CFloat(..)) -- internal imports import Interior import Util import Types import Floorplan import MindMap import NPC -- import Object import Animation loadMap :: Affection UserData () loadMap = do ud <- getAffection ad <- get let (Subsystems _ m k) = subsystems ud uu1 <- partSubscribe m movePlayer uu2 <- partSubscribe k changeMaps uu3 <- partSubscribe m playerInteract future <- liftIO newEmptyMVar progress <- liftIO $ newMVar (0, "Ohai!") _ <- liftIO $ forkIO $ loadMapFork ud ad future progress putAffection ud { stateData = None , uuid = [uu1, uu2, uu3] , stateMVar = future , stateProgress = progress } changeMaps :: KeyboardMessage -> Affection UserData () changeMaps (MsgKeyboardEvent _ _ SDL.Pressed False sym) | SDL.keysymKeycode sym == SDL.KeycodeF1 = do ud <- getAffection putAffection ud { state = Main WorldMap } | SDL.keysymKeycode sym == SDL.KeycodeF2 = do ud <- getAffection putAffection ud { state = Main MindMap } | otherwise = return () changeMaps _ = return () loadMapFork :: UserData -> AffectionData UserData -> MVar (SystemState Entity (AffectionState (AffectionData UserData) IO), StateData) -> MVar (Float, T.Text) -> IO () loadMapFork ud ad future progress = do let loadSteps = 22 increment = 1 / loadSteps fc = FloorConfig (10, 10) [] -- [(5, 5), (5, 20)] (40, 40) modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Building floor" ))) (mat, gr) <- buildHallFloorIO fc progress increment -- 10 increments inside modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Converting to images" ))) let imgmat = convertTileToImg mat exits = Prelude.foldl (\acc coord@(r, c) -> if imgmat M.! coord == Just ImgEmpty then ReachPoint RoomExit (V2 r c) NE : acc else acc ) [] ((,) <$> [1 .. nrows mat] <*> [1 .. ncols mat]) modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Placing furniture" ))) (inter, rps) <- placeInteriorIO mat imgmat exits gr modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Creating WorldState" ))) (nws, mmimgmat) <- evalStateT (runState (yieldSystemT (worldState ud) $ do liftIO $ modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Registering copiers into WorldState" ))) let copiers = Prelude.filter (\a -> pointType a == Copier) rps mapM_ (\(ReachPoint _ icoord _) -> do let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord void $ createEntity $ newEntity { pos = Just $ reachCoord - V2 1 0 , obstacle = Just $ Boundaries (10/36, 8/36) (28/36, 30/36) , anim = Just $ AnimState (AnimId "copier" "open" N) 0 0 , objAccess = Just (V2 1 0, NW) , objType = Just ObjCopier , objState = Just "idle" } ) (A.log A.Debug ("number of copiers: " ++ show (length copiers)) copiers) liftIO $ modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Registering computers into WorldState" ))) let computers = Prelude.filter (\a -> pointType a == Computer) rps compEnts <- mapM (\(ReachPoint _ icoord dir) -> do let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord createEntity $ newEntity { pos = Just $ reachCoord - case dir of N -> V2 1 (-1) _ -> error "not yet defined" , anim = Just $ AnimState (AnimId "computer" "off" N) 0 0 , objAccess = Just (V2 1 (-1), dir) , objType = Just ObjComputer , objState = Just "off" } ) (A.log A.Debug ("number of computers: " ++ show (length computers)) computers) liftIO $ modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Registering toilets into WorldState" ))) let toilets = Prelude.filter (\a -> pointType a == Toilet) rps mapM_ (\(ReachPoint _ icoord dir) -> do let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord void $ createEntity $ newEntity { pos = Just $ reachCoord - V2 0 (-1) , obstacle = Just $ Boundaries (0, 0) (1, 1) , anim = Just $ AnimState (AnimId "toilet" "free" N) 0 0 , objAccess = Just (V2 0 (-1), dir) , objType = Just ObjToilet } ) (A.log A.Debug ("number of toilets: " ++ show (length toilets)) toilets) liftIO $ modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Placing NPCs" ))) liftIO $ logIO A.Debug ("number of reachpoints: " ++ show (length rps)) let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps npcposs <- liftIO $ placeNPCs inter mat rps (length computers) liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs) liftIO $ modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Preparing MindMap graph" ))) (mmintmat, mmgraph) <- liftIO $ buildFloorMap . springField <$> buildMindMap (length npcposs) 2 liftIO $ modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Unfolding and Converting MindMap to images" ))) let !mmimgmat = convertTileToImg $ manhattan mmgraph mmintmat pmmpos = (+ 0.5) . (fromIntegral :: Int -> Double) . floor <$> mmPos (fromJust $ find (\a -> mmId a == 0) (vertexList mmgraph)) delta = (0, 0) : Prelude.filter (/= (0,0)) ((,) <$> [-1 .. 1] <*> [-1 .. 1]) :: [(Int, Int)] mmmpos = Prelude.foldl (\acc (dr, dc) -> let (V2 pmr pmc) = floor <$> pmmpos seekpos = (pmr + fromIntegral dr, pmc + fromIntegral dc) in if isNothing (mmimgmat M.! seekpos) && mmintmat M.! seekpos == 0 && isNothing acc then Just (pmmpos + (fromIntegral <$> V2 dr dc)) else acc ) Nothing delta void $ createEntity $ newEntity { pos = Just (V2 10.5 10.5) , mmpos = mmmpos , vel = Just (V2 0 0) , mmvel = Just (V2 0 0) , player = Just () , rot = Just SE , anim = Just $ AnimState (AnimId "intruder" "standing" SE) 0 0 } liftIO $ modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Registering NPCs into WorldState" ))) posbounds <- efor allEnts $ do with pos with obstacle pos' <- query pos bnds <- query obstacle return (pos', bnds) mapM_ (\(ce, npcpos@(V2 nr nc)) -> do fact <- liftIO $ randomRIO (0.5, 1.5) fut <- liftIO newEmptyMVar [access] <- efor (anEnt ce) $ do with pos pos' <- query pos acc <- queryMaybe objAccess return $ fmap floor pos' + fromMaybe (V2 0 0) (fst <$> acc) _ <- liftIO $ forkIO $ getPathTo (fmap floor npcpos) fut access inter posbounds stats <- liftIO $ NPCStats <$> (randomRIO (0, 1)) <*> (randomRIO (0, 1)) <*> (randomRIO (0, 1)) <*> (randomRIO (0, 1)) <*> (randomRIO (0, 1)) <*> (randomRIO (0, 1)) void $ createEntity $ newEntity { pos = Just (fmap (+ 0.5) npcpos) , vel = Just (V2 0 0) , velFact = Just fact , rot = Just SE , npcMoveState = Just (NPCStanding 0 fut) , npcWorkplace = Just ce , npcStats = Just stats , anim = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0 } ) (zip compEnts npcposs) liftIO $ modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Handing over" ))) return mmimgmat )) ad putMVar future (nws, MainData { mapMat = mat , imgMat = M.fromList (nrows inter) (ncols inter) $ Prelude.map (\a -> if a == Just ImgEmpty || a == Just ImgEmptyNoWalk then Nothing else a) (M.toList inter) , reachPoints = rps , mmImgMat = mmimgmat }) mouseToPlayer :: V2 Int32 -> Affection UserData () mouseToPlayer mv2 = do ud <- getAffection (V2 rx ry) <- liftIO $ relativizeMouseCoords mv2 let dr = (ry / sin (atan (1/2)) / 2) + rx dc = rx - (ry / sin (atan (1/2)) / 2) (nws, _) <- yieldSystemT (worldState ud) $ emap allEnts $ do with player pure $ unchanged { vel = Set $ 4 * V2 dr dc } putAffection ud { worldState = nws } movePlayer :: MouseMessage -> Affection UserData () movePlayer (MsgMouseMotion _ _ _ [SDL.ButtonLeft] m _) = mouseToPlayer m movePlayer (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft _ m) = mouseToPlayer m movePlayer (MsgMouseButton _ _ SDL.Released _ SDL.ButtonLeft _ _) = do ud <- getAffection (nws, _) <- yieldSystemT (worldState ud) $ emap allEnts $ do with player pure $ unchanged { vel = Set $ V2 0 0 } putAffection ud { worldState = nws } movePlayer _ = return () playerInteract :: MouseMessage -> Affection UserData () playerInteract (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonRight _ m) = do ud <- getAffection (V2 rx ry) <- liftIO $ (* V2 640 360) <$> relativizeMouseCoords m let dr = ((ry / 32) / sin (atan 0.5) / 2) + (rx / 64) dc = (rx / 64) - ((ry / 32) / sin (atan 0.5) / 2) (nws, _) <- yieldSystemT (worldState ud) $ do emap allEnts $ do with player with rot rot' <- query rot let ndir = direction (V2 dr dc) return $ unchanged { rot = Set $ fromMaybe rot' ndir } [(ppos, pdir)] <- efor allEnts $ do with player with pos with rot pos' <- query pos rot' <- query rot return (pos', rot') mrelEnts <- efor allEnts $ do with pos with objAccess with objType with objState (rel, dir) <- query objAccess pos' <- query pos otype <- query objType ostate <- query objState ent <- queryEnt if ((fmap floor ppos :: V2 Int) == (fmap floor pos' :: V2 Int) || (fmap floor ppos :: V2 Int) == (fmap floor pos' :: V2 Int) + rel) && (fmap floor (ppos + V2 dr dc) :: V2 Int) == (fmap floor pos' ::V2 Int) && pdir == dir then return $ Just (otype, ostate, ent) else return Nothing let relEnts = catMaybes mrelEnts liftIO $ A.logIO A.Debug ("relEnts: " ++ show relEnts) -- liftIO $ A.logIO A.Debug ("dV2: " ++ show (V2 dr dc)) mapM_ (\(t, s, e) -> setEntity e =<< objectTransition t s True e ) relEnts putAffection ud { worldState = nws } playerInteract _ = return () drawMap :: Affection UserData () drawMap = do ud <- getAffection let ctx = nano ud case stateData ud of None -> liftIO $ do progress <- readMVar (stateProgress ud) drawLoadScreen ud progress _ -> do dt <- getDelta (_, (playerPos, posanims, posActions)) <- yieldSystemT (worldState ud) $ do pc <- fmap head $ efor allEnts $ do with player with pos query pos posanims <- efor allEnts $ do with anim with pos stat <- query anim pos' <- query pos mbnds <- queryMaybe obstacle return (pos', stat, mbnds) posActions <- efor allEnts $ do with objType with objState with objStateTime with objPlayerActivated with pos pos' <- query pos t <- query objType s <- query objState pa <- query objPlayerActivated let maxt = actionTime t s ttl <- query objStateTime return (pos', pa, realToFrac (1 - ttl / maxt)) return (pc, posanims, posActions) let V2 pr pc = playerPos mat = imgMat (stateData ud) cols = fromIntegral (ncols mat) rows = fromIntegral (nrows mat) tileWidth = 64 :: Double tileHeight = 32 :: Double x = realToFrac $ 640 + ((1 - pc) + (1 - pr)) * (tileWidth / 2) y = realToFrac $ 360 + ((1 - pr) - (1 - pc)) * (tileHeight / 2) partposanims = M.fromList (nrows $ mapMat $ stateData ud) (ncols $ mapMat $ stateData ud) ((reverse . fst) (Prelude.foldl (\(done, proc) coord -> let (ndone, nproc) = processList proc coord in (ndone : done, nproc) ) ([], posanims) ((,) <$> [1 .. (nrows $ mapMat $ stateData ud)] <*> [1 .. (ncols $ mapMat $ stateData ud)] ) ) ) processList :: [(V2 Double, AnimState, Maybe (Boundaries Double))] -> (Int, Int) -> ( [(V2 Double, AnimState, Maybe (Boundaries Double))] , [(V2 Double, AnimState, Maybe (Boundaries Double))] ) processList list (r, c) = let delimiter (V2 nr nc, _, _) = floor nr == r && floor nc == c in L.partition delimiter list liftIO $ do -- draw floor beginPath ctx moveTo ctx (x + realToFrac tileWidth / 2) y lineTo ctx (x + cols * (realToFrac tileWidth / 2)) (y - (realToFrac tileHeight / 2) * (cols - 1)) lineTo ctx (x + (realToFrac tileWidth / 2) * (cols + rows - 1)) (y + (rows - cols) * (realToFrac tileHeight / 2)) lineTo ctx (x + (realToFrac tileWidth / 2) * rows) (y + (realToFrac tileHeight / 2) * (rows - 1)) closePath ctx fillColor ctx (rgb 255 255 255) fill ctx mapM_ (\(i, ls) -> mapM_ (\(j, t) -> drawTile ud ctx (partposanims M.! (i, j)) pr pc i j t) (reverse $ zip [1..] ls)) (zip [1..] (toLists mat)) mapM_ (\(V2 sr sc, pa, perc) -> when pa $ do let lx = realToFrac $ 640 + ((sc - pc) + (sr - pr)) * (tileWidth / 2) :: CFloat ly = realToFrac $ 360 - (tileHeight / 2) + ((sr - pr) - (sc - pc)) * (tileHeight / 2) :: CFloat fillColor ctx (rgb 0 255 0) strokeColor ctx (rgb 0 255 0) strokeWidth ctx 2 beginPath ctx rect ctx (lx - 25) (ly - 50) 50 10 stroke ctx closePath ctx beginPath ctx rect ctx (lx - 25 * perc) (ly - 50) (50 * perc) 10 fill ctx closePath ctx ) posActions fontSize ctx 20 fontFace ctx (assetFonts ud Map.! FontBedstead) textAlign ctx (S.fromList [AlignCenter,AlignTop]) fillColor ctx (rgb 255 128 0) textBox ctx 0 0 200 ("FPS: " `T.append` T.pack (Prelude.take 5 $ show (1/dt))) drawTile :: UserData -> Context -> [(V2 Double, AnimState, Maybe (Boundaries Double))] -> Double -> Double -> Int -> Int -> Maybe ImgId -> IO () drawTile ud ctx posanims pr pc row col img = when ((realToFrac x > -tileWidth && realToFrac y > -tileHeight) && ((realToFrac x :: Double) < 1280 && (realToFrac (y - (74 - (realToFrac tileHeight :: CFloat))) :: Double) < 720)) $ do let (bef, beh) = L.partition delimiter sorted save ctx mapM_ drawAnim beh maybe (return ()) (draw ud x (y - 42) 64 74 fact) ((assetImages ud Map.!) <$> case img of Just ImgEmpty -> Nothing _ -> img ) mapM_ drawAnim bef restore ctx -- when (floor pr == row && floor pc == col) $ do -- A.logIO A.Debug ("sorted: " ++ show sorted) -- A.logIO A.Debug ("beh: " ++ show beh) -- A.logIO A.Debug ("bef: " ++ show bef) where delimiter (V2 nr nc, as, mbnds) = animFloats (asId as) || all delimit mb where delimit b | nnr > fst (matmax b) || nnc < snd (matmin b) = True | nnr > fst (matmin b) && nnr < fst (matmax b) = nnc < snd (matmin b) | nnc > snd (matmin b) && nnc < snd (matmax b) = nnr > fst (matmax b) | otherwise = False nnr = case mbnds of Just (Boundaries (_, _) (maxr, _)) -> maxr Nothing -> nr - fromIntegral ((floor nr) :: Int) :: Double nnc = case mbnds of Just (Boundaries (_, minc) (_, _)) -> minc Nothing -> nc - fromIntegral ((floor nc) :: Int) :: Double -- any (\m -> nr < fromIntegral (floor nr :: Int) + m) maxrs && -- any (\m -> nc > fromIntegral (floor nc :: Int) + m) mincs tileWidth = 64 :: Double tileHeight = 32 :: Double sorted = sortOn (\(V2 sr sc, _, mbnds) -> case mbnds of Just (Boundaries (_, minc) (maxr, _)) -> maxr * 10 + (1 - minc) _ -> (sr - (fromIntegral ((floor sr) :: Int))) * 10 + (1 - (sc - (fromIntegral ((floor sc) :: Int)))) ) posanims -- sorted = posanims minrs = Prelude.map (fst . matmin) mb maxrs = Prelude.map (fst . matmax) mb mincs = Prelude.map (snd . matmin) mb maxcs = Prelude.map (snd . matmax) mb x = realToFrac $ 640 + ((fromIntegral col - pc) + (fromIntegral row - pr)) * (tileWidth / 2) :: CFloat y = realToFrac $ 360 - (tileHeight / 2) + ((fromIntegral row - pr) - (fromIntegral col - pc)) * (tileHeight / 2) :: CFloat dist = distance (V2 (fromIntegral row) (fromIntegral col)) (V2 (realToFrac pr - 1) (realToFrac pc)) / 4 fact = if isWall (fromJust img) && (pr <= fromIntegral row + minimum maxrs && pc >= fromIntegral col + maximum mincs) then min 1 dist else 1 mb = maybe [] collisionObstacle img drawAnim (V2 nr nc, as, _) = do let ax = realToFrac $ 640 + ((nc - pc) + (nr - pr)) * 32 - 32 ay = realToFrac $ 360 + ((nr - pr) - (nc - pc)) * 16 - 58 draw ud ax ay 64 74 1 as updateMap :: Double -> Affection UserData () updateMap dt = do ud <- getAffection isFut <- liftIO $ isEmptyMVar (stateMVar ud) if not isFut && stateData ud == None then do liftIO $ logIO A.Debug "Loaded game data" Just (nws, mendat) <- liftIO $ tryTakeMVar (stateMVar ud) putAffection ud { worldState = nws , stateData = mendat } else do (nws, _) <- yieldSystemT (worldState ud) $ do emap allEnts $ do with anim stat <- query anim let an = assetAnimations ud Map.! asId stat ntime = asElapsedTime stat + dt nstate = if ntime > fromIntegral (asCurrentFrame stat + 1) * (animDuration an / fromIntegral (length $ animSprites an)) then let nframe = asCurrentFrame stat + 1 in case animPlay an of APLoop -> let (nnframe, nntime) = if nframe >= length (animSprites an) then (0, 0) else (nframe, ntime) in stat { asCurrentFrame = nnframe , asElapsedTime = nntime } APOnce -> let nnframe = if nframe >= length (animSprites an) then nframe - 1 else nframe in stat { asCurrentFrame = nnframe , asElapsedTime = ntime } else stat { asElapsedTime = ntime } return $ unchanged { anim = Set nstate } emap allEnts $ do without player with vel with velFact with pos with rot with anim pos' <- query pos vel' <- query vel rot' <- query rot fact' <- query velFact stat <- query anim let npos = pos' + fmap (* (dt * fact')) vel' aId = asId stat nstat = case aiName aId of "walking" | sqrt (vel' `dot` vel') > 0 -> stat { asId = aId { aiDirection = fromMaybe rot' (direction vel') } } | otherwise -> stat { asId = aId { aiDirection = fromMaybe rot' (direction vel') , aiName = "standing" } , asCurrentFrame = 0 } "standing" | sqrt (vel' `dot` vel') > 0 -> stat { asId = aId { aiDirection = fromMaybe rot' (direction vel') , aiName = "walking" } , asCurrentFrame = 0 } | otherwise -> stat { asId = aId { aiDirection = fromMaybe rot' (direction vel') } } x -> error ("unknown animation name" ++ x) ent = unchanged { pos = Set npos , rot = Set $ fromMaybe rot' (direction vel') , anim = Set nstat } return ent obstacleBounds <- efor allEnts $ do with obstacle with pos b <- query obstacle pos' <- query pos return (pos', b) emap allEnts $ do with player with vel with pos with rot with anim pos'@(V2 pr pc) <- query pos vel' <- query vel rot' <- query rot stat <- query anim let npos = pos' + fmap (* dt) vel' dpos@(V2 dpr dpc) = npos - pos' aId = asId stat nstat = case aiName aId of "walking" | sqrt (colldpos `dot` colldpos) > 0 -> stat { asId = aId { aiDirection = fromMaybe rot' (direction vel') } } | otherwise -> stat { asId = aId { aiDirection = fromMaybe rot' (direction vel') , aiName = "standing" } , asCurrentFrame = 0 } "standing" | sqrt (colldpos `dot` colldpos) > 0 -> stat { asId = aId { aiDirection = fromMaybe rot' (direction vel') , aiName = "walking" } , asCurrentFrame = 0 } | otherwise -> stat { asId = aId { aiDirection = fromMaybe rot' (direction vel') } } x -> error ("unknown animation name" ++ x) lll = (,) <$> ( if dpr < 0 then [(floor dpr :: Int) .. 0] else [0 .. (ceiling dpr :: Int)]) <*> ( if dpc < 0 then [(floor dpc :: Int) .. 0] else [0 .. (ceiling dpc :: Int)]) colldpos = dpos * Prelude.foldl (\acc a -> let ret = checkBoundsCollision2 pos' npos dt acc a in A.log A.Verbose (show ret) ret) (V2 1 1) ( concatMap (\(dr, dc) -> let bs = (++) (maybe [] collisionObstacle (fromMaybe Nothing $ M.safeGet (fromIntegral $ floor pr + dr) (fromIntegral $ floor pc + dc) (imgMat (stateData ud)))) (Prelude.map snd $ Prelude.filter (\((V2 br bc), _) -> floor pr + dr == floor br && floor pc + dc == floor bc ) obstacleBounds) in Prelude.map (\(Boundaries (minr, minc) (maxr, maxc))-> Boundaries (minr + fromIntegral dr, minc + fromIntegral dc) (maxr + fromIntegral dr, maxc + fromIntegral dc) ) bs ) lll -- (A.log A.Verbose (show lll ++ " " ++ show len) lll) ) ent = unchanged { pos = Set $ pos' + colldpos , rot = Set (fromMaybe rot' $ direction vel') , anim = Set nstat } -- liftIO $ A.logIO A.Debug ("player position: " ++ show (pos' + colldpos)) return ent tses <- efor allEnts $ do with objType with objState t <- query objType s <- query objState e <- queryEnt return (t, s, e) mapM_ (\(t, s, e) -> objectAction dt t s e ) tses (nws2, _) <- yieldSystemT nws $ updateNPCs (imgMat $ stateData ud) (Prelude.filter (\p -> pointType p /= RoomExit) (reachPoints $ stateData ud) ) dt putAffection ud { worldState = nws2 } checkBoundsCollision2 :: V2 Double -> V2 Double -> Double -> V2 Double -> Boundaries Double -> V2 Double checkBoundsCollision2 pre@(V2 pr pc) nex dt acc (Boundaries (minr, minc) (maxr, maxc)) | colltr < dt && colltc < dt = V2 0 0 | colltr < dt && incol = V2 0 1 * acc | colltc < dt && inrow = V2 1 0 * acc | otherwise = acc where V2 vr vc = fmap (/ dt) (nex - pre) colltr | vr > 0 && prr <= maxr = ((fromIntegral (floor pr :: Int) + minr - 0.15) - pr) / vr | vr < 0 && prr >= minr = ((fromIntegral (floor pr :: Int) + maxr + 0.15) - pr) / vr | otherwise = dt colltc | vc > 0 && prc <= maxc = ((fromIntegral (floor pc :: Int) + minc - 0.15) - pc) / vc | vc < 0 && prc >= minc = ((fromIntegral (floor pc :: Int) + maxc + 0.15) - pc) / vc | otherwise = dt inrow = pr > minr && pr < maxr incol = pc > minc && pc < maxc prr = pr - fromIntegral (floor pr :: Int) prc = pc - fromIntegral (floor pc :: Int)