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

Work towards making world read/showable

Browse Source
This commit is contained in:
justin
2022-07-22 11:16:12 +01:00
parent 6b69fc1684
commit 7fdb70dd1c
22 changed files with 223 additions and 218 deletions
Download Patch File Download Diff File Expand all files Collapse all files
appDodge/Main.hs
+4 -2
View File
@@ -2,6 +2,7 @@ module Main
( main
) where
import Loop
import Dodge.TestString
import Dodge.Data
import Dodge.StartNewGame
import Dodge.Initialisation
@@ -76,11 +77,12 @@ firstWorldLoad theConfig = do
pdata <- doPreload >>= applyWorldConfig theConfig
return $ startNewGame $ Universe
{_uvWorld = initialWorld
,_config = theConfig
,_uvConfig = theConfig
,_preloadData = pdata
,_menuLayers = []
,_savedWorlds = M.empty
,_keyConfig = theKeyConfig
, _uvTestString = testStringInit
}
theUpdateStep :: Universe -> IO Universe
@@ -107,7 +109,7 @@ doSideEffects u = do
u' <- _sideEffects w u
endTicks <- SDL.ticks
let lastFrameTicks = _frameTimer preData
when (debugOn Show_ms_frame $ _config u) $ void $ renderFoldable
when (debugOn Show_ms_frame $ _uvConfig u) $ void $ renderFoldable
(_pictureShaders $ _renderData preData)
(setDepth (-1)
. translate (-0.5) (-0.8) . scale 0.0005 0.0005
src/Dodge/CullBox.hs
+6 -4
View File
@@ -18,9 +18,11 @@ findBoundDists cfig w
hw = halfWidth cfig
hh = halfHeight cfig
updateBounds :: Configuration -> World -> World
updateBounds cfig w = w
& boundDist .~ bdists
& boundBox .~ map ( (+.+ _cameraCenter w) . rotateV (_cameraRot w) ) (rectNSWE n s w' e)
updateBounds :: Universe -> Universe
updateBounds uv = uv
& uvWorld . boundDist .~ bdists
& uvWorld . boundBox .~ map ( (+.+ _cameraCenter w) . rotateV (_cameraRot w) ) (rectNSWE n s w' e)
where
w = _uvWorld uv
cfig = _uvConfig uv
bdists@(n,s,e,w') = findBoundDists cfig w
src/Dodge/Data.hs
+97 -98
View File
@@ -164,106 +164,105 @@ type CRUpdate = Creature -> World -> (World -> World, Maybe Creature)
type CRUpdate' = Creature -> World -> (World -> World, Creature)
data Universe = Universe
{ _uvWorld :: World
, _preloadData :: PreloadData
, _menuLayers :: [ScreenLayer]
, _savedWorlds :: M.Map SaveSlot World
, _keyConfig :: KeyConfigSDL
, _config :: Configuration
{ _uvWorld :: World
, _preloadData :: PreloadData
, _menuLayers :: [ScreenLayer]
, _savedWorlds :: M.Map SaveSlot World
, _keyConfig :: KeyConfigSDL
, _uvConfig :: Configuration
, _uvTestString :: Universe -> [String]
}
data World = World
{ _keys :: S.Set Scancode
, _mouseButtons :: M.Map MouseButton Bool
, _mousePos :: Point2
, _cameraCenter :: Point2
, _cameraRot :: Float
, _cameraZoom :: Float -- smaller values zoom out
, _itemZoom :: Float
, _defaultZoom :: Float
, _cameraViewFrom :: Point2
, _viewDistance :: Float
, _boundBox :: [Point2]
, _boundDist :: (Float,Float,Float,Float) -- NSEW, S and W negative
, _creatures :: IM.IntMap Creature
, _crZoning :: Zoning IM.IntMap Creature
, _creatureGroups :: IM.IntMap CrGroupParams
, _itemPositions :: IM.IntMap ItemPos
, _clouds :: [Cloud]
, _clZoning :: Zoning [] Cloud
, _gusts :: IM.IntMap Gust
, _gsZoning :: Zoning IM.IntMap Gust
, _props :: IM.IntMap Prop
, _projectiles :: IM.IntMap Proj
, _instantBullets :: [Bullet]
, _bullets :: [Bullet]
, _instantParticles :: [Particle]
, _particles :: [Particle]
, _radarSweeps :: [RadarSweep]
, _energyBalls :: [EnergyBall]
, _posEvents :: [PosEvent]
, _flames :: [Flame]
, _sparks :: [Spark]
, _radarBlips :: [RadarBlip]
, _flares :: [Flare]
, _newBeams :: WorldBeams
, _beams :: WorldBeams
, _walls :: IM.IntMap Wall
, _wallDamages :: IM.IntMap [Damage]
, _doors :: IM.IntMap Door
, _machines :: IM.IntMap Machine
, _terminals :: IM.IntMap Terminal
, _magnets :: IM.IntMap Magnet
, _blocks :: IM.IntMap Block
, _coordinates :: IM.IntMap Point2
, _triggers :: IM.IntMap Bool
, _wlZoning :: Zoning IM.IntMap Wall
, _floorItems :: IM.IntMap FloorItem
, _floorTiles :: [(Point3,Point3)]
, _randGen :: StdGen
, _testString :: Configuration -> World -> [String]
, _modifications :: IM.IntMap Modification
, _yourID :: Int
, _worldEvents :: World -> World
, _delayedEvents :: [(Int,World -> World)]
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _toPlaySounds :: M.Map SoundOrigin Sound
, _playingSounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Picture
, _foregroundShapes :: IM.IntMap ForegroundShape
, _corpses :: IM.IntMap Corpse
, _clickMousePos :: Point2
, _pathGraph :: Gr Point2 PathEdge
-- , _pathGraphP :: S.Set (Point2,Point2)
, _pnZoning :: Zoning [] (Int,Point2)
, _peZoning :: Zoning [] (Int,Int,PathEdge)
, _hud :: HUD
, _lightSources :: IM.IntMap LightSource
, _tempLightSources :: [TempLightSource]
, _closeObjects :: [Either FloorItem Button]
, _rbOptions :: RightButtonOptions
, _seenLocations :: IM.IntMap (World -> Point2,String)
, _selLocation :: Int
, _sideEffects :: Universe -> IO Universe
, _distortions :: [Distortion]
, _worldBounds :: Bounds
, _gameRooms :: [GameRoom] -- consider using an IntMap
, _roomClipping :: [ConvexPoly]
, _maybeWorld :: Maybe' World
, _rewindWorlds :: [World]
, _timeFlow :: TimeFlowStatus
, _worldClock :: Int
, _hammers :: M.Map WorldHammer HammerPosition
, _backspaceTimer :: Int
, _genParams :: GenParams
, _genPlacements :: IM.IntMap [(Placement,Int)]
, _genRooms :: IM.IntMap Room
, _deathDelay :: Maybe Int
, _testFloat :: Float
, _lLine :: (Point2,Point2)
, _rLine :: (Point2,Point2)
, _lSelect :: Point2
, _rSelect :: Point2
{ _keys :: S.Set Scancode
, _mouseButtons :: M.Map MouseButton Bool
, _mousePos :: Point2
, _cameraCenter :: Point2
, _cameraRot :: Float
, _cameraZoom :: Float -- smaller values zoom out
, _itemZoom :: Float
, _defaultZoom :: Float
, _cameraViewFrom :: Point2
, _viewDistance :: Float
, _boundBox :: [Point2]
, _boundDist :: (Float,Float,Float,Float) -- NSEW, S and W negative
, _creatures :: IM.IntMap Creature
, _crZoning :: Zoning IM.IntMap Creature
, _creatureGroups :: IM.IntMap CrGroupParams
, _itemPositions :: IM.IntMap ItemPos
, _clouds :: [Cloud]
, _clZoning :: Zoning [] Cloud
, _gusts :: IM.IntMap Gust
, _gsZoning :: Zoning IM.IntMap Gust
, _props :: IM.IntMap Prop
, _projectiles :: IM.IntMap Proj
, _instantBullets :: [Bullet]
, _bullets :: [Bullet]
, _instantParticles :: [Particle]
, _particles :: [Particle]
, _radarSweeps :: [RadarSweep]
, _energyBalls :: [EnergyBall]
, _posEvents :: [PosEvent]
, _flames :: [Flame]
, _sparks :: [Spark]
, _radarBlips :: [RadarBlip]
, _flares :: [Flare]
, _newBeams :: WorldBeams
, _beams :: WorldBeams
, _walls :: IM.IntMap Wall
, _wallDamages :: IM.IntMap [Damage]
, _doors :: IM.IntMap Door
, _machines :: IM.IntMap Machine
, _terminals :: IM.IntMap Terminal
, _magnets :: IM.IntMap Magnet
, _blocks :: IM.IntMap Block
, _coordinates :: IM.IntMap Point2
, _triggers :: IM.IntMap Bool
, _wlZoning :: Zoning IM.IntMap Wall
, _floorItems :: IM.IntMap FloorItem
, _floorTiles :: [(Point3,Point3)]
, _randGen :: StdGen
, _modifications :: IM.IntMap Modification
, _yourID :: Int
, _worldEvents :: World -> World
, _delayedEvents :: [(Int,World -> World)]
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _toPlaySounds :: M.Map SoundOrigin Sound
, _playingSounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Picture
, _foregroundShapes :: IM.IntMap ForegroundShape
, _corpses :: IM.IntMap Corpse
, _clickMousePos :: Point2
, _pathGraph :: Gr Point2 PathEdge
, _pnZoning :: Zoning [] (Int,Point2)
, _peZoning :: Zoning [] (Int,Int,PathEdge)
, _hud :: HUD
, _lightSources :: IM.IntMap LightSource
, _tempLightSources :: [TempLightSource]
, _closeObjects :: [Either FloorItem Button]
, _rbOptions :: RightButtonOptions
, _seenLocations :: IM.IntMap (World -> Point2,String)
, _selLocation :: Int
, _sideEffects :: Universe -> IO Universe
, _distortions :: [Distortion]
, _worldBounds :: Bounds
, _gameRooms :: [GameRoom] -- consider using an IntMap
, _roomClipping :: [ConvexPoly]
, _maybeWorld :: Maybe' World
, _rewindWorlds :: [World]
, _timeFlow :: TimeFlowStatus
, _worldClock :: Int
, _hammers :: M.Map WorldHammer HammerPosition
, _backspaceTimer :: Int
, _genParams :: GenParams
, _genPlacements :: IM.IntMap [(Placement,Int)]
, _genRooms :: IM.IntMap Room
, _deathDelay :: Maybe Int
, _testFloat :: Float
, _lLine :: (Point2,Point2)
, _rLine :: (Point2,Point2)
, _lSelect :: Point2
, _rSelect :: Point2
}
data WorldHammer
= SubInvHam
src/Dodge/Data/ActionPlan.hs
+2 -4
View File
@@ -4,13 +4,11 @@
module Dodge.Data.ActionPlan where
import Dodge.Creature.Stance.Data
import Dodge.Data.CreatureEffect
import Dodge.ShortShow
--import Dodge.ShortShow
import Control.Lens
import Geometry.Data
import Control.Monad.State
import System.Random
import Sound.Data
import GHC.Generics
--import GHC.Generics
data ActionPlan
= Inanimate
| ActionPlan
src/Dodge/Data/Creature.hs
-1
View File
@@ -17,7 +17,6 @@ import Dodge.Creature.Memory.Data
import Dodge.Creature.Stance.Data
import Dodge.Creature.State.Data
import Dodge.Equipment.Data
import ShapePicture
import Geometry.Data
import qualified IntMapHelp as IM
import qualified Data.Map.Strict as M
src/Dodge/Debug/Terminal.hs
+1 -1
View File
@@ -30,7 +30,7 @@ applyTerminalString ss = case ss of
applyTerminalCommand :: String -> Universe -> Universe
applyTerminalCommand s = case s of
"NOCLIP" -> config . debug_booleans . at Noclip %~ toggleJust
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
"LOADME" -> (uvWorld . creatures . ix 0 . crInv .~ stackedInventory)
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
"LM" -> applyTerminalCommand "LOADME"
src/Dodge/Default/Creature.hs
-5
View File
@@ -98,11 +98,6 @@ defaultChaseMvType = CrMvType
, _mvTurnJit = 0.2
, _mvAimSpeed = FloatAbsCheckGreaterLess (pi/8) 0.2 0.01
}
where
g x | x > pi/8 = 0.2
| otherwise = 0.01
f x | x > pi / 4 = 0.2
| otherwise = 0.05
defaultAimMvType :: CrMvType
defaultAimMvType = CrMvType
{ _mvSpeed = 3
src/Dodge/Default/World.hs
-1
View File
@@ -66,7 +66,6 @@ defaultWorld = World
, _floorTiles = []
, _randGen = mkStdGen 2
, _mousePos = V2 0 0
, _testString = const . const []
, _yourID = 0
, _worldEvents = id
, _delayedEvents = []
src/Dodge/Event.hs
+6 -6
View File
@@ -49,7 +49,7 @@ handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
(fromIntegral x - 0.5*_windowX cfig)
(0.5*_windowY cfig - fromIntegral y)
where
cfig = _config u
cfig = _uvConfig u
P (V2 x y) = mouseMotionEventPos mmev
handleMouseButtonEvent :: MouseButtonEventData -> World -> World
@@ -62,8 +62,8 @@ handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
{- | Sets window position in config. -}
handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe
handleWindowMoveEvent mev = Just
. (config . windowPosX .~ fromIntegral x)
. (config . windowPosY .~ fromIntegral y)
. (uvConfig . windowPosX .~ fromIntegral x)
. (uvConfig . windowPosY .~ fromIntegral y)
where
P (V2 x y) = windowMovedEventPosition mev
@@ -72,14 +72,14 @@ handleWindowMoveEvent mev = Just
-- later may be a good idea
handleResizeEvent :: WindowSizeChangedEventData -> Universe -> IO (Maybe Universe)
handleResizeEvent sev u = return . Just $ u
& config . windowX .~ fromIntegral x
& config . windowY .~ fromIntegral y
& uvConfig . windowX .~ fromIntegral x
& uvConfig . windowY .~ fromIntegral y
& uvWorld . sideEffects %~ sideEffectUpdatePreload divRes x y
where
x = fromIntegral x'
y = fromIntegral y'
V2 x' y' = windowSizeChangedEventSize sev
divRes = resFactorNum $ u ^. config . graphics_resolution_factor
divRes = resFactorNum $ u ^. uvConfig . graphics_resolution_factor
handleMouseWheelEvent :: MouseWheelEventData -> Universe -> Maybe Universe
handleMouseWheelEvent mwev w = case _menuLayers w of
src/Dodge/Event/Menu.hs
+1 -1
View File
@@ -48,7 +48,7 @@ optionListToEffects defaulteff sc mops u = case sc of
where
f x | x > length mops = 0
| otherwise = x
mlines = availableMenuLines $ _config u
mlines = availableMenuLines $ _uvConfig u
menuOptionToEffects :: MenuOption -> [(Scancode,Universe -> IO (Maybe Universe))]
menuOptionToEffects Toggle {_moKey = k, _moEff = eff} = [(k,eff)]
src/Dodge/Initialisation.hs
-5
View File
@@ -28,7 +28,6 @@ initialWorld = defaultWorld
, _floorItems = IM.empty
, _randGen = mkStdGen 2
, _mousePos = V2 0 0
, _testString = testStringInit
, _yourID = 0
, _sideEffects = return
, _worldEvents = soundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing
@@ -40,7 +39,3 @@ initialWorld = defaultWorld
-- , _menuLayers = [TerminalScreen 300 rezText']
}
testStringInit :: Configuration -> World -> [String]
testStringInit _ _ = []
--testStringInit = map (show . _drStatus) . IM.elems . _doors
--testStringInit = const . const []
src/Dodge/Menu.hs
+6 -6
View File
@@ -86,8 +86,8 @@ debugMenuOptions = zipWith ($)
$ map Scancode [4..]
where
f :: DebugBool -> Scancode -> MenuOption
f bd = Toggle (return . Just . (config . debug_booleans . at bd %~ toggleJust))
(Right . g bd . (^? config . debug_booleans . ix bd))
f bd = Toggle (return . Just . (uvConfig . debug_booleans . at bd %~ toggleJust))
(Right . g bd . (^? uvConfig . debug_booleans . ix bd))
g bd Nothing = (show bd, "False")
g bd _ = (show bd, "True")
-- zipWith ($)
@@ -133,14 +133,14 @@ soundMenuOptions =
(change dec stype)
scod2
(change inc stype)
(\w -> Right (str , leftPad 2 '.' $ show (round $ 10 * voltype (_config w)::Int)))
change g vt = return . Just . (config . vt %~ g) . sw
(\w -> Right (str , leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w)::Int)))
change g vt = return . Just . (uvConfig . vt %~ g) . sw
dec x = max 0 (x - 0.1)
inc x = min 1 (x + 0.1)
sw w = w & uvWorld . sideEffects %~ setVolThen (_config w)
sw w = w & uvWorld . sideEffects %~ setVolThen (_uvConfig w)
writeConfig :: Universe -> Universe
writeConfig w = w & uvWorld . sideEffects %~ saveConfig (_config w)
writeConfig w = w & uvWorld . sideEffects %~ saveConfig (_uvConfig w)
graphicsMenu :: ScreenLayer
graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
src/Dodge/Menu/OptionType.hs
+4 -4
View File
@@ -5,12 +5,12 @@ import Dodge.Menu.PushPop
import Control.Lens
makeBoolOption lns t = Toggle
(return . Just . (config . lns #%~ not))
(\u -> Right (t , show (u ^# config . lns)))
(return . Just . (uvConfig . lns #%~ not))
(\u -> Right (t , show (u ^# uvConfig . lns)))
makeEnumOption lns str sideeff = Toggle
(\u -> Just <$> sideeff (u & config . lns #%~ cycleEnum) )
(\u -> Right (str , show (u ^# config . lns)) )
(\u -> Just <$> sideeff (u & uvConfig . lns #%~ cycleEnum) )
(\u -> Right (str , show (u ^# uvConfig . lns)) )
makeSubmenuOption submenu t = Toggle (pushScreen submenu) (const t)
src/Dodge/PreloadData.hs
+2 -2
View File
@@ -25,5 +25,5 @@ updateFramebufferSize :: Universe -> IO Universe
updateFramebufferSize u = updatePreload divRes x y u
where
(x,y) = (round $ _windowX cfig, round $ _windowY cfig)
cfig = _config u
divRes = resFactorNum $ u ^. config . graphics_resolution_factor
cfig = _uvConfig u
divRes = resFactorNum $ u ^. uvConfig . graphics_resolution_factor
src/Dodge/Render.hs
+3 -3
View File
@@ -33,7 +33,7 @@ doDrawing :: RenderData -> Universe -> IO Word32
doDrawing pdata u = do
sTicks <- SDL.ticks
let w = _uvWorld u
cfig = _config u
cfig = _uvConfig u
rot = _cameraRot w
camzoom = _cameraZoom w
trans = _cameraCenter w
@@ -160,7 +160,7 @@ doDrawing pdata u = do
nWalls
nSilIndices
nIndices
(_graphics_object_shadows $ _config u)
(_graphics_object_shadows $ _uvConfig u)
(snd $ snd $ _fboBase pdata)
colorMask $= Color4 Enabled Enabled Enabled Enabled
clearColor $= Color4 0 0 0 0
@@ -216,7 +216,7 @@ doDrawing pdata u = do
blend $= Enabled
bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
createLightMap pdata lightPoints nWalls nSilIndices nIndices
(_graphics_object_shadows $ _config u)
(_graphics_object_shadows $ _uvConfig u)
(snd $ snd $ _fboCloud pdata)
colorMask $= Color4 Enabled Enabled Enabled Enabled
clearColor $= Color4 0 0 0 0
src/Dodge/Render/HUD.hs
+12 -6
View File
@@ -32,18 +32,24 @@ import qualified Data.Text as T
--import Data.List
--import Data.Bifunctor
hudDrawings :: Configuration -> World -> Picture
hudDrawings cfig w = case _hudElement $ _hud w of
hudDrawings :: Universe -> Picture
hudDrawings uv = case _hudElement $ _hud w of
DisplayCarte -> drawCarte cfig w
DisplayInventory subinv -> drawInGameHUD cfig w
DisplayInventory subinv -> drawInGameHUD uv
<> subInventoryDisplay subinv cfig w
where
w = _uvWorld uv
cfig = _uvConfig uv
drawInGameHUD :: Configuration -> World -> Picture
drawInGameHUD cfig w = pictures
drawInGameHUD :: Universe -> Picture
drawInGameHUD uv = pictures
[ winScale cfig . dShadCol white $ displayHP 0 cfig w
, listPicturesAt (halfWidth cfig) 0 cfig $ map text (_testString w cfig w)
, listPicturesAt (halfWidth cfig) 0 cfig $ map text (_uvTestString uv uv)
, inventoryDisplay cfig w
]
where
w = _uvWorld uv
cfig = _uvConfig uv
inventoryDisplay :: Configuration -> World -> Picture
inventoryDisplay cfig w = listPicturesAt 0 0 cfig invlist
src/Dodge/Render/MenuScreen.hs
+2 -2
View File
@@ -18,7 +18,7 @@ menuScreen w screen = case screen of
(WaitScreen sf _) -> drawOptions w (sf w) [] 0 ""
(InputScreen inputstr help) -> drawOptions w ('>':T.unpack inputstr) [] 0 help
(DisplayScreen sd ) -> sd w
(ColumnsScreen titf pairs) -> drawTwoColumnsScreen (_config w) (titf w) pairs
(ColumnsScreen titf pairs) -> drawTwoColumnsScreen (_uvConfig w) (titf w) pairs
--displayStringList :: World -> [String] -> Picture
--displayStringList w ss = pictures
@@ -76,7 +76,7 @@ drawOptions u title ops off footer = pictures $
notInvisible _ = True
hh = halfHeight cfig
hw = halfWidth cfig
cfig = _config u
cfig = _uvConfig u
optionValueOffset :: Universe -> MenuOption -> Int
optionValueOffset u mo = case _moString mo u of
src/Dodge/Render/Picture.hs
+2 -2
View File
@@ -13,13 +13,13 @@ import Picture
fixedCoordPictures :: Universe -> Picture
fixedCoordPictures u = case _menuLayers u of
[] -> pictures
[ hudDrawings cfig w
[ hudDrawings u
, customMouseCursor cfig w
]
(lay:_) -> setDepth (-1) . winScale cfig $ menuScreen u lay
where
w = _uvWorld u
cfig = _config u
cfig = _uvConfig u
customMouseCursor :: Configuration -> World -> Picture
customMouseCursor cfig w = winScale cfig
src/Dodge/TestString.hs
+7
View File
@@ -0,0 +1,7 @@
module Dodge.TestString where
import Dodge.Data
testStringInit :: Universe -> [String]
testStringInit _ = []
--testStringInit = map (show . _drStatus) . IM.elems . _doors
--testStringInit = const . const []
src/Dodge/Update.hs
+48 -50
View File
@@ -56,61 +56,59 @@ updateUniverse u = case _menuLayers u of
. updateLightSources
. updateClouds )
(_ : _) -> u
[] -> over uvWorld (functionalUpdate (_config u)) u
[] -> functionalUpdate u
{- | The update step. -}
functionalUpdate :: Configuration -> World -> World
functionalUpdate cfig w = checkEndGame
functionalUpdate :: Universe -> Universe
functionalUpdate w = over uvWorld checkEndGame
-- . updateRandGen
. (mouseButtons . each .~ True) -- to determine if the mouse button is held
. (worldClock +~ 1)
. updateWorldSelect
. doRewind
. (hammers . each %~ moveHammerUp)
. updateDistortions
. updateCreatureSoundPositions
. ppEvents
. updateCamera cfig
. colCrsWalls cfig
. simpleCrSprings
. zoneCreatures
. updateIMl _doors _drMech
. updateDelayedEvents
. resetWorldEvents
. dbArg _worldEvents
. updateIMl _modifications _mdUpdate
. updateSparks
. updateRadarSweeps
. updatePosEvents
. updateFlames
. updateEnergyBalls
. updateParticles
. updateBullets
. updateRadarBlips
. updateFlares
. updateBeams
. updateIMl _props _pjUpdate
. updateIMl' _projectiles updateProjectile
. updateLightSources
. updateClouds
. updateGusts
. zoneClouds
. updateMIM magnets _mgUpdate
. updateIMl' _terminals tmUpdate
. over uvWorld (mouseButtons . each .~ True) -- to determine if the mouse button is held
. over uvWorld (worldClock +~ 1)
. over uvWorld updateWorldSelect
. over uvWorld doRewind
. over uvWorld (hammers . each %~ moveHammerUp)
. over uvWorld updateDistortions
. over uvWorld updateCreatureSoundPositions
. over uvWorld ppEvents
. updateCamera
. colCrsWalls
. over uvWorld (simpleCrSprings )
. over uvWorld (zoneCreatures )
. over uvWorld (updateIMl _doors _drMech )
. over uvWorld (updateDelayedEvents )
. over uvWorld (resetWorldEvents )
. over uvWorld (dbArg _worldEvents )
. over uvWorld (updateIMl _modifications _mdUpdate )
. over uvWorld (updateSparks )
. over uvWorld (updateRadarSweeps )
. over uvWorld (updatePosEvents )
. over uvWorld (updateFlames )
. over uvWorld (updateEnergyBalls )
. over uvWorld (updateParticles )
. over uvWorld (updateBullets )
. over uvWorld (updateRadarBlips )
. over uvWorld (updateFlares )
. over uvWorld (updateBeams )
. over uvWorld (updateIMl _props _pjUpdate )
. over uvWorld (updateIMl' _projectiles updateProjectile)
. over uvWorld (updateLightSources )
. over uvWorld (updateClouds )
. over uvWorld (updateGusts )
. over uvWorld (zoneClouds )
. over uvWorld (updateMIM magnets _mgUpdate )
. over uvWorld (updateIMl' _terminals tmUpdate )
-- . updateIMl _machines mcChooseUpdate
. updateIMl' _machines updateMachine
. updateIMl' _creatures updateCreature
. over uvWorld (updateIMl' _machines updateMachine )
. over uvWorld (updateIMl' _creatures updateCreature )
-- creatures should be updated early so that crOldPos is set before any position change
. over creatures (fmap setOldPos)
. updateCreatureGroups
-- . updateBlocks
. updateWallDamages
. updateSeenWalls
-- . (youHammerPosition %~ moveHammerUp)
. updateTerminal
. updateRBList
. updateBounds cfig -- where should this go? next to update camera?
$ updateCloseObjects w
. over (uvWorld . creatures) (fmap setOldPos)
. over uvWorld updateCreatureGroups
. over uvWorld updateWallDamages
. over uvWorld updateSeenWalls
. over uvWorld updateTerminal
. over uvWorld updateRBList
. updateBounds -- where should this go? next to update camera?
$ over uvWorld updateCloseObjects w
zoneClouds :: World -> World
zoneClouds w = w
src/Dodge/Update/Camera.hs
+18 -13
View File
@@ -33,20 +33,25 @@ import qualified Streaming.Prelude as S
import Streaming
{- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
update where your avatar's view is from. -}
updateCamera :: Configuration -> World -> World
updateCamera cfig = setViewDistance cfig
. moveZoomCamera cfig
. updateScopeZoom
. rotateCamera cfig
moveZoomCamera :: Configuration -> World -> World
moveZoomCamera cfig w = w
& cameraCenter .~ newcen
& cameraViewFrom .~ newvf
& cameraZoom .~ newzoom
& defaultZoom .~ newDefaultZoom
& itemZoom .~ newItemZoom
updateCamera :: Universe -> Universe
updateCamera uv = uv
& over uvWorld (setViewDistance cfig )
& moveZoomCamera
& over uvWorld (updateScopeZoom )
& over uvWorld (rotateCamera cfig )
where
cfig = _uvConfig uv
moveZoomCamera :: Universe -> Universe
moveZoomCamera uv = uv
& uvWorld . cameraCenter .~ newcen
& uvWorld . cameraViewFrom .~ newvf
& uvWorld . cameraZoom .~ newzoom
& uvWorld . defaultZoom .~ newDefaultZoom
& uvWorld . itemZoom .~ newItemZoom
where
cfig = _uvConfig uv
w = _uvWorld uv
cpos =_crPos (you w)
newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
vfoffset = do
src/Dodge/WallCreatureCollisions.hs
+2 -2
View File
@@ -20,8 +20,8 @@ import Control.Lens
import qualified Streaming.Prelude as S
colCrsWalls :: Configuration -> World -> World
colCrsWalls cfig w = w & creatures %~ fmap (noclipCheck cfig w)
colCrsWalls :: Universe -> Universe
colCrsWalls uv = uv & uvWorld . creatures %~ fmap (noclipCheck (_uvConfig uv) (_uvWorld uv))
noclipCheck :: Configuration -> World -> Creature -> Creature
noclipCheck cfig w c