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

Assorted changes, cleanup menu selection text

Browse Source
This commit is contained in:
justin
2022-04-25 23:27:39 +01:00
parent 67e6c4a5bd
commit fa8d8b5899
22 changed files with 217 additions and 108 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+3 -2
View File
@@ -79,7 +79,7 @@ pointHitsWalls p1 p2
collidePointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
collidePointWalkable p1 p2 ws
= any (isJust . uncurry (intersectSegSeg p1 p2) . _wlLine)
$ IM.filter (fromMaybe True . (^? wlPathable)) ws
$ IM.filter (not . fromMaybe True . (^? wlPathable)) ws
--furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
--furthestPointWalkable p1 p2 ws
@@ -179,7 +179,8 @@ hasLOSIndirect p1 p2 w = case collidePointIndirect' p1 p2 $ wallsAlongLine p1 p2
isWalkable :: Point2 -> Point2 -> World -> Bool
isWalkable p1 p2 w = not
$ collidePointWalkable p1 p2
$ wallsAlongLine p1 p2 w
$ _walls w
-- $ wallsAlongLine p1 p2 w
canSee :: Int -> Int -> World -> Bool
canSee i j w = hasLOS p1 p2 w
src/Dodge/Base/Coordinate.hs
+4 -5
View File
@@ -14,11 +14,10 @@ worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTransla
- These have to be scaled according to the size of the window to get actual screen positions.
- This allows for line thicknesses etc to correspond to pixel sizes.-}
worldPosToScreen :: World -> Point2 -> Point2
worldPosToScreen w = doRotate . doZoom . doTranslate
where
doTranslate p = p -.- _cameraCenter w
doZoom p = _cameraZoom w *.* p
doRotate p = rotateV (negate $ _cameraRot w) p
worldPosToScreen w
= rotateV (negate $ _cameraRot w)
. (_cameraZoom w *.*)
. (-.- _cameraCenter w)
{- | Transform coordinates from the map position to screen
coordinates. -}
cartePosToScreen :: Configuration -> World -> Point2 -> Point2
src/Dodge/Config/Data.hs
+2
View File
@@ -22,6 +22,7 @@ data Configuration = Configuration
, _debug_noclip :: Bool
, _debug_cr_status :: Bool
, _debug_cr_awareness :: Bool
, _debug_mouse_position :: Bool
, _debug_view_boundaries :: Bool
, _debug_view_clip_bounds :: RoomClipping
, _debug_pathing :: Bool
@@ -66,6 +67,7 @@ defaultConfig = Configuration
, _debug_show_sound = False
, _debug_seconds_frame = True
, _debug_noclip = False
, _debug_mouse_position = False
, _debug_cr_status = False
, _debug_cr_awareness = False
, _debug_view_boundaries = False
src/Dodge/Creature/Action.hs
+17 -3
View File
@@ -18,6 +18,7 @@ module Dodge.Creature.Action
)
where
import Dodge.Inventory.Add
--import Dodge.ShortShow
import Dodge.Path
import Dodge.Default
import Dodge.WallCreatureCollisions
@@ -65,14 +66,27 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
performPathTo :: Creature -> World -> Point2 -> OutAction
performPathTo cr w p
| dist cpos p < 5 = ([], Nothing)
| hasLOS cpos p w = ([MvTurnToward p,MvForward,RandomTurn jit] , Just (PathTo p))
| otherwise = case pointTowardsImpulse cpos p w of
Just q -> ([MvTurnToward q,MvForward,RandomTurn jit] , Just (PathTo p))
| isWalkable cpos p w = ([MvTurnToward p,MvForward,RandomTurn jit] , Just (PathTo p))
| otherwise = case pointTowardsImpulse p cpos w of
Just q -> ([MvTurnToward q
,MvForward
,RandomTurn jit
,ArbitraryImpulseEffect . const
$ debugPicture .~ drawPathList cpos p w
]
, Just (PathTo p))
_ -> ([],Nothing)
where
cpos = _crPos cr
jit = _mvTurnJit $ _crMvType cr
drawPathList :: Point2 -> Point2 -> World -> Picture
drawPathList x y w = case makePathBetweenPs x y w of
Nothing -> setLayer DebugLayer $ color red $ line [x,y]
Just [] -> setLayer DebugLayer $ color green $ line [x,y]
Just as -> setLayer DebugLayer $ color orange (line as)
<> color blue (line [head as,x]) <> color yellow (line [last as, y])
performTurnToA :: Creature -> Point2 -> OutAction
performTurnToA cr p
| angleVV cdirv dirv < 0.1 = ([], Nothing)
src/Dodge/Creature/ChaseCrit.hs
+4 -11
View File
@@ -35,9 +35,9 @@ chaseCrit = defaultCreature
, performActions
, const overrideMeleeCloseTarget
, const setViewPos
, const setMvPos
, goToTarget
, perceptionUpdate [0]
, setMvPos
, chaseCritMv
, chaseCritPerceptionUpdate [0]
, targetYouWhenCognizant
, const (crMeleeCooldown %~ max 0 . subtract 1)
]
@@ -47,12 +47,5 @@ chaseCrit = defaultCreature
, _crMeleeCooldown = 0
, _crFaction = ColorFaction green
, _crVocalization = Vocalization seagullChatterS 50 0
, _crMvType = ChaseMvType
{ _mvSpeed = 3
, _mvTurnRad = f
, _mvTurnJit = 0.2
}
, _crMvType = defaultChaseMvType
}
where
f x | x > pi / 4 = 0.2
| otherwise = 0.05
src/Dodge/Creature/Impulse.hs
+1
View File
@@ -67,6 +67,7 @@ followImpulse cr w imp = case imp of
AddGoal gl -> crup $ cr & crActionPlan . crGoal .:~ gl
ArbitraryImpulseFunction f -> crup $ f w cr
ArbitraryImpulse f -> followImpulse cr w (f cr w)
ArbitraryImpulseEffect f -> (f cr, cr)
ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> followImpulse cr w (f $ _crID tcr)
_ -> crup cr
src/Dodge/Creature/Perception.hs
+40 -4
View File
@@ -1,11 +1,13 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Perception
( perceptionUpdate
, chaseCritPerceptionUpdate
, newSounds
) where
import Dodge.Data
import Dodge.Creature.Vocalization
import Dodge.Base.Collide
import Dodge.RandomHelp
--import Dodge.SoundLogic
import Geometry.Vector
--import Geometry.Data
@@ -13,6 +15,7 @@ import Geometry.Data
import Sound.Data
--import StrictHelp
import Control.Monad.State
import Data.Maybe
import Control.Lens
import qualified Data.IntMap.Strict as IM
@@ -25,10 +28,16 @@ perceptionUpdate
-> Creature
perceptionUpdate is w = rememberSounds w . basicAwarenessUpdate . basicAttentionUpdate is w
chaseCritPerceptionUpdate :: [Int] -> World -> Creature -> Creature
chaseCritPerceptionUpdate is w =
rememberSounds w . chaseCritAwarenessUpdate w . basicAttentionUpdate is w
{- | Update a creatures awareness based upon the creatures' current direction
of attention -}
basicAwarenessUpdate :: Creature -> Creature
basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of
Fixated i -> cr & crPerception . crAwarenessLevel
%~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
AttentiveTo is -> cr
& crPerception . crAwarenessLevel
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
@@ -41,8 +50,29 @@ basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of
Just sid -> crActionPlan . crImpulse .~ [Bark sid]
Nothing -> id
| otherwise = id
Fixated i -> cr & crPerception . crAwarenessLevel
%~ ( IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
chaseCritAwarenessUpdate :: World -> Creature -> Creature
chaseCritAwarenessUpdate w cr = case _crAttentionDir $ _crPerception cr of
Fixated i -> cr & crPerception . crAwarenessLevel
%~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
AttentiveTo is -> cr
& crPerception . crAwarenessLevel
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
& maybeBark
where
oldAwareness = _crAwarenessLevel $ _crPerception cr
newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
randBool = takeOne [False,True] & evalState $ _randGen w
maybeBark
| becomesCognizant && randBool =
crActionPlan . crStrategy .~ StrategyActions WarningCry
[DoImpulses [Bark $ fromJust $ vocalizationTest cr]
`DoActionThen` 20
`WaitThen` DoImpulses [ChangeStrategy $ CloseToMelee 0]
, AimAt 0 (_crPos $ _creatures w IM.! 0)
]
| otherwise = id
cogRaised :: AwarenessLevel -> AwarenessLevel -> AwarenessLevel
cogRaised Suspicious{} Cognizant{} = Cognizant 100
@@ -76,7 +106,7 @@ basicAttentionUpdate
-> Creature
-> Creature
basicAttentionUpdate cids w cr = cr & crPerception . crAttentionDir .~
AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
newExtraAwareness
:: Creature -- ^ source creature
@@ -110,7 +140,13 @@ newSounds = mapMaybe f . M.elems . _playingSounds
rememberSounds :: World -> Creature -> Creature
rememberSounds w cr = cr
& crMemory . soundsToInvestigate .~ map fst (filter (soundIsClose cr) (newSounds w))
& crMemory . soundsToInvestigate .~ closesounds
& awakeupdate
where
awakeupdate | null closesounds = id
| otherwise = crPerception . crAwakeLevel .~ Vigilant
closesounds = map fst (filter (soundIsClose cr) (newSounds w))
soundIsClose :: Creature -> (Point2,Float) -> Bool
soundIsClose cr (pos,vol) = vol > (_auDist . _crAudition $ _crPerception cr) (dist pos (_crPos cr))
src/Dodge/Creature/ReaderUpdate.hs
+17 -3
View File
@@ -9,6 +9,7 @@ module Dodge.Creature.ReaderUpdate
, overrideInternal
, goToTarget
, flockACC
, chaseCritMv
, setMvPos
, setViewPos
) where
@@ -38,11 +39,16 @@ tryMeleeAttack cr tcr
where
cpos = _crPos cr
setMvPos :: Creature -> Creature
setMvPos cr = cr & crIntention . mvToPoint .~ mpos
setMvPos :: World -> Creature -> Creature
setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
where
int = _crIntention cr
mpos = (_crPos <$> _targetCr int)
mtpos = do
tpos <- _crPos <$> _targetCr int
if hasLOS (_crPos cr) tpos w
then Just tpos
else Nothing
mpos = mtpos
<|> _mvToPoint int
-- <|> listToMaybe (_soundsToInvestigate $ _crMemory cr)
@@ -80,6 +86,14 @@ flockACC w cr = case cr ^? crIntention . targetCr . _Just of
else negate r *.* horDir
in cr & crIntention . mvToPoint ?~ tpos +.+ horShift
chaseCritMv :: World -> Creature -> Creature
chaseCritMv w cr = case _crStrategy (_crActionPlan cr) of
StrategyActions _ _ -> cr
WarningCry -> cr
_ -> case cr ^? crIntention . mvToPoint . _Just of
Just p -> cr & crActionPlan . crAction .~ [PathTo p]
_ -> viewTarget w cr
goToTarget :: World -> Creature -> Creature
goToTarget w cr =
case cr ^? crIntention . mvToPoint . _Just of
src/Dodge/Creature/State.hs
+13 -11
View File
@@ -129,27 +129,29 @@ movementSideEff cr w
(randAng,_) = randomR (0,2*pi) $ _randGen w
heldItemUpdate :: Int -> Item -> Item
heldItemUpdate invid = (itIsHeld .~ True) . invItemUpdate invid
heldItemUpdate invid = (itUse %~ useUpdate) . (itIsHeld .~ True) . (itInvPos ?~ invid)
invItemUpdate :: Int -> Item -> Item
invItemUpdate invid = (itUse %~ useupdate) . (itIsHeld .~ False) . (itInvPos ?~ invid)
where
useupdate = (useHammer . hammerPosition %~ moveHammerUp)
invItemUpdate invid = (itUse %~ useUpdate) . (itIsHeld .~ False) . (itInvPos ?~ invid)
useUpdate :: ItemUse -> ItemUse
useUpdate = (useHammer . hammerPosition %~ moveHammerUp)
. (useDelay . warmTime %~ decreaseToZero)
. (useDelay . rateTime %~ decreaseToZero)
useEquipment :: Creature -> Int -> World -> World
useEquipment cr i = _eqUse (_itUse $ _crInv cr IM.! i) cr i
invSideEff :: Creature -> World -> World
invSideEff cr w = weaponReloadSounds cr
. flip (IS.foldr useeq) (_crInvEquipped cr)
-- . doHeldItemTargeting cr
. flip (IS.foldr $ useEquipment cr) (_crInvEquipped cr)
$ IM.foldrWithKey f w (_crInv cr)
where
useeq i = _eqUse (_itUse $ _crInv cr IM.! i) cr i
f i it w' = case it ^? itEffect . itInvEffect of
Nothing -> w' & doitemupdate
Just g -> g (_itEffect it) cr i w' & doitemupdate
f i it w' = doitemupdate w' & case it ^? itEffect . itInvEffect of
Nothing -> id
Just g -> g (heldItemUpdate i it) cr -- this is done twice!
where
doitemupdate
doitemupdate
| i == _crInvSel cr = doItemTargeting i cr . (itpointer %~ heldItemUpdate i)
| otherwise = doItemTargeting i cr . (itpointer %~ invItemUpdate i)
itpointer = creatures . ix (_crID cr) . crInv . ix i
src/Dodge/Data.hs
+23 -25
View File
@@ -21,6 +21,7 @@ module Dodge.Data
, module Dodge.Item.Data
, module Dodge.Config.Data
) where
import Dodge.ShortShow
import Dodge.Creature.State.Data
import Dodge.Creature.Stance.Data
import Dodge.Creature.Perception.Data
@@ -100,6 +101,7 @@ data World = World
, _floorTiles :: [(Point3,Point3)]
, _randGen :: StdGen
, _testString :: World -> [String]
, _debugPicture :: Picture
, _modifications :: IM.IntMap Modification
, _yourID :: Int
, _worldEvents :: World -> World
@@ -197,14 +199,14 @@ data MenuOption
= Toggle
{ _moKey :: Scancode
, _moEff :: Universe -> IO (Maybe Universe)
, _moString :: Universe -> String
, _moString :: Universe -> Either String (String,String)
}
| Toggle2
{ _moKey1 :: Scancode
, _moEff1 :: Universe -> IO (Maybe Universe)
, _moKey2 :: Scancode
, _moEff2 :: Universe -> IO (Maybe Universe)
, _moString :: Universe -> String
, _moString :: Universe -> Either String (String,String)
}
| InvisibleToggle
{ _moKey :: Scancode
@@ -308,12 +310,7 @@ data Intention = Intention
data CrMvType
= NoMvType
| MvWalking { _mvSpeed :: Float }
| ChaseMvType
{ _mvSpeed :: Float
, _mvTurnRad :: Float -> Float
, _mvTurnJit :: Float
}
| AimMvType
| CrMvType
{ _mvSpeed :: Float
, _mvTurnRad :: Float -> Float
, _mvTurnJit :: Float
@@ -478,27 +475,24 @@ data ReloadType
-- I believe this is called every frame, not sure when though
data ItEffect
= NoItEffect
| ItSimpleInvEffect
{_itInvEffect :: ItEffect -> Creature -> Int -> World -> World
-- the Int is the items inventory position
}
-- | ItSimpleInvEffect
-- {_itInvEffect :: Item -> Creature -> World -> World
-- }
| ItInvEffect
{_itInvEffect :: ItEffect -> Creature -> Int -> World -> World
-- the Int is the items inventory position
{_itInvEffect :: Item -> Creature -> World -> World
,_itEffectCounter :: Int
}
| ItRewindEffect
{_itInvEffect :: ItEffect -> Creature -> Int -> World -> World
{_itInvEffect :: Item -> Creature -> World -> World
,_itStoredWorlds :: [World]
}
| ItEffect
{_itInvEffect :: ItEffect -> Creature -> Int -> World -> World
{_itInvEffect :: Item -> Creature -> World -> World
,_itFloorEffect :: Int -> World -> World
,_itEffectCounter :: Int
}
| ItInvEffectID
{_itInvEffect :: ItEffect -> Creature -> Int -> World -> World
-- the Int is the items inventory position
{_itInvEffect :: Item -> Creature -> World -> World
,_itEffectID :: Maybe Int
}
data IntID a = IntID Int a
@@ -932,6 +926,7 @@ data Impulse
| AddGoal Goal
| ArbitraryImpulseFunction (World -> Creature -> Creature)
| ArbitraryImpulse (Creature -> World -> Impulse)
| ArbitraryImpulseEffect (Creature -> World -> World)
| ImpulseUseTargetCID
{_impulseUseTargetCID :: Int -> Impulse
}
@@ -943,14 +938,14 @@ data Impulse
}
instance Show Impulse where
show imp = case imp of
Move p -> "Move "++show p
Move p -> "Move "++shortPoint2 p
MoveForward f -> "MoveForward "++ show f
Turn f -> "Turn "++show f
RandomTurn f -> "RandomTurn "++show f
TurnToward p f -> "TurnToward "++show p++show f
MvTurnToward p -> "MvTurnToward "++show p
TurnToward p f -> "TurnToward "++shortPoint2 p++show f
MvTurnToward p -> "MvTurnToward "++shortPoint2 p
MvForward -> "MvForward"
TurnTo p -> "TurnTo "++show p
TurnTo p -> "TurnTo "++shortPoint2 p
UseItem -> "UseItem"
SwitchToItem i -> "SwitchToItem "++show i
DropItem -> "DropItem"
@@ -962,6 +957,7 @@ instance Show Impulse where
AddGoal g -> "AddGoal " ++ show g
ArbitraryImpulseFunction {} -> "ArbitraryImpulseFunction"
ArbitraryImpulse {} -> "ArbitraryImpulse"
ArbitraryImpulseEffect {} -> "ArbitraryImpulseEffect"
ImpulseUseTargetCID {} -> "ImpulseUseTargetCID"
ImpulseUseTarget {} -> "ImpulseUseTarget"
ImpulseUseAheadPos {} -> "ImpulseUseAheadPos"
@@ -1067,13 +1063,13 @@ instance Show Action where
AimAt
{_targetID = tid
,_targetSeenAt = p
} -> "AimAt tid:"++show tid++" seenAt:"++show p
} -> "AimAt tid:"++show tid++" seenAt:"++shortPoint2 p
PathTo
{_pathToPoint = p
} -> "PathTo:"++show p
} -> "PathTo:"++shortPoint2 p
TurnToA
{_turnToAPoint = p
} -> "TurnToA:"++show p
} -> "TurnToA:"++shortPoint2 p
---- | PickupItem
---- {_pickupItemID :: Int
---- }
@@ -1161,6 +1157,8 @@ data Strategy
| ShootAt Int
| FollowImpulses
| WatchAndWait
| WarningCry
| CloseToMelee Int
| StrategyActions Strategy [Action]
| GetTo Point2
| Reload
src/Dodge/Default.hs
+5 -2
View File
@@ -101,16 +101,19 @@ defaultIntention = Intention
, _viewPoint = Nothing
}
defaultChaseMvType :: CrMvType
defaultChaseMvType = ChaseMvType
defaultChaseMvType = CrMvType
{ _mvSpeed = 3
, _mvTurnRad = f
, _mvTurnJit = 0.2
, _mvAimSpeed = g
}
where
g x | x > pi/8 = 0.2
| otherwise = 0.01
f x | x > pi / 4 = 0.2
| otherwise = 0.05
defaultAimMvType :: CrMvType
defaultAimMvType = AimMvType
defaultAimMvType = CrMvType
{ _mvSpeed = 3
, _mvTurnRad = const 0.2
, _mvTurnJit = 0.05
src/Dodge/Default/World.hs
+1
View File
@@ -52,6 +52,7 @@ defaultWorld = World
, _randGen = mkStdGen 2
, _mousePos = V2 0 0
, _testString = const []
, _debugPicture = mempty
, _yourID = 0
, _worldEvents = id
, _delayedEvents = []
src/Dodge/Item/Equipment.hs
+7 -2
View File
@@ -14,6 +14,7 @@ import Shape
import qualified IntMapHelp as IM
import LensHelp
import Data.Maybe
magShield :: Item
magShield = defaultEquipment
{ _itType = MAGSHIELD
@@ -98,9 +99,11 @@ effectOnEquip f = ItInvEffectID
, _itEffectID = Nothing
}
where
g f' _ cr invid w
g f' itm cr w
| _crInvSel cr == invid = f' cr (_crInv (_creatures w IM.! _crID cr) IM.! invid) w
| otherwise = w
where
invid = fromJust $ _itInvPos itm
shieldWall :: Int -> Wall
shieldWall crid = defaultWall
@@ -156,9 +159,11 @@ effectOnOffEquip f f' = ItInvEffectID
, _itEffectID = Nothing
}
where
g _ cr invid w
g itm cr w
| _crInvSel cr == invid = f cr invid w
| otherwise = f' cr invid w
where
invid = fromJust $ _itInvPos itm
{- | Increases speed, reduces friction, cannot only move forwards. -}
jetPack :: Item
src/Dodge/Item/Weapon/Booster.hs
+3 -1
View File
@@ -123,8 +123,10 @@ boosterGun = defaultGun
resetAttachmentID :: ItEffect
resetAttachmentID = ItInvEffect f 0
where
f iteff cr invid w
f itm cr w
| _itEffectCounter iteff < 0 = w & pointToIt . itAttachment .~ NoItAttachment
| otherwise = w & pointToIt . itEffect . itEffectCounter -~ 1
where
iteff = _itEffect itm
invid = fromJust $ _itInvPos itm
pointToIt = creatures . ix (_crID cr) . crInv . ix invid
src/Dodge/Item/Weapon/ExtraEffect.hs
+14 -11
View File
@@ -35,22 +35,25 @@ import qualified SDL
autoRadarEffect :: ItEffect
autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
where
f :: Int -> ItEffect -> Creature -> Int -> World -> World
f 0 _ cr i w = aRadarPulse cr w
& creatures . ix (_crID cr) . crInv . ix i
f :: Int -> Item -> Creature -> World -> World
f 0 itm cr w = aRadarPulse cr w
& creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm)
. itEffect . itInvEffect .~ f 100
f t _ cr i w = w
& creatures . ix (_crID cr) . crInv . ix i
f t itm cr w = w
& creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm)
. itEffect . itInvEffect .~ f (t-1)
{- | Automatically send out sonar pulses that detect creatures. -}
autoSonarEffect :: ItEffect
autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
autoSonarEffect = ItInvEffect {_itInvEffect = f ,_itEffectCounter = 50 }
where
f :: Int -> ItEffect -> Creature -> Int -> World -> World
f 0 _ cr i w = aSonarPulse cr w
& creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f 140
f t _ cr i w = w
& creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1)
f :: Item -> Creature -> World -> World
f itm cr w
| _itEffectCounter (_itEffect itm) == 0 = aSonarPulse cr w
& decreasecounter
| otherwise = decreasecounter w
where
decreasecounter = creatures . ix (_crID cr) . crInv
. ix (fromJust $ _itInvPos itm) . itEffect . itEffectCounter %~ (\i -> (i - 1) `mod` 50)
defaultTargeting :: Targeting
defaultTargeting = Targeting
src/Dodge/Item/Weapon/Grenade.hs
+3 -1
View File
@@ -119,7 +119,9 @@ throwGrenade thePayload cr w = setWp $ removePict $ over props addG w
throwArmReset :: Int -> ItEffect
throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x }
where
f _ cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i
f itm cr = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i
where
i = fromJust $ _itInvPos itm
counterDown it
| _itEffectCounter (_itEffect it) == 0 = it
& itUse . useHammer . hammerPosition .~ HammerUp
src/Dodge/Item/Weapon/Utility.hs
+4 -2
View File
@@ -13,6 +13,7 @@ import qualified IntMapHelp as IM
import Shape
import ShapePicture
import Data.Maybe
--import qualified Data.Map.Strict as M
import Control.Lens
@@ -28,13 +29,14 @@ rewindGun = defaultGun
, _itEffect = ItRewindEffect rewindEffect []
, _itUse = defaultlUse {_lUse = \cr invid -> useRewindGun (_crInv cr IM.! invid) cr}
}
rewindEffect :: ItEffect -> Creature -> Int -> World -> World
rewindEffect _ cr invid w
rewindEffect :: Item -> Creature -> World -> World
rewindEffect itm cr w
| Just invid == _crLeftInvSel cr = w & rewindWorlds %~ (take maxcharge . (w' : ))
& ptrWpCharge .~ length (_rewindWorlds w)
| otherwise = w & rewindWorlds .~ []
& ptrWpCharge .~ 0
where
invid = fromJust $ _itInvPos itm
ptrWpCharge = creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge
maxcharge = _wpMaxCharge . _itConsumption $ _crInv cr IM.! invid
w' = w & rewindWorlds .~ []
src/Dodge/Menu.hs
+19 -15
View File
@@ -11,6 +11,7 @@ import Dodge.Data
import Dodge.PreloadData
import Dodge.Save
import Dodge.Config.Update
import Padding
--import SDL.Internal.Numbered
--import Preload.Update
import Dodge.SoundLogic
@@ -33,18 +34,20 @@ pauseMenu :: ScreenLayer
pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
pauseMenuOptions :: [MenuOption]
pauseMenuOptions =
[ Toggle ScancodeN (return . Just . startNewGame) (const "NEW LEVEL")
, Toggle ScancodeR (return . Just . loadSaveSlot LevelStartSlot) (const "RESTART")
, Toggle ScancodeS (pushScreen $ seedStartMenu "START FROM SEED") (const "START FROM SEED")
, Toggle ScancodeO (pushScreen optionMenu ) (const "OPTIONS")
, Toggle ScancodeC (pushScreen displayControls) (const "CONTROLS")
[ Toggle ScancodeN (return . Just . startNewGame) (opText "NEW LEVEL")
, Toggle ScancodeR (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
, Toggle ScancodeS (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
, Toggle ScancodeO (pushScreen optionMenu ) (opText "OPTIONS")
, Toggle ScancodeC (pushScreen displayControls) (opText "CONTROLS")
, InvisibleToggle ScancodeEscape (return . const Nothing)
]
where
opText = const . Left
seedStartMenu :: String -> ScreenLayer
seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
seedStartOptions :: [MenuOption]
seedStartOptions =
[ Toggle ScancodeP trySeedFromClipboard (const "PASTE NUMBER FROM CLIPBOARD")
[ Toggle ScancodeP trySeedFromClipboard (const $ Left "PASTE NUMBER FROM CLIPBOARD")
-- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
]
@@ -64,10 +67,10 @@ optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen
optionsOptions :: [MenuOption]
optionsOptions =
[ makeSubmenuOption ScancodeV soundMenu "VOLUME"
, makeSubmenuOption ScancodeG graphicsMenu "GRAPHICS"
, makeSubmenuOption ScancodeP gameplayMenu "GAMEPLAY"
, makeSubmenuOption ScancodeD debugMenu "DEBUG OPTIONS"
[ makeSubmenuOption ScancodeV soundMenu $ Left "VOLUME"
, makeSubmenuOption ScancodeG graphicsMenu $ Left "GRAPHICS"
, makeSubmenuOption ScancodeP gameplayMenu $ Left "GAMEPLAY"
, makeSubmenuOption ScancodeD debugMenu $ Left "DEBUG OPTIONS"
]
debugMenu :: ScreenLayer
debugMenu = slTitleOptions
@@ -83,10 +86,11 @@ debugMenuOptions =
, makeEnumOption ScancodeB debug_view_clip_bounds "SHOW ROOM CLIP" return
, doption ScancodeP debug_pathing "SHOW PATHING" _debug_pathing
, doption ScancodeS debug_show_sound "SHOW VISUAL SOUNDS" _debug_show_sound
, doption ScancodeM debug_mouse_position "SHOW MOUSE POSITION" _debug_mouse_position
]
where
doption scode l t rec
= Toggle scode (return . Just . (config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config w))
= Toggle scode (return . Just . (config . l %~ not)) (\w -> Right (t ,show (rec $ _config w)))
gameplayMenu :: ScreenLayer
gameplayMenu = slTitleOptions
"OPTIONS:GAMEPLAY"
@@ -104,9 +108,9 @@ soundMenu = slTitleOptions
soundMenuOptions :: [MenuOption]
soundMenuOptions =
[ theoption ScancodeY volume_master ScancodeU "MASTER VOLUME:" _volume_master
, theoption ScancodeH volume_sound ScancodeJ "EFFECTS VOLUME:" _volume_sound
, theoption ScancodeN volume_music ScancodeM "MUSIC VOLUME:" _volume_music
[ theoption ScancodeY volume_master ScancodeU "MASTER VOLUME" _volume_master
, theoption ScancodeH volume_sound ScancodeJ "EFFECTS VOLUME" _volume_sound
, theoption ScancodeN volume_music ScancodeM "MUSIC VOLUME" _volume_music
]
where
theoption scod1 stype scod2 str voltype = Toggle2
@@ -114,7 +118,7 @@ soundMenuOptions =
(change dec stype)
scod2
(change inc stype)
(\w -> str ++ show (round $ 10 * voltype (_config w)::Int))
(\w -> Right (str , leftPad 2 '.' $ show (round $ 10 * voltype (_config w)::Int)))
change g vt = return . Just . (config . vt %~ g) . sw
dec x = max 0 (x - 0.1)
inc x = min 1 (x + 0.1)
src/Dodge/Menu/OptionType.hs
+2 -2
View File
@@ -7,12 +7,12 @@ import Control.Lens
makeBoolOption scode lns t = Toggle
scode
(return . Just . (config . lns #%~ not))
(\u -> t ++ ":" ++ show (u ^# config . lns))
(\u -> Right (t , show (u ^# config . lns)))
makeEnumOption scode lns str sideeff = Toggle
scode
(\u -> Just <$> sideeff (u & config . lns #%~ cycleEnum) )
(\u -> str ++ ":" ++ show (u ^# config . lns))
(\u -> Right (str , show (u ^# config . lns)) )
makeSubmenuOption scode submenu t = Toggle scode (pushScreen submenu) (const t)
src/Dodge/Path.hs
+1 -1
View File
@@ -30,7 +30,7 @@ makePathBetween a b w = do -- join $ sp <$> a' <*> b' <*> return (_pathGraph w)
walkableNodeNear p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear p
makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph w) <$> makePathBetween b a w
makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph w) <$> makePathBetween a b w
pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2
pointTowardsImpulse a b w = find (flip (isWalkable a) w) =<< makePathBetweenPs a b w
src/Dodge/Render/MenuScreen.hs
+12 -3
View File
@@ -54,9 +54,10 @@ drawOptions u title ops footer = pictures $
, drawFooterText cfig red footer
] ++
zipWith (\s vpos -> placeString (-hw + 50) vpos 0.2 s)
(map (menuOptionToString u) ops')
(map (menuOptionToString u maxOptionLength) ops')
[hh-100,hh-150 ..]
where
maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops')
ops' = filter notInvisible ops
notInvisible InvisibleToggle {} = False
notInvisible _ = True
@@ -64,6 +65,11 @@ drawOptions u title ops footer = pictures $
hw = halfWidth cfig
cfig = _config u
optionValueOffset :: Universe -> MenuOption -> Int
optionValueOffset u mo = case _moString mo u of
Left _ -> 0
Right (s,_) -> length s
darkenBackground :: Configuration -> Picture
darkenBackground = color (withAlpha 0.5 black) . polygon . screenBox
@@ -87,9 +93,12 @@ drawFooterText cfig col = color col . placeString (-hw + 30) (-hh+10) 0.1
hh = halfHeight cfig
hw = halfWidth cfig
menuOptionToString :: Universe -> MenuOption -> String
menuOptionToString w mo = theKeys ++ _moString mo w
menuOptionToString :: Universe -> Int -> MenuOption -> String
menuOptionToString w padAmount mo = theKeys ++ optionText
where
optionText = case _moString mo w of
Left s -> s
Right (s,t) -> rightPad padAmount '.' s ++ t
theKeys = case mo of
Toggle {_moKey = k} -> stc k : ":"
Toggle2 {_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":"
src/Dodge/Render/ShapePicture.hs
+22 -4
View File
@@ -1,6 +1,7 @@
module Dodge.Render.ShapePicture
( worldSPic
) where
import Dodge.ShortShow
import Dodge.Config.Data
import Dodge.Render.InfoBox
import Dodge.Debug.Picture
@@ -51,11 +52,13 @@ extraPics cfig w = pictures (_decorations w)
<> concatMapPic (dbArg _bmDraw) (_electronBeams $ _beams w)
<> concatMapPic (dbArg _lsPict) (_lightSources w)
<> testPic w
<> _debugPicture w
<> concatMapPic clDraw (_clouds w )
<> concatMapPic ppDraw (_pressPlates w )
<> soundPics cfig w
<> viewBoundaries cfig w
<> viewClipBounds cfig w
<> drawMousePosition cfig w
<> drawPathing cfig w
<> drawCrInfo cfig w
@@ -95,6 +98,19 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
theScale = 0.15 * f (_soundVolume s * 0.0001)
f x = 1 - 0.5 * (1 - x)
drawMousePosition :: Configuration -> World -> Picture
drawMousePosition cfig w
| not $ _debug_mouse_position cfig = mempty
| otherwise
= setLayer FixedCoordLayer . winScale cfig
. uncurryV translate p
. scale 0.1 0.1
. text
$ shortPoint2 mwp
where
p = worldPosToScreen w mwp
mwp = mouseWorldPos w
drawPathing :: Configuration -> World -> Picture
drawPathing cfig w
| _debug_pathing cfig
@@ -111,9 +127,11 @@ crDisplayInfo cfig w cr
| _crID cr == 0 = Nothing
| crOnScreen = Just (_crPos cr, catMaybes
-- [fmap show $ ap ^? crGoal
-- ,fmap show $ ap ^? crStrategy
[fmap show $ cr ^? crPos
,fmap show $ cr ^? crOldPos
[fmap show $ cr ^? crHP
,fmap show $ ap ^? crStrategy
,fmap show $ cr ^? crPos
,fmap show $ cr ^? crPerception . crAwakeLevel
-- ,fmap show $ cr ^? crOldPos
,fmap show $ ap ^? crAction
,fmap show $ ap ^? crImpulse
]
@@ -126,7 +144,7 @@ crDisplayInfo cfig w cr
drawCrInfo :: Configuration -> World -> Picture
drawCrInfo cfig w
| _debug_cr_status cfig = setLayer FixedCoordLayer
$ renderInfoListsAt (2*hw - 200) 0 cfig w
$ renderInfoListsAt (2*hw - 400) 0 cfig w
$ mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures w
| otherwise = mempty
where