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

Cleanup

Browse Source
This commit is contained in:
justin
2022-12-28 10:21:00 +00:00
parent 2d4a55dee0
commit d1f80f1f7f
7 changed files with 76 additions and 138 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/You.hs
+1 -1
View File
@@ -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
src/Dodge/Button/Event.hs
+2 -1
View File
@@ -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 )
src/Dodge/Menu.hs
+1 -1
View File
@@ -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
src/Dodge/Render.hs
+1 -1
View File
@@ -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
src/Dodge/Render/Lights.hs
+9 -7
View File
@@ -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)
src/Dodge/SoundLogic.hs
+37 -103
View File
@@ -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
src/Dodge/Update/Camera.hs
+25 -24
View File
@@ -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