nek0/tracer
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

linting in progress

Browse source
This commit is contained in:
nek0 2018-09-02 10:44:33 +02:00
parent 8d2aba5f7b
commit 5916f302a6
9 changed files with 50 additions and 50 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
src/Floorplan.hs
View file

@ -263,7 +263,7 @@ closeOffices input =
let tups mat = (,) <$> [2 .. nrows mat - 1] <*> [2 .. ncols mat - 1]
isNeighbor (row, col) =
let subm = M.submatrix (row -1) (row + 1) (col - 1) (col + 1) input
in Hall `elem` (M.toList subm)
in Hall `elem` M.toList subm
in foldl (\acc coord ->
if input M.! coord == Offi && isNeighbor coord
then M.setElem Wall coord acc
@ -393,8 +393,7 @@ buildDoorsGraph mat =
in buildGraph mat [GHall []] (2, 2)
buildDoors :: Matrix TileState -> [Graph] -> IO (Matrix TileState)
buildDoors input graph =
foldM placeDoors input graph
buildDoors = foldM placeDoors
where
placeDoors :: Matrix TileState -> Graph -> IO (Matrix TileState)
placeDoors amat (GHall conns) =

7
src/Interior.hs
View file

@ -40,12 +40,11 @@ placeInteriorIO imat imgmat irp graph =
foldl traverseGraph acc sub
traverseGraph putt (GRoom _ bnds) =
let applicable =
(L.sortBy (\b a -> size a `compare` size b) (
L.sortBy (\b a -> size a `compare` size b) (
L.filter
(\a -> roomType `elem` clusterRoom a && size a <= size bnds)
[minBound .. maxBound] :: [Cluster])
)
roomType = fst (head $ L.sortBy
roomType = fst (L.minimumBy
(\b a -> (snd a :: Int) `compare` (snd b :: Int)) $ Map.toList $ foldl
(\acc a -> if a `Map.member` acc
then Map.insert a (acc Map.! a + 1) acc
@ -75,7 +74,7 @@ placeInteriorIO imat imgmat irp graph =
let (pr, g1) = randomR (fst (matmin bnds) - 1, fst (matmax bnds) - 1) rng
(pc, g2) = randomR (snd (matmin bnds) - 1, snd (matmax bnds) - 1) g1
freeRoom = foldl
(\acc a -> if a == Nothing then acc + 1 else acc)
(\acc a -> if isNothing a then acc + 1 else acc)
0
(M.toList $ M.submatrix
(fst $ matmin bnds) (fst $ matmax bnds)

2
src/Load.hs
View file

@ -29,7 +29,7 @@ loadLoad = do
ad <- A.get
ud <- getAffection
progress <- liftIO $ newMVar (0, "Starting up")
future <- liftIO $ newEmptyMVar
future <- liftIO newEmptyMVar
_ <- liftIO $ createFont (nano ud) "bedstead"
(FileName "assets/font/Bedstead-Semicondensed.ttf")
_ <- liftIO $ forkIO $

10
src/MainGame/WorldMap.hs
View file

@ -105,7 +105,7 @@ loadMapFork ud ad future progress = do
npcposs <- placeNPCs inter mat rps 40 -- (length $ filter (\a -> pointType a == Table) nnex)
_ <- liftIO $ swapMVar progress (14 / loadSteps, "Preparing MindMap graph")
A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs)
!(mmintmat, mmgraph) <- buildFloorMap . springField <$>
(mmintmat, mmgraph) <- buildFloorMap . springField <$>
buildMindMap (length npcposs) 2
_ <- liftIO $ swapMVar progress (15 / loadSteps, "Unfolding and Converting MindMap to images")
let !mmimgmat = convertTileToImg $ manhattan mmgraph mmintmat
@ -140,7 +140,7 @@ loadMapFork ud ad future progress = do
{ 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)
, objAccess = Just (V2 1 0, NW)
, objType = Just ObjCopier
, objState = Just "idle"
}
@ -155,7 +155,7 @@ loadMapFork ud ad future progress = do
_ -> error "not yet defined"
-- , obstacle = Just $ Boundaries (10/36, 8/36) (28/36, 30/36)
, anim = Just $ AnimState (AnimId "computer" "off" N) 0 0
, objAccess = Just $ (V2 1 (-1), dir)
, objAccess = Just (V2 1 (-1), dir)
, objType = Just ObjComputer
, objState = Just "off"
}
@ -168,7 +168,7 @@ loadMapFork ud ad future progress = do
{ 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)
, objAccess = Just (V2 0 (-1), dir)
, objType = Just ObjToilet
}
) (A.log A.Debug ("number of toilets: " ++ show (length toilets)) toilets)
@ -272,7 +272,7 @@ playerInteract (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonRight _ m) = do
otype <- query objType
ostate <- query objState
ent <- queryEnt
if (fmap floor ppos == fmap floor pos' ||
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

10
src/MindMap.hs
View file

@ -34,7 +34,7 @@ buildMindMap num difficulty = do
aux <- randomRIO (0, floor (fromIntegral num * 5 / 8 :: Double)) :: IO Int
auxPaths <- mapM (\_ -> do
ln <- randomRIO (0, num `div` 10)
(path . (MMNode (V2 0 0) 0 :)) <$> foldM makeVert [] [1 .. ln]
path . (MMNode (V2 0 0) 0 :) <$> foldM makeVert [] [1 .. ln]
)
[0 .. aux]
return $ overlays (mainPath : auxPaths)
@ -65,7 +65,7 @@ springField =
(vertexList graph)
ngraph = fmap (\n -> fromJust (find ((== mmId n) . mmId) deltaNodes)) graph
in -- A.log A.Debug "\n\nRECURSING\n"
(calcul ngraph)
calcul ngraph
else graph
len :: (Floating a, Metric f) => f a -> a
@ -138,13 +138,13 @@ calculDelta2 graph =
sproing2 [] = []
sproing2 ((cnode, cacc):nodeaccs) =
( mmId cnode
, if (len (V2 100 100 * normv deltasum)) < len deltasum
, if len (V2 100 100 * normv deltasum) < len deltasum
then V2 100 100 * normv deltasum
else deltasum
) : sproing2 dnodeaccs
where
deltasum = cacc + sum deltas
deltas = map ((fmap (* friction)) . doForce) (map fst nodeaccs)
deltas = map (fmap (* friction) . doForce) (map fst nodeaccs)
doForce n
-- are the nodes identic? (unlikely)
| mmId cnode == mmId n =
@ -159,7 +159,7 @@ calculDelta2 graph =
(normv (mmPos cnode - mmPos n))
-- Do gravitational push in all other cases
| otherwise =
- fmap (* (1000 / ((distance (mmPos cnode) (mmPos n)) ^ (2 :: Int))))
- fmap (* (1000 / (distance (mmPos cnode) (mmPos n)) ^ (2 :: Int)))
(normv (mmPos n - mmPos cnode))
dnodeaccs = zipWith (\(n, a) d -> (n, a - d)) nodeaccs deltas
in accel2

22
src/NPC.hs
View file

@ -42,12 +42,12 @@ placeNPCs imgmat tilemat rp count =
c <- randomRIO (1, M.ncols imgmat)
if null (maybe [] collisionObstacle $ imgmat M.! (r, c)) &&
tilemat M.! (r, c) == Hall
then doPlace (nr + 1) ((V2 (fromIntegral r) (fromIntegral c)) : acc)
then doPlace (nr + 1) (V2 (fromIntegral r) (fromIntegral c) : acc)
else do
i <- randomRIO (0, length nonexits - 1)
doPlace
(nr + 1)
((fmap fromIntegral $ pointCoord (nonexits !! i)) : acc)
(fmap fromIntegral (pointCoord (nonexits !! i)) : acc)
else
return acc
nonexits =
@ -79,7 +79,7 @@ updateNPCs imgmat rp dt = do
e <- queryEnt
return (e, pos')
eaccess <- getObjects npcposs
moent <- catMaybes <$> (eover allEnts $ do
moent <- catMaybes <$> eover allEnts (do
with pos
with npcMoveState
with vel
@ -93,7 +93,7 @@ updateNPCs imgmat rp dt = do
let nttl = ttl - dt
if nttl > 0
then
return $ (Nothing, unchanged
return (Nothing, unchanged
{ npcMoveState = Set $ NPCStanding nttl future
, vel = Set $ V2 0 0
})
@ -101,24 +101,24 @@ updateNPCs imgmat rp dt = do
mpath <- liftIO $ tryTakeMVar future
case mpath of
Just path ->
return $ (Nothing, unchanged
return (Nothing, unchanged
{ npcMoveState = Set $ NPCWalking path
})
Nothing ->
return $ (Nothing, unchanged
return (Nothing, unchanged
{ npcMoveState = Set $ NPCStanding 1 future
})
NPCWalking path -> do
NPCWalking path ->
if not (null path)
then do
let itarget = V2 0.5 0.5 + (fromIntegral <$> head path) :: V2 Double
if distance pos' itarget < 0.1
then
return $ (Nothing, unchanged
return (Nothing, unchanged
{ npcMoveState = Set $ NPCWalking (tail path)
})
else
return $ (Nothing, unchanged
return (Nothing, unchanged
{ vel = Set $ (* 2) <$> signorm (itarget - pos')
})
else do
@ -128,12 +128,12 @@ updateNPCs imgmat rp dt = do
getPath (fmap floor pos') future rp imgmat posbounds
e <- queryEnt
let mdir =
(pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp
accessibles = fromMaybe [] $ lookup e eaccess
case accessibles of
[] -> do
ttl <- liftIO $ randomRIO (5, 30)
return $ (Nothing, unchanged
return (Nothing, unchanged
{ npcMoveState = Set $ NPCStanding ttl future
, vel = Set $ V2 0 0
, rot = Set $ fromMaybe rot' mdir

6
src/Navigation.hs
View file

@ -18,7 +18,7 @@ isReachable
-> Bool
isReachable imgmat animBounds reaches exits =
let result =
(concatMap
(\exit -> map (astarAppl imgmat animBounds exit) reaches)
(map pointCoord exits))
concatMap
((\exit -> map (astarAppl imgmat animBounds exit) reaches) . pointCoord)
exits
in all isJust result

12
src/Object.hs
View file

@ -25,7 +25,7 @@ instance ObjectAction ObjType ObjState where
{ objStateTime = Set (actionTime t s)
, objState = Set "copying"
}
Just ttl -> do
Just ttl ->
return unchanged
{ objStateTime = Set (ttl - dt)
}
@ -50,7 +50,7 @@ instance ObjectAction ObjType ObjState where
return unchanged
{ objStateTime = Set dur
}
Just ttl -> do
Just ttl ->
return unchanged
{ objStateTime = Set (ttl - dt)
}
@ -60,10 +60,10 @@ instance ObjectAction ObjType ObjState where
Nothing -> return Nothing
Just ttl -> do
pa <- query objPlayerActivated
if (ttl < 0)
then do
if ttl < 0
then
return (Just pa)
else if (pa && vl `dot` vl > 0)
else if pa && vl `dot` vl > 0
then return (Just pa)
else return Nothing
maybe
@ -84,7 +84,7 @@ instance ObjectAction ObjType ObjState where
return unchanged
{ objStateTime = Set (actionTime t s)
}
Just ttl -> do
Just ttl ->
return unchanged
{ objStateTime = Set (ttl - dt)
}

26
src/Util.hs
View file

@ -32,8 +32,10 @@ convertTileToImg :: Matrix TileState -> Matrix (Maybe ImgId)
convertTileToImg mat = fromLists conversion
where
conversion =
map (\(i, ls) -> map (uncurry $ convertTile i) (zip [1..] ls))
(zip [1..] (toLists mat))
zipWith
(\i ls -> zipWith (convertTile i) [1..] ls)
[1..]
(toLists mat)
convertTile irow icol tile =
case tile of
Wall -> Just (case neighWalls irow icol mat of
@ -148,7 +150,7 @@ astarAppl imgmat animBounds target = aStar
(fmap (fromIntegral :: Int -> Double) a)
(fmap (fromIntegral :: Int -> Double) b)
)
(\a -> distance (fmap fromIntegral target) (fmap fromIntegral a))
(distance (fmap fromIntegral target) . fmap fromIntegral)
(== target)
naviGraph
@ -161,9 +163,9 @@ naviGraph imgmat animBounds (V2 r c) =
foldl
(\acc (rr, cc) ->
if null
((maybe [] collisionObstacle
(fromMaybe Nothing $ M.safeGet (r + rr) (c + cc) imgmat)) ++
(map snd $ filter
(maybe [] collisionObstacle
(fromMaybe Nothing $ M.safeGet (r + rr) (c + cc) imgmat) ++
map snd (filter
(\(V2 br bc, _) -> floor br == r + rr && floor bc == c + cc)
animBounds))
then V2 (r + rr) (c + cc): acc
@ -175,16 +177,16 @@ naviGraph imgmat animBounds (V2 r c) =
foldl
(\acc (rr, cc) ->
if null
((maybe [] collisionObstacle
(fromMaybe Nothing $ M.safeGet (r + rr) (c + cc) imgmat)) ++
(map snd $ filter
(maybe [] collisionObstacle
(fromMaybe Nothing $ M.safeGet (r + rr) (c + cc) imgmat) ++
map snd (filter
(\(V2 br bc, _) -> floor br == r + rr && floor bc == c + cc)
animBounds))
&& all null
(map
(\(oor, ooc) -> (maybe [] collisionObstacle
(fromMaybe Nothing $ M.safeGet (r + oor) (c + ooc) imgmat)) ++
(map snd $ filter
map snd (filter
(\(V2 br bc, _) -> floor br == r + oor && floor bc == c + ooc)
animBounds))
[(0, cc), (rr, 0)])
@ -227,7 +229,7 @@ loadAnimationSprites fp nvg idconfs = do
Right dimg -> do
let img = convertRGBA8 dimg
mapM
(\(i, (AnimationConfig (xoffs, yoffs) (w, h) (sx, sy) count dur pb)) -> do
(\(i, AnimationConfig (xoffs, yoffs) (w, h) (sx, sy) count dur pb) -> do
let crs = map
(\iid -> crop (xoffs + (iid * sx)) (yoffs + (iid * sy)) w h img)
[0 .. (count - 1)]
@ -242,7 +244,7 @@ loadAnimationSprites fp nvg idconfs = do
exitFailure
else
return $ catMaybes mresimgs
return $
return
( i
, Animation dur imgs pb
)