From db44d5d6ce790747b91ef7a07e204673e09b2cd0 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 19 Jul 2022 21:51:37 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Creature/Inanimate.hs | 16 ++-------------- src/Dodge/Creature/Lamp.hs | 15 +-------------- src/Dodge/Creature/State.hs | 2 +- src/Dodge/Data.hs | 4 +++- src/Dodge/Placement/Instance/Button.hs | 3 +-- src/Dodge/Render/ShapePicture.hs | 26 +++++++++++++++++++++++++- src/Dodge/Room/LongDoor.hs | 6 +++--- 7 files changed, 36 insertions(+), 36 deletions(-) diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 415d3420b..fed435bce 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -10,16 +10,11 @@ module Dodge.Creature.Inanimate import Dodge.Data import Dodge.Creature.Lamp import Dodge.WorldEvent.Explosion -import Dodge.Creature.Picture import Dodge.Spark import Dodge.Default import Dodge.Creature.State -import Picture import qualified IntMapHelp as IM import Geometry ---import Geometry.Data ---import Geometry.Vector3D -import Shape import Dodge.SoundLogic import LensHelp @@ -30,11 +25,7 @@ barrel :: Creature barrel = defaultInanimate { _crUpdate = updateBarrel , _crHP = 500 - , _crType = DrawnCreature $ picAtCrPos $ setDepth 20 $ pictures - [ color orange $ circleSolid 10 - , setDepth 0.049 . color (greyN 0.5) $ circleSolid 8 - , color (greyN 0.5) $ circleSolid 8 - ] + , _crType = Barreloid , _crState = defaultState {_csSpState = Barrel [] } @@ -45,10 +36,7 @@ explosiveBarrel :: Creature explosiveBarrel = defaultInanimate { _crUpdate = updateExpBarrel , _crHP = 400 - , _crType = DrawnCreature $ shapeAtCrPos - . colorSH orange - . upperPrismPoly 20 - $ polyCirc 4 10 + , _crType = Barreloid , _crState = defaultState {_csSpState = Barrel [] } diff --git a/src/Dodge/Creature/Lamp.hs b/src/Dodge/Creature/Lamp.hs index 26dc48819..862efd2a1 100644 --- a/src/Dodge/Creature/Lamp.hs +++ b/src/Dodge/Creature/Lamp.hs @@ -5,19 +5,14 @@ module Dodge.Creature.Lamp import Dodge.Data import Dodge.Material.Sound import Dodge.Default -import Dodge.Creature.Picture import Dodge.LightSource import Dodge.WorldEvent.Flash import Dodge.WorldEvent.Sound import Dodge.Creature.State import Geometry -import Picture -import Polyhedra import qualified IntMapHelp as IM import LensHelp ---import qualified Streaming.Prelude as S - colorLamp :: Point3 -- color of lamp -> Float -- height of lamp @@ -25,7 +20,7 @@ colorLamp colorLamp col h = defaultInanimate { _crUpdate = initialiseColorLamp col h , _crHP = 100 - , _crType = DrawnCreature $ picAtCrPosNoRot (lampCrPic h) + , _crType = Lampoid h , _crRad = 3 , _crMass = 3 } @@ -33,14 +28,6 @@ colorLamp col h = defaultInanimate lamp :: Float -> Creature lamp = colorLamp 0.75 -lampCrPic :: Float -> Picture -lampCrPic h = pictures - [ setLayer BloomLayer (setDepth h . color white $ circleSolid 3) - , foldMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1) - ] - where - f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] BottomLayer polyNum - initialiseColorLamp :: Point3 -> Float -> Creature -> World -> World initialiseColorLamp col h cr w = w & lightSources . at lsid ?~ lsColPosID col (addZ h $ _crPos cr) lsid diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index c1e0f194d..4c582e062 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -63,7 +63,7 @@ checkDeath cr w where removecr | _crID cr == 0 = (creatures . ix (_crID cr) . crUpdate .~ const id) - . (creatures . ix (_crID cr) . crType .~ DrawnCreature (const mempty)) + . (creatures . ix (_crID cr) . crType .~ NonDrawnCreature) . (creatures . ix (_crID cr) . crHP .~ 0) -- hack to get around player creature being killed but left with more than 0 hp | otherwise = creatures . at (_crID cr) .~ Nothing diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 43d993a1b..6f605ee60 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -312,7 +312,9 @@ data CreatureType , _skinUpper :: Color , _skinLower :: Color } - | DrawnCreature { _cdDraw :: Creature -> SPic } + | Barreloid + | Lampoid {_lampHeight :: Float} + | NonDrawnCreature data Creature = Creature { _crPos :: Point2 , _crOldPos :: Point2 diff --git a/src/Dodge/Placement/Instance/Button.hs b/src/Dodge/Placement/Instance/Button.hs index 0c6c75f07..694fc5f20 100644 --- a/src/Dodge/Placement/Instance/Button.hs +++ b/src/Dodge/Placement/Instance/Button.hs @@ -12,7 +12,6 @@ import ShapePicture import Data.Maybe import Control.Lens -import qualified Data.IntMap.Strict as IM triggerSwitchSPic :: (Button -> SPic) -> PlacementSpot -> Placement triggerSwitchSPic sdraw ps = psPtCont ps (PutTrigger False) @@ -69,7 +68,7 @@ extTrigLitPos ps f = psPtCont ps (PutTrigger False) {_mdID = 0 ,_mdExternalID1 = lsid ,_mdExternalID2 = fromJust $ _plMID tp - ,_mdUpdate = \md w -> if (_triggers w IM.! _mdExternalID2 md) + ,_mdUpdate = \md w -> if w ^?! triggers . ix (_mdExternalID2 md) then w & lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ V3 0 0.5 0 else w & lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ V3 0.5 0 0 } diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index e0f1a7274..e07d9d4c7 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -33,6 +33,7 @@ import Picture import Sound.Data import Geometry.ConvexPoly import ShortShow +import Polyhedra import StreamingHelp import qualified Data.IntMap.Strict as IM -- Lazy? @@ -74,7 +75,30 @@ anyTargeting cfig w = (mempty,pictures $ IM.elems $ IM.mapMaybe f $ _crInv cr) drawCreature :: Creature -> SPic drawCreature cr = case _crType cr of Humanoid {} -> basicCrPict cr - DrawnCreature f -> f cr + Barreloid {} -> picAtCrPos1 (setDepth 20 $ pictures + [ color orange $ circleSolid 10 + , setDepth 0.049 . color (greyN 0.5) $ circleSolid 8 + , color (greyN 0.5) $ circleSolid 8 + ]) cr + Lampoid h -> picAtCrPosNoRot1 (lampCrPic h) cr + NonDrawnCreature -> mempty + +lampCrPic :: Float -> Picture +lampCrPic h = pictures + [ setLayer BloomLayer (setDepth h . color white $ circleSolid 3) + , foldMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1) + ] + where + f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] BottomLayer polyNum + --DrawnCreature f -> f cr + -- +picAtCrPosNoRot1 :: Picture -> Creature -> SPic +--{-# INLINE picAtCrPos #-} +picAtCrPosNoRot1 thePic cr = (,) mempty $ uncurryV translate (_crPos cr) thePic + +picAtCrPos1 :: Picture -> Creature -> SPic +--{-# INLINE picAtCrPos #-} +picAtCrPos1 thePic cr = (,) mempty $ tranRot (_crPos cr) (_crDir cr) thePic shiftDraw :: (a -> Point2) -> (a -> Float) -> (a -> a -> SPic) -> a -> SPic shiftDraw fpos fdir fdraw x = uncurryV translateSPf (fpos x) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index b1ed886ca..9576d94dc 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -48,8 +48,8 @@ twinSlowDoorRoom w h x = defaultRoom [ pContID (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id) $ \btid -> jsps0J (PutSlideDr (thedoor btid) thewall DoorObstacle 1 (V2 x 1) (V2 x h)) $ ps0 (PutSlideDr (thedoor btid) thewall DoorObstacle 1 (V2 (-x) 1) (V2 (-x) h)) - $ \did -> jps0' (PutLS (lsColPos (V3 0.75 0 0) (V3 0 (h-1) lampHeight))) - $ \lspl -> jsps0 $ PutProp $ addColorChange (fromJust $ _plMID lspl) did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight + $ \did -> jps0' (PutLS (lsColPos (V3 0.75 0 0) (V3 0 (h-1) lampheight))) + $ \lspl -> jsps0 $ PutProp $ addColorChange (fromJust $ _plMID lspl) did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampheight ] , _rmBound = ps , _rmName = "twinSlowDoorRoom" @@ -65,7 +65,7 @@ twinSlowDoorRoom w h x = defaultRoom | otherwise = u & updatelscol 0.7 updatelscol c = lightSources . ix lsid . lsParam . lsCol .~ c drmoving i w' = DoorHalfway == _drStatus (_doors w' IM.! i) - lampHeight = 41 + lampheight = 41 ps = [rectNSWE h 0 (-w) w ,rectNSWE 20 (-h) (negate x) x