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