diff --git a/appDodge/Main.hs b/appDodge/Main.hs index 472db59ac..d0f92725b 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -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 diff --git a/src/Dodge/CullBox.hs b/src/Dodge/CullBox.hs index f9de9389e..9dda65be3 100644 --- a/src/Dodge/CullBox.hs +++ b/src/Dodge/CullBox.hs @@ -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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index d3c1fc7e7..b6dd91509 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Data/ActionPlan.hs b/src/Dodge/Data/ActionPlan.hs index 8ac8ed29d..7aa5ebd10 100644 --- a/src/Dodge/Data/ActionPlan.hs +++ b/src/Dodge/Data/ActionPlan.hs @@ -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 diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index d3fbd49c1..f01ad3f28 100644 --- a/src/Dodge/Data/Creature.hs +++ b/src/Dodge/Data/Creature.hs @@ -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 diff --git a/src/Dodge/Debug/Terminal.hs b/src/Dodge/Debug/Terminal.hs index af520dfa4..926da8e45 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/src/Dodge/Debug/Terminal.hs @@ -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" diff --git a/src/Dodge/Default/Creature.hs b/src/Dodge/Default/Creature.hs index 3e5e9cc41..b298e9563 100644 --- a/src/Dodge/Default/Creature.hs +++ b/src/Dodge/Default/Creature.hs @@ -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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 5baf5ab3d..a91d4dc37 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -66,7 +66,6 @@ defaultWorld = World , _floorTiles = [] , _randGen = mkStdGen 2 , _mousePos = V2 0 0 - , _testString = const . const [] , _yourID = 0 , _worldEvents = id , _delayedEvents = [] diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index d3ba7ea16..73fd93c54 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -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 diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index a337ac3fb..ab9e97cd5 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -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)] diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 21fca39d1..0c8ecccfa 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -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 [] diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 479fb1a4a..e973ba644 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -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 diff --git a/src/Dodge/Menu/OptionType.hs b/src/Dodge/Menu/OptionType.hs index f8bf5715c..3b96a2c53 100644 --- a/src/Dodge/Menu/OptionType.hs +++ b/src/Dodge/Menu/OptionType.hs @@ -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) diff --git a/src/Dodge/PreloadData.hs b/src/Dodge/PreloadData.hs index 0b7ebfb26..08b3a8638 100644 --- a/src/Dodge/PreloadData.hs +++ b/src/Dodge/PreloadData.hs @@ -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 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 234f16c69..1e5c47e59 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 3916a9f64..17c716f4f 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -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 diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index fcb66dd57..45d47c660 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -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 diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index ecb14e28c..c7a289066 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -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 diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs new file mode 100644 index 000000000..d4850a629 --- /dev/null +++ b/src/Dodge/TestString.hs @@ -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 [] diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 81d8b1bc7..2dc025371 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -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 diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index c4d8d9d11..f62a7b270 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -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 diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index 11adfd462..86c7d6ff1 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/src/Dodge/WallCreatureCollisions.hs @@ -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