diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 21cc4ffb2..ab8d4e26b 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -561,6 +561,7 @@ data Machine = Machine , _mcHP :: Int , _mcSensor :: Int , _mcDamage :: [DamageType] + , _mcLSs :: [Int] } data Door = Door { _drID :: Int diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 0e2c763cf..0c0ee9b60 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -221,6 +221,7 @@ defaultMachine = Machine , _mcHP = 1000 , _mcSensor = 0 , _mcDamage = [] + , _mcLSs = [] } defaultMachineUpdate :: Machine -> World -> World defaultMachineUpdate mc @@ -270,6 +271,20 @@ defaultPP = PressPlate , _ppID = -1 , _ppText = "Pressure plate" } +defaultLS :: LightSource +defaultLS = LS + { _lsID = 0 + , _lsPos = 0 + , _lsDir = 0 + , _lsRad = 4 + , _lsIntensity = 0.5 + , _lsPict = defLSPic + } +defLSPic :: LightSource -> Picture +defLSPic ls = setLayer 1 . translate3 (_lsPos ls) . color col $ circleSolid 4 + where + col = V4 r g b 2 + V3 r g b = _lsIntensity ls defaultTLS :: TempLightSource defaultTLS = TLS { _tlsPos = 0 diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 95c39512c..bac38862f 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -196,7 +196,7 @@ placeMachine color wallpoly mc p rot w = (mcid where mcid = IM.newKey $ _machines w wlid = IM.newKey $ _walls w - wlids = IS.fromList [wlid .. wlid + length wallpoly] + wlids = IS.fromList [wlid .. wlid + length wallpoly - 1] addMc mcs = IM.insert mcid (mc {_mcPos = p,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids}) mcs -- TODO correctly remove/shift pathfinding lines (removePathsCrossing) placeMachineWalls :: Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall diff --git a/src/Dodge/LightSources/Lamp.hs b/src/Dodge/LightSources/Lamp.hs index f88d22b63..222bcbd61 100644 --- a/src/Dodge/LightSources/Lamp.hs +++ b/src/Dodge/LightSources/Lamp.hs @@ -12,10 +12,10 @@ module Dodge.LightSources.Lamp where import Dodge.Data import Geometry.Data -import Picture import ShapePicture import Shape import Geometry +import Dodge.Default import Control.Lens @@ -26,13 +26,8 @@ colorLightAt col pos i = ,_lsDir = 0 ,_lsRad = 700 ,_lsIntensity = col - ,_lsPict = lightSourcePicture + ,_lsPict = defLSPic } -lightSourcePicture :: LightSource -> Picture -lightSourcePicture ls = setLayer 1 . translate3 (_lsPos ls) . color col $ circleSolid 4 - where - col = V4 r g b 2 - V3 r g b = _lsIntensity ls lightAt :: Point3 -> Int -> LightSource lightAt = colorLightAt 0.75 diff --git a/src/Dodge/Machine/Sensor.hs b/src/Dodge/Machine/Sensor.hs index fa019e694..380059c7e 100644 --- a/src/Dodge/Machine/Sensor.hs +++ b/src/Dodge/Machine/Sensor.hs @@ -5,17 +5,46 @@ import Color import Dodge.Data import Dodge.LevelGen.Data import Dodge.Default +import Dodge.Data.DamageType import Geometry import ShapePicture import Shape -lightSensor :: PSType -lightSensor = PutMachine blue (reverse $ square wdth) defaultMachine - { _mcDraw = const lightSensorSPic - } +import Control.Lens -lightSensorSPic :: SPic -lightSensorSPic = ( colorSH blue $ upperPrismPoly 25 (square wdth) +lightSensor :: Point2 -> Float -> Placement +lightSensor p r = Placement (PS p r $ PutLS theLS) + $ \lsid -> jsps p r $ PutMachine blue (reverse $ square wdth) defaultMachine + { _mcDraw = lightSensorSPic + , _mcUpdate = lightSensorUpdate + , _mcLSs = [lsid] + } + where + theLS = defaultLS + { _lsPos = V3 0 0 30 + , _lsIntensity = 0.1 + } + +lightSensorUpdate :: Machine -> World -> World +lightSensorUpdate mc w = w & machines . ix mcid %~ upmc + & lightSources . ix lsid %~ upls + where + upmc = ( mcSensor %~ \x' -> min 750 (max 0 (x' - 5 + newSense)) ) + . (mcDamage .~ []) + x = _mcSensor mc + mcid = _mcID mc + lsid = head (_mcLSs mc) + newSense = sum . map _dmAmount $ filter isLasering $ _mcDamage mc + ni = fromIntegral x / 500 + upls = lsIntensity .~ V3 ni ni ni + +isLasering Lasering {} = True +isLasering _ = False +isElectrical Electrical {} = True +isElectrical _ = False + +lightSensorSPic :: Machine -> SPic +lightSensorSPic mc = ( colorSH blue $ upperPrismPoly 25 (square wdth) , mempty ) wdth :: Float diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 8fb22cf67..a9f9792c1 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -120,12 +120,10 @@ bulIncCr' bt p cr w incFlamelets = over worldEvents $ (.) (makeFlameletTimed p 20 v Nothing 3 20) {- | Creates a shockwave when hitting a creature. -} bulConCr :: Particle -> Point2 -> Creature -> World -> World -bulConCr bt p cr w - = over (creatures . ix cid . crState . crDamage) - ( Blunt 10 sp p ep : ) - $ bulletHitSound p - $ (worldEvents %~ (makeShockwaveAt [] p 15 4 1 white . )) - w +bulConCr bt p cr + = over (creatures . ix cid . crState . crDamage) (Blunt 10 sp p ep :) + . over worldEvents (makeShockwaveAt [] p 15 4 1 white .) + . bulletHitSound p where cid = _crID cr sp = head $ _btTrail' bt diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 7ad37fe78..148d33192 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -37,7 +37,7 @@ startRoom = do , tankSquareEmboss4 (dim orange) 50 (h-60) , tankSquare (dim orange) 50 50 , tankSquare (dim orange) 50 120 - , sPS (V2 (0.8*w) (0.25*h)) 0 lightSensor + , lightSensor (V2 (0.8*w) (0.25*h)) 0 , sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25) ] )