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
+4 -175
View File
@@ -5,113 +5,16 @@
module Dodge.Data.CWorld ( module Dodge.Data.CWorld (
module Dodge.Data.CWorld, module Dodge.Data.CWorld,
module Dodge.Data.Beam, module Dodge.Data.LWorld,
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,
) where ) where
import Data.Set (Set) import Dodge.Data.LWorld
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
import Data.Aeson.TH import Data.Aeson.TH
import Data.Graph.Inductive --import Dodge.Data.GenParams
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.GameRoom import Dodge.GameRoom
import Geometry.ConvexPoly 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 data CWorld = CWorld
{ _lWorld :: LWorld { _lWorld :: LWorld
@@ -136,68 +39,6 @@ data TimeFlowStatus
| RewindLeftClick | RewindLeftClick
{ _reverseAmount :: Int } { _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 data CWGen = CWGen
{ _cwgParams :: GenParams { _cwgParams :: GenParams
@@ -209,26 +50,14 @@ data CWGen = CWGen
--deriving (Eq, Ord, Show, Read) --Generic, Flat) --deriving (Eq, Ord, Show, Read) --Generic, Flat)
data WorldBeams = WorldBeams
{ _blockingBeams :: [Beam]
, _lightBeams :: [Beam]
, _positronBeams :: [Beam]
, _electronBeams :: [Beam]
}
makeLenses ''CWorld makeLenses ''CWorld
makeLenses ''LWorld
makeLenses ''WorldBeams
makeLenses ''CWCam
makeLenses ''CWGen makeLenses ''CWGen
makeLenses ''TimeFlowStatus makeLenses ''TimeFlowStatus
concat concat
<$> mapM <$> mapM
(deriveJSON defaultOptions) (deriveJSON defaultOptions)
[ ''WorldBeams [ ''CWGen
, ''CWCam
, ''CWGen
, ''CWorld , ''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 applyTerminalCommand s = case s of
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust "NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
['L', x] -> ['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 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x))
. (uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ 50) . (uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ 50)
"GODON" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMaterial .~ Crystal "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 module Dodge.Item.Location.Initialize
( initSpecificCrItemLocations
, initItemLocations
)
where where
import Dodge.Data.CWorld import Dodge.Data.LWorld
import Control.Lens import Control.Lens
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import Data.Traversable import Data.Traversable
initItemLocations :: CWorld -> CWorld initItemLocations :: LWorld -> LWorld
initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
initCrsItemLocations :: CWorld -> CWorld initCrsItemLocations :: LWorld -> LWorld
initCrsItemLocations w = w' & lWorld . creatures .~ newcreatures initCrsItemLocations w = w' & creatures .~ newcreatures
where where
(w', newcreatures) = mapAccumR initCrItemLocations w (w ^. lWorld . creatures) (w', newcreatures) = mapAccumR initCrItemLocations w (w ^. creatures)
initFlItemsLocations :: CWorld -> CWorld initFlItemsLocations :: LWorld -> LWorld
initFlItemsLocations w = w' & lWorld . floorItems .~ newfloorItems initFlItemsLocations w = w' & floorItems .~ newfloorItems
where where
(w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. lWorld . floorItems) (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems)
initTusItemLocations :: CWorld -> CWorld initTusItemLocations :: LWorld -> LWorld
initTusItemLocations w = w' & lWorld . machines .~ newmachines initTusItemLocations w = w' & machines .~ newmachines
where where
(w', newmachines) = mapAccumR initTuItemLocation w (w ^. lWorld . machines) (w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
initSpecificCrItemLocations :: Int -> CWorld -> CWorld initSpecificCrItemLocations :: Int -> LWorld -> LWorld
initSpecificCrItemLocations crid w = w' & lWorld . creatures . ix crid .~ newcr initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
where 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) initCrItemLocations w cr = (w', cr & crInv .~ newinv)
where where
(w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr) (w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
initCrItemLocation :: Creature -> Int -> CWorld -> Item -> (CWorld,Item) initCrItemLocation :: Creature -> Int -> LWorld -> Item -> (LWorld,Item)
initCrItemLocation cr invid w it = (w & lWorld . itemLocations . at locid ?~ loc initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
,it & itID .~ locid ,it & itID .~ locid
& itLocation .~ loc) & itLocation .~ loc)
where where
locid = IM.newKey ( w ^. lWorld . itemLocations) locid = IM.newKey ( w ^. itemLocations)
loc = InInv (_crID cr) invid loc = InInv (_crID cr) invid
initFlItemLocation :: CWorld -> FloorItem -> (CWorld, FloorItem) initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
initFlItemLocation w flit = (w & lWorld . itemLocations . at locid ?~ loc initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
, flit & flIt . itID .~ locid , flit & flIt . itID .~ locid
& flIt . itLocation .~ loc & flIt . itLocation .~ loc
) )
where where
locid = IM.newKey (w ^. lWorld . itemLocations ) locid = IM.newKey (w ^. itemLocations )
loc = OnFloor (_flItID flit) loc = OnFloor (_flItID flit)
initTuItemLocation :: CWorld -> Machine -> (CWorld, Machine) initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
Nothing -> (w, mc) Nothing -> (w, mc)
Just _ -> Just _ ->
let locid = IM.newKey ( w ^. lWorld . itemLocations) let locid = IM.newKey ( w ^. itemLocations)
loc = OnTurret (_mcID mc) loc = OnTurret (_mcID mc)
in ( w & lWorld . itemLocations . at locid ?~ loc in ( w & itemLocations . at locid ?~ loc
, mc & mcType . _McTurret . tuWeapon . itID .~ locid , mc & mcType . _McTurret . tuWeapon . itID .~ locid
& mcType . _McTurret . tuWeapon . itLocation .~ loc & 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 initWallZoning
. over gwWorld randomCompass . over gwWorld randomCompass
. over gwWorld setupWorldBounds . over gwWorld setupWorldBounds
. over (gwWorld . cWorld) initItemLocations . over (gwWorld . cWorld . lWorld) initItemLocations
. doAfterPlacements . doAfterPlacements
. doInPlacements . doInPlacements
. doOutPlacements . doOutPlacements