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 ( main
) where ) where
import Loop import Loop
import Dodge.TestString
import Dodge.Data import Dodge.Data
import Dodge.StartNewGame import Dodge.StartNewGame
import Dodge.Initialisation import Dodge.Initialisation
@@ -76,11 +77,12 @@ firstWorldLoad theConfig = do
pdata <- doPreload >>= applyWorldConfig theConfig pdata <- doPreload >>= applyWorldConfig theConfig
return $ startNewGame $ Universe return $ startNewGame $ Universe
{_uvWorld = initialWorld {_uvWorld = initialWorld
,_config = theConfig ,_uvConfig = theConfig
,_preloadData = pdata ,_preloadData = pdata
,_menuLayers = [] ,_menuLayers = []
,_savedWorlds = M.empty ,_savedWorlds = M.empty
,_keyConfig = theKeyConfig ,_keyConfig = theKeyConfig
, _uvTestString = testStringInit
} }
theUpdateStep :: Universe -> IO Universe theUpdateStep :: Universe -> IO Universe
@@ -107,7 +109,7 @@ doSideEffects u = do
u' <- _sideEffects w u u' <- _sideEffects w u
endTicks <- SDL.ticks endTicks <- SDL.ticks
let lastFrameTicks = _frameTimer preData 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) (_pictureShaders $ _renderData preData)
(setDepth (-1) (setDepth (-1)
. translate (-0.5) (-0.8) . scale 0.0005 0.0005 . 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 hw = halfWidth cfig
hh = halfHeight cfig hh = halfHeight cfig
updateBounds :: Configuration -> World -> World updateBounds :: Universe -> Universe
updateBounds cfig w = w updateBounds uv = uv
& boundDist .~ bdists & uvWorld . boundDist .~ bdists
& boundBox .~ map ( (+.+ _cameraCenter w) . rotateV (_cameraRot w) ) (rectNSWE n s w' e) & uvWorld . boundBox .~ map ( (+.+ _cameraCenter w) . rotateV (_cameraRot w) ) (rectNSWE n s w' e)
where where
w = _uvWorld uv
cfig = _uvConfig uv
bdists@(n,s,e,w') = findBoundDists cfig w bdists@(n,s,e,w') = findBoundDists cfig w
src/Dodge/Data.hs
+2 -3
View File
@@ -169,7 +169,8 @@ data Universe = Universe
, _menuLayers :: [ScreenLayer] , _menuLayers :: [ScreenLayer]
, _savedWorlds :: M.Map SaveSlot World , _savedWorlds :: M.Map SaveSlot World
, _keyConfig :: KeyConfigSDL , _keyConfig :: KeyConfigSDL
, _config :: Configuration , _uvConfig :: Configuration
, _uvTestString :: Universe -> [String]
} }
data World = World data World = World
{ _keys :: S.Set Scancode { _keys :: S.Set Scancode
@@ -220,7 +221,6 @@ data World = World
, _floorItems :: IM.IntMap FloorItem , _floorItems :: IM.IntMap FloorItem
, _floorTiles :: [(Point3,Point3)] , _floorTiles :: [(Point3,Point3)]
, _randGen :: StdGen , _randGen :: StdGen
, _testString :: Configuration -> World -> [String]
, _modifications :: IM.IntMap Modification , _modifications :: IM.IntMap Modification
, _yourID :: Int , _yourID :: Int
, _worldEvents :: World -> World , _worldEvents :: World -> World
@@ -234,7 +234,6 @@ data World = World
, _corpses :: IM.IntMap Corpse , _corpses :: IM.IntMap Corpse
, _clickMousePos :: Point2 , _clickMousePos :: Point2
, _pathGraph :: Gr Point2 PathEdge , _pathGraph :: Gr Point2 PathEdge
-- , _pathGraphP :: S.Set (Point2,Point2)
, _pnZoning :: Zoning [] (Int,Point2) , _pnZoning :: Zoning [] (Int,Point2)
, _peZoning :: Zoning [] (Int,Int,PathEdge) , _peZoning :: Zoning [] (Int,Int,PathEdge)
, _hud :: HUD , _hud :: HUD
src/Dodge/Data/ActionPlan.hs
+2 -4
View File
@@ -4,13 +4,11 @@
module Dodge.Data.ActionPlan where module Dodge.Data.ActionPlan where
import Dodge.Creature.Stance.Data import Dodge.Creature.Stance.Data
import Dodge.Data.CreatureEffect import Dodge.Data.CreatureEffect
import Dodge.ShortShow --import Dodge.ShortShow
import Control.Lens import Control.Lens
import Geometry.Data import Geometry.Data
import Control.Monad.State
import System.Random
import Sound.Data import Sound.Data
import GHC.Generics --import GHC.Generics
data ActionPlan data ActionPlan
= Inanimate = Inanimate
| ActionPlan | 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.Stance.Data
import Dodge.Creature.State.Data import Dodge.Creature.State.Data
import Dodge.Equipment.Data import Dodge.Equipment.Data
import ShapePicture
import Geometry.Data import Geometry.Data
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import qualified Data.Map.Strict as M 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 :: String -> Universe -> Universe
applyTerminalCommand s = case s of 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) "LOADME" -> (uvWorld . creatures . ix 0 . crInv .~ stackedInventory)
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
"LM" -> applyTerminalCommand "LOADME" "LM" -> applyTerminalCommand "LOADME"
src/Dodge/Default/Creature.hs
-5
View File
@@ -98,11 +98,6 @@ defaultChaseMvType = CrMvType
, _mvTurnJit = 0.2 , _mvTurnJit = 0.2
, _mvAimSpeed = FloatAbsCheckGreaterLess (pi/8) 0.2 0.01 , _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
defaultAimMvType = CrMvType defaultAimMvType = CrMvType
{ _mvSpeed = 3 { _mvSpeed = 3
src/Dodge/Default/World.hs
-1
View File
@@ -66,7 +66,6 @@ defaultWorld = World
, _floorTiles = [] , _floorTiles = []
, _randGen = mkStdGen 2 , _randGen = mkStdGen 2
, _mousePos = V2 0 0 , _mousePos = V2 0 0
, _testString = const . const []
, _yourID = 0 , _yourID = 0
, _worldEvents = id , _worldEvents = id
, _delayedEvents = [] , _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) (fromIntegral x - 0.5*_windowX cfig)
(0.5*_windowY cfig - fromIntegral y) (0.5*_windowY cfig - fromIntegral y)
where where
cfig = _config u cfig = _uvConfig u
P (V2 x y) = mouseMotionEventPos mmev P (V2 x y) = mouseMotionEventPos mmev
handleMouseButtonEvent :: MouseButtonEventData -> World -> World handleMouseButtonEvent :: MouseButtonEventData -> World -> World
@@ -62,8 +62,8 @@ handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
{- | Sets window position in config. -} {- | Sets window position in config. -}
handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe
handleWindowMoveEvent mev = Just handleWindowMoveEvent mev = Just
. (config . windowPosX .~ fromIntegral x) . (uvConfig . windowPosX .~ fromIntegral x)
. (config . windowPosY .~ fromIntegral y) . (uvConfig . windowPosY .~ fromIntegral y)
where where
P (V2 x y) = windowMovedEventPosition mev P (V2 x y) = windowMovedEventPosition mev
@@ -72,14 +72,14 @@ handleWindowMoveEvent mev = Just
-- later may be a good idea -- later may be a good idea
handleResizeEvent :: WindowSizeChangedEventData -> Universe -> IO (Maybe Universe) handleResizeEvent :: WindowSizeChangedEventData -> Universe -> IO (Maybe Universe)
handleResizeEvent sev u = return . Just $ u handleResizeEvent sev u = return . Just $ u
& config . windowX .~ fromIntegral x & uvConfig . windowX .~ fromIntegral x
& config . windowY .~ fromIntegral y & uvConfig . windowY .~ fromIntegral y
& uvWorld . sideEffects %~ sideEffectUpdatePreload divRes x y & uvWorld . sideEffects %~ sideEffectUpdatePreload divRes x y
where where
x = fromIntegral x' x = fromIntegral x'
y = fromIntegral y' y = fromIntegral y'
V2 x' y' = windowSizeChangedEventSize sev 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 :: MouseWheelEventData -> Universe -> Maybe Universe
handleMouseWheelEvent mwev w = case _menuLayers w of 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 where
f x | x > length mops = 0 f x | x > length mops = 0
| otherwise = x | otherwise = x
mlines = availableMenuLines $ _config u mlines = availableMenuLines $ _uvConfig u
menuOptionToEffects :: MenuOption -> [(Scancode,Universe -> IO (Maybe Universe))] menuOptionToEffects :: MenuOption -> [(Scancode,Universe -> IO (Maybe Universe))]
menuOptionToEffects Toggle {_moKey = k, _moEff = eff} = [(k,eff)] menuOptionToEffects Toggle {_moKey = k, _moEff = eff} = [(k,eff)]
src/Dodge/Initialisation.hs
-5
View File
@@ -28,7 +28,6 @@ initialWorld = defaultWorld
, _floorItems = IM.empty , _floorItems = IM.empty
, _randGen = mkStdGen 2 , _randGen = mkStdGen 2
, _mousePos = V2 0 0 , _mousePos = V2 0 0
, _testString = testStringInit
, _yourID = 0 , _yourID = 0
, _sideEffects = return , _sideEffects = return
, _worldEvents = soundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing , _worldEvents = soundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing
@@ -40,7 +39,3 @@ initialWorld = defaultWorld
-- , _menuLayers = [TerminalScreen 300 rezText'] -- , _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..] $ map Scancode [4..]
where where
f :: DebugBool -> Scancode -> MenuOption f :: DebugBool -> Scancode -> MenuOption
f bd = Toggle (return . Just . (config . debug_booleans . at bd %~ toggleJust)) f bd = Toggle (return . Just . (uvConfig . debug_booleans . at bd %~ toggleJust))
(Right . g bd . (^? config . debug_booleans . ix bd)) (Right . g bd . (^? uvConfig . debug_booleans . ix bd))
g bd Nothing = (show bd, "False") g bd Nothing = (show bd, "False")
g bd _ = (show bd, "True") g bd _ = (show bd, "True")
-- zipWith ($) -- zipWith ($)
@@ -133,14 +133,14 @@ soundMenuOptions =
(change dec stype) (change dec stype)
scod2 scod2
(change inc stype) (change inc stype)
(\w -> Right (str , leftPad 2 '.' $ show (round $ 10 * voltype (_config w)::Int))) (\w -> Right (str , leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w)::Int)))
change g vt = return . Just . (config . vt %~ g) . sw change g vt = return . Just . (uvConfig . vt %~ g) . sw
dec x = max 0 (x - 0.1) dec x = max 0 (x - 0.1)
inc x = min 1 (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 :: Universe -> Universe
writeConfig w = w & uvWorld . sideEffects %~ saveConfig (_config w) writeConfig w = w & uvWorld . sideEffects %~ saveConfig (_uvConfig w)
graphicsMenu :: ScreenLayer graphicsMenu :: ScreenLayer
graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions 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 import Control.Lens
makeBoolOption lns t = Toggle makeBoolOption lns t = Toggle
(return . Just . (config . lns #%~ not)) (return . Just . (uvConfig . lns #%~ not))
(\u -> Right (t , show (u ^# config . lns))) (\u -> Right (t , show (u ^# uvConfig . lns)))
makeEnumOption lns str sideeff = Toggle makeEnumOption lns str sideeff = Toggle
(\u -> Just <$> sideeff (u & config . lns #%~ cycleEnum) ) (\u -> Just <$> sideeff (u & uvConfig . lns #%~ cycleEnum) )
(\u -> Right (str , show (u ^# config . lns)) ) (\u -> Right (str , show (u ^# uvConfig . lns)) )
makeSubmenuOption submenu t = Toggle (pushScreen submenu) (const t) 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 updateFramebufferSize u = updatePreload divRes x y u
where where
(x,y) = (round $ _windowX cfig, round $ _windowY cfig) (x,y) = (round $ _windowX cfig, round $ _windowY cfig)
cfig = _config u cfig = _uvConfig u
divRes = resFactorNum $ u ^. config . graphics_resolution_factor 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 doDrawing pdata u = do
sTicks <- SDL.ticks sTicks <- SDL.ticks
let w = _uvWorld u let w = _uvWorld u
cfig = _config u cfig = _uvConfig u
rot = _cameraRot w rot = _cameraRot w
camzoom = _cameraZoom w camzoom = _cameraZoom w
trans = _cameraCenter w trans = _cameraCenter w
@@ -160,7 +160,7 @@ doDrawing pdata u = do
nWalls nWalls
nSilIndices nSilIndices
nIndices nIndices
(_graphics_object_shadows $ _config u) (_graphics_object_shadows $ _uvConfig u)
(snd $ snd $ _fboBase pdata) (snd $ snd $ _fboBase pdata)
colorMask $= Color4 Enabled Enabled Enabled Enabled colorMask $= Color4 Enabled Enabled Enabled Enabled
clearColor $= Color4 0 0 0 0 clearColor $= Color4 0 0 0 0
@@ -216,7 +216,7 @@ doDrawing pdata u = do
blend $= Enabled blend $= Enabled
bindFramebuffer Framebuffer $= fst (_fboLighting pdata) bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
createLightMap pdata lightPoints nWalls nSilIndices nIndices createLightMap pdata lightPoints nWalls nSilIndices nIndices
(_graphics_object_shadows $ _config u) (_graphics_object_shadows $ _uvConfig u)
(snd $ snd $ _fboCloud pdata) (snd $ snd $ _fboCloud pdata)
colorMask $= Color4 Enabled Enabled Enabled Enabled colorMask $= Color4 Enabled Enabled Enabled Enabled
clearColor $= Color4 0 0 0 0 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.List
--import Data.Bifunctor --import Data.Bifunctor
hudDrawings :: Configuration -> World -> Picture hudDrawings :: Universe -> Picture
hudDrawings cfig w = case _hudElement $ _hud w of hudDrawings uv = case _hudElement $ _hud w of
DisplayCarte -> drawCarte cfig w DisplayCarte -> drawCarte cfig w
DisplayInventory subinv -> drawInGameHUD cfig w DisplayInventory subinv -> drawInGameHUD uv
<> subInventoryDisplay subinv cfig w <> subInventoryDisplay subinv cfig w
where
w = _uvWorld uv
cfig = _uvConfig uv
drawInGameHUD :: Configuration -> World -> Picture drawInGameHUD :: Universe -> Picture
drawInGameHUD cfig w = pictures drawInGameHUD uv = pictures
[ winScale cfig . dShadCol white $ displayHP 0 cfig w [ 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 , inventoryDisplay cfig w
] ]
where
w = _uvWorld uv
cfig = _uvConfig uv
inventoryDisplay :: Configuration -> World -> Picture inventoryDisplay :: Configuration -> World -> Picture
inventoryDisplay cfig w = listPicturesAt 0 0 cfig invlist 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 "" (WaitScreen sf _) -> drawOptions w (sf w) [] 0 ""
(InputScreen inputstr help) -> drawOptions w ('>':T.unpack inputstr) [] 0 help (InputScreen inputstr help) -> drawOptions w ('>':T.unpack inputstr) [] 0 help
(DisplayScreen sd ) -> sd w (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 :: World -> [String] -> Picture
--displayStringList w ss = pictures --displayStringList w ss = pictures
@@ -76,7 +76,7 @@ drawOptions u title ops off footer = pictures $
notInvisible _ = True notInvisible _ = True
hh = halfHeight cfig hh = halfHeight cfig
hw = halfWidth cfig hw = halfWidth cfig
cfig = _config u cfig = _uvConfig u
optionValueOffset :: Universe -> MenuOption -> Int optionValueOffset :: Universe -> MenuOption -> Int
optionValueOffset u mo = case _moString mo u of 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 :: Universe -> Picture
fixedCoordPictures u = case _menuLayers u of fixedCoordPictures u = case _menuLayers u of
[] -> pictures [] -> pictures
[ hudDrawings cfig w [ hudDrawings u
, customMouseCursor cfig w , customMouseCursor cfig w
] ]
(lay:_) -> setDepth (-1) . winScale cfig $ menuScreen u lay (lay:_) -> setDepth (-1) . winScale cfig $ menuScreen u lay
where where
w = _uvWorld u w = _uvWorld u
cfig = _config u cfig = _uvConfig u
customMouseCursor :: Configuration -> World -> Picture customMouseCursor :: Configuration -> World -> Picture
customMouseCursor cfig w = winScale cfig 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 . updateLightSources
. updateClouds ) . updateClouds )
(_ : _) -> u (_ : _) -> u
[] -> over uvWorld (functionalUpdate (_config u)) u [] -> functionalUpdate u
{- | The update step. -} {- | The update step. -}
functionalUpdate :: Configuration -> World -> World functionalUpdate :: Universe -> Universe
functionalUpdate cfig w = checkEndGame functionalUpdate w = over uvWorld checkEndGame
-- . updateRandGen -- . updateRandGen
. (mouseButtons . each .~ True) -- to determine if the mouse button is held . over uvWorld (mouseButtons . each .~ True) -- to determine if the mouse button is held
. (worldClock +~ 1) . over uvWorld (worldClock +~ 1)
. updateWorldSelect . over uvWorld updateWorldSelect
. doRewind . over uvWorld doRewind
. (hammers . each %~ moveHammerUp) . over uvWorld (hammers . each %~ moveHammerUp)
. updateDistortions . over uvWorld updateDistortions
. updateCreatureSoundPositions . over uvWorld updateCreatureSoundPositions
. ppEvents . over uvWorld ppEvents
. updateCamera cfig . updateCamera
. colCrsWalls cfig . colCrsWalls
. simpleCrSprings . over uvWorld (simpleCrSprings )
. zoneCreatures . over uvWorld (zoneCreatures )
. updateIMl _doors _drMech . over uvWorld (updateIMl _doors _drMech )
. updateDelayedEvents . over uvWorld (updateDelayedEvents )
. resetWorldEvents . over uvWorld (resetWorldEvents )
. dbArg _worldEvents . over uvWorld (dbArg _worldEvents )
. updateIMl _modifications _mdUpdate . over uvWorld (updateIMl _modifications _mdUpdate )
. updateSparks . over uvWorld (updateSparks )
. updateRadarSweeps . over uvWorld (updateRadarSweeps )
. updatePosEvents . over uvWorld (updatePosEvents )
. updateFlames . over uvWorld (updateFlames )
. updateEnergyBalls . over uvWorld (updateEnergyBalls )
. updateParticles . over uvWorld (updateParticles )
. updateBullets . over uvWorld (updateBullets )
. updateRadarBlips . over uvWorld (updateRadarBlips )
. updateFlares . over uvWorld (updateFlares )
. updateBeams . over uvWorld (updateBeams )
. updateIMl _props _pjUpdate . over uvWorld (updateIMl _props _pjUpdate )
. updateIMl' _projectiles updateProjectile . over uvWorld (updateIMl' _projectiles updateProjectile)
. updateLightSources . over uvWorld (updateLightSources )
. updateClouds . over uvWorld (updateClouds )
. updateGusts . over uvWorld (updateGusts )
. zoneClouds . over uvWorld (zoneClouds )
. updateMIM magnets _mgUpdate . over uvWorld (updateMIM magnets _mgUpdate )
. updateIMl' _terminals tmUpdate . over uvWorld (updateIMl' _terminals tmUpdate )
-- . updateIMl _machines mcChooseUpdate -- . updateIMl _machines mcChooseUpdate
. updateIMl' _machines updateMachine . over uvWorld (updateIMl' _machines updateMachine )
. updateIMl' _creatures updateCreature . over uvWorld (updateIMl' _creatures updateCreature )
-- creatures should be updated early so that crOldPos is set before any position change -- creatures should be updated early so that crOldPos is set before any position change
. over creatures (fmap setOldPos) . over (uvWorld . creatures) (fmap setOldPos)
. updateCreatureGroups . over uvWorld updateCreatureGroups
-- . updateBlocks . over uvWorld updateWallDamages
. updateWallDamages . over uvWorld updateSeenWalls
. updateSeenWalls . over uvWorld updateTerminal
-- . (youHammerPosition %~ moveHammerUp) . over uvWorld updateRBList
. updateTerminal . updateBounds -- where should this go? next to update camera?
. updateRBList $ over uvWorld updateCloseObjects w
. updateBounds cfig -- where should this go? next to update camera?
$ updateCloseObjects w
zoneClouds :: World -> World zoneClouds :: World -> World
zoneClouds w = w zoneClouds w = w
src/Dodge/Update/Camera.hs
+18 -13
View File
@@ -33,20 +33,25 @@ import qualified Streaming.Prelude as S
import Streaming import Streaming
{- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers; {- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
update where your avatar's view is from. -} update where your avatar's view is from. -}
updateCamera :: Configuration -> World -> World updateCamera :: Universe -> Universe
updateCamera cfig = setViewDistance cfig updateCamera uv = uv
. moveZoomCamera cfig & over uvWorld (setViewDistance cfig )
. updateScopeZoom & moveZoomCamera
. rotateCamera cfig & over uvWorld (updateScopeZoom )
& over uvWorld (rotateCamera cfig )
moveZoomCamera :: Configuration -> World -> World
moveZoomCamera cfig w = w
& cameraCenter .~ newcen
& cameraViewFrom .~ newvf
& cameraZoom .~ newzoom
& defaultZoom .~ newDefaultZoom
& itemZoom .~ newItemZoom
where 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) cpos =_crPos (you w)
newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
vfoffset = do vfoffset = do
src/Dodge/WallCreatureCollisions.hs
+2 -2
View File
@@ -20,8 +20,8 @@ import Control.Lens
import qualified Streaming.Prelude as S import qualified Streaming.Prelude as S
colCrsWalls :: Configuration -> World -> World colCrsWalls :: Universe -> Universe
colCrsWalls cfig w = w & creatures %~ fmap (noclipCheck cfig w) colCrsWalls uv = uv & uvWorld . creatures %~ fmap (noclipCheck (_uvConfig uv) (_uvWorld uv))
noclipCheck :: Configuration -> World -> Creature -> Creature noclipCheck :: Configuration -> World -> Creature -> Creature
noclipCheck cfig w c noclipCheck cfig w c