diff --git a/src/Dodge/Base/You.hs b/src/Dodge/Base/You.hs index a65dce00c..c470d2818 100644 --- a/src/Dodge/Base/You.hs +++ b/src/Dodge/Base/You.hs @@ -14,7 +14,7 @@ yourItem :: World -> Maybe Item yourItem w = _crInv (you w) IM.!? crSel (you w) yourInv :: World -> IM.IntMap Item -yourInv w = _crInv (you w) +yourInv = _crInv . you yourInvSel :: World -> Int yourInvSel = crSel . you diff --git a/src/Dodge/Button/Event.hs b/src/Dodge/Button/Event.hs index debfe56ef..f2a32b325 100644 --- a/src/Dodge/Button/Event.hs +++ b/src/Dodge/Button/Event.hs @@ -1,5 +1,6 @@ module Dodge.Button.Event where +import Sound.Data import Control.Lens import Dodge.Data.World import Dodge.SoundLogic @@ -28,7 +29,7 @@ flipSwitch oneff offeff bt where turnon = (btState .~ BtOn) . (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 -- BtOff -> effOn . (buttons . ix (_btID b) %~ turnOn ) diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 96216b719..1537366d0 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -201,7 +201,7 @@ gameOverMenu u = --charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum 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 displayConfig :: Universe -> ScreenLayer diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 3a1e3ac6e..98e7f17e1 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -38,7 +38,7 @@ doDrawing pdata u = do wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig) resFact = resFactorNum $ cfig ^. graphics_resolution_factor (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 viewFrom3d = Vector3 vfx vfy 20 shadV = _pictureShaders pdata diff --git a/src/Dodge/Render/Lights.hs b/src/Dodge/Render/Lights.hs index cd55f5c91..f28e66b26 100644 --- a/src/Dodge/Render/Lights.hs +++ b/src/Dodge/Render/Lights.hs @@ -3,20 +3,22 @@ module Dodge.Render.Lights ( ) where import Data.Maybe -import Dodge.Data.Universe +import Dodge.Data.LWorld +import Dodge.Data.CamPos +import Dodge.Data.Config import Geometry import qualified IntMapHelp as IM import Control.Lens -lightsToRender :: Configuration -> World -> [(Point3, Float, Point3)] -lightsToRender cfig w = - mapMaybe getLS (IM.elems $ w ^. cWorld . lWorld . lightSources) - ++ mapMaybe getTLS (w ^. cWorld . lWorld . tempLightSources) +lightsToRender :: Configuration -> CamPos -> LWorld -> [(Point3, Float, Point3)] +lightsToRender cfig campos w = + mapMaybe getLS (IM.elems $ w ^. lightSources) + ++ mapMaybe getTLS (w ^. tempLightSources) where getLS = getlsparam . _lsParam getTLS = getlsparam . _tlsParam - cbox = w ^. cWorld . camPos . camBoundBox - cpos = w ^. cWorld . camPos . camCenter + cbox = campos ^. camBoundBox + cpos = campos ^. camCenter getlsparam ls | not (pointInPolygon lpos cbox) && extraculltest = Nothing | otherwise = Just (_lsPos ls, rad ^ (2 :: Int), _lsCol ls) diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index 297776d8f..42e3c6813 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -9,9 +9,9 @@ module Dodge.SoundLogic ( soundStart, soundContinue, soundContinueVol, - soundFromGeneral, soundMultiFrom, stopSoundFrom, + soundWithStatus, -- * helper to determine the angle of a sound given a world position soundAngle, @@ -27,7 +27,7 @@ import Control.Lens import Data.Int (Int16) import qualified Data.Map as M import Data.Maybe -import Dodge.Data.Universe +import Dodge.Data.World import Dodge.SoundLogic.LoadSound import Geometry.Data import Geometry.Vector @@ -42,43 +42,9 @@ pauseSound :: World -> World pauseSound w = w -- | Placeholder... -resumeSound :: Universe -> Universe +resumeSound :: World -> World 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 :: -- | Volume factor, 0 - 1 Float -> @@ -93,25 +59,41 @@ soundWithStatusVolume :: Maybe Int -> 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 --- where --- sound = Sound --- { _soundChunkID = sType --- , _soundTime = mtime --- , _soundStatus = SoundStatus --- {_playStatus = status --- ,_isLooping = isJust mtime --- } --- , _soundChannel = Nothing --- , _soundAngDist = Just (a,floor (225 * (1 - vol))) --- , _soundPos = pos --- , _soundVolume = soundToVol sType * vol --- , _soundVolumeFraction = vol --- } --- f _ s = s {_soundTime = mtime } --- a = soundAngle pos w +aSound :: + -- | Volume factor, 0 - 1 + Float -> + PlayStatus -> + -- | Position of sound + Point2 -> + -- | ID of sound to be played + SoundID -> + -- | Frames to play sound for, Nothing for until finished + Maybe Int -> + World -> + Sound +aSound vol status fpos sType mtime w = + Sound + { _soundChunkID = sType + , _soundTime = mtime + , _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 :: PlayStatus -> @@ -169,37 +151,6 @@ soundContinueVol :: World 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'. Within 10 units considers the sound to be directly in front. -} @@ -230,23 +181,6 @@ soundMultiFrom :: World -> World 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 | so `M.member` _playingSounds w = soundMultiFrom sos pos sType mtime w | otherwise = over toPlaySounds (M.insert so sound) w diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 137fd9d56..2af39696b 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -32,52 +32,53 @@ updateCamera :: Configuration -> World -> World updateCamera cfig w = w & over (cWorld . camPos) (setViewDistance cfig) - & moveZoomCamera cfig + & cWorld . camPos %~ moveZoomCamera cfig (w ^. input) (you w) & updateScopeZoom & rotateCamera cfig -moveZoomCamera :: Configuration -> World -> World -moveZoomCamera cfig w = - w - & cWorld . camPos . camCenter .~ newcen - & cWorld . camPos . camViewFrom .~ newvf - & cWorld . camPos . camZoom .~ newzoom - & cWorld . camPos . camDefaultZoom .~ newDefaultZoom - & cWorld . camPos . camItemZoom .~ newItemZoom +moveZoomCamera :: Configuration -> Input -> Creature -> CamPos -> CamPos +moveZoomCamera cfig theinput cr campos = + campos + & camCenter .~ newcen + & camViewFrom .~ newvf + & camZoom .~ newzoom + & camDefaultZoom .~ newDefaultZoom + & camItemZoom .~ newItemZoom where --cfig = _uvConfig uv --w = _uvWorld uv - cpos = _crPos (you w) + cpos = _crPos cr + mitm = cr ^? crInv . ix (crSel cr) newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset vfoffset = do - iscam <- yourItem w ^? _Just . itScope . scopeIsCamera + iscam <- mitm ^? _Just . itScope . scopeIsCamera guard iscam - guard (SDL.ButtonRight `M.member` _mouseButtons (_input w)) - yourItem w ^? _Just . itScope . scopePos + guard (SDL.ButtonRight `M.member` _mouseButtons theinput) + mitm ^? _Just . itScope . scopePos mscopeoffset = do - guard (SDL.ButtonRight `M.member` _mouseButtons (_input w)) - yourItem w ^? _Just . itScope . scopePos + guard (SDL.ButtonRight `M.member` _mouseButtons theinput) + mitm ^? _Just . itScope . scopePos newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset - offset = rotateV (w ^. cWorld . camPos . camRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos (_input w) - newzoom = case yourItem w ^? _Just . itScope of + offset = rotateV (campos ^. camRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput + newzoom = case mitm ^? _Just . itScope of Just zs@ZoomScope{} -> _scopeZoom zs _ -> newDefaultZoom * newItemZoom idealDefaultZoom = clipZoom wallZoom - newDefaultZoom = case yourItem w ^? _Just . itScope of + newDefaultZoom = case mitm ^? _Just . itScope of Just zs@ZoomScope{} -> _scopeZoom zs - _ -> changeZoom (w ^. cWorld . camPos . camDefaultZoom) idealDefaultZoom + _ -> changeZoom (campos ^. camDefaultZoom) idealDefaultZoom idealItemZoom = fromMaybe 1 $ do - guard $ crIsAiming (you w) - zoomFromItem' <$> (yourItem w ^? _Just . itUse . heldAim . aimZoom) - newItemZoom = changeZoom (w ^. cWorld . camPos . camItemZoom) idealItemZoom + guard $ crIsAiming cr + zoomFromItem' <$> (mitm ^? _Just . itUse . heldAim . aimZoom) + newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom changeZoom curZoom idealZoom | curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed | curZoom < idealZoom - 0.01 = ((zoomInSpeed -1) * curZoom + idealZoom) / zoomInSpeed | 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)] 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 hh = halfHeight cfig -- = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom