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

Add frame clock

Browse Source
This commit is contained in:
justin
2021-09-09 13:29:09 +01:00
parent a2288110ae
commit be7b2d2cd7
27 changed files with 176 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files
appDodge/Main.hs
+3 -2
View File
@@ -63,6 +63,7 @@ doSideEffects w = do
void $ doDrawing (_renderData preData) w
playPositionalSoundQueue (_loadedChunks $ _soundData preData) (_soundQueue w)
newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_playingSounds w) (_sounds w)
w' <- _sideEffects w w
endTicks <- SDL.ticks
let lastFrameTicks = _frameTimer preData
@@ -73,9 +74,9 @@ doSideEffects w = do
. translate (-0.5) (-0.8) . scale 0.0005 0.0005
. text $ "ms/frame " ++ show (endTicks - lastFrameTicks)
)
newpdata <- foldr (=<<) (return (preData & frameTimer .~ endTicks)) (_doneSideEffects w)
return $ w & preloadData .~ newpdata
return $ w' & preloadData . frameTimer .~ endTicks
& playingSounds .~ newPlayingSounds
& sideEffects .~ return
doPreload :: IO PreloadData
doPreload = do
src/Dodge/Clock.hs
+14
View File
@@ -0,0 +1,14 @@
module Dodge.Clock
( clockCycle
)
where
import Dodge.Data
import qualified Data.Vector as V
clockCycle :: Int -> V.Vector a -> World -> a
{-# INLINABLE clockCycle #-}
clockCycle tPeriod xs w = xs V.! i
where
l = V.length xs
t = _frameClock w `mod` (l * tPeriod)
i = t `div` tPeriod
src/Dodge/Config/Update.hs
+13 -7
View File
@@ -14,20 +14,25 @@ import Data.Aeson (encodeFile)
{- |
Write the current world configuration to disk as a json file.
-}
saveConfig :: Configuration -> PreloadData -> IO PreloadData
saveConfig cfig d = do
saveConfig :: Configuration -> (a -> IO a) -> a -> IO a
saveConfig cfig f x = do
putStrLn "Saving config to data/dodge.config.json"
encodeFile "data/dodge.config.json" cfig
return d
f x
{- |
Apply the volume settings from the world configuration to the running game.
-}
setVol :: Configuration -> PreloadData -> IO PreloadData
setVol cfig d = do
setVol :: Configuration -> IO ()
setVol cfig = do
setSoundVolume ( _volume_master cfig * _volume_sound cfig)
setMusicVolume ( _volume_master cfig * _volume_music cfig)
return d
setVol' :: Configuration -> (a -> IO a) -> a -> IO a
setVol' cfig f a = do
setVol cfig
f a
{- |
Apply /all/ of the values in the world configuration to the running game.
@@ -37,7 +42,8 @@ applyWorldConfig
-> PreloadData
-> IO PreloadData
applyWorldConfig cfig pdata = do
setVol cfig pdata >>= pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y
setVol cfig
pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y pdata
where
x = round $ _windowX cfig
y = round $ _windowY cfig
src/Dodge/Creature/Action.hs
+14 -3
View File
@@ -69,6 +69,16 @@ performPathTo cr w p
cpos = _crPos cr
jit = _mvTurnJit $ _crMvType cr
performTurnToA :: Creature -> Point2 -> OutAction
performTurnToA cr p
| angleVV cdirv dirv < 0.1 = ([], Nothing)
| otherwise = ([MvTurnToward p,RandomTurn jit] , Just (TurnToA p))
where
cpos = _crPos cr
cdirv = unitVectorAtAngle (_crDir cr)
dirv = p -.- cpos
jit = _mvTurnJit $ _crMvType cr
{- | Performing an action means that a creature has some impulses for a frame, and
updates or deletes the action itself.
-- doAction -}
@@ -108,13 +118,14 @@ performAction cr w ac = case ac of
in (concat imps, Just . DoActions $ catMaybes newAcs)
StartSentinelPost -> ([AddGoal $ SentinelAt (_crPos cr) (_crDir cr)], Nothing)
PathTo p -> performPathTo cr w p
LeadTarget p -> case cr ^? crTarget . _Just of
TurnToA p -> performTurnToA cr p
LeadTarget p -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing)
_ -> ([], Nothing)
UseTarget f -> performAction cr w $ f $ cr ^? crTarget . _Just
UseTarget f -> performAction cr w $ f $ cr ^? crIntention . targetCr . _Just
UseSelf f -> performAction cr w $ f cr
UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
UseMvTargetPos f -> performAction cr w $ f $ _crMvTarget cr
UseMvTargetPos f -> performAction cr w $ f $ _mvToPoint $ _crIntention cr
ArbitraryAction f -> performAction cr w (f cr w)
DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
(imp, Just nxtac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp nxtac)
src/Dodge/Creature/ArmourChase.hs
+1 -1
View File
@@ -26,7 +26,7 @@ armourChaseCrit = defaultCreature
doStrategyActionsR >=>
performActionsR >=>
targetYouWhenCognizantR >=>
setTargetMv (pure . _crTarget) >=> -- should be able to remove this?
setTargetMv (pure . _targetCr . _crIntention) >=> -- should be able to remove this?
flockACCR >=>
perceptionUpdate [0] >=>
goToTarget >=>
src/Dodge/Creature/Boid.hs
+3 -3
View File
@@ -171,7 +171,7 @@ swarmUsingCenter
-> World
-> Creature
-> Creature
swarmUsingCenter updT upd w cr = case _crTarget cr of
swarmUsingCenter updT upd w cr = case _targetCr $ _crIntention cr of
Nothing -> upd cenp cr
Just tcr -> updT tcr cenp cr
where
@@ -184,7 +184,7 @@ flockChaseTarget
-> World
-> Creature
-> Creature
flockChaseTarget updT upd w cr = case _crTarget cr of
flockChaseTarget updT upd w cr = case _targetCr $ _crIntention cr of
Nothing -> upd crs cr
Just tcr -> updT tcr crs cr
where
@@ -210,7 +210,7 @@ flockToPointUsing
-> (Point2 -> Creature -> Creature -> [Impulse])
-> Creature
-> Reader World Creature
flockToPointUsing pf mvf cr = reader $ \w -> case _crTarget cr of
flockToPointUsing pf mvf cr = reader $ \w -> case _targetCr $ _crIntention cr of
Nothing -> cr
Just tcr -> cr & crActionPlan . crImpulse .~ mvf ptarg cr tcr
where
src/Dodge/Creature/ChaseCrit.hs
+1
View File
@@ -38,6 +38,7 @@ chaseCrit = defaultCreature
doStrategyActionsR >=>
performActionsR >=>
overrideMeleeCloseTargetR >=>
setViewPos >=>
setMvPos >=>
-- setTargetMv (pure . _crTarget) >=>
goToTarget >=>
src/Dodge/Creature/Impulse.hs
+2 -2
View File
@@ -62,10 +62,10 @@ followImpulse cr w imp = case imp of
AddGoal gl -> (id, cr & crActionPlan . crGoal %~ (gl :) )
ArbitraryImpulseFunction f -> (id, f w cr)
ArbitraryImpulse f -> followImpulse cr w (f cr w)
ImpulseUseTargetCID f -> case cr ^? crTarget . _Just of
ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> followImpulse cr w (f $ _crID tcr)
_ -> (id,cr)
ImpulseUseTarget f -> case cr ^? crTarget . _Just of
ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> followImpulse cr w (f tcr)
_ -> (id,cr)
ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
src/Dodge/Creature/Intention.hs
+2
View File
@@ -0,0 +1,2 @@
module Dodge.Creature.Intention
where
src/Dodge/Creature/Memory/Data.hs
+1 -1
View File
@@ -6,7 +6,7 @@ import Geometry.Data
import Control.Lens
data MemoryState = MemoryState
newtype MemoryState = MemoryState
{ _soundsToInvestigate :: [Point2]
}
src/Dodge/Creature/Perception.hs
+2 -2
View File
@@ -1,4 +1,4 @@
{-# LANGUAGE TupleSections #-}
--{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Perception
( perceptionUpdate
, newSounds
@@ -96,7 +96,7 @@ newSounds = mapMaybe f . M.elems . _playingSounds
rememberSounds :: Creature -> Reader World Creature
rememberSounds cr = do
sList <- fmap newSounds ask
sList <- asks newSounds
return $ cr & crMemory . soundsToInvestigate .~ map fst (filter (soundIsClose cr) sList)
-- return $ cr & crMemory . soundsToInvestigate .~ [V2 0 0]
src/Dodge/Creature/Perception/Data.hs
+1 -1
View File
@@ -35,7 +35,7 @@ data Vision = Eyes
{ _viFOV :: Float -> Float
, _viDist :: Float -> Float
}
data Audition = Ears
newtype Audition = Ears
{ _auDist :: Float -> Float
}
src/Dodge/Creature/Picture.hs
+29 -15
View File
@@ -10,14 +10,15 @@ module Dodge.Creature.Picture
import Dodge.Data
--import Dodge.Base
--import Dodge.Creature.Stance.Data
--import Dodge.Creature.Perception.Data
import Dodge.Creature.Perception.Data
import Dodge.Creature.State.Data
import Dodge.Creature.Stance.Data
import Dodge.Creature.Memory.Data
--import Dodge.Creature.Memory.Data
import Dodge.Creature.Test
--import Dodge.Creature.AlertLevel.Data
--import Dodge.Picture.Layer
import Dodge.Item.Data
import Dodge.Clock
import Picture
import Geometry
--import Geometry.Vector3D
@@ -25,6 +26,7 @@ import Geometry
import Control.Lens
import Data.List
import qualified Data.IntMap.Strict as IM
import qualified Data.Vector as V
basicCrPict
:: Color -- ^ Creature color
-> Creature
@@ -56,26 +58,38 @@ creatureDisplayText w cr
. color white
. rotate a
. scale theScale theScale
$ text $ creatureDisplayString cr
. text
$ clockCycle 50 (V.fromList [crDisplayAwake, crDisplayAlert]) w cr
where
campos = _cameraViewFrom w
theScale = 0.2 / _cameraZoom w
theScale = 0.15 / _cameraZoom w
cpos = _crPos cr
v = cpos -.- campos
a = argV v - 0.5 * pi
(V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v
creatureDisplayString :: Creature -> String
creatureDisplayString cr = show . take 1 . _soundsToInvestigate $ _crMemory cr
-- | isAsleep = "Z"
-- | isSuspicious = "?"
-- | otherwise = ""
-- where
-- isAsleep = _crAwakeLevel (_crPerception cr) == Asleep
-- imAwarenesses = _crAwarenessLevel (_crPerception cr)
-- isSuspicious = any f imAwarenesses && not (null imAwarenesses)
-- f (Suspicious _) = True
-- f _ = False
crDisplayAlert :: Creature -> String
crDisplayAlert cr
| isSuspicious = "?"
| isCognizant = "!"
| otherwise = "."
where
imAwarenesses = _crAwarenessLevel (_crPerception cr)
isSuspicious = any f imAwarenesses && not (null imAwarenesses)
isCognizant = any g imAwarenesses && not (null imAwarenesses)
f (Suspicious _) = True
f _ = False
g (Cognizant _) = True
g _ = False
crDisplayAwake :: Creature -> String
crDisplayAwake cr = case _crAwakeLevel (_crPerception cr) of
Comatose -> "-"
Asleep -> "Z"
Lethargic -> "L"
Vigilant -> "V"
Overstrung -> "O"
damageMod :: Creature -> Picture -> Picture
damageMod cr pic = piercingMod $ bluntScale pic
where
src/Dodge/Creature/ReaderUpdate.hs
+36 -12
View File
@@ -10,6 +10,7 @@ module Dodge.Creature.ReaderUpdate
, goToTarget
, flockACCR
, setMvPos
, setViewPos
)
where
import Dodge.Data
@@ -19,6 +20,7 @@ import Dodge.Creature.Test
import Dodge.Creature.Volition
import Dodge.Creature.Perception.Data
import Dodge.Base
import Dodge.Base.Collide
import Geometry
import FoldableHelp
@@ -31,7 +33,7 @@ import Data.Maybe
overrideMeleeCloseTargetR
:: Creature
-> Reader World Creature
overrideMeleeCloseTargetR cr = return $ maybe cr (tryMeleeAttack cr) (_crTarget cr)
overrideMeleeCloseTargetR cr = return $ maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
tryMeleeAttack :: Creature -> Creature -> Creature
tryMeleeAttack cr tcr
@@ -45,11 +47,17 @@ tryMeleeAttack cr tcr
cpos = _crPos cr
setMvPos :: Creature -> Reader World Creature
setMvPos cr = pure $ cr & crMvTarget .~ mpos
setMvPos cr = pure $ cr & crIntention . mvToPoint .~ mpos
where
mpos = (_crPos <$> _crTarget cr)
<|> _crMvTarget cr
<|> listToMaybe (_soundsToInvestigate $ _crMemory cr)
int = _crIntention cr
mpos = (_crPos <$> _targetCr int)
<|> _mvToPoint int
-- <|> listToMaybe (_soundsToInvestigate $ _crMemory cr)
setViewPos :: Creature -> Reader World Creature
setViewPos cr = pure $ cr & crIntention . viewPoint %~ (<|> mpos)
where
mpos = listToMaybe (_soundsToInvestigate $ _crMemory cr)
setTargetMv
:: (Creature -> Reader World (Maybe Creature)) -- ^ Function for determining target
@@ -59,10 +67,10 @@ setTargetMv targFunc cr = do
targ <- targFunc cr
case targ of
Nothing -> pure cr
Just crTarg -> pure $ cr & crMvTarget .~ Just (_crPos crTarg)
Just crTarg -> pure $ cr & crIntention . mvToPoint ?~ _crPos crTarg
flockACCR :: Creature -> Reader World Creature
flockACCR cr = do
case cr ^? crTarget . _Just of
case cr ^? crIntention . targetCr . _Just of
Nothing -> pure cr
Just tcr -> do
w <- ask
@@ -81,13 +89,29 @@ flockACCR cr = do
horShift = if isLHS tpos cpos (_crPos acr)
then r *.* horDir
else negate r *.* horDir
pure $ cr & crMvTarget .~ Just (tpos +.+ horShift)
pure $ cr & crIntention . mvToPoint ?~ tpos +.+ horShift
goToTarget :: Creature -> Reader World Creature
goToTarget cr = do
case cr ^? crMvTarget . _Just of
case cr ^? crIntention . mvToPoint . _Just of
Just p -> pure $ cr & crActionPlan . crAction .~ [PathTo p]
_ -> pure cr
_ -> viewTarget cr
viewTarget :: Creature -> Reader World Creature
viewTarget cr = do
w <- ask
case cr ^? crIntention . viewPoint . _Just of
Just p | hasLOSIndirect p (_crPos cr) w -> pure $ cr'
& crActionPlan . crAction %~ replaceNullWith (TurnToA p)
& crIntention . viewPoint .~ Nothing
| otherwise -> pure $ cr' & crActionPlan . crAction %~ replaceNullWith (PathTo p)
Nothing -> pure $ cr & crPerception . crAwakeLevel .~ Lethargic
where
cr' = cr & crPerception . crAwakeLevel .~ Vigilant
replaceNullWith :: a -> [a] -> [a]
replaceNullWith x [] = [x]
replaceNullWith _ xs = xs
doStrategyActionsR
:: Creature
@@ -138,5 +162,5 @@ listGuard (_,z) _ = z
targetYouWhenCognizantR :: Creature -> Reader World Creature
targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crPerception . crAwarenessLevel . ix 0 of
Just (Cognizant _) -> cr {_crTarget = Just $! _creatures w IM.! 0}
_ -> cr & crTarget .~ Nothing
Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures w IM.! 0
_ -> cr & crIntention . targetCr .~ Nothing
src/Dodge/Creature/SentinelAI.hs
+1 -1
View File
@@ -40,7 +40,7 @@ sentinelAI = sentinelExtraWatchUpdate
>=> reloadOverrideR
where
advanceShoot = DoImpulses [UseItem, MoveForward 3]
tcid cr = _crID <$> _crTarget cr
tcid cr = _crID <$> _targetCr (_crIntention cr)
lostest (w,cr) = maybe False (\cid -> canSee (_crID cr) cid w) (tcid cr)
sentinelFireType
src/Dodge/Creature/SetTarget.hs
+2 -2
View File
@@ -14,6 +14,6 @@ targetYouWhenCognizant
-> Creature
-> Creature
targetYouWhenCognizant w cr = case cr ^? crPerception . crAwarenessLevel . ix 0 of
Just (Cognizant _) -> cr & crTarget ?~ _creatures w IM.! 0
_ -> cr & crTarget .~ Nothing
Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures w IM.! 0
_ -> cr & crIntention . targetCr .~ Nothing
src/Dodge/Creature/Test.hs
+6 -6
View File
@@ -56,28 +56,28 @@ crIsAimingR :: Creature -> Reader World Bool
crIsAimingR cr = return $ _posture (_crStance cr) == Aiming
crHasTarget :: (World,Creature) -> Bool
crHasTarget (_,cr) = isJust $ cr ^? crTarget . _Just
crHasTarget (_,cr) = isJust $ cr ^? crIntention . targetCr . _Just
crHasTargetR :: Creature -> Reader World Bool
crHasTargetR cr = return $ isJust $ cr ^? crTarget . _Just
crHasTargetR cr = return $ isJust $ cr ^? crIntention . targetCr . _Just
crHasTargetLOS :: (World,Creature) -> Bool
crHasTargetLOS (w,cr) = case cr ^? crTarget . _Just of
crHasTargetLOS (w,cr) = case cr ^? crIntention . targetCr . _Just of
Just i -> crCanSeeCr i (w,cr)
Nothing -> False
crHasTargetLOSR :: Creature -> Reader World Bool
crHasTargetLOSR cr = reader $ \w -> case cr ^? crTarget . _Just of
crHasTargetLOSR cr = reader $ \w -> case cr ^? crIntention . targetCr . _Just of
Just i -> crCanSeeCr i (w,cr)
Nothing -> False
crSafeDistFromTarg :: Float -> (World,Creature) -> Bool
crSafeDistFromTarg d (_,cr) = case cr ^? crTarget . _Just of
crSafeDistFromTarg d (_,cr) = case cr ^? crIntention . targetCr . _Just of
Just tcr -> dist (_crPos cr) (_crPos tcr) > d
Nothing -> True
crSafeDistFromTargR :: Float -> Creature -> Reader World Bool
crSafeDistFromTargR d cr = return $ case cr ^? crTarget . _Just of
crSafeDistFromTargR d cr = return $ case cr ^? crIntention . targetCr . _Just of
Just tcr -> dist (_crPos cr) (_crPos tcr) > d
Nothing -> True
src/Dodge/Data.hs
+14 -5
View File
@@ -103,14 +103,14 @@ data World = World
, _selLocation :: Int
, _keyConfig :: KeyConfigSDL
, _config :: Configuration
, _sideEffects :: [PreloadData -> IO PreloadData]
, _doneSideEffects :: [PreloadData -> IO PreloadData]
, _sideEffects :: World -> IO World
, _debugFlags :: DebugFlags
, _inventoryMode :: InventoryMode
, _lClickHammer :: HammerPosition
, _radDistortion :: [(Point2,Point2,Point2,Float)]
, _gameRooms :: [GameRoom]
, _preloadData :: PreloadData
, _frameClock :: Int
}
data OptionScreenFlag = NormalOptions | GameOverOptions
data ScreenLayer
@@ -221,10 +221,15 @@ data Creature = Creature
, _crMemory :: MemoryState
, _crFaction :: Faction
, _crGroup :: CrGroup
, _crTarget :: Maybe Creature
, _crMvTarget :: Maybe Point2
, _crIntention :: Intention
, _crMvType :: CrMvType
}
data Intention = Intention
{ _targetCr :: Maybe Creature
, _mvToPoint :: Maybe Point2
, _viewPoint :: Maybe Point2
}
data CrMvType
= NoMvType
| ChaseMvType
@@ -580,7 +585,7 @@ data Impulse
| DropItem
-- | PickupNearby Int
-- | UseWorldObject Int
| Bark -- placeholder for various communication types
-- | Bark -- placeholder for various communication types
-- | UseIntrinsicAbility
| Melee Int
| ChangePosture Posture
@@ -612,6 +617,9 @@ data Action
| PathTo
{_pathToPoint :: Point2
}
| TurnToA
{_turnToAPoint :: Point2
}
-- | PickupItem
-- {_pickupItemID :: Int
-- }
@@ -737,6 +745,7 @@ makeLenses ''Impulse
makeLenses ''Action
makeLenses ''CrGroupParams
makeLenses ''CrMvType
makeLenses ''Intention
numColor :: Int -> Color
numColor 0 = toV4 (1,0,0,1)
numColor 1 = toV4 (0,1,0,1)
src/Dodge/Default.hs
+7 -2
View File
@@ -54,8 +54,7 @@ defaultCreature = Creature
, _crMemory = defaultCreatureMemory
, _crMeleeCooldown = 0
, _crFaction = NoFaction
, _crTarget = Nothing
, _crMvTarget= Nothing
, _crIntention = defaultIntention
, _crGroup = LoneWolf
, _crMvType = defaultAimMvType
}
@@ -86,6 +85,12 @@ defaultAudition :: Audition
defaultAudition = Ears
{ _auDist = \x -> x * x
}
defaultIntention :: Intention
defaultIntention = Intention
{ _targetCr = Nothing
, _mvToPoint = Nothing
, _viewPoint = Nothing
}
defaultChaseMvType :: CrMvType
defaultChaseMvType = ChaseMvType
{ _mvSpeed = 3
src/Dodge/Default/World.hs
+2 -2
View File
@@ -76,8 +76,7 @@ defaultWorld = World
, _selLocation = 0
, _keyConfig = defaultKeyConfigSDL
, _config = defaultConfig
, _sideEffects = []
, _doneSideEffects = []
, _sideEffects = return
, _debugFlags = defaultDebugFlags
, _inventoryMode = TopInventory
, _lClickHammer = HammerUp
@@ -86,6 +85,7 @@ defaultWorld = World
, _radDistortion = []
, _gameRooms = []
, _preloadData = DummyPdata -- hack TODO remove this
, _frameClock = 0
}
defaultDebugFlags :: DebugFlags
defaultDebugFlags = DebugFlags
src/Dodge/Event.hs
+5 -1
View File
@@ -65,9 +65,13 @@ handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World
handleResizeEvent sev w = Just
. set (config . windowX) (fromIntegral x)
. set (config . windowY) (fromIntegral y)
$ over sideEffects (pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y : )
$ over sideEffects up
w
where
up :: (World -> IO World) -> World -> IO World
up f w' = do
pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData w')
f $ w' & preloadData .~ pdata
x = fromIntegral x'
y = fromIntegral y'
V2 x' y' = windowSizeChangedEventSize sev
src/Dodge/Initialisation.hs
+3 -3
View File
@@ -9,7 +9,7 @@ import Dodge.Story
import Dodge.WorldEvent.Cloud
import Dodge.SoundLogic
import Dodge.SoundLogic.Synonyms
import Dodge.Creature.Perception
--import Dodge.Creature.Perception
import Geometry.Data
--import Dodge.GameRoom
--import Geometry
@@ -53,8 +53,8 @@ initialWorld = defaultWorld
, _worldState = M.empty
}
testStringInit :: World -> [String]
--testStringInit _ = []
testStringInit w = [show . length $ newSounds w]
testStringInit _ = []
--testStringInit w = [show . length $ newSounds w]
--testStringInit w = (show . _crPos $ _creatures w IM.! 0)
-- : (map show . _grBound . last $ sortOn _grName grs)
-- ++ closeRooms
src/Dodge/Menu.hs
+9 -5
View File
@@ -53,7 +53,8 @@ soundMenuOptions =
where
dec x = max 0 (x - 0.1)
inc x = min 1 (x + 0.1)
sw w = w & sideEffects %~ (setVol (_config w) : )
--sw w = w & sideEffects %~ (setVol (_config w) : )
sw w = w & sideEffects %~ setVol' (_config w)
master g = Just . (config . volume_master %~ g)
soundEffs g = Just . (config . volume_sound %~ g)
music g = Just . (config . volume_music %~ g)
@@ -70,7 +71,7 @@ popScreen :: World -> Maybe World
popScreen = Just . (menuLayers %~ tail)
writeConfig :: World -> World
writeConfig w = w & sideEffects %~ (saveConfig (_config w) :)
writeConfig w = w & sideEffects %~ saveConfig (_config w)
graphicsMenu :: ScreenLayer
graphicsMenu = OptionScreen
@@ -138,12 +139,15 @@ charToScode :: Char -> Scancode
charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
updateFramebufferSize :: World -> World
updateFramebufferSize w = w & sideEffects
%~ (pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y : )
updateFramebufferSize w = w & sideEffects %~ up
where
(x,y) = (round $ getWindowX w, round $ getWindowY w)
divRes = w ^. config . resolution_factor
up :: (World -> IO World) -> World -> IO World
up f w' = do
pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData w')
f $ w' & preloadData .~ pdata
levelMenu :: Int -> ScreenLayer
levelMenu x = OptionScreen
{ _scTitle = const $ "LEVEL "++ show x
src/Dodge/Room/Path.hs
+1 -3
View File
@@ -22,9 +22,7 @@ createPathGrid rm = rm
{ _rmPath = linksAndPath (_rmLinks rm) filterGrid }
where
filterGrid = filter (\p -> pairInPolys (_rmPolys rm) p && testCrossWalls outerWalls p) grid
grid = case shiftedGrid <$> minx <*> maxx <*> miny <*> maxy of
Nothing -> []
Just xs -> xs
grid = fromMaybe [] $ shiftedGrid <$> minx <*> maxx <*> miny <*> maxy
outerWalls = foldr cutPoly [] $ _rmPolys rm
outerPoints = map fst outerWalls
(minx, maxx, miny, maxy) = L.fold theFold outerPoints
src/Dodge/Update.hs
+1 -5
View File
@@ -35,12 +35,8 @@ import System.Random
--import Data.Bifunctor
update :: World -> World
update = functionalUpdate . pushSideEffects
update = (frameClock +~ 1) . functionalUpdate
pushSideEffects :: World -> World
pushSideEffects w = w
& sideEffects .~ []
& doneSideEffects .~ _sideEffects w
{- |
The update step.
For most menus the only way to change the world is using event handling. -}
src/Sound/Data.hs
+2 -2
View File
@@ -3,7 +3,7 @@ module Sound.Data
where
import qualified SDL.Mixer as Mix
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
--import qualified Data.Map.Strict as M
import Control.Lens
import Geometry.Data
import Data.Word (Word8)
@@ -16,7 +16,7 @@ data SoundStatus
| ToStart
deriving (Eq,Ord,Show)
data SoundData = SoundData
newtype SoundData = SoundData
{_loadedChunks :: IM.IntMap Mix.Chunk
}
data Sound = Sound
src/Tile.hs
+1 -1
View File
@@ -36,7 +36,7 @@ makeTileFromPoly poly z = Tile
{ _tilePoly = poly
, _tileZero = c
--, _tileXY = c +.+ xdir +.+ vNormal xdir
, _tileX = c +.+ (normalizeV $ (poly !! 1) -.- c)
, _tileX = c +.+ normalizeV ((poly !! 1) -.- c)
, _tileZ = z
}
where