justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Clear all warnings

Browse Source
This commit is contained in:
justin
2021-05-17 23:23:10 +02:00
parent 69f915a894
commit 44f239c673
22 changed files with 176 additions and 202 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action/UseItem.hs
+1 -3
View File
@@ -1,13 +1,11 @@
module Dodge.Creature.Action.UseItem
where
import Dodge.Data
import Dodge.Inventory
import qualified Data.IntMap as IM
import Control.Lens
import Data.Maybe (maybe)
--import Data.Maybe (maybe)
useItem :: Int -> World -> World
useItem n w = itemEffect n it w
src/Dodge/Creature/ChooseTarget.hs
+1 -1
View File
@@ -5,7 +5,7 @@ import Dodge.Base
import Dodge.Creature.AlertLevel.Data
import Control.Lens
import qualified Data.IntMap.Strict as IM
--import qualified Data.IntMap.Strict as IM
targetYouLOS :: Creature -> World -> Maybe Creature
{-# INLINE targetYouLOS #-}
src/Dodge/Creature/Rationality.hs
+6 -6
View File
@@ -184,13 +184,13 @@ performAction cr w ac = case ac of
UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
ArbitraryAction f -> performAction cr w (f cr w)
DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
(imp, Just ac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp ac)
(imp, Just nxtac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp nxtac)
(imp, _) -> (sideImp ++ imp, Nothing)
DoReplicate t ac -> performAction cr w $ DoReplicatePartial ac t ac
DoReplicatePartial _ 0 ac' -> performAction cr w ac'
DoReplicatePartial ac t ac' -> case performAction cr w ac' of
(imps , Just ac'') -> (imps, Just $ DoReplicatePartial ac t ac'')
(imps , _) -> (imps, Just $ DoReplicatePartial ac (t-1) ac)
DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac
DoReplicatePartial _ 0 pac -> performAction cr w pac
DoReplicatePartial sac t pac -> case performAction cr w pac of
(imps , Just nac) -> (imps, Just $ DoReplicatePartial sac t nac)
(imps , _) -> (imps, Just $ DoReplicatePartial sac (t-1) sac)
_ -> ([], Nothing)
where
cpos = _crPos cr
src/Dodge/Creature/Test.hs
+7 -7
View File
@@ -25,7 +25,7 @@ onBoth :: (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c
onBoth f g h x = f (g x) (h x)
crIsReloading :: (World, Creature) -> Bool
crIsReloading (w,cr) = case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of
crIsReloading (_,cr) = case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of
Just t -> t > 0
_ -> False
@@ -69,12 +69,12 @@ crHasTargetLOSR cr = reader $ \w -> case cr ^? crTarget . _Just of
Nothing -> False
crSafeDistFromTarg :: Float -> (World,Creature) -> Bool
crSafeDistFromTarg d (w,cr) = case cr ^? crTarget . _Just of
crSafeDistFromTarg d (_,cr) = case cr ^? crTarget . _Just of
Just tcr -> dist (_crPos cr) (_crPos tcr) > d
Nothing -> True
crSafeDistFromTargR :: Float -> Creature -> Reader World Bool
crSafeDistFromTargR d cr = reader $ \w -> case cr ^? crTarget . _Just of
crSafeDistFromTargR d cr = return $ case cr ^? crTarget . _Just of
Just tcr -> dist (_crPos cr) (_crPos tcr) > d
Nothing -> True
@@ -86,16 +86,16 @@ crStratConMatchesR strat cr = return $ eqConstr strat (_crStrategy $ _crActionPl
crAwayFromPost :: (World,Creature) -> Bool
crAwayFromPost (_,cr) = case find sentinelGoal $ _crGoal $ _crActionPlan cr of
Just (SentinelAt p dir) -> dist p (_crPos cr) > 15
Just (SentinelAt p _) -> dist p (_crPos cr) > 15
_ -> False
where
sentinelGoal (SentinelAt p dir) = True
sentinelGoal (SentinelAt _ _) = True
sentinelGoal _ = False
crAwayFromPostR :: Creature -> Reader World Bool
crAwayFromPostR cr = return $ case find sentinelGoal $ _crGoal $ _crActionPlan cr of
Just (SentinelAt p dir) -> dist p (_crPos cr) > 15
Just (SentinelAt p _) -> dist p (_crPos cr) > 15
_ -> False
where
sentinelGoal (SentinelAt p dir) = True
sentinelGoal (SentinelAt _ _) = True
sentinelGoal _ = False
src/Dodge/Layout/Tree/GenerateStructure.hs
+4 -12
View File
@@ -10,17 +10,11 @@ import Dodge.RandomHelp
import Data.Tree
import Control.Monad.State
import System.Random
{-
Single branched tree (a trunk).
-}
{- Single branched tree (a trunk). -}
treePath :: Int -> Tree ()
treePath 0 = Node () []
treePath x = Node () [treePath (x-1)]
{-
Adds a branch at a certain point down a trunk.
-}
{- Adds a branch at a certain point down a trunk. -}
addBranchAt
:: Int -- ^ Depth to add branch at
-> Tree () -- ^ Branch to add
@@ -29,10 +23,8 @@ addBranchAt
addBranchAt 0 b (Node () xs) = Node () (xs ++ [b])
addBranchAt i b (Node () (x:xs))
= Node () (addBranchAt (i-1) b x : xs)
{-
Randomly generate a tree containing a maximum of three nodes.
-}
addBranchAt _ _ _ = error "Trying to add a branch too far along a tree"
{- Randomly generate a tree containing a maximum of three nodes. -}
smallBranch :: RandomGen g => State g (Tree ())
smallBranch = takeOne
[ treePath 0
src/Dodge/Layout/Tree/Polymorphic.hs
+5 -2
View File
@@ -40,6 +40,8 @@ Applies a function to the root of a tree.
applyToRoot :: (a -> a) -> Tree a -> Tree a
applyToRoot f (Node t ts) = Node (f t) ts
-- | Consider defining this using generalised recursion patterns
treeSize :: Tree a -> Int
treeSize = length . flatten
{- |
@@ -72,7 +74,7 @@ treeChildNums :: Tree a -> Tree Int
treeChildNums = setRoot 0
where
setRoot :: Int -> Tree a -> Tree Int
setRoot i (Node x xs) = Node i (zipWith setRoot [0..] xs)
setRoot i (Node _ xs) = Node i (zipWith setRoot [0..] xs)
{- |
Makes each node into its path, i.e. the list of indices that,
@@ -109,7 +111,7 @@ Find the depth of a tree along the trunk.
-}
trunkDepth :: Tree a -> Int
trunkDepth (Node _ []) = 0
trunkDepth (Node _ (x:xs)) = trunkDepth x + 1
trunkDepth (Node _ (x:_)) = trunkDepth x + 1
{- |
Split a tree at a given point along its trunk.
@@ -121,6 +123,7 @@ splitTrunkAt 0 (Node x xs) = (Node x [],xs)
splitTrunkAt i (Node y (x:xs)) =
let (t, ts) = splitTrunkAt (i-1) x
in (Node y (t : xs) , ts)
splitTrunkAt _ (Node _ []) = error "Trying to split to short a trunk"
{- |
Split a tree at a random point along its trunk.
src/Dodge/RandomHelp.hs
+6 -5
View File
@@ -3,7 +3,7 @@ Helpers for random generation.
-}
module Dodge.RandomHelp where
import Geometry
import Geometry.Data
--import Geometry.Data
import System.Random
import Control.Monad.State
@@ -20,15 +20,15 @@ takeOne xs = state (randomR (0,length xs - 1)) >>= (\i -> return (xs !! i))
takeOneWeighted :: (RandomGen g, Random b, Ord b, Num b) => [b] -> [a] -> State g a
takeOneWeighted ws xs = state (randomR (0, sum ws))
>>= (\w -> return (xs !! i w ws))
>>= (\w -> return (xs !! i w ws))
where
i y (z:zs)
| y <= z = 0
| otherwise = 1 + i (y-z) zs
i y _ = 0
i _ _ = 0
takeOneMore :: RandomGen g => ([a],[a]) -> State g ([a],[a])
takeOneMore (xs,[]) = error "trying to takeOneMore from empty list"
takeOneMore ( _,[]) = error "trying to takeOneMore from empty list"
takeOneMore (xs,ys) = do
i <- state $ randomR (0,length ys - 1)
let (zs, w:ws) = splitAt i ys
@@ -38,7 +38,7 @@ takeNMore :: RandomGen g => Int -> ([a],[a]) -> State g ([a],[a])
takeNMore n p = foldr (const (>>= takeOneMore)) (return p) [1..n]
takeN :: RandomGen g => Int -> [a] -> State g [a]
takeN 0 xs = return []
takeN 0 _ = return []
takeN i xs = fst <$> takeNMore i ([],xs)
-- | Randomly shuffle a list.
@@ -54,6 +54,7 @@ shuffle xs = do
-- | Randomly shuffle the tail of a list, not safe.
shuffleTail :: RandomGen g => [a] -> State g [a]
shuffleTail (x:xs) = (x :) <$> shuffle xs
shuffleTail _ = undefined
randomSelectionFromList :: RandomGen g => Float -> [a] -> State g [a]
randomSelectionFromList p = filterM $ const $ randProb p
src/Dodge/Render/PerspectiveMatrix.hs
+5 -5
View File
@@ -24,11 +24,11 @@ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
(V4 (sin rot) (cos rot) 0 0)
(V4 0 0 1 0)
(V4 0 0 0 1)
tranMat3 = Linear.Matrix.transpose $
V4 (V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 0)
(V4 (-tranx) (-trany) 0 1)
--tranMat3 = Linear.Matrix.transpose $
-- V4 (V4 1 0 0 0)
-- (V4 0 1 0 0)
-- (V4 0 0 1 0)
-- (V4 (-tranx) (-trany) 0 1)
tranMat2 = Linear.Matrix.transpose $
V4 (V4 1 0 0 0)
(V4 0 1 0 0)
src/Dodge/Update/UsingInput.hs
+10 -10
View File
@@ -18,30 +18,30 @@ updateUsingInput w =
else updatePressedButtons (_mouseButtons w) w
updatePressedButtons :: S.Set MouseButton -> World -> World
updatePressedButtons keys w
updatePressedButtons pkeys w
| lbPressed && rbPressed
= useItem (_yourID w) w
| mbPressed = w & clickMousePos .~ _mousePos w
& cameraRot -~ rotation
| otherwise = w
where
lbPressed = ButtonLeft `S.member` keys
rbPressed = ButtonRight `S.member` keys
mbPressed = ButtonMiddle `S.member` keys
lbPressed = ButtonLeft `S.member` pkeys
rbPressed = ButtonRight `S.member` pkeys
mbPressed = ButtonMiddle `S.member` pkeys
rotation = angleBetween (_mousePos w) (_clickMousePos w)
updatePressedButtonsCarte :: S.Set MouseButton -> World -> World
updatePressedButtonsCarte keys w
updatePressedButtonsCarte pkeys w
| rbPressed = w & clickMousePos .~ _mousePos w
& carteCenter %~ (-.- trans)
| lbPressed = w & clickMousePos .~ _mousePos w
& carteRot -~ rot
& carteZoom *~ zoom
& carteZoom *~ czoom
| otherwise = w
where
lbPressed = ButtonLeft `S.member` keys
rbPressed = ButtonRight `S.member` keys
mbPressed = ButtonMiddle `S.member` keys
lbPressed = ButtonLeft `S.member` pkeys
rbPressed = ButtonRight `S.member` pkeys
--mbPressed = ButtonMiddle `S.member` pkeys
rot = angleBetween (_mousePos w) (_clickMousePos w)
zoom = magV (_mousePos w) / magV (_clickMousePos w)
czoom = magV (_mousePos w) / magV (_clickMousePos w)
trans = rotateV (_carteRot w) $ (1 / _carteZoom w) *.* (_mousePos w -.- _clickMousePos w)