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

Refactor light sources

Browse Source
This commit is contained in:
justin
2021-11-28 16:53:26 +00:00
parent 1d9dd3e4e0
commit 618653a86e
28 changed files with 169 additions and 155 deletions
Download Patch File Download Diff File Expand all files Collapse all files
appDodge/Main.hs
+1 -1
View File
@@ -58,11 +58,11 @@ firstWorldLoad theConfig = do
w <- generateWorldFromSeed 0
return $ Universe
{_uvWorld = w
& keyConfig .~ theKeyConfig
& config .~ theConfig
,_preloadData = pdata
,_menuLayers = []
,_savedWorlds = M.empty
,_keyConfig = theKeyConfig
}
theUpdateStep :: Universe -> IO Universe
src/Dodge/Creature/Inanimate.hs
+2 -2
View File
@@ -87,7 +87,7 @@ initialiseColorLamp col h cr _ = ( Endo addLS , Just $ cr & crUpdate .~ updateLa
where
i = _crID cr
addLS w = w
& lightSources %~ IM.insert lsid (colorLightAt col (V3 x y h) lsid)
& lightSources %~ IM.insert lsid (lsColPosID col (V3 x y h) lsid)
& creatures . ix i . crUpdate .~ updateLamp h lsid
where
lsid = IM.newKey $ _lightSources w
@@ -99,7 +99,7 @@ updateLamp h i = unrandUpdate handleLS internalUpdate
handleLS cr w
| _crHP cr < 0 = explosionFlashAt cPos
$ mkSoundBreakGlass cPos w & lightSources %~ IM.delete i
| otherwise = w & lightSources . ix i . lsPos .~ f cPos
| otherwise = w & lightSources . ix i . lsParam . lsPos .~ f cPos
where
cPos = _crPos cr
f (V2 x y) = V3 x y h
src/Dodge/Creature/YourControl.hs
+9 -9
View File
@@ -4,7 +4,7 @@ module Dodge.Creature.YourControl
import Dodge.Data
import Dodge.Creature.Impulse.Movement
import Dodge.Update.UsingInput
import Dodge.Config.KeyConfig
--import Dodge.Config.KeyConfig
import Geometry
import Control.Lens
@@ -49,16 +49,16 @@ wasdWithAiming w speed i cr
*.* rotateV (_cameraRot w) (_mousePos w)
_ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w
wasdM :: World -> SDL.Scancode -> Point2
wasdM w scancode
| scancode == moveUpKey (_keyConfig w) = V2 0 1
| scancode == moveDownKey (_keyConfig w) = V2 0 (-1)
| scancode == moveRightKey (_keyConfig w) = V2 1 0
| scancode == moveLeftKey (_keyConfig w) = V2 (-1) 0
wasdM _ _ = V2 0 0
wasdM :: SDL.Scancode -> Point2
wasdM scancode = case scancode of
SDL.ScancodeW -> V2 0 1
SDL.ScancodeS -> V2 0 (-1)
SDL.ScancodeD -> V2 1 0
SDL.ScancodeA -> V2 (-1) 0
_ -> V2 0 0
wasdDir :: World -> Point2
wasdDir w = foldr ((+.+) . wasdM w) (V2 0 0) $ _keys w
wasdDir w = foldr ((+.+) . wasdM) (V2 0 0) $ _keys w
{- | Set posture according to mouse presses. -}
mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
src/Dodge/Data.hs
+9 -7
View File
@@ -57,6 +57,7 @@ data Universe = Universe
, _preloadData :: PreloadData
, _menuLayers :: [ScreenLayer]
, _savedWorlds :: M.Map SaveSlot World
, _keyConfig :: KeyConfigSDL
}
data World = World
{ _keys :: !(S.Set Scancode)
@@ -115,7 +116,6 @@ data World = World
, _distortions :: [Distortion]
, _worldBounds :: Bounds
, _gameRooms :: [GameRoom] -- consider using and IntMap
, _keyConfig :: KeyConfigSDL
, _config :: Configuration
, _rewindWorlds :: [World]
, _rewinding :: Bool
@@ -192,18 +192,19 @@ data Cloud = Cloud
data CloudType
= SmokeCloud
| GasCloud
data LSParam = LSParam
{ _lsPos :: !Point3
, _lsRad :: !Float
, _lsCol :: !Point3
}
data LightSource = LS
{ _lsID :: !Int
, _lsPos :: !Point3
, _lsParam :: LSParam
, _lsDir :: !Float
, _lsRad :: !Float
, _lsIntensity :: !Point3
, _lsPict :: LightSource -> Picture
}
data TempLightSource = TLS
{ _tlsPos :: !Point3
, _tlsRad :: !Float
, _tlsIntensity :: !Point3
{ _tlsParam :: LSParam
, _tlsUpdate :: World -> TempLightSource -> Maybe TempLightSource
, _tlsTime :: !Int
}
@@ -904,3 +905,4 @@ makeLenses ''Vocalization
makeLenses ''UseDelay
makeLenses ''AimParams
makeLenses ''Universe
makeLenses ''LSParam
src/Dodge/Default.hs
+12 -8
View File
@@ -272,22 +272,26 @@ defaultPP = PressPlate
defaultLS :: LightSource
defaultLS = LS
{ _lsID = 0
, _lsPos = V3 0 0 50
, _lsDir = 0
, _lsParam = LSParam
{ _lsPos = V3 0 0 50
, _lsRad = 700
, _lsIntensity = 0.6
, _lsCol = 0.6
}
, _lsDir = 0
, _lsPict = defLSPic
}
defLSPic :: LightSource -> Picture
defLSPic ls = setLayer 1 . translate3 (_lsPos ls) . color col $ circleSolid 4
defLSPic ls = setLayer 1 . translate3 (_lsPos $ _lsParam ls) . color col $ circleSolid 4
where
col = V4 r g b 2
V3 r g b = _lsIntensity ls
V3 r g b = _lsCol $ _lsParam ls
defaultTLS :: TempLightSource
defaultTLS = TLS
{ _tlsPos = 0
, _tlsRad = 0
, _tlsIntensity = 0.5
{ _tlsParam = LSParam
{ _lsPos = 0
, _lsRad = 0
, _lsCol = 0.5
}
, _tlsUpdate = f
, _tlsTime = 1
}
src/Dodge/Default/World.hs
+10 -8
View File
@@ -1,8 +1,7 @@
module Dodge.Default.World
where
module Dodge.Default.World where
import Dodge.Data
import Dodge.Base
import Dodge.Config.KeyConfig
--import Dodge.Config.KeyConfig
import Dodge.Bounds
--import Dodge.Menu
--import Picture
@@ -10,6 +9,7 @@ import Geometry.Data
--import Picture.Texture
--import Data.Preload
import Control.Lens
import System.Random
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
@@ -73,7 +73,7 @@ defaultWorld = World
,(1, (const (V2 0 0) , "START POSITION"))
]
, _selLocation = 0
, _keyConfig = defaultKeyConfigSDL
--, _keyConfig = defaultKeyConfigSDL
, _config = defaultConfig
, _sideEffects = return
, _inventoryMode = TopInventory
@@ -89,10 +89,12 @@ defaultWorld = World
}
youLight :: TempLightSource
youLight =
TLS { _tlsPos = V3 0 0 0
,_tlsRad = 300
,_tlsIntensity = 0.1
,_tlsUpdate = \w _ -> Just (youLight {_tlsPos = f $ _crPos (you w)})
TLS { _tlsParam = LSParam
{_lsPos = V3 0 0 0
,_lsRad = 300
,_lsCol = 0.1
}
,_tlsUpdate = \w _ -> Just (youLight & tlsParam . lsPos .~ f (_crPos $ you w))
,_tlsTime = 0
}
where
src/Dodge/Event.hs
+1 -1
View File
@@ -60,7 +60,7 @@ handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
handleMouseButtonEvent :: MouseButtonEventData -> Universe -> Maybe Universe
handleMouseButtonEvent mbev u = case mouseButtonEventMotion mbev of
Released -> Just $ u & uvWorld . mouseButtons %~ S.delete but
Pressed -> (handlePressedMouseButton but)
Pressed -> handlePressedMouseButton but
(u & uvWorld . mouseButtons %~ S.insert but)
where
but = mouseButtonEventButton mbev
src/Dodge/Event/Keyboard.hs
+13 -16
View File
@@ -7,7 +7,6 @@ import Dodge.Data
import Dodge.Save
import Dodge.Base
import Dodge.Creature.Action
import Dodge.Config.KeyConfig
import Dodge.Event.Test
import Dodge.Event.Menu
import Dodge.Menu
@@ -26,7 +25,7 @@ see 'handlePressedKeyInGame'.
handleKeyboardEvent :: KeyboardEventData -> Universe -> Maybe Universe
handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
Released -> Just $ u & uvWorld . keys %~ S.delete kcode
Pressed -> (handlePressedKey (keyboardEventRepeat kev) kcode)
Pressed -> handlePressedKey (keyboardEventRepeat kev) kcode
(u & uvWorld . keys %~ S.insert kcode)
where
kcode = (keysymScancode . keyboardEventKeysym) kev
@@ -41,20 +40,18 @@ handlePressedKey _ scode w
| otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w
handlePressedKeyInGame :: Scancode -> World -> Maybe World
handlePressedKeyInGame scode w
| scode == escapeKey (_keyConfig w) = Nothing
| scode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w
| scode == dropItemKey (_keyConfig w) = Just $ youDropItem w
| scode == toggleMapKey (_keyConfig w) = Just $ toggleMap w
| scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (you w) w
| scode == testEventKey (_keyConfig w) = Just $ testEvent w
| scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
| scode == rotateCameraPlusKey (_keyConfig w) = Just $ w & cameraRot +~ 0.01
| scode == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 0.01
| scode == ScancodeX = Just $ w & inventoryMode %~ toggleInv TweakInventory
| scode == ScancodeC = Just $ w & inventoryMode %~ toggleInv CombineInventory
| scode == ScancodeI = Just $ w & inventoryMode %~ toggleInv InspectInventory
handlePressedKeyInGame _ w = Just w
handlePressedKeyInGame scode w = case scode of
ScancodeEscape -> Nothing
ScancodeSpace -> Just $ spaceAction w
ScancodeP -> Just $ pauseGame $ escapeMap w
ScancodeF -> Just $ youDropItem w
ScancodeM -> Just $ toggleMap w
ScancodeR -> Just $ fromMaybe w $ startReloadingWeapon (you w) w
ScancodeT -> Just $ testEvent w
ScancodeX -> Just $ w & inventoryMode %~ toggleInv TweakInventory
ScancodeC -> Just $ w & inventoryMode %~ toggleInv CombineInventory
ScancodeI -> Just $ w & inventoryMode %~ toggleInv InspectInventory
_ -> Just w
toggleInv :: InventoryMode -> InventoryMode -> InventoryMode
toggleInv x y
src/Dodge/Event/Menu.hs
+1 -1
View File
@@ -21,7 +21,7 @@ handlePressedKeyInMenu mState scode = case mState of
TerminalScreen _ m -> Just . (menuLayers %~ ( (TerminalScreen 0 m : ) . tail) )
InputScreen s -> case scode of
ScancodeEscape -> popScreen
ScancodeReturn -> popScreen . (over uvWorld $ applyTerminalString s)
ScancodeReturn -> popScreen . over uvWorld (applyTerminalString s)
ScancodeBackspace
-> popScreen >=> pushScreen (InputScreen $ dropLast s)
_ -> popScreen >=> pushScreen (InputScreen $ s ++ [scodeToChar scode])
src/Dodge/Item/Weapon/TriggerType.hs
+2 -6
View File
@@ -45,6 +45,7 @@ import Dodge.Default
import Sound.Data
import Geometry
import Geometry.Vector3D
import Dodge.LightSource
--import Data.Preload
import System.Random
@@ -293,12 +294,7 @@ withTempLight :: Int -> Float -> V3 Float -> ChainEffect
withTempLight time rad col eff item cr = eff item cr
. over tempLightSources (theTLS :)
where
theTLS = defaultTLS
{ _tlsPos = V3 x y 10
, _tlsRad=rad
, _tlsIntensity = col
, _tlsTime = time
}
theTLS = tlsTimeRadColPos time rad col (V3 x y 10)
V2 x y = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
modClock :: Int -> ChainEffect -> ChainEffect
src/Dodge/LightSource.hs
+48 -28
View File
@@ -1,8 +1,13 @@
module Dodge.LightSource
( tLightTimedIntensity
, tLight
, lightAt
, colorLightAt
( tlsTimeRadFunPos
, tlsTimeRadColPos
, lsRadCol
, lsPosRadCol
, lsColPosRad
, lsPosColRad
, lsColPos
, lsPosCol
, lsColPosID
)
where
import Dodge.Data
@@ -11,24 +16,16 @@ import Dodge.Default
import Control.Lens
colorLightAt :: Point3 -> Point3 -> Int -> LightSource
colorLightAt col pos i =
LS {_lsID = i
,_lsPos = pos
,_lsDir = 0
,_lsRad = 700
,_lsIntensity = col
,_lsPict = defLSPic
lsPosRad :: Point3 -> Float -> LightSource
lsPosRad = lsColPosRad 0.75
tlsTimeRadFunPos :: Int -> Float -> (Int -> Float) -> Point3 -> TempLightSource
tlsTimeRadFunPos t rmax intensityF p = TLS
{ _tlsParam = LSParam
{ _lsPos = p
, _lsRad = rmax
, _lsCol = f $ intensityF t
}
lightAt :: Point3 -> Int -> LightSource
lightAt = colorLightAt 0.75
tLightTimedIntensity :: Int -> Float -> (Int -> Float) -> Point2 -> TempLightSource
tLightTimedIntensity t rmax intensityF (V2 x y) = TLS
{ _tlsPos = V3 x y 0
, _tlsRad = rmax
, _tlsIntensity = f $ intensityF t
, _tlsUpdate = upF
, _tlsTime = t
}
@@ -37,19 +34,43 @@ tLightTimedIntensity t rmax intensityF (V2 x y) = TLS
| _tlsTime tls <= 0 = Nothing
| otherwise = Just $ tls
& tlsTime -~ 1
& tlsIntensity .~ f (intensityF (_tlsTime tls) )
& tlsParam . lsCol .~ f (intensityF (_tlsTime tls) )
f x' = V3 x' x' x'
tLight
lsPosColRad p col = lsColPosRad col p
lsPosRadCol p r col = defaultLS
& lsParam . lsPos .~ p
& lsParam . lsRad .~ r
& lsParam . lsCol .~ col
lsColPosID :: Point3 -> Point3 -> Int -> LightSource
lsColPosID col p i = lsColPos col p & lsID .~ i
lsColPos :: Point3 -> Point3 -> LightSource
lsColPos col pos = lsColPosRad col pos 700
lsPosCol :: Point3 -> Point3 -> LightSource
lsPosCol pos col = lsColPos col pos
lsColPosRad :: Point3 -> Point3 -> Float -> LightSource
lsColPosRad col pos r = lsPosRadCol pos r col
lsRadCol r col = defaultLS & lsParam . lsRad .~ r
& lsParam . lsCol .~ col
tlsTimeRadColPos
:: Int
-> Float -- ^ maximal radius
-> Point3
-> Point3
-> TempLightSource
tLight t rmax col (V3 x y z) = TLS
{ _tlsPos = V3 x y z
, _tlsRad = rmax
, _tlsIntensity = col
tlsTimeRadColPos t rmax col (V3 x y z) = TLS
{ _tlsParam = LSParam
{ _lsPos = V3 x y z
, _lsRad = rmax
, _lsCol = col
}
, _tlsUpdate = upF
, _tlsTime = t
}
@@ -58,4 +79,3 @@ tLight t rmax col (V3 x y z) = TLS
| _tlsTime tls <= 0 = Nothing
| otherwise = Just $ tls
& tlsTime -~ 1
src/Dodge/Menu.hs
+1 -1
View File
@@ -165,7 +165,7 @@ startNewGame w = Just $ w
i = fst $ random (_randGen (_uvWorld w))
uvWorldSideEffects :: Int -> World -> b -> IO World
uvWorldSideEffects i w = const (generateWorldFromSeed i <&> keyConfig .~ _keyConfig w <&> config .~ _config w
uvWorldSideEffects i w = const (generateWorldFromSeed i <&> config .~ _config w
-- <&> preloadData .~ _preloadData w
)
-- this kills save games etc...
src/Dodge/Placement/Instance/Button.hs
+13 -11
View File
@@ -1,5 +1,6 @@
module Dodge.Placement.Instance.Button where
import Dodge.Data
import Dodge.LightSource
import Color
import Geometry
import Geometry.Vector3D
@@ -30,10 +31,10 @@ triggerSwitchSPicLight sdraw ps = psPtCont ps (PutTrigger (const False))
$ pContID ps (PutButton (makeSwitchSPic sdraw (oneff lsid $ trigid tp) (offeff lsid $ trigid tp)))
(const Nothing)
where
thels = defaultLS {_lsIntensity = V3 0.5 0 0, _lsPos = V3 0 0 78, _lsRad = 75}
thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75
trigid tp = fromJust $ _plMID tp
eff lsid tid b c = (triggers . ix tid .~ const b)
. (lightSources . ix lsid . lsIntensity .~ c)
. (lightSources . ix lsid . lsParam . lsCol .~ c)
oneff lsid tid = eff lsid tid True (V3 0 0.5 0)
offeff lsid tid = eff lsid tid False (V3 0.5 0 0)
@@ -54,8 +55,8 @@ putLitButtonID col p a subpl = mntLSOn aShape (Just col) ls p'' (addZ 40 p')
where
p' = p -.- 30 *.* vNormal (unitVectorAtAngle a)
p'' = p +.+ 10 *.* vNormal (unitVectorAtAngle a)
changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
changeLight lsid = lightSources . ix lsid . lsParam . lsCol .~ V3 0 0.5 0
ls = lsRadCol 75 (V3 0.5 0 0)
putLitButOnPos :: Color
-> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
@@ -66,10 +67,11 @@ putLitButOnPos col f subpl
in jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = V2 0 (-1), _btRot = pi})
subpl <&> plSpot .~ _plSpot plmnt
where
changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
changeLight lsid = lightSources . ix lsid . lsParam . lsCol .~ V3 0 0.5 0
ls = lsRadCol 75 (V3 0.5 0 0)
thePS = PSPos f (const id) Nothing
-- creates a lit external trigger, passes the trigger placement forward
extTrigLitPos :: PlacementSpot -> (Placement -> Maybe Placement) -> Placement
extTrigLitPos ps f = psPtCont ps (PutTrigger (const False))
@@ -83,10 +85,10 @@ extTrigLitPos ps f = psPtCont ps (PutTrigger (const False))
,_mdExternalID1 = lsid
,_mdExternalID2 = fromJust $ _plMID tp
,_mdUpdate = \md w -> if (_triggers w IM.! _mdExternalID2 md) w
then w & lightSources . ix (_mdExternalID1 md) . lsIntensity .~ V3 0 0.5 0
else w & lightSources . ix (_mdExternalID1 md) . lsIntensity .~ V3 0.5 0 0
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
}
thels = defaultLS {_lsIntensity = V3 0.5 0 0, _lsPos = V3 0 0 78, _lsRad = 75}
thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75
putLitButOnPosExtTrig :: Color
-> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
@@ -101,6 +103,6 @@ putLitButOnPosExtTrig col f
where
trigid tp = fromJust $ _plMID tp
oneff tid = triggers . ix tid .~ const True
changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
changeLight lsid = lightSources . ix lsid . lsParam . lsCol .~ V3 0 0.5 0
ls = lsRadCol 75 (V3 0.5 0 0)
thePS = PSPos f (const id) Nothing
src/Dodge/Placement/Instance/LightSource.hs
+4 -4
View File
@@ -21,7 +21,7 @@ mntLSOn
-> LightSource -> Point2 -> Point3 -> (Placement -> Maybe Placement) -> Placement
mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _)
= ps0jPushPS (PutShape . setCol $ shapeF wallp lsp)
. pt0 (PutLS $ ls {_lsPos = lsp'})
. pt0 (PutLS $ ls & lsParam . lsPos .~ lsp')
where
lsp' = lsp -.-.- V3 x y 1
-- hack! perturb the light position
@@ -105,7 +105,7 @@ unusedLnkToPS rp _ = case rp of
_ -> Nothing
spanLSLightI :: LightSource -> Float -> Point2 -> Point2 -> Placement
spanLSLightI ls h a b = ps0j (PutLS ls {_lsPos = V3 x y h})
spanLSLightI ls h a b = ps0j (PutLS $ ls & lsParam . lsPos .~ V3 x y h)
$ sps0 $ PutShape $ thinHighBar h a b
where
V2 x y = 0.5 *.* (a +.+ b)
@@ -114,11 +114,11 @@ spanLS :: LightSource -> Point2 -> Point2 -> Placement
spanLS ls a b = Placement (PS (V2 x y) 0) (PutLS ls) Nothing
$ const $ Just $ sps0 $ PutShape $ thinHighBar h a b
where
V3 _ _ h = _lsPos ls + 5
V3 _ _ h = _lsPos (_lsParam ls) + 5
V2 x y = 0.5 *.* (a +.+ b)
spanColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement
spanColLightI col h a b = ps0j (PutLS $ colorLightAt col (V3 x y (h-5)) 0)
spanColLightI col h a b = ps0j (PutLS $ lsColPos col (V3 x y (h-5)))
$ sps0 $ PutShape $ thinHighBar h a b
where
V2 x y = 0.5 *.* (a +.+ b)
src/Dodge/Placement/Instance/LightSource/Flicker.hs
+2 -2
View File
@@ -19,12 +19,12 @@ flickerMod pl = Just $ sps0 $ PutMod $ ModIDTimerPoint3Bool
flickerUpdate :: Modification -> World -> World
flickerUpdate md w
| _mdTimer md > 0 = w & modifications . ix mdid . mdTimer -~ 1
| otherwise = w & lightSources . ix lsid . lsIntensity .~ mdcol
| otherwise = w & lightSources . ix lsid . lsParam . lsCol .~ mdcol
& modifications . ix mdid
%~ ( (mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not) )
where
mdcol = _mdPoint3 md
lscol = _lsIntensity $ _lightSources w IM.! lsid
lscol = _lsCol $ _lsParam $ _lightSources w IM.! lsid
lsid = _mdExternalID md
mdid = _mdID md
timerange
src/Dodge/Placement/Instance/Sensor.hs
+3 -2
View File
@@ -2,6 +2,7 @@ module Dodge.Placement.Instance.Sensor
( lightSensor
) where
import Color
import Dodge.LightSource
import Dodge.Data
import Dodge.LevelGen.Data
import Dodge.Default
@@ -24,7 +25,7 @@ damageSensor damF wdth upf ps = pContID ps ( PutLS theLS)
, _mcLSs = [lsid]
}
where
theLS = defaultLS { _lsPos = V3 0 0 30 , _lsIntensity = 0.1 }
theLS = lsPosCol (V3 0 0 30) (0.1)
lightSensor :: Float -> (Machine -> World -> World) -> PlacementSpot -> Placement
lightSensor = damageSensor senseLasering
@@ -46,7 +47,7 @@ sensorUpdate damF mc w = w & machines . ix mcid %~ upmc
(senseData,dam) = partitionEithers $ map damF $ _mcDamage mc
newSense = sum senseData
ni = fromIntegral x / 1000
upls = lsIntensity .~ V3 ni ni ni
upls = lsParam . lsCol .~ V3 ni ni ni
sensorSPic :: Float -> Machine -> SPic
sensorSPic wdth _ = ( colorSH yellow $ upperPrismPoly 25 (square wdth)
src/Dodge/Placement/PlaceSpot.hs
+3 -2
View File
@@ -198,6 +198,7 @@ placeMachineWalls col poly mcid wlid = flip (foldr f) $ zip [wlid..] $ loopPairs
& wlStructure . wlStMachine .~ mcid
mvLS :: Point3 -> Float -> LightSource -> LightSource
mvLS (V3 x y z) rot ls = ls {_lsPos = V3 x y z +.+.+ startPos,_lsDir = rot}
mvLS (V3 x y z) rot ls = ls & lsParam . lsPos .~ V3 x y z +.+.+ startPos
& lsDir .~ rot
where
startPos = onXY (rotateV rot) $ _lsPos ls
startPos = onXY (rotateV rot) $ _lsPos (_lsParam ls)
src/Dodge/Render/Lights.hs
+4 -5
View File
@@ -10,11 +10,10 @@ import qualified Data.IntMap.Lazy as IM
lightsForGloom :: World -> [(Point3,Float,Point3)]
lightsForGloom w = mapMaybe getLS (IM.elems $ _lightSources w) ++ mapMaybe getTLS (_tempLightSources w)
where
getLS ls
getLS = getlsparam . _lsParam
getTLS = getlsparam . _tlsParam
getlsparam ls
| dist campos (fst2 $ _lsPos ls) > 1000 = Nothing
| otherwise = Just ( _lsPos ls, _lsRad ls^(2::Int) , _lsIntensity ls)
getTLS ls
| dist campos (fst2 $ _tlsPos ls) > 1000 = Nothing
| otherwise = Just ( _tlsPos ls, _tlsRad ls^(2::Int), _tlsIntensity ls)
| otherwise = Just ( _lsPos ls, _lsRad ls^(2::Int) , _lsCol ls)
campos = _cameraCenter w
fst2 (V3 a b _) = V2 a b
src/Dodge/Room/LongDoor.hs
+3 -3
View File
@@ -46,7 +46,7 @@ twinSlowDoorRoom w h x = defaultRoom
[ pContID (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id)
$ \btid -> jsps0J (PutSlideDr False col (cond' btid) (V2 x 1) (V2 x h) wlSpeed)
$ ps0 (PutSlideDr False col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
$ \did -> jps0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0))
$ \did -> jps0 (PutLS (lsColPos (V3 0.75 0 0) (V3 0 (h-1) lampHeight)))
$ \lsid -> jsps0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight
]
, _rmBound = ps
@@ -58,8 +58,8 @@ twinSlowDoorRoom w h x = defaultRoom
addColorChange lsid drid' = over pjUpdate $ dbArgChain $ const f
where
f w' | _drStatus (_doors w' IM.! drid') == DoorHalfway
= w' & lightSources . ix lsid . lsIntensity .~ V3 8 0 0
| otherwise = w' & lightSources . ix lsid . lsIntensity .~ 0.7
= w' & lightSources . ix lsid . lsParam . lsCol .~ V3 8 0 0
| otherwise = w' & lightSources . ix lsid . lsParam . lsCol .~ 0.7
drmoving i w' = DoorHalfway == _drStatus (_doors w' IM.! i)
lampHeight = 41
ps =
src/Dodge/Room/RezBox.hs
+2 -5
View File
@@ -3,6 +3,7 @@ import Dodge.LevelGen.Data
--import Dodge.PlacementSpot
--import Dodge.Room.RunPast
import Dodge.RoomLink
import Dodge.LightSource
--import Dodge.Room.LasTurret
import Dodge.Data
import Dodge.Default
@@ -130,11 +131,7 @@ rezColor = do
col <- takeOne [V3 0.0 0.1 0.5, V3 0.0 0.5 0.1]
h <- takeOne [30,50,80,90,90,90,90]
rad <- takeOne [150,200,200,250,250,300,300,300]
return defaultLS
{ _lsPos = V3 0 0 h
, _lsIntensity = col
, _lsRad = rad
}
return $ lsPosColRad (V3 0 0 h) col rad
rezInvBox :: LightSource -> Room
rezInvBox = swapInOutLinks . rezBox
src/Dodge/Room/RunPast.hs
+2 -5
View File
@@ -1,5 +1,6 @@
module Dodge.Room.RunPast where
import Dodge.LevelGen.Data
import Dodge.LightSource
import Dodge.RoomLink
import Dodge.Data
import Dodge.Default
@@ -40,11 +41,7 @@ roomCritLS = do
col <- takeOne [0.5, 0.6]
h <- takeOne [30,35]
rad <- takeOne [300]
return defaultLS
{ _lsPos = V3 0 0 h
, _lsIntensity = col
, _lsRad = rad
}
return $ lsPosColRad (V3 0 0 h) col rad
critRoom :: Room
critRoom = corridorWallN
src/Dodge/Save.hs
+1 -4
View File
@@ -7,13 +7,10 @@ module Dodge.Save
import Dodge.Data
import qualified Data.Map.Strict as M
import Data.Maybe
--import Data.Maybe
import Control.Lens
import qualified Data.Set as S
clearSaves :: Universe -> Universe
clearSaves = savedWorlds .~ M.empty
saveWorldInEmptySlot :: SaveSlot -> Universe -> Universe
saveWorldInEmptySlot slot w = case M.lookup slot $ _savedWorlds w of
Nothing -> w & savedWorlds %~ M.insert slot (clearKeys (_uvWorld w))
src/Dodge/Update/Camera.hs
+10 -10
View File
@@ -11,7 +11,7 @@ import Dodge.Base
import Dodge.Zone
import Dodge.Base.Window
import Dodge.Base.Collide
import Dodge.Config.KeyConfig
--import Dodge.Config.KeyConfig
import Geometry
--import Geometry.ConvexPoly
import Dodge.GameRoom
@@ -135,11 +135,11 @@ rotateCamera w
| keyr = rotateCameraBy (-0.025) w
| otherwise = ifConfigWallRotate w
where
keyl = rotateCameraPlusKey (_keyConfig w) `S.member` _keys w
keyr = rotateCameraMinusKey (_keyConfig w) `S.member` _keys w
keyl = SDL.ScancodeQ `S.member` _keys w
keyr = SDL.ScancodeE `S.member` _keys w
zoomCamBy :: Float -> World -> World
zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01}
--zoomCamBy :: Float -> World -> World
--zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01}
zoomFromItem
:: ItZoom
@@ -154,11 +154,11 @@ zoomNoItem = min 20 . max 0.2
{- Automatically sets the zoom of the camera according to the surrounding walls. -}
autoZoomCamera :: World -> World
autoZoomCamera w
| zoomInKey (_keyConfig w) `S.member` _keys w
= zoomCamBy 0.01 w
| zoomOutKey (_keyConfig w) `S.member` _keys w
= zoomCamBy (-0.01) w
| otherwise = w & cameraZoom %~ changeZoom
-- | zoomInKey (_keyConfig w) `S.member` _keys w
-- = zoomCamBy 0.01 w
-- | zoomOutKey (_keyConfig w) `S.member` _keys w
-- = zoomCamBy (-0.01) w
= w & cameraZoom %~ changeZoom
where
camPos = _cameraViewFrom w
wallZoom = farWallDist camPos w
src/Dodge/WorldEvent.hs
+1 -1
View File
@@ -55,4 +55,4 @@ damCrsOnLine dam p1 p2 = over creatures (IM.map damIfOnLine)
| otherwise = cr
makeTLight :: Int -> Float -> Point3 -> Point3 -> World -> World
makeTLight i rad col p = tempLightSources %~ (tLight i rad col p :)
makeTLight i rad (V3 r g b) p = tempLightSources %~ (tlsTimeRadColPos i rad (V3 r g b) p :)
src/Dodge/WorldEvent/Explosion.hs
+2 -1
View File
@@ -8,6 +8,7 @@ module Dodge.WorldEvent.Explosion
, makeTeslaExplosionAt
) where
import Dodge.Data
import Dodge.LightSource
import Dodge.Default
import Dodge.Zone
import Dodge.Base.Collide
@@ -78,7 +79,7 @@ makeExplosionAt p w
. over tempLightSources (theTLS :)
$ makeShockwaveAt [] p 50 50 1 white w
where
theTLS = defaultTLS {_tlsPos = addZ 20 p, _tlsIntensity = V3 1 0.5 0, _tlsTime = 20, _tlsRad = 150}
theTLS = tlsTimeRadColPos 20 150 (V3 1 0.5 0) (addZ 20 p)
fVs = replicateM 15 (randInCirc 1) & evalState $ _randGen w
fPs'' = replicateM 15 (fmap (15 *.*.*) randInHemisphere) & evalState $ _randGen w
(fPs',zs) = let (a,b,c) = unzip3 $ map fromV3 fPs''
src/Dodge/WorldEvent/Flash.hs
+2 -6
View File
@@ -59,7 +59,7 @@ flareCircleAt col alphax tranv = particles %~ (theFlareCircle :)
}
explosionFlashAt :: Point2 -> World -> World
explosionFlashAt p = tempLightSources %~ (tLightTimedIntensity 20 150 intensityFunc p :)
explosionFlashAt p = tempLightSources %~ (tlsTimeRadFunPos 20 150 intensityFunc (addZ 20 p) :)
where
intensityFunc x
| x < 10 = 1 / (10 - fromIntegral x)
@@ -74,8 +74,4 @@ flameFlicker pt
| otherwise = id
where
V2 x y = _btPos' pt
theLight = defaultTLS
{ _tlsPos = V3 x y 10
, _tlsRad = 70
, _tlsIntensity = V3 0.5 0 0
}
theLight = tlsTimeRadColPos 1 70 (V3 0.5 0 0) (V3 x y 10)
src/Geometry.hs
+2
View File
@@ -14,6 +14,7 @@ module Geometry
, module Geometry.Intersect
, module Geometry.Bezier
, module Geometry.Vector
, module Geometry.Vector3D
, module Geometry.LHS
)
where
@@ -21,6 +22,7 @@ import Geometry.Data
import Geometry.Intersect
import Geometry.Bezier
import Geometry.Vector
import Geometry.Vector3D
import Geometry.LHS
import Geometry.ConvexPoly