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

Refactor initialising functions

Browse Source
This commit is contained in:
justin
2022-10-28 14:51:38 +01:00
parent 0150655c6d
commit 68c2a78f43
5 changed files with 223 additions and 202 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/CWorld.hs
+5 -176
View File
@@ -5,113 +5,16 @@
module Dodge.Data.CWorld (
module Dodge.Data.CWorld,
module Dodge.Data.Beam,
module Dodge.Data.Block,
module Dodge.Data.Bounds,
module Dodge.Data.Bullet,
module Dodge.Data.Button,
module Dodge.Data.Cloud,
module Dodge.Data.Corpse,
module Dodge.Data.CrGroupParams,
module Dodge.Data.Creature,
module Dodge.Data.Damage,
module Dodge.Data.Distortion,
module Dodge.Data.Door,
module Dodge.Data.EnergyBall,
module Dodge.Data.Flame,
module Dodge.Data.Flare,
module Dodge.Data.FloorItem,
module Dodge.Data.ForegroundShape,
module Dodge.Data.GenParams,
module Dodge.Data.Gust,
module Dodge.Data.HUD,
module Dodge.Data.Item,
module Dodge.Data.Laser,
module Dodge.Data.LightSource,
module Dodge.Data.LinearShockwave,
module Dodge.Data.Machine,
module Dodge.Data.Magnet,
module Dodge.Data.Modification,
module Dodge.Data.PathGraph,
module Dodge.Data.PosEvent,
module Dodge.Data.PressPlate,
module Dodge.Data.Projectile,
module Dodge.Data.Prop,
module Dodge.Data.RadarBlip,
module Dodge.Data.RadarSweep,
module Dodge.Data.Shockwave,
module Dodge.Data.Spark,
module Dodge.Data.Terminal,
module Dodge.Data.TeslaArc,
module Dodge.Data.TractorBeam,
module Dodge.Data.Wall,
module Dodge.Data.WorldEffect,
module Dodge.Data.LWorld,
) where
import Data.Set (Set)
import Dodge.Data.LWorld
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Data.Graph.Inductive
import qualified Data.IntSet as IS
import Dodge.Data.Beam
import Dodge.Data.Block
import Dodge.Data.Bounds
import Dodge.Data.Bullet
import Dodge.Data.Button
import Dodge.Data.Cloud
import Dodge.Data.Corpse
import Dodge.Data.CrGroupParams
import Dodge.Data.Creature
import Dodge.Data.Damage
import Dodge.Data.Distortion
import Dodge.Data.Door
import Dodge.Data.EnergyBall
import Dodge.Data.Flame
import Dodge.Data.Flare
import Dodge.Data.FloorItem
import Dodge.Data.ForegroundShape
import Dodge.Data.GenParams
import Dodge.Data.Gust
import Dodge.Data.HUD
import Dodge.Data.Item
import Dodge.Data.Laser
import Dodge.Data.LightSource
import Dodge.Data.LinearShockwave
import Dodge.Data.Machine
import Dodge.Data.Magnet
import Dodge.Data.Modification
import Dodge.Data.PathGraph
import Dodge.Data.PosEvent
import Dodge.Data.PressPlate
import Dodge.Data.Projectile
import Dodge.Data.Prop
import Dodge.Data.RadarBlip
import Dodge.Data.RadarSweep
import Dodge.Data.Shockwave
import Dodge.Data.Spark
import Dodge.Data.Terminal
import Dodge.Data.TeslaArc
import Dodge.Data.TractorBeam
import Dodge.Data.Wall
import Dodge.Data.WorldEffect
--import Dodge.Data.GenParams
import Dodge.GameRoom
import Geometry.ConvexPoly
import Geometry.Data
import qualified IntMapHelp as IM
import Picture.Data
data CWCam = CWCam
{ _cwcCenter :: Point2
, _cwcRot :: Float
, _cwcZoom :: Float -- smaller values zoom out
, _cwcItemZoom :: Float
, _cwcDefaultZoom :: Float
, _cwcViewFrom :: Point2
, _cwcViewDistance :: Float
, _cwcBoundBox :: [Point2]
, _cwcBoundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
}
data CWorld = CWorld
{ _lWorld :: LWorld
@@ -136,68 +39,6 @@ data TimeFlowStatus
| RewindLeftClick
{ _reverseAmount :: Int }
data LWorld = LWorld
{ _cwCam :: CWCam
, _creatures :: IM.IntMap Creature
, _crZoning :: IM.IntMap (IM.IntMap IS.IntSet)
, _creatureGroups :: IM.IntMap CrGroupParams
, _itemLocations :: IM.IntMap ItemLocation
, _clouds :: [Cloud]
, _clZoning :: IM.IntMap (IM.IntMap [Cloud])
, _gusts :: IM.IntMap Gust
, _gsZoning :: IM.IntMap (IM.IntMap IS.IntSet)
, _props :: IM.IntMap Prop
, _projectiles :: IM.IntMap Proj
, _instantBullets :: [Bullet]
, _bullets :: [Bullet]
, _radarSweeps :: [RadarSweep]
, _energyBalls :: [EnergyBall]
, _posEvents :: [PosEvent]
, _flames :: [Flame]
, _sparks :: [Spark]
, _radarBlips :: [RadarBlip]
, _flares :: [Flare]
, _newBeams :: WorldBeams
, _beams :: WorldBeams
, _teslaArcs :: [TeslaArc]
, _shockwaves :: [Shockwave]
, _lasers :: [LaserStart]
, _lasersToDraw :: [Laser]
, _linearShockwaves :: IM.IntMap LinearShockwave
, _tractorBeams :: [TractorBeam]
, _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 :: IM.IntMap (IM.IntMap IS.IntSet) -- Zoning IM.IntMap Wall
, _floorItems :: IM.IntMap FloorItem
, _floorTiles :: [(Point3, Point3)]
, _modifications :: IM.IntMap Modification
, _yourID :: Int
, _worldEvents :: [WdWd]
, _delayedEvents :: [(Int, WdWd)]
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _decorations :: IM.IntMap Picture
, _foregroundShapes :: IM.IntMap ForegroundShape
, _corpses :: IM.IntMap Corpse
, _pathGraph :: Gr Point2 PathEdge
, _pnZoning :: IM.IntMap (IM.IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
, _peZoning :: IM.IntMap (IM.IntMap (Set PathEdgeNodes))
, _hud :: HUD
, _lightSources :: IM.IntMap LightSource
, _tempLightSources :: [TempLightSource]
, _closeObjects :: [Either FloorItem Button]
, _seenLocations :: IM.IntMap (WdP2, String)
, _selLocation :: Int
, _distortions :: [Distortion]
, _lClock :: Int
}
data CWGen = CWGen
{ _cwgParams :: GenParams
@@ -209,26 +50,14 @@ data CWGen = CWGen
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data WorldBeams = WorldBeams
{ _blockingBeams :: [Beam]
, _lightBeams :: [Beam]
, _positronBeams :: [Beam]
, _electronBeams :: [Beam]
}
makeLenses ''CWorld
makeLenses ''LWorld
makeLenses ''WorldBeams
makeLenses ''CWCam
makeLenses ''CWGen
makeLenses ''TimeFlowStatus
concat
<$> mapM
(deriveJSON defaultOptions)
[ ''WorldBeams
, ''CWCam
, ''CWGen
[ ''CWGen
, ''CWorld
, ''LWorld
, '' TimeFlowStatus
, ''TimeFlowStatus
]
src/Dodge/Data/LWorld.hs
+189
View File
@@ -0,0 +1,189 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.LWorld (
module Dodge.Data.LWorld,
module Dodge.Data.Beam,
module Dodge.Data.Block,
module Dodge.Data.Bounds,
module Dodge.Data.Bullet,
module Dodge.Data.Button,
module Dodge.Data.Cloud,
module Dodge.Data.Corpse,
module Dodge.Data.CrGroupParams,
module Dodge.Data.Creature,
module Dodge.Data.Damage,
module Dodge.Data.Distortion,
module Dodge.Data.Door,
module Dodge.Data.EnergyBall,
module Dodge.Data.Flame,
module Dodge.Data.Flare,
module Dodge.Data.FloorItem,
module Dodge.Data.ForegroundShape,
module Dodge.Data.Gust,
module Dodge.Data.HUD,
module Dodge.Data.Item,
module Dodge.Data.Laser,
module Dodge.Data.LightSource,
module Dodge.Data.LinearShockwave,
module Dodge.Data.Machine,
module Dodge.Data.Magnet,
module Dodge.Data.Modification,
module Dodge.Data.PathGraph,
module Dodge.Data.PosEvent,
module Dodge.Data.PressPlate,
module Dodge.Data.Projectile,
module Dodge.Data.Prop,
module Dodge.Data.RadarBlip,
module Dodge.Data.RadarSweep,
module Dodge.Data.Shockwave,
module Dodge.Data.Spark,
module Dodge.Data.Terminal,
module Dodge.Data.TeslaArc,
module Dodge.Data.TractorBeam,
module Dodge.Data.Wall,
module Dodge.Data.WorldEffect,
) where
import Data.Set (Set)
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Data.Graph.Inductive
import qualified Data.IntSet as IS
import Dodge.Data.Beam
import Dodge.Data.Block
import Dodge.Data.Bounds
import Dodge.Data.Bullet
import Dodge.Data.Button
import Dodge.Data.Cloud
import Dodge.Data.Corpse
import Dodge.Data.CrGroupParams
import Dodge.Data.Creature
import Dodge.Data.Damage
import Dodge.Data.Distortion
import Dodge.Data.Door
import Dodge.Data.EnergyBall
import Dodge.Data.Flame
import Dodge.Data.Flare
import Dodge.Data.FloorItem
import Dodge.Data.ForegroundShape
import Dodge.Data.Gust
import Dodge.Data.HUD
import Dodge.Data.Item
import Dodge.Data.Laser
import Dodge.Data.LightSource
import Dodge.Data.LinearShockwave
import Dodge.Data.Machine
import Dodge.Data.Magnet
import Dodge.Data.Modification
import Dodge.Data.PathGraph
import Dodge.Data.PosEvent
import Dodge.Data.PressPlate
import Dodge.Data.Projectile
import Dodge.Data.Prop
import Dodge.Data.RadarBlip
import Dodge.Data.RadarSweep
import Dodge.Data.Shockwave
import Dodge.Data.Spark
import Dodge.Data.Terminal
import Dodge.Data.TeslaArc
import Dodge.Data.TractorBeam
import Dodge.Data.Wall
import Dodge.Data.WorldEffect
import Geometry.Data
import qualified IntMapHelp as IM
import Picture.Data
data LWorld = LWorld
{ _cwCam :: CWCam
, _creatures :: IM.IntMap Creature
, _crZoning :: IM.IntMap (IM.IntMap IS.IntSet)
, _creatureGroups :: IM.IntMap CrGroupParams
, _itemLocations :: IM.IntMap ItemLocation
, _clouds :: [Cloud]
, _clZoning :: IM.IntMap (IM.IntMap [Cloud])
, _gusts :: IM.IntMap Gust
, _gsZoning :: IM.IntMap (IM.IntMap IS.IntSet)
, _props :: IM.IntMap Prop
, _projectiles :: IM.IntMap Proj
, _instantBullets :: [Bullet]
, _bullets :: [Bullet]
, _radarSweeps :: [RadarSweep]
, _energyBalls :: [EnergyBall]
, _posEvents :: [PosEvent]
, _flames :: [Flame]
, _sparks :: [Spark]
, _radarBlips :: [RadarBlip]
, _flares :: [Flare]
, _newBeams :: WorldBeams
, _beams :: WorldBeams
, _teslaArcs :: [TeslaArc]
, _shockwaves :: [Shockwave]
, _lasers :: [LaserStart]
, _lasersToDraw :: [Laser]
, _linearShockwaves :: IM.IntMap LinearShockwave
, _tractorBeams :: [TractorBeam]
, _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 :: IM.IntMap (IM.IntMap IS.IntSet) -- Zoning IM.IntMap Wall
, _floorItems :: IM.IntMap FloorItem
, _floorTiles :: [(Point3, Point3)]
, _modifications :: IM.IntMap Modification
, _yourID :: Int
, _worldEvents :: [WdWd]
, _delayedEvents :: [(Int, WdWd)]
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _decorations :: IM.IntMap Picture
, _foregroundShapes :: IM.IntMap ForegroundShape
, _corpses :: IM.IntMap Corpse
, _pathGraph :: Gr Point2 PathEdge
, _pnZoning :: IM.IntMap (IM.IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
, _peZoning :: IM.IntMap (IM.IntMap (Set PathEdgeNodes))
, _hud :: HUD
, _lightSources :: IM.IntMap LightSource
, _tempLightSources :: [TempLightSource]
, _closeObjects :: [Either FloorItem Button]
, _seenLocations :: IM.IntMap (WdP2, String)
, _selLocation :: Int
, _distortions :: [Distortion]
, _lClock :: Int
}
data CWCam = CWCam
{ _cwcCenter :: Point2
, _cwcRot :: Float
, _cwcZoom :: Float -- smaller values zoom out
, _cwcItemZoom :: Float
, _cwcDefaultZoom :: Float
, _cwcViewFrom :: Point2
, _cwcViewDistance :: Float
, _cwcBoundBox :: [Point2]
, _cwcBoundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
}
data WorldBeams = WorldBeams
{ _blockingBeams :: [Beam]
, _lightBeams :: [Beam]
, _positronBeams :: [Beam]
, _electronBeams :: [Beam]
}
makeLenses ''LWorld
makeLenses ''CWCam
makeLenses ''WorldBeams
concat
<$> mapM
(deriveJSON defaultOptions)
[ ''WorldBeams
, ''CWCam
, ''LWorld
]
src/Dodge/Debug/Terminal.hs
+1 -1
View File
@@ -29,7 +29,7 @@ applyTerminalCommand :: String -> Universe -> Universe
applyTerminalCommand s = case s of
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
['L', x] ->
(uvWorld . cWorld %~ initSpecificCrItemLocations 0)
(uvWorld . cWorld . lWorld %~ initSpecificCrItemLocations 0)
. (uvWorld . cWorld . lWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x))
. (uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ 50)
"GODON" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMaterial .~ Crystal
src/Dodge/Item/Location/Initialize.hs
+27 -24
View File
@@ -1,63 +1,66 @@
module Dodge.Item.Location.Initialize
( initSpecificCrItemLocations
, initItemLocations
)
where
import Dodge.Data.CWorld
import Dodge.Data.LWorld
import Control.Lens
import qualified IntMapHelp as IM
import Data.Traversable
initItemLocations :: CWorld -> CWorld
initItemLocations :: LWorld -> LWorld
initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
initCrsItemLocations :: CWorld -> CWorld
initCrsItemLocations w = w' & lWorld . creatures .~ newcreatures
initCrsItemLocations :: LWorld -> LWorld
initCrsItemLocations w = w' & creatures .~ newcreatures
where
(w', newcreatures) = mapAccumR initCrItemLocations w (w ^. lWorld . creatures)
(w', newcreatures) = mapAccumR initCrItemLocations w (w ^. creatures)
initFlItemsLocations :: CWorld -> CWorld
initFlItemsLocations w = w' & lWorld . floorItems .~ newfloorItems
initFlItemsLocations :: LWorld -> LWorld
initFlItemsLocations w = w' & floorItems .~ newfloorItems
where
(w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. lWorld . floorItems)
(w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems)
initTusItemLocations :: CWorld -> CWorld
initTusItemLocations w = w' & lWorld . machines .~ newmachines
initTusItemLocations :: LWorld -> LWorld
initTusItemLocations w = w' & machines .~ newmachines
where
(w', newmachines) = mapAccumR initTuItemLocation w (w ^. lWorld . machines)
(w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
initSpecificCrItemLocations :: Int -> CWorld -> CWorld
initSpecificCrItemLocations crid w = w' & lWorld . creatures . ix crid .~ newcr
initSpecificCrItemLocations :: Int -> LWorld -> LWorld
initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
where
(w',newcr) = initCrItemLocations w (w ^?! lWorld . creatures . ix crid)
(w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid)
initCrItemLocations :: CWorld -> Creature -> (CWorld, Creature)
initCrItemLocations :: LWorld -> Creature -> (LWorld, Creature)
initCrItemLocations w cr = (w', cr & crInv .~ newinv)
where
(w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
initCrItemLocation :: Creature -> Int -> CWorld -> Item -> (CWorld,Item)
initCrItemLocation cr invid w it = (w & lWorld . itemLocations . at locid ?~ loc
initCrItemLocation :: Creature -> Int -> LWorld -> Item -> (LWorld,Item)
initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
,it & itID .~ locid
& itLocation .~ loc)
where
locid = IM.newKey ( w ^. lWorld . itemLocations)
locid = IM.newKey ( w ^. itemLocations)
loc = InInv (_crID cr) invid
initFlItemLocation :: CWorld -> FloorItem -> (CWorld, FloorItem)
initFlItemLocation w flit = (w & lWorld . itemLocations . at locid ?~ loc
initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
, flit & flIt . itID .~ locid
& flIt . itLocation .~ loc
)
where
locid = IM.newKey (w ^. lWorld . itemLocations )
locid = IM.newKey (w ^. itemLocations )
loc = OnFloor (_flItID flit)
initTuItemLocation :: CWorld -> Machine -> (CWorld, Machine)
initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
Nothing -> (w, mc)
Just _ ->
let locid = IM.newKey ( w ^. lWorld . itemLocations)
let locid = IM.newKey ( w ^. itemLocations)
loc = OnTurret (_mcID mc)
in ( w & lWorld . itemLocations . at locid ?~ loc
in ( w & itemLocations . at locid ?~ loc
, mc & mcType . _McTurret . tuWeapon . itID .~ locid
& mcType . _McTurret . tuWeapon . itLocation .~ loc
)
src/Dodge/Layout.hs
+1 -1
View File
@@ -35,7 +35,7 @@ generateLevelFromRoomList gr' w =
over gwWorld initWallZoning
. over gwWorld randomCompass
. over gwWorld setupWorldBounds
. over (gwWorld . cWorld) initItemLocations
. over (gwWorld . cWorld . lWorld) initItemLocations
. doAfterPlacements
. doInPlacements
. doOutPlacements