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

Cleanup

Browse Source
This commit is contained in:
justin
2024-10-22 11:22:38 +01:00
parent 65f05b93f8
commit 9e3d8ae6b0
8 changed files with 425 additions and 407 deletions
Download Patch File Download Diff File Expand all files Collapse all files
data/dodge.config.json
+1 -1
View File
@@ -14,7 +14,7 @@
"_graphics_num_shadow_casters": "NumShadowCasters20",
"_graphics_shadow_rendering": "GeoObjShads",
"_graphics_shadow_size": "Typical",
"_graphics_world_resolution": "QuarterRes",
"_graphics_world_resolution": "HalfRes",
"_volume_master": 1,
"_volume_music": 0,
"_volume_sound": 1,
ghcidOutput
+1 -1
View File
@@ -1 +1 @@
All good (596 modules, at 10:48:32)
All good (596 modules, at 11:08:10)
src/Dodge/Block.hs
+14 -9
View File
@@ -1,15 +1,19 @@
module Dodge.Block where
module Dodge.Block (
splinterBlock,
destroyBlock,
destroyDoor,
) where
import Control.Monad
import Data.Set (Set)
import Dodge.Data.MountedObject
import Control.Lens
import Control.Monad
import Data.Foldable
import qualified Data.Graph.Inductive as FGL
import qualified Data.IntSet as IS
import Data.Maybe
import Data.Set (Set)
import Dodge.Base.Collide
import Dodge.Block.Debris
import Dodge.Data.MountedObject
import Dodge.Data.World
import Dodge.DrWdWd
import Dodge.LightSource
@@ -44,10 +48,10 @@ unshadowBlock w wlid = case w ^? cWorld . lWorld . walls . ix wlid of
& insertWallInZones (wl & wlUnshadowed .~ True)
Nothing -> w
checkBlockHP :: Block -> World -> World
checkBlockHP bl
| _blHP bl < 1 = destroyBlock bl
| otherwise = id
--checkBlockHP :: Block -> World -> World
--checkBlockHP bl
-- | _blHP bl < 1 = destroyBlock bl
-- | otherwise = id
destroyBlock :: Block -> World -> World
destroyBlock bl w =
@@ -74,7 +78,8 @@ maybeClearPath :: World -> PathEdgeNodes -> World
maybeClearPath w (PathEdgeNodes x y pe)
| not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w =
w
| otherwise = w
| otherwise =
w
& cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles .~ mempty) . FGL.delEdge (x, y)
destroyDoor :: Door -> World -> World
src/Dodge/Prop/Gib.hs
+11 -11
View File
@@ -1,7 +1,9 @@
module Dodge.Prop.Gib where
module Dodge.Prop.Gib (
addCrGibs,
) where
import Control.Monad
import Color
import Control.Monad
import Data.Foldable
import Data.List (zip4)
import Dodge.Base
@@ -30,17 +32,15 @@ aGib =
}
addCrGibs :: Creature -> World -> World
addCrGibs cr w = case damageDirection $ _csDamage $ _crState cr of
addCrGibs cr = case damageDirection $ _csDamage $ _crState cr of
Nothing ->
w
& addGibAt 25 (_skinHead skin) cpos
& addGibsAt 3 7 (_skinLower skin) cpos
& addGibsAt 13 20 (_skinUpper skin) cpos
addGibAt 25 (_skinHead skin) cpos
. addGibsAt 3 7 (_skinLower skin) cpos
. addGibsAt 13 20 (_skinUpper skin) cpos
Just d ->
w
& addGibsAtDir d 3 7 (_skinLower skin) cpos
& addGibsAtDir d 13 20 (_skinUpper skin) cpos
& addGibAtDir d 25 (_skinHead skin) cpos
addGibsAtDir d 3 7 (_skinLower skin) cpos
. addGibsAtDir d 13 20 (_skinUpper skin) cpos
. addGibAtDir d 25 (_skinHead skin) cpos
where
skin = _crType cr -- this should be cleaned up
cpos = _crPos cr
src/Dodge/Tree/GenerateStructure.hs
+16 -12
View File
@@ -3,31 +3,35 @@ Procedural generation of tree structures.
A /trunk/ refers to the successive first nodes in lists of children.
-}
module Dodge.Tree.GenerateStructure
where
import RandomHelp
import Control.Monad
module Dodge.Tree.GenerateStructure where
import Control.Monad
import Data.Tree
import RandomHelp
{- Single branched tree (a trunk). -}
treePath :: Int -> Tree ()
treePath 0 = Node () []
treePath x = Node () [treePath (x -1)]
{- Adds a branch at a certain point down a trunk. -}
addBranchAt
:: Int -- ^ Depth to add branch at
-> Tree () -- ^ Branch to add
-> Tree () -- ^ Starting tree
-> Tree ()
addBranchAt ::
-- | Depth to add branch at
Int ->
-- | Branch to add
Tree () ->
-- | Starting tree
Tree () ->
Tree ()
addBranchAt 0 b (Node () xs) = Node () (xs ++ [b])
addBranchAt i b (Node () (x:xs))
= Node () (addBranchAt (i-1) b x : xs)
addBranchAt i b (Node () (x : xs)) =
Node () (addBranchAt (i -1) b x : xs)
addBranchAt _ _ _ = error "Trying to add a branch too far along a tree"
{- Randomly generate a tree containing a maximum of three nodes. -}
smallBranch :: RandomGen g => State g (Tree ())
smallBranch = takeOne
smallBranch =
takeOne
[ treePath 0
, treePath 1
, treePath 2
src/Dodge/Update.hs
+49 -33
View File
@@ -6,41 +6,32 @@ Description : Simulation update
-}
module Dodge.Update (updateUniverse) where
import Dodge.Inventory
import Dodge.ListDisplayParams
import Dodge.SelectionSections
import Data.Monoid
import NewInt
import Control.Monad
import Dodge.Update.Input.InGame
import Dodge.Update.Input.ScreenLayer
import Dodge.Debug
import Dodge.SmoothScroll
import Color
--import Control.Applicative
import Control.Monad
import Data.List
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
import Dodge.Base
--import Dodge.Beam
import Dodge.Bullet
import Dodge.CrGroupUpdate
import Dodge.Creature.Update
--import Dodge.Data.SelectionList
import Dodge.Data.Universe
import Dodge.Debug
import Dodge.DisplayInventory
import Dodge.Distortion
import Dodge.DrWdWd
import Dodge.EnergyBall
import Dodge.Flame
import Dodge.Inventory
import Dodge.Item.Location
import Dodge.Laser.Update
import Dodge.LightSource.Update
import Dodge.LinearShockwave.Update
import Dodge.ListDisplayParams
import Dodge.Machine.Update
import Dodge.Magnet.Update
import Dodge.Menu
--import Dodge.Menu.Option
import Dodge.ModificationEffect
import Dodge.PosEvent
import Dodge.PressPlate
@@ -49,7 +40,9 @@ import Dodge.Prop.Update
import Dodge.RadarBlip
import Dodge.RadarSweep
import Dodge.ScrollValue
import Dodge.SelectionSections
import Dodge.Shockwave.Update
import Dodge.SmoothScroll
import Dodge.SoundLogic
import Dodge.Spark
import Dodge.Tesla.Arc
@@ -57,6 +50,8 @@ import Dodge.TmTm
import Dodge.TractorBeam.Update
import Dodge.Update.Camera
import Dodge.Update.Cloud
import Dodge.Update.Input.InGame
import Dodge.Update.Input.ScreenLayer
import Dodge.Update.Scroll
import Dodge.Update.WallDamage
import Dodge.WallCreatureCollisions
@@ -66,6 +61,7 @@ import Dodge.Zoning.Creature
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import NewInt
import SDL
import Sound.Data
import StrictHelp
@@ -92,12 +88,13 @@ updateUniverseFirst u =
updateDebugMessageOffset :: Universe -> Universe
updateDebugMessageOffset u
| SDL.ScancodeRShift `M.member` (u ^. uvWorld . input . pressedKeys)
= u & uvDebugMessageOffset %~ (max 0 . subtract (u ^. uvWorld . input . scrollAmount))
| SDL.ScancodeRShift `M.member` (u ^. uvWorld . input . pressedKeys) =
u & uvDebugMessageOffset %~ (max 0 . subtract (u ^. uvWorld . input . scrollAmount))
| otherwise = u
setClickWorldPos :: Universe -> M.Map MouseButton Point2
setClickWorldPos u = fmap
setClickWorldPos u =
fmap
(const (screenToWorldPos (u ^. uvWorld . wCam) (u ^. uvWorld . input . mousePos)))
(M.filter (== 0) $ u ^. uvWorld . input . mouseButtons)
@@ -136,8 +133,10 @@ updateUniverseLast u =
& uvWorld . input . pressedKeys . each %~ f
& uvWorld . input . mouseMoving .~ False
& uvWorld . input . mouseButtons . each +~ 1
& uvWorld . input . heldPos %~ M.union (fmap (const mp) (u ^. uvWorld . input . mouseButtons))
& uvWorld . input . heldWorldPos %~ M.union (fmap (const mwp) (u ^. uvWorld . input . mouseButtons))
& uvWorld . input . heldPos
%~ M.union (fmap (const mp) (u ^. uvWorld . input . mouseButtons))
& uvWorld . input . heldWorldPos
%~ M.union (fmap (const mwp) (u ^. uvWorld . input . mouseButtons))
where
mp = u ^. uvWorld . input . mousePos
mwp = screenToWorldPos (u ^. uvWorld . wCam) mp
@@ -166,8 +165,8 @@ timeFlowUpdate u = case u ^. uvWorld . timeFlow of
NormalTimeFlow -> functionalUpdate u
ItemScrollTimeFlow smoothing _ _ _ -> over uvWorld (doItemTimeScroll smoothing) u
CameraScrollTimeFlow smoothing _ _
| SDL.ScancodeLShift `M.member` (u ^. uvWorld . input . pressedKeys)
-> over uvWorld (doTimeScroll smoothing) u
| SDL.ScancodeLShift `M.member` (u ^. uvWorld . input . pressedKeys) ->
over uvWorld (doTimeScroll smoothing) u
CameraScrollTimeFlow{} -> u
RewindLeftClick 0 _ -> u & uvWorld . timeFlow .~ NormalTimeFlow
RewindLeftClick _ _ -> over uvWorld scrollTimeBack u -- & uvWorld . cWorld . timeFlow .~ NormalTimeFlow
@@ -214,7 +213,8 @@ scrollTimeBack w = case w ^? pastWorlds . _head of
mupdateitem x = fromMaybe id $ do
i <- w ^? timeFlow . scrollItemID . unNInt
let pointituse = pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse
return $ (pointituse . leftConsumption . wpCharge .~ (x -1))
return $
(pointituse . leftConsumption . wpCharge .~ (x -1))
. (pointituse . leftHammer .~ HammerDown)
scrollTimeForward :: World -> World
@@ -308,22 +308,30 @@ updateMouseInventorySelection' sss cfig w
return $ w & hud . hudElement . subInventory . nsSelected .~ MouseInvSelect ysel Nothing
Just p -> w & hud . hudElement . subInventory . nsSelected %~ startdrag p
| leftclickheld = case w ^? hud . hudElement . subInventory . nsSelected of
Just MouseInvSelect{} -> w
Just MouseInvSelect{} ->
w
& hud . hudElement . subInventory . nsSelected . misMaybeEnd .~ msel
Just (MouseInvChosen ssel esel)
| maybe False (<ssel) $ inverseSelBoundaryUp cfig ldp sss mpos -> w
| maybe False (< ssel) $ inverseSelBoundaryUp cfig ldp sss mpos ->
w
& shiftInvItemsUp ssel esel (inverseSelBoundaryUp cfig ldp sss mpos)
Just (MouseInvChosen ssel esel)
| maybe False (>esel) $ inverseSelBoundaryDown cfig ldp sss mpos -> w
| maybe False (> esel) $ inverseSelBoundaryDown cfig ldp sss mpos ->
w
& shiftInvItemsDown ssel esel (inverseSelBoundaryDown cfig ldp sss mpos)
Just (MouseInvChosen{}) -> w
_ -> w
_ ->
w
& hud . hudElement . subInventory . nsSelected .~ NoMouseSel
| otherwise = case w ^? hud . hudElement . subInventory . nsSelected of
Just (MouseInvSelect ssel (Just esel)) -> w
& hud . hudElement . subInventory . nsSelected .~ MouseInvChosen (min ssel esel)
Just (MouseInvSelect ssel (Just esel)) ->
w
& hud . hudElement . subInventory . nsSelected
.~ MouseInvChosen
(min ssel esel)
(max ssel esel)
Just (MouseInvSelect _ Nothing) -> w
Just (MouseInvSelect _ Nothing) ->
w
& hud . hudElement . subInventory . nsSelected .~ NoMouseSel
_ -> w
where
@@ -338,7 +346,8 @@ updateMouseInventorySelection' sss cfig w
mysel = inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
shiftInvItemsUp :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int) -> World -> World
shiftInvItemsUp (_,i) (_,j) Just{} w = w
shiftInvItemsUp (_, i) (_, j) Just{} w =
w
& flip (foldl' f) [i .. j]
& hud . hudElement . subInventory . nsSelected . misChosenStart . _2 -~ 1
& hud . hudElement . subInventory . nsSelected . misChosenEnd . _2 -~ 1
@@ -348,7 +357,8 @@ shiftInvItemsUp (_,i) (_,j) Just{} w = w
shiftInvItemsUp _ _ Nothing w = w
shiftInvItemsDown :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int) -> World -> World
shiftInvItemsDown (_,i) (_,j) Just{} w = w
shiftInvItemsDown (_, i) (_, j) Just{} w =
w
& flip (foldl' f) (reverse [i .. j])
& hud . hudElement . subInventory . nsSelected . misChosenStart . _2 +~ 1
& hud . hudElement . subInventory . nsSelected . misChosenEnd . _2 +~ 1
@@ -360,8 +370,9 @@ shiftInvItemsDown _ _ Nothing w = w
updateMouseOverInventory :: Configuration -> World -> World
updateMouseOverInventory cfig w = fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
return $ w & hud . hudElement . subInventory . nsMouseOver .~
inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
return $
w & hud . hudElement . subInventory . nsMouseOver
.~ inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
where
ldp = invDisplayParams w
@@ -380,6 +391,7 @@ advanceScrollAmount u =
updatePastWorlds :: World -> World
updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
--updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 600 . ((w ^. cWorld . lWorld) :))
doWorldEvents :: World -> World
@@ -462,10 +474,12 @@ updateCreatureSoundPositions w =
--updateIMr fim fup w = foldr (dbArg fup) w (fim w)
updateIMl :: (World -> IM.IntMap a) -> (a -> a -> World -> World) -> World -> World
updateIMl fim fup w = alaf Endo foldMap (dbArg fup) (fim w) w
--updateIMl fim fup w = foldl' (flip $ dbArg fup) w (fim w)
updateIMl' :: (World -> IM.IntMap a) -> (a -> World -> World) -> World -> World
updateIMl' fim fup w = alaf Endo foldMap fup (fim w) w
--updateIMl' fim fup w = foldl' (flip fup) w (fim w)
updateCreatureGroups :: World -> World
@@ -638,10 +652,12 @@ ppEvents w = IM.foldl' (flip $ \pp -> doPressPlateEvent (_ppEvent pp) pp) w $ w
updateSeenWalls :: World -> World
updateSeenWalls w = alaf Endo foldMap (markWallSeen . _wlID . snd) (allVisibleWalls w) w
--updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w)
markWallSeen :: Int -> World -> World
markWallSeen i = cWorld . seenWalls . at i ?~ ()
--markWallSeen :: World -> Int -> World
--markWallSeen w i = w & cWorld . seenWalls . at i ?~ ()
src/Dodge/WorldEvent/Explosion.hs
-7
View File
@@ -8,10 +8,6 @@ module Dodge.WorldEvent.Explosion (
makeTeslaExplosionAt,
) where
--import Dodge.WorldEvent.Flash
--import Geometry.Vector3D
import Control.Monad
import Data.List
import Dodge.Base.Collide
@@ -27,8 +23,6 @@ import LensHelp
import Picture
import RandomHelp
--import Data.Maybe
makePoisonExplosionAt ::
-- | Position
Point2 ->
@@ -97,7 +91,6 @@ makeExplosionAt p w =
inversePushOut v = (15 - magV v) * 0.01 *.* v
fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
sizes = randomRs (2, 9) $ _randGen w
--times = randomRs (20,25) $ _randGen w
times = randomRs (15, 20) $ _randGen w
mF q z v size time = makeFlamelet q z v size time
newFs = zipWith5 mF fPs zs (fmap (3 *.*) fVs') sizes times
tags
+295 -295
View File
File diff suppressed because it is too large Load Diff