This commit is contained in:
2022-12-28 10:21:00 +00:00
parent 2d4a55dee0
commit d1f80f1f7f
7 changed files with 76 additions and 138 deletions
+1 -1
View File
@@ -14,7 +14,7 @@ yourItem :: World -> Maybe Item
yourItem w = _crInv (you w) IM.!? crSel (you w) yourItem w = _crInv (you w) IM.!? crSel (you w)
yourInv :: World -> IM.IntMap Item yourInv :: World -> IM.IntMap Item
yourInv w = _crInv (you w) yourInv = _crInv . you
yourInvSel :: World -> Int yourInvSel :: World -> Int
yourInvSel = crSel . you yourInvSel = crSel . you
+2 -1
View File
@@ -1,5 +1,6 @@
module Dodge.Button.Event where module Dodge.Button.Event where
import Sound.Data
import Control.Lens import Control.Lens
import Dodge.Data.World import Dodge.Data.World
import Dodge.SoundLogic import Dodge.SoundLogic
@@ -28,7 +29,7 @@ flipSwitch oneff offeff bt
where where
turnon = (btState .~ BtOn) . (btText .~ "SWITCH\\") turnon = (btState .~ BtOn) . (btText .~ "SWITCH\\")
turnoff = (btState .~ BtOff) . (btText .~ "SWITCH/") turnoff = (btState .~ BtOff) . (btText .~ "SWITCH/")
dosound = soundFromGeneral (LeverSound 0) (const $ _btPos bt) click1S Nothing dosound = soundWithStatus ToStart (LeverSound 0) (_btPos bt) click1S Nothing
-- switchEffect b = case _btState b of -- switchEffect b = case _btState b of
-- BtOff -> effOn . (buttons . ix (_btID b) %~ turnOn ) -- BtOff -> effOn . (buttons . ix (_btID b) %~ turnOn )
+1 -1
View File
@@ -201,7 +201,7 @@ gameOverMenu u =
--charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum --charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
unpause :: Universe -> Universe unpause :: Universe -> Universe
unpause w = resumeSound $ w & uvScreenLayers .~ [] unpause w = over uvWorld resumeSound $ w & uvScreenLayers .~ []
-- note that this won't update after it is first loaded -- note that this won't update after it is first loaded
displayConfig :: Universe -> ScreenLayer displayConfig :: Universe -> ScreenLayer
+1 -1
View File
@@ -38,7 +38,7 @@ doDrawing pdata u = do
wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig) wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
resFact = resFactorNum $ cfig ^. graphics_resolution_factor resFact = resFactorNum $ cfig ^. graphics_resolution_factor
(wallPointsCol, windowPoints, wallSPics) = wallsToDraw w (wallPointsCol, windowPoints, wallSPics) = wallsToDraw w
lightPoints = lightsToRender cfig w lightPoints = lightsToRender cfig (w ^. cWorld . camPos) (w ^. cWorld . lWorld)
viewFroms@(V2 vfx vfy) = w ^. cWorld . camPos . camViewFrom viewFroms@(V2 vfx vfy) = w ^. cWorld . camPos . camViewFrom
viewFrom3d = Vector3 vfx vfy 20 viewFrom3d = Vector3 vfx vfy 20
shadV = _pictureShaders pdata shadV = _pictureShaders pdata
+9 -7
View File
@@ -3,20 +3,22 @@ module Dodge.Render.Lights (
) where ) where
import Data.Maybe import Data.Maybe
import Dodge.Data.Universe import Dodge.Data.LWorld
import Dodge.Data.CamPos
import Dodge.Data.Config
import Geometry import Geometry
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import Control.Lens import Control.Lens
lightsToRender :: Configuration -> World -> [(Point3, Float, Point3)] lightsToRender :: Configuration -> CamPos -> LWorld -> [(Point3, Float, Point3)]
lightsToRender cfig w = lightsToRender cfig campos w =
mapMaybe getLS (IM.elems $ w ^. cWorld . lWorld . lightSources) mapMaybe getLS (IM.elems $ w ^. lightSources)
++ mapMaybe getTLS (w ^. cWorld . lWorld . tempLightSources) ++ mapMaybe getTLS (w ^. tempLightSources)
where where
getLS = getlsparam . _lsParam getLS = getlsparam . _lsParam
getTLS = getlsparam . _tlsParam getTLS = getlsparam . _tlsParam
cbox = w ^. cWorld . camPos . camBoundBox cbox = campos ^. camBoundBox
cpos = w ^. cWorld . camPos . camCenter cpos = campos ^. camCenter
getlsparam ls getlsparam ls
| not (pointInPolygon lpos cbox) && extraculltest = Nothing | not (pointInPolygon lpos cbox) && extraculltest = Nothing
| otherwise = Just (_lsPos ls, rad ^ (2 :: Int), _lsCol ls) | otherwise = Just (_lsPos ls, rad ^ (2 :: Int), _lsCol ls)
+37 -103
View File
@@ -9,9 +9,9 @@ module Dodge.SoundLogic (
soundStart, soundStart,
soundContinue, soundContinue,
soundContinueVol, soundContinueVol,
soundFromGeneral,
soundMultiFrom, soundMultiFrom,
stopSoundFrom, stopSoundFrom,
soundWithStatus,
-- * helper to determine the angle of a sound given a world position -- * helper to determine the angle of a sound given a world position
soundAngle, soundAngle,
@@ -27,7 +27,7 @@ import Control.Lens
import Data.Int (Int16) import Data.Int (Int16)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe import Data.Maybe
import Dodge.Data.Universe import Dodge.Data.World
import Dodge.SoundLogic.LoadSound import Dodge.SoundLogic.LoadSound
import Geometry.Data import Geometry.Data
import Geometry.Vector import Geometry.Vector
@@ -42,43 +42,9 @@ pauseSound :: World -> World
pauseSound w = w pauseSound w = w
-- | Placeholder... -- | Placeholder...
resumeSound :: Universe -> Universe resumeSound :: World -> World
resumeSound w = w resumeSound w = w
soundWithStatusVolumeGeneral ::
-- | Volume factor, 0 - 1
Float ->
PlayStatus ->
-- | \"Creator\" of sound
SoundOrigin ->
-- | Position of sound
(World -> Point2) ->
-- | ID of sound to be played
SoundID ->
-- | Frames to play sound for, Nothing for until finished
Maybe Int ->
World ->
World
soundWithStatusVolumeGeneral vol status so fpos sType mtime w = w & toPlaySounds %~ M.insertWith f so sound
where
sound =
Sound
{ _soundChunkID = sType
, _soundTime = mtime
, _soundStatus =
SoundStatus
{ _playStatus = status
, _isLooping = isJust mtime
}
, _soundChannel = Nothing
, _soundAngDist = Just (a, floor (225 * (1 - vol)))
, _soundPos = fpos w
, _soundVolume = soundToVol sType * vol
, _soundVolumeFraction = vol
}
f _ s = s{_soundTime = mtime}
a = soundAngle (fpos w) w
soundWithStatusVolume :: soundWithStatusVolume ::
-- | Volume factor, 0 - 1 -- | Volume factor, 0 - 1
Float -> Float ->
@@ -93,25 +59,41 @@ soundWithStatusVolume ::
Maybe Int -> Maybe Int ->
World -> World ->
World World
soundWithStatusVolume vol status so pos = soundWithStatusVolumeGeneral vol status so (const pos) soundWithStatusVolume vol status so fpos sType mtime w =
w & toPlaySounds
%~ M.insert
so
(aSound vol status fpos sType mtime w)
--soundWithStatusVolume vol status so pos sType mtime w = w & toPlaySounds %~ M.insertWith f so sound aSound ::
-- where -- | Volume factor, 0 - 1
-- sound = Sound Float ->
-- { _soundChunkID = sType PlayStatus ->
-- , _soundTime = mtime -- | Position of sound
-- , _soundStatus = SoundStatus Point2 ->
-- {_playStatus = status -- | ID of sound to be played
-- ,_isLooping = isJust mtime SoundID ->
-- } -- | Frames to play sound for, Nothing for until finished
-- , _soundChannel = Nothing Maybe Int ->
-- , _soundAngDist = Just (a,floor (225 * (1 - vol))) World ->
-- , _soundPos = pos Sound
-- , _soundVolume = soundToVol sType * vol aSound vol status fpos sType mtime w =
-- , _soundVolumeFraction = vol Sound
-- } { _soundChunkID = sType
-- f _ s = s {_soundTime = mtime } , _soundTime = mtime
-- a = soundAngle pos w , _soundStatus =
SoundStatus
{ _playStatus = status
, _isLooping = isJust mtime
}
, _soundChannel = Nothing
, _soundAngDist = Just (a, floor (225 * (1 - vol)))
, _soundPos = fpos
, _soundVolume = soundToVol sType * vol
, _soundVolumeFraction = vol
}
where
a = soundAngle fpos w
soundWithStatus :: soundWithStatus ::
PlayStatus -> PlayStatus ->
@@ -169,37 +151,6 @@ soundContinueVol ::
World World
soundContinueVol vol = soundWithStatusVolume vol ToContinueStart soundContinueVol vol = soundWithStatusVolume vol ToContinueStart
soundFromGeneral ::
-- | \"Creator\" of sound
SoundOrigin ->
-- | Position of sound
(World -> Point2) ->
-- | ID of sound to be played
SoundID ->
-- | Frames to play sound for, Nothing for until finished
Maybe Int ->
World ->
World
soundFromGeneral = soundWithStatusVolumeGeneral 1 ToStart
--soundFromGeneral so fpos sType mtime w = w & toPlaySounds %~ M.insertWith f so sound
-- where
-- sound = Sound
-- { _soundChunkID = sType
-- , _soundTime = mtime
-- , _soundStatus = SoundStatus
-- { _playStatus = ToStart
-- , _isLooping = isJust mtime
-- }
-- , _soundChannel = Nothing
-- , _soundAngDist = Just (a,0)
-- , _soundPos = fpos w
-- , _soundVolume = soundToVol sType
-- , _soundVolumeFraction = 1
-- }
-- f _ s = s {_soundTime = mtime }
-- a = soundAngle (fpos w) w
{- | Calculates the angle of a sound with reference to '_cameraViewFrom'. {- | Calculates the angle of a sound with reference to '_cameraViewFrom'.
Within 10 units considers the sound to be directly in front. Within 10 units considers the sound to be directly in front.
-} -}
@@ -230,23 +181,6 @@ soundMultiFrom ::
World -> World ->
World World
soundMultiFrom [] _ _ _ w = w soundMultiFrom [] _ _ _ w = w
--soundMultiFrom [so] pos sType mtime w
-- = over toPlaySounds (M.insert so sound) w
-- where
-- sound = Sound
-- { _soundChunkID = sType
-- , _soundTime = mtime
-- , _soundStatus = SoundStatus
-- { _playStatus = ToStart
-- , _isLooping = isJust mtime
-- }
-- , _soundChannel = Nothing
-- , _soundAngDist = Just (a,0)
-- , _soundPos = pos
-- , _soundVolume = soundToVol sType
-- , _soundVolumeFraction = 1
-- }
-- a = soundAngle pos w
soundMultiFrom (so : sos) pos sType mtime w soundMultiFrom (so : sos) pos sType mtime w
| so `M.member` _playingSounds w = soundMultiFrom sos pos sType mtime w | so `M.member` _playingSounds w = soundMultiFrom sos pos sType mtime w
| otherwise = over toPlaySounds (M.insert so sound) w | otherwise = over toPlaySounds (M.insert so sound) w
+25 -24
View File
@@ -32,52 +32,53 @@ updateCamera :: Configuration -> World -> World
updateCamera cfig w = updateCamera cfig w =
w w
& over (cWorld . camPos) (setViewDistance cfig) & over (cWorld . camPos) (setViewDistance cfig)
& moveZoomCamera cfig & cWorld . camPos %~ moveZoomCamera cfig (w ^. input) (you w)
& updateScopeZoom & updateScopeZoom
& rotateCamera cfig & rotateCamera cfig
moveZoomCamera :: Configuration -> World -> World moveZoomCamera :: Configuration -> Input -> Creature -> CamPos -> CamPos
moveZoomCamera cfig w = moveZoomCamera cfig theinput cr campos =
w campos
& cWorld . camPos . camCenter .~ newcen & camCenter .~ newcen
& cWorld . camPos . camViewFrom .~ newvf & camViewFrom .~ newvf
& cWorld . camPos . camZoom .~ newzoom & camZoom .~ newzoom
& cWorld . camPos . camDefaultZoom .~ newDefaultZoom & camDefaultZoom .~ newDefaultZoom
& cWorld . camPos . camItemZoom .~ newItemZoom & camItemZoom .~ newItemZoom
where where
--cfig = _uvConfig uv --cfig = _uvConfig uv
--w = _uvWorld uv --w = _uvWorld uv
cpos = _crPos (you w) cpos = _crPos cr
mitm = cr ^? crInv . ix (crSel cr)
newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
vfoffset = do vfoffset = do
iscam <- yourItem w ^? _Just . itScope . scopeIsCamera iscam <- mitm ^? _Just . itScope . scopeIsCamera
guard iscam guard iscam
guard (SDL.ButtonRight `M.member` _mouseButtons (_input w)) guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
yourItem w ^? _Just . itScope . scopePos mitm ^? _Just . itScope . scopePos
mscopeoffset = do mscopeoffset = do
guard (SDL.ButtonRight `M.member` _mouseButtons (_input w)) guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
yourItem w ^? _Just . itScope . scopePos mitm ^? _Just . itScope . scopePos
newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
offset = rotateV (w ^. cWorld . camPos . camRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos (_input w) offset = rotateV (campos ^. camRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
newzoom = case yourItem w ^? _Just . itScope of newzoom = case mitm ^? _Just . itScope of
Just zs@ZoomScope{} -> _scopeZoom zs Just zs@ZoomScope{} -> _scopeZoom zs
_ -> newDefaultZoom * newItemZoom _ -> newDefaultZoom * newItemZoom
idealDefaultZoom = clipZoom wallZoom idealDefaultZoom = clipZoom wallZoom
newDefaultZoom = case yourItem w ^? _Just . itScope of newDefaultZoom = case mitm ^? _Just . itScope of
Just zs@ZoomScope{} -> _scopeZoom zs Just zs@ZoomScope{} -> _scopeZoom zs
_ -> changeZoom (w ^. cWorld . camPos . camDefaultZoom) idealDefaultZoom _ -> changeZoom (campos ^. camDefaultZoom) idealDefaultZoom
idealItemZoom = fromMaybe 1 $ do idealItemZoom = fromMaybe 1 $ do
guard $ crIsAiming (you w) guard $ crIsAiming cr
zoomFromItem' <$> (yourItem w ^? _Just . itUse . heldAim . aimZoom) zoomFromItem' <$> (mitm ^? _Just . itUse . heldAim . aimZoom)
newItemZoom = changeZoom (w ^. cWorld . camPos . camItemZoom) idealItemZoom newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom
changeZoom curZoom idealZoom changeZoom curZoom idealZoom
| curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed | curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed
| curZoom < idealZoom - 0.01 = ((zoomInSpeed -1) * curZoom + idealZoom) / zoomInSpeed | curZoom < idealZoom - 0.01 = ((zoomInSpeed -1) * curZoom + idealZoom) / zoomInSpeed
| otherwise = idealZoom | otherwise = idealZoom
wallZoom = min4 (w ^. cWorld . camPos . camBoundDist) wallZoom = min4 (campos ^. camBoundDist)
min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)] min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)]
maxd = max distFromEqmnt maxd = max distFromEqmnt
distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment $ you w distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment $ cr
hw = halfWidth cfig hw = halfWidth cfig
hh = halfHeight cfig hh = halfHeight cfig
-- = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom -- = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom