From 84a9badea871e87692ed2f1d62d3166a2abda629 Mon Sep 17 00:00:00 2001 From: jgk Date: Sun, 25 Jul 2021 01:29:43 +0200 Subject: [PATCH] Refactor modules --- src/Dodge/Base.hs | 19 +++---------------- src/Dodge/Base/Collide.hs | 11 ++--------- src/Dodge/Creature/Action.hs | 2 ++ src/Dodge/Creature/Action/Flee.hs | 2 +- src/Dodge/Creature/AlertLevel.hs | 6 +++--- src/Dodge/Creature/ArmourChase.hs | 1 + src/Dodge/Creature/ChooseTarget.hs | 1 + src/Dodge/Creature/State.hs | 5 +++-- src/Dodge/Event.hs | 1 + src/Dodge/Event/Menu.hs | 2 +- src/Dodge/Inventory.hs | 2 ++ src/Dodge/Item/Weapon.hs | 1 + src/Dodge/Item/Weapon/Booster.hs | 2 ++ src/Dodge/Item/Weapon/Grenade.hs | 1 + src/Dodge/Item/Weapon/Launcher.hs | 1 + src/Dodge/Item/Weapon/UseEffect.hs | 2 ++ src/Dodge/Layout.hs | 3 ++- src/Dodge/LevelGen/AutoDoor.hs | 2 +- src/Dodge/LevelGen/Block.hs | 1 + src/Dodge/LevelGen/MoveDoor.hs | 3 ++- src/Dodge/LevelGen/Pathing.hs | 1 + src/Dodge/LevelGen/StaticWalls.hs | 2 +- src/Dodge/LevelGen/TriggerDoor.hs | 3 ++- src/Dodge/Path.hs | 3 ++- src/Dodge/Render.hs | 4 ++-- src/Dodge/Render/HUD.hs | 1 + src/Dodge/Render/Picture.hs | 2 ++ src/Dodge/Room.hs | 8 ++++---- src/Dodge/Update.hs | 1 + src/Dodge/Update/Camera.hs | 2 ++ src/Dodge/WallCreatureCollisions.hs | 2 +- src/Dodge/WorldEvent/Explosion.hs | 3 ++- src/Dodge/WorldEvent/Shockwave.hs | 1 + src/Dodge/WorldEvent/SpawnParticle.hs | 2 ++ src/Dodge/WorldEvent/ThingsHit.hs | 1 + src/Picture/Data.hs | 9 ++++++++- src/Picture/Tree.hs | 10 ++++++++++ src/Polyhedra.hs | 2 +- 38 files changed, 77 insertions(+), 48 deletions(-) diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 67935c3f1..260905d3a 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -4,21 +4,15 @@ Basic helpers. Consider splitting. -} module Dodge.Base - ( module Dodge.Base - , module Dodge.Base.Zone - , module Dodge.Base.Window - , module Dodge.Base.Collide - ) where import Dodge.Data import Dodge.Base.Zone import Dodge.Base.Window -import Dodge.Base.Collide import Geometry --import Picture import qualified IntMapHelp as IM +import FoldableHelp -import Data.Foldable import Control.Lens --import Control.Monad.State --import Data.List @@ -47,7 +41,7 @@ midPadL i x xs ys = take j (xs ++ repeat x) ++ ys {- | Implementation copied from - https://hackage.haskell.org/package/utility-ht-0.0.16/docs/src/Data.List.HT.Private.html#takeUntil -} -takeUntil :: (a -> Bool) -> [a] -> [a] +takeUntil :: Foldable t => (a -> Bool) -> t a -> [a] takeUntil p = foldr (\x xs -> x : if p x then [] else xs) [] you :: World -> Creature @@ -124,7 +118,7 @@ creaturesNearPointI n p w = IM.unions [f b $ f a $ _creaturesZone w | a<-[x-n.. cloudsNearPoint :: Point2 -> World -> [Cloud] --cloudsNearPoint p w = IM.unions [f b $ f a $ _cloudsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]] -cloudsNearPoint p w = f ((IM.lookup x $ _cloudsZone w) >>= IM.lookup y) +cloudsNearPoint p w = f (IM.lookup x (_cloudsZone w) >>= IM.lookup y) where (x,y) = cloudZoneOfPoint p f Nothing = [] @@ -495,13 +489,6 @@ isAnimate cr = case _crActionPlan cr of sigmoid :: Floating a => a -> a sigmoid x = x/sqrt(1+x^(2::Int)) -{- | In order to force a list, apply with seq. -} -forceSpine :: [a] -> () -forceSpine = foldr (const id) () - -forceList :: [a] -> [a] -forceList l = seq (forceSpine l) l - normalizeAnglePi :: Float -> Float normalizeAnglePi angle | normalizeAngle angle > pi = normalizeAngle angle - 2*pi diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index c6eed148e..931539b86 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -5,10 +5,10 @@ module Dodge.Base.Collide import Dodge.Data import Dodge.Base.Zone import Geometry +import FoldableHelp --import Data.List import Data.Maybe -import Data.Foldable import qualified Data.IntMap.Strict as IM import Control.Lens @@ -26,13 +26,6 @@ safeMinimumOn' f (x:xs) = g x (f x) xs | otherwise = g v mv ys where my = f y -safeMinimumOn :: (Foldable t,Ord b) => (a -> b) -> t a -> Maybe a -safeMinimumOn f = foldl' g Nothing - where - g (Just x) y - | f x < f y = Just x - | otherwise = Just y - g Nothing y = Just y hasLOS :: Point2 -> Point2 -> World -> Bool {-# INLINE hasLOS #-} @@ -46,7 +39,7 @@ hitPointLines hitPointLines p1 p2 = safeMinimumOn (dist p1 . fst) . mapMaybe - (\(x,y) -> (, (x,y)) <$> (intersectSegSeg' p1 p2 x y)) + (\(x,y) -> (, (x,y)) <$> intersectSegSeg' p1 p2 x y) -- | looks for first collision of a point with walls -- if found, gives point and reflection velocity diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 8c8879ca9..4dbe0b628 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -13,6 +13,8 @@ import Dodge.Creature.Stance.Data import Dodge.WorldEvent.Shockwave import Dodge.Data import Dodge.Base +import Dodge.Base.Zone +import Dodge.Base.Collide import Dodge.SoundLogic import Dodge.SoundLogic.Synonyms --import Dodge.WorldEvent diff --git a/src/Dodge/Creature/Action/Flee.hs b/src/Dodge/Creature/Action/Flee.hs index c3451edbd..058a33b72 100644 --- a/src/Dodge/Creature/Action/Flee.hs +++ b/src/Dodge/Creature/Action/Flee.hs @@ -1,8 +1,8 @@ module Dodge.Creature.Action.Flee where import Dodge.Data -import Dodge.Base.Collide import Geometry +import FoldableHelp retreatPointForFrom :: Float -> World -> Creature -> Point2 -> Maybe Point2 diff --git a/src/Dodge/Creature/AlertLevel.hs b/src/Dodge/Creature/AlertLevel.hs index 9821cd622..dd5cf3169 100644 --- a/src/Dodge/Creature/AlertLevel.hs +++ b/src/Dodge/Creature/AlertLevel.hs @@ -3,8 +3,8 @@ module Dodge.Creature.AlertLevel where import Dodge.Data import Dodge.Creature.AlertLevel.Data -import Dodge.Base ---import Dodge.Base.Collide +import Dodge.Base.Collide +import StrictHelp import Control.Lens import Control.Monad.Reader @@ -62,4 +62,4 @@ basicAttentionUpdate -> Creature -> Creature basicAttentionUpdate cids w cr = cr & crAttentionDir .~ - AttentiveTo (forceList $ filter (\cid -> canSee (_crID cr) cid w) cids) + AttentiveTo (forceFoldable $ filter (\cid -> canSee (_crID cr) cid w) cids) diff --git a/src/Dodge/Creature/ArmourChase.hs b/src/Dodge/Creature/ArmourChase.hs index 4de30a95d..878986d23 100644 --- a/src/Dodge/Creature/ArmourChase.hs +++ b/src/Dodge/Creature/ArmourChase.hs @@ -15,6 +15,7 @@ import Dodge.Item.Equipment import Dodge.Item.Consumable import Picture import Geometry +import FoldableHelp import Data.Maybe import qualified Data.IntMap.Strict as IM diff --git a/src/Dodge/Creature/ChooseTarget.hs b/src/Dodge/Creature/ChooseTarget.hs index 9829f7de0..6f1853680 100644 --- a/src/Dodge/Creature/ChooseTarget.hs +++ b/src/Dodge/Creature/ChooseTarget.hs @@ -2,6 +2,7 @@ module Dodge.Creature.ChooseTarget where import Dodge.Data import Dodge.Base +import Dodge.Base.Collide import Dodge.Creature.AlertLevel.Data import Control.Lens diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index d01993734..7b8842e3b 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -5,7 +5,7 @@ import Dodge.Creature.State.Data import Dodge.Creature.State.WalkCycle import Dodge.Creature.Stance.Data --import Dodge.Creature.Test -import Dodge.Base +--import Dodge.Base import Dodge.SoundLogic import Dodge.SoundLogic.Synonyms import Dodge.RandomHelp @@ -15,6 +15,7 @@ import Dodge.Creature.Action import Geometry import Picture import qualified IntMapHelp as IM +import StrictHelp import Data.List --import Data.Char @@ -81,7 +82,7 @@ crFriction _ _ = (0,0) doDamage :: Creature -> Creature doDamage cr = set (crState . crDamage) [] - $ over (crState . crPastDamage) (forceList . take 20 . (dams :) ) damagedCr + $ over (crState . crPastDamage) (forceFoldable . take 20 . (dams :) ) damagedCr where dams = _crDamage $ _crState cr damagedCr = snd $ _crApplyDamage cr dams cr diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 2852bc291..a0781078a 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -17,6 +17,7 @@ import Dodge.Event.Keyboard --import Dodge.Event.Menu import Dodge.Data import Dodge.Base +import Dodge.Base.Window --import Dodge.Creature.Action import Dodge.SoundLogic import Dodge.Inventory diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index d7639264f..71447f30f 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -3,7 +3,7 @@ module Dodge.Event.Menu ) where import Dodge.Data import Dodge.Data.Menu -import Dodge.Base +import Dodge.Base.Window import Dodge.Floor import Dodge.Initialisation import Dodge.SoundLogic diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 2540a6790..d63cd8147 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -2,7 +2,9 @@ module Dodge.Inventory where import Dodge.Data import Dodge.Base +import Dodge.Base.Collide import Geometry +import FoldableHelp --import Data.Maybe import Data.List diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 43acb1828..b8c8aeb28 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -4,6 +4,7 @@ module Dodge.Item.Weapon where import Dodge.Data import Dodge.Base +import Dodge.Base.Zone import Dodge.Picture.Layer import Dodge.SoundLogic import Dodge.SoundLogic.Synonyms diff --git a/src/Dodge/Item/Weapon/Booster.hs b/src/Dodge/Item/Weapon/Booster.hs index 2cb8ad283..95eed7ebe 100644 --- a/src/Dodge/Item/Weapon/Booster.hs +++ b/src/Dodge/Item/Weapon/Booster.hs @@ -2,6 +2,8 @@ module Dodge.Item.Weapon.Booster where import Dodge.Data import Dodge.Base +import Dodge.Base.Zone +import Dodge.Base.Collide import Geometry import qualified IntMapHelp as IM import Dodge.Picture.Layer diff --git a/src/Dodge/Item/Weapon/Grenade.hs b/src/Dodge/Item/Weapon/Grenade.hs index 4c66c30b9..8631d4b0c 100644 --- a/src/Dodge/Item/Weapon/Grenade.hs +++ b/src/Dodge/Item/Weapon/Grenade.hs @@ -3,6 +3,7 @@ module Dodge.Item.Weapon.Grenade import Dodge.Data import Dodge.Item.Data import Dodge.Base +import Dodge.Base.Zone import Dodge.Picture.Layer import Dodge.SoundLogic import Dodge.SoundLogic.Synonyms diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index cb630d7e8..858dccf97 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -11,6 +11,7 @@ import Dodge.Item.Draw import Dodge.Item.Weapon.Shell import Dodge.Item.Weapon.TriggerType import Dodge.Base +import Dodge.Base.Zone import Dodge.SoundLogic import Dodge.WorldEvent.SpawnParticle import Dodge.WorldEvent.Cloud diff --git a/src/Dodge/Item/Weapon/UseEffect.hs b/src/Dodge/Item/Weapon/UseEffect.hs index 117c13db4..d208f0a88 100644 --- a/src/Dodge/Item/Weapon/UseEffect.hs +++ b/src/Dodge/Item/Weapon/UseEffect.hs @@ -5,6 +5,8 @@ module Dodge.Item.Weapon.UseEffect where import Dodge.Data import Dodge.Base +import Dodge.Base.Zone +import Dodge.Base.Collide import Dodge.Picture.Layer --import Dodge.Item.Weapon.Decoration import Dodge.Item.Weapon.TriggerType diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index ded45cc07..e2d974015 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -5,6 +5,7 @@ import Dodge.LevelGen import Dodge.LevelGen.StaticWalls --import Dodge.LevelGen.Data import Dodge.Base +import Dodge.Base.Zone --import Dodge.RandomHelp import Dodge.Graph import Dodge.Layout.Tree.Polymorphic (applyToRoot) @@ -64,7 +65,7 @@ initializeStaticWalls :: World -> World initializeStaticWalls w = w & staticWalls %~ (\wls' -> foldl' (flip wallToWall) wls' wls) & walls %~ IM.filter (not . wlIsWall) where - wls = [wl | wl@Wall{} <- (IM.elems $ _walls w)] + wls = [wl | wl@Wall{} <- IM.elems $ _walls w] wlIsWall Wall{} = True wlIsWall _ = False diff --git a/src/Dodge/LevelGen/AutoDoor.hs b/src/Dodge/LevelGen/AutoDoor.hs index c3e692bcc..a7efb461c 100644 --- a/src/Dodge/LevelGen/AutoDoor.hs +++ b/src/Dodge/LevelGen/AutoDoor.hs @@ -1,7 +1,7 @@ {- | Creation of doors that open when creatures approach them. -} -{-# LANGUAGE BangPatterns #-} +--{-# LANGUAGE BangPatterns #-} module Dodge.LevelGen.AutoDoor where import Dodge.Data diff --git a/src/Dodge/LevelGen/Block.hs b/src/Dodge/LevelGen/Block.hs index 92e973f7a..850c0718a 100644 --- a/src/Dodge/LevelGen/Block.hs +++ b/src/Dodge/LevelGen/Block.hs @@ -2,6 +2,7 @@ module Dodge.LevelGen.Block where import Dodge.Data import Dodge.Base +import Dodge.Base.Zone import Dodge.SoundLogic import Dodge.WorldEvent.Sound import Dodge.LevelGen.Pathing diff --git a/src/Dodge/LevelGen/MoveDoor.hs b/src/Dodge/LevelGen/MoveDoor.hs index c49ae5d86..bdae7eb9e 100644 --- a/src/Dodge/LevelGen/MoveDoor.hs +++ b/src/Dodge/LevelGen/MoveDoor.hs @@ -3,6 +3,7 @@ module Dodge.LevelGen.MoveDoor where import Dodge.Data import Dodge.Base +import Dodge.Base.Zone import Geometry import qualified Data.IntMap.Strict as IM @@ -14,7 +15,7 @@ mvP !ep !p = mvPointTowardAtSpeed 2 ep p mvPs :: (Point2,Point2) -> (Point2,Point2) -> (Point2,Point2) {-# INLINE mvPs #-} -mvPs !(!ex,!ey) !(!sx,!sy) = (mvP ex sx,mvP ey sy) +mvPs (!ex,!ey) (!sx,!sy) = (mvP ex sx,mvP ey sy) moveDoorToward :: (Point2,Point2) -> Wall -> Wall {-# INLINE moveDoorToward #-} diff --git a/src/Dodge/LevelGen/Pathing.hs b/src/Dodge/LevelGen/Pathing.hs index 0ea7a65e8..097287c59 100644 --- a/src/Dodge/LevelGen/Pathing.hs +++ b/src/Dodge/LevelGen/Pathing.hs @@ -2,6 +2,7 @@ module Dodge.LevelGen.Pathing where import Dodge.Data import Dodge.Base +import Dodge.Base.Zone import Geometry import Control.Lens diff --git a/src/Dodge/LevelGen/StaticWalls.hs b/src/Dodge/LevelGen/StaticWalls.hs index b6865bc52..d94ba9473 100644 --- a/src/Dodge/LevelGen/StaticWalls.hs +++ b/src/Dodge/LevelGen/StaticWalls.hs @@ -5,8 +5,8 @@ Description : Concerns carving out of static walls to create the general room pl module Dodge.LevelGen.StaticWalls where import Dodge.Data -import Dodge.Base.Collide import Geometry +import FoldableHelp --import Control.Lens import Data.List diff --git a/src/Dodge/LevelGen/TriggerDoor.hs b/src/Dodge/LevelGen/TriggerDoor.hs index 911e0d6e4..ac7c67818 100644 --- a/src/Dodge/LevelGen/TriggerDoor.hs +++ b/src/Dodge/LevelGen/TriggerDoor.hs @@ -1,8 +1,9 @@ -{-# LANGUAGE BangPatterns #-} +--{-# LANGUAGE BangPatterns #-} module Dodge.LevelGen.TriggerDoor where import Dodge.Data import Dodge.Base +import Dodge.Base.Zone import Dodge.SoundLogic import Dodge.SoundLogic.Synonyms import Dodge.LevelGen.Switch diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index 3993938b5..01b7691d0 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -1,6 +1,7 @@ module Dodge.Path where import Dodge.Data -import Dodge.Base +import Dodge.Base.Collide +import Dodge.Base.Zone import Dodge.Graph import Geometry diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 60494f62d..326a36de3 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -6,7 +6,7 @@ module Dodge.Render where import Dodge.Data import Dodge.Config.Data -import Dodge.Base +import Dodge.Base.Window --import Dodge.Render.HUD --import Dodge.Render.MenuScreen import Dodge.Render.Picture @@ -80,7 +80,7 @@ doDrawing pdata w = do else renderBlankWalls pdata nWalls --_ <- renderFoldable pdata $ (picToAlt (Just 0) (polysToPic $ foregroundPics w) :: [RenderType]) --_ <- renderFoldable pdata $ (picToAlt (Just 0) pic :: [RenderType]) - _ <- renderFoldable pdata $ picToLTree (Just 0) (polysToPic $ foregroundPics w) + _ <- renderFoldable pdata $ picToLTree Nothing (polysToPic $ foregroundPics w) _ <- renderFoldable pdata $ picToLTree (Just 0) pic _ <- renderShader (_textureArrayShader pdata) (_floorTiles w) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index b9fefd8ce..76097d999 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -3,6 +3,7 @@ module Dodge.Render.HUD where import Dodge.Data import Dodge.Base +import Dodge.Base.Window import Dodge.Inventory import Picture import Geometry diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 88ce9c7e4..a1266ed2f 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -2,6 +2,8 @@ module Dodge.Render.Picture where import Dodge.Data import Dodge.Base +import Dodge.Base.Window +import Dodge.Base.Zone import Dodge.Picture import Dodge.Picture.Layer import Dodge.Render.HUD diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index e4ef6ce4c..23e58b05a 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -226,11 +226,11 @@ roomOctogon = defaultRoom poly = [(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)] lnks = [((0,140),0) - ,((35,125),0-pi/4) + ,((35,125),negate $ pi/4) ,((-35,125),pi/4) - ,( (50,90),0-pi/2) + ,( (50,90),negate $ pi/2) ,( (-50,90),pi/2) - ,((35,55),0-3*pi/4) + ,((35,55),negate $ 3*pi/4) ,((-35,55),3*pi/4) ,( (0,40),pi) ] @@ -306,7 +306,7 @@ weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room)) weaponBetweenPillars = do wpPos <- takeOne [(x,y) | x <- [20,120,220], y <- [20,120,220]] (ps,_) <- takeNMore 2 ([], [(x,y) | x <- [20,220], y <- [20,120,220]]) - let crPos1 = ps !! 0 + let crPos1 = ps !! 0 crPos2 = ps !! 1 d p = argV $ (120,120) -.- p plmnts = diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index fe4f82a05..dcce8a63d 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -10,6 +10,7 @@ import Dodge.Data.Menu import Dodge.World.Trigger.Data --import Dodge.Config.Data import Dodge.Base +import Dodge.Base.Zone import Dodge.WallCreatureCollisions import Dodge.LevelGen.Block import Dodge.Update.Camera diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 8e1c613bd..5afbb7329 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -8,6 +8,8 @@ module Dodge.Update.Camera where import Dodge.Data import Dodge.Base +import Dodge.Base.Window +import Dodge.Base.Collide import Dodge.Config.KeyConfig import Dodge.Item.Attachment.Data import Geometry diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index 93307ee2d..a0a0d4e68 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/src/Dodge/WallCreatureCollisions.hs @@ -3,7 +3,7 @@ module Dodge.WallCreatureCollisions where import Dodge.Data import Dodge.Creature.State.Data import Dodge.Debug.Flag.Data -import Dodge.Base +import Dodge.Base.Zone import Geometry import Data.List diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index 86d607c2c..c50848bf3 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -4,7 +4,8 @@ Explosions: creation of shockwave and particles at a given point. module Dodge.WorldEvent.Explosion where import Dodge.Data -import Dodge.Base +import Dodge.Base.Zone +import Dodge.Base.Collide import Dodge.WorldEvent.SpawnParticle import Dodge.WorldEvent.Flash import Dodge.RandomHelp diff --git a/src/Dodge/WorldEvent/Shockwave.hs b/src/Dodge/WorldEvent/Shockwave.hs index e9716ce4a..2c5a85336 100644 --- a/src/Dodge/WorldEvent/Shockwave.hs +++ b/src/Dodge/WorldEvent/Shockwave.hs @@ -7,6 +7,7 @@ import Dodge.Data import Dodge.WorldEvent.DamageBlock import Dodge.Creature.State.Data import Dodge.Base +import Dodge.Base.Zone import Dodge.Picture.Layer import Geometry import Picture diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 8094f74b4..1b62787b1 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -6,6 +6,8 @@ module Dodge.WorldEvent.SpawnParticle import Dodge.Data import Dodge.Creature.State.Data import Dodge.Base +import Dodge.Base.Zone +import Dodge.Base.Collide import Dodge.Picture import Dodge.Picture.Layer import Dodge.WorldEvent.HitEffect diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index 074dce9cd..49748120b 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -5,6 +5,7 @@ module Dodge.WorldEvent.ThingsHit where import Dodge.Data import Dodge.Base +import Dodge.Base.Zone import Geometry import qualified Data.IntMap.Strict as IM diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index b74d8405d..7648af3ba 100644 --- a/src/Picture/Data.hs +++ b/src/Picture/Data.hs @@ -1,9 +1,12 @@ --{-# LANGUAGE TemplateHaskell #-} --{-# LANGUAGE Strict #-} +{-# LANGUAGE DeriveGeneric #-} module Picture.Data where import Geometry.Data +import GHC.Generics (Generic) +import Control.DeepSeq import Data.Foldable --import qualified Data.List as L --import Data.Monoid @@ -29,6 +32,8 @@ data RenderType | Render22x4 {_unRender22x4 :: ((Point2,Point2),Point4)} | Render3x2 {_unRender3x2 :: (Point3,Point2)} | Render3x3 {_unRender3x3 :: (Point3,Point3)} + deriving Generic +instance NFData RenderType type RGBA = (Float,Float,Float,Float) type Color = (Float,Float,Float,Float) @@ -47,11 +52,13 @@ instance Functor FTree where fmap f (FBranches ts) = FBranches $ fmap (fmap f) ts fmap f (FLeaf x) = FLeaf (f x) {-# INLINE fmap #-} - + {- Tree with values at and only at the leaves. -} data LTree a = LBranches [LTree a] | LLeaf a + deriving (Generic) +instance NFData a => NFData (LTree a) instance Foldable LTree where foldMap g (LBranches ts) = mconcat $ map (foldMap g) ts foldMap g (LLeaf a) = g a diff --git a/src/Picture/Tree.hs b/src/Picture/Tree.hs index 324aa5c53..bc5c2d907 100644 --- a/src/Picture/Tree.hs +++ b/src/Picture/Tree.hs @@ -1,6 +1,7 @@ {- Transform a picture into renderable objects. -} module Picture.Tree ( picToLTree + , picToLTree' , picToFTree , picToRenderList , picToAlt @@ -10,6 +11,8 @@ module Picture.Tree import Picture.Data import Geometry import Geometry.Data +--import StrictHelp +import Control.DeepSeq import Data.Bifunctor import Data.List @@ -17,6 +20,12 @@ import qualified Data.DList as DL import Control.Applicative --import Data.Maybe (isNothing) +picToLTree' + :: Maybe Int -- ^ Layer filter. Draw 'Nothing' when value is the same as at the leaf. + -> Picture + -> LTree RenderType +picToLTree' x p = rnf (picToLTree x p) `seq` picToLTree x p + -- todo: refactor out the layer check somehow -- consider generalising to alternative rather than using LTree -- | Transform a picture into a tree of renderable objects @@ -58,6 +67,7 @@ picToLTree _ (ThickArc startA endA rad wdth) = LLeaf $ RenderArc picToLTree _ (Text s) = LLeaf $ RenderText $ stringToList s picToLTree _ Blank = LBranches [] picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics +--picToLTree j (Pictures pics) = LBranches . forceFoldable $ map (picToLTree j) pics picToLTree j (OverPic f f' (OverPic g g' pic)) = picToLTree j $ OverPic (f . g) (f' . g') pic picToLTree j (OverPic f f' (Pictures ps)) = LBranches (map (picToLTree j . OverPic f f') ps) picToLTree j (OverPic f f' pic) = overPos f . overCol f' <$> picToLTree j pic diff --git a/src/Polyhedra.hs b/src/Polyhedra.hs index 6072688ee..3f572dc03 100644 --- a/src/Polyhedra.hs +++ b/src/Polyhedra.hs @@ -83,7 +83,7 @@ boxABC a b c = faceNA = rhombus c b polyToPics :: Polyhedra -> [Picture] -polyToPics = map (Poly3D) . _pyFaces +polyToPics = map Poly3D . _pyFaces polysToPic :: [Polyhedra] -> Picture polysToPic = pictures . concatMap polyToPics