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-07-26 10:22:55 +01:00
parent 0d479cba87
commit 5c8e786dfa
24 changed files with 191 additions and 158 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Coordinate.hs
+4 -3
View File
@@ -30,8 +30,9 @@ crToMousePosOffset :: Creature -> World -> (Point2,Float)
crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr,0)
{- | The mouse position in world coordinates. -}
mouseWorldPos :: World -> Point2
mouseWorldPos w = _cameraCenter (_cWorld w) +.+ (1/_cameraZoom (_cWorld w)) *.* rotateV (_cameraRot (_cWorld w)) (_mousePos (_cWorld w))
mouseWorldPos w = _cameraCenter (_cWorld w) +.+
(1/_cameraZoom (_cWorld w)) *.* rotateV (_cameraRot (_cWorld w)) (_mousePos w)
{- | The mouse position in map coordinates -}
mouseCartePos :: World -> Point2
mouseCartePos w = _carteCenter (_hud (_cWorld w)) +.+ (1/_carteZoom (_hud (_cWorld w)))
*.* rotateV (_carteRot (_hud (_cWorld w))) (_mousePos (_cWorld w))
mouseCartePos w = _carteCenter (_hud (_cWorld w)) +.+
(1/_carteZoom (_hud (_cWorld w))) *.* rotateV (_carteRot (_hud (_cWorld w))) (_mousePos w)
src/Dodge/Combine/Data.hs
+1 -1
View File
@@ -4,7 +4,7 @@ module Dodge.Combine.Data
where
import GHC.Generics
import Data.Aeson
import Dodge.Equipment.Data
import Dodge.Data.Equipment.Misc
import Dodge.Data.ItemAmount
import Control.Lens
import qualified Data.Map.Strict as M
src/Dodge/Creature/Impulse/UseItem.hs
+1 -1
View File
@@ -46,7 +46,7 @@ itemEffect cr it w = case it ^? itUse of
tryReload :: Creature -> Item -> World -> (World -> World) -> World -> World
tryReload cr it w f
| _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons (_cWorld w) M.!? SDL.ButtonLeft == Just False
| _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False
= crToggleReloading cr
| otherwise
= (runIdentity . pointToItem (_itPos it) (return . (itUse . useHammer .~ HammerDown)))
src/Dodge/Creature/YourControl.hs
+4 -4
View File
@@ -19,7 +19,7 @@ yourControl cr w
| inTermFocus w = dimCreatureLight cr w & updateUsingInput
| otherwise = dimCreatureLight cr w
& cWorld . creatures . ix (_crID cr) %~
(wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_cWorld w)))
(wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w))
& updateUsingInput
dimCreatureLight :: Creature -> World -> World
@@ -35,7 +35,7 @@ wasdWithAiming
-> Creature
wasdWithAiming w speed cr
| isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr
| crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_cWorld w)
| crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons w
= addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr
| otherwise = theMovement $ theTurn $ removeTwist cr
where
@@ -57,7 +57,7 @@ wasdWithAiming w speed cr
isAiming = _posture (_crStance cr) == Aiming
mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of
Just _ -> argV $ mouseWorldPos w -.- _crPos cr
_ -> argV (_mousePos (_cWorld w)) + _cameraRot (_cWorld w)
_ -> argV (_mousePos w) + _cameraRot (_cWorld w)
wasdM :: SDL.Scancode -> Point2
wasdM scancode = case scancode of
@@ -68,7 +68,7 @@ wasdM scancode = case scancode of
_ -> V2 0 0
wasdDir :: World -> Point2
wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys . _cWorld
wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys
{- | Set posture according to mouse presses. -}
mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature
src/Dodge/Data.hs
+5 -12
View File
@@ -70,7 +70,6 @@ module Dodge.Data
, module Dodge.Item.Attachment.Data
, module Dodge.Item.Data
, module Dodge.Config.Data
, module Dodge.Equipment.Data
, module MaybeHelp
, module Dodge.Data.ItemAmount
, module Dodge.RoomCluster.Data
@@ -165,7 +164,6 @@ import Dodge.Creature.Stance.Data
import Dodge.Creature.Perception.Data
import Dodge.Creature.Memory.Data
import Dodge.Distortion.Data
import Dodge.Equipment.Data
import Dodge.Data.SoundOrigin
import Dodge.Data.Damage
import Dodge.Combine.Data
@@ -217,12 +215,13 @@ data World = World
, _randGen :: StdGen
, _toPlaySounds :: M.Map SoundOrigin Sound
, _playingSounds :: M.Map SoundOrigin Sound
, _mousePos :: Point2
, _keys :: S.Set Scancode
, _mouseButtons :: M.Map MouseButton Bool
, _hammers :: M.Map WorldHammer HammerPosition
}
data CWorld = CWorld
{ _keys :: S.Set Scancode
, _mouseButtons :: M.Map MouseButton Bool
, _mousePos :: Point2
, _cameraCenter :: Point2
{ _cameraCenter :: Point2
, _cameraRot :: Float
, _cameraZoom :: Float -- smaller values zoom out
, _itemZoom :: Float
@@ -236,7 +235,6 @@ data CWorld = CWorld
, _creatureGroups :: IM.IntMap CrGroupParams
, _itemPositions :: IM.IntMap ItemPos
, _clouds :: [Cloud]
--, _clZoning :: Zoning [] Cloud
, _clZoning :: IM.IntMap (IM.IntMap [Cloud]) --Zoning IM.IntMap Creature
, _gusts :: IM.IntMap Gust
, _gsZoning :: IM.IntMap (IM.IntMap IS.IntSet)
@@ -244,8 +242,6 @@ data CWorld = CWorld
, _projectiles :: IM.IntMap Proj
, _instantBullets :: [Bullet]
, _bullets :: [Bullet]
-- , _instantParticles :: [Particle]
-- , _particles :: [Particle]
, _radarSweeps :: [RadarSweep]
, _energyBalls :: [EnergyBall]
, _posEvents :: [PosEvent]
@@ -284,8 +280,6 @@ data CWorld = CWorld
, _corpses :: IM.IntMap Corpse
, _clickMousePos :: Point2
, _pathGraph :: Gr Point2 PathEdge
--, _pnZoning :: Zoning [] (Int,Point2)
--, _peZoning :: Zoning [] (Int,Int,PathEdge)
, _pnZoning :: IM.IntMap (IM.IntMap [(Int,Point2)]) --Zoning IM.IntMap Creature
, _peZoning :: IM.IntMap (IM.IntMap [(Int,Int,PathEdge)]) --Zoning IM.IntMap Creature
, _hud :: HUD
@@ -303,7 +297,6 @@ data CWorld = CWorld
, _rewindWorlds :: [CWorld]
, _timeFlow :: TimeFlowStatus
, _worldClock :: Int
, _hammers :: M.Map WorldHammer HammerPosition
, _backspaceTimer :: Int
, _genParams :: GenParams
, _deathDelay :: Maybe Int
src/Dodge/Data/Creature.hs
-1
View File
@@ -19,7 +19,6 @@ import Dodge.Creature.Perception.Data
import Dodge.Creature.Memory.Data
import Dodge.Creature.Stance.Data
import Dodge.Creature.State.Data
import Dodge.Equipment.Data
import Geometry.Data
import qualified IntMapHelp as IM
import qualified Data.Map.Strict as M
src/Dodge/Data/Equipment.hs
+35
View File
@@ -0,0 +1,35 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.Equipment
( module Dodge.Data.Equipment.Misc
, module Dodge.Data.Equipment
)
where
import Dodge.Data.Item.HeldUse
import Dodge.Data.Equipment.Misc
import GHC.Generics
import Data.Aeson
import Control.Lens
data Equipment = Equipment
{ _eqUse :: Euse --Item -> Creature -> World -> World
, _eqOnEquip :: Euse --Item -> Creature -> World -> World
, _eqOnRemove :: Euse --Item -> Creature -> World -> World
, _eqSite :: EquipSite
, _eqParams :: EquipParams
, _eqViewDist :: Maybe Float
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Equipment where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Equipment
data EquipParams
= NoEquipParams
| EquipID {_eparamID :: Int}
| EquipCounter {_eparamInt :: Int}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON EquipParams where
toEncoding = genericToEncoding defaultOptions
instance FromJSON EquipParams
makeLenses ''Equipment
makeLenses ''EquipParams
src/Dodge/Equipment/Data.hs → src/Dodge/Data/Equipment/Misc.hs
+2 -1
View File
@@ -1,6 +1,7 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Equipment.Data where
module Dodge.Data.Equipment.Misc
where
import GHC.Generics
import Data.Aeson
data EquipSite
src/Dodge/Data/Item/Use.hs
+6 -24
View File
@@ -1,14 +1,18 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Item.Use where
module Dodge.Data.Item.Use
( module Dodge.Data.Item.Use
, module Dodge.Data.Equipment
)
where
import GHC.Generics
import Data.Aeson
import Dodge.Data.Item.HeldUse
import Dodge.Data.Item.HeldScroll
import Dodge.Data.Item.UseDelay
import Dodge.Data.Hammer
import Dodge.Equipment.Data
import Dodge.Data.Equipment
import Control.Lens
data ItemUse
= RightUse
@@ -36,18 +40,6 @@ data ItemUse
instance ToJSON ItemUse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemUse
data Equipment = Equipment
{ _eqUse :: Euse --Item -> Creature -> World -> World
, _eqOnEquip :: Euse --Item -> Creature -> World -> World
, _eqOnRemove :: Euse --Item -> Creature -> World -> World
, _eqSite :: EquipSite
, _eqParams :: EquipParams
, _eqViewDist :: Maybe Float
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Equipment where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Equipment
data AimParams = AimParams
{ _aimWeight :: Int
, _aimRange :: Float
@@ -69,14 +61,6 @@ data AimStance
instance ToJSON AimStance where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AimStance
data EquipParams
= NoEquipParams
| EquipID {_eparamID :: Int}
| EquipCounter {_eparamInt :: Int}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON EquipParams where
toEncoding = genericToEncoding defaultOptions
instance FromJSON EquipParams
data ItZoom = ItZoom
{ _itZoomMax :: Float
, _itZoomMin :: Float
@@ -87,7 +71,5 @@ instance ToJSON ItZoom where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItZoom
makeLenses ''ItemUse
makeLenses ''Equipment
makeLenses ''AimParams
makeLenses ''EquipParams
makeLenses ''ItZoom
src/Dodge/Data/RightButtonOptions.hs
+1 -1
View File
@@ -4,7 +4,7 @@
module Dodge.Data.RightButtonOptions where
import GHC.Generics
import Data.Aeson
import Dodge.Equipment.Data
import Dodge.Data.Equipment.Misc
import Control.Lens
data RightButtonOptions
src/Dodge/Default/World.hs
+6 -6
View File
@@ -15,16 +15,18 @@ defaultWorld = World
, _toPlaySounds = M.empty
, _playingSounds = M.empty
, _randGen = mkStdGen 2
, _keys = S.empty
, _mouseButtons = mempty
, _mousePos = V2 0 0
, _hammers = defaultWorldHammers
}
defaultCWorld :: CWorld
defaultCWorld = CWorld
{ _keys = S.empty
, _magnets = IM.empty
, _mouseButtons = mempty
, _cameraCenter = V2 0 0
{ _cameraCenter = V2 0 0
, _cameraRot = 0
, _cameraZoom = 1
, _magnets = IM.empty
, _itemZoom = 1
, _defaultZoom = 1
, _cameraViewFrom = V2 0 0
@@ -70,7 +72,6 @@ defaultCWorld = CWorld
, _wlZoning = IM.empty --Zoning IM.empty wlZoneSize zoneOfWall
, _floorItems = IM.empty
, _floorTiles = []
, _mousePos = V2 0 0
, _yourID = 0
, _worldEvents = []
, _delayedEvents = []
@@ -109,7 +110,6 @@ defaultCWorld = CWorld
, _maybeWorld = Nothing'
, _rewindWorlds = []
, _timeFlow = NormalTimeFlow
, _hammers = defaultWorldHammers
, _backspaceTimer = 0
, _genParams = GenParams M.empty
-- , _genPlacements = IM.empty
src/Dodge/Event.hs
+6 -6
View File
@@ -46,7 +46,7 @@ handleEvent e = case eventPayload e of
_ -> return . Just
handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe
handleMouseMotionEvent mmev u = Just $ u & uvWorld . cWorld . mousePos .~ V2
handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
(fromIntegral x - 0.5*_windowX cfig)
(0.5*_windowY cfig - fromIntegral y)
where
@@ -55,8 +55,8 @@ handleMouseMotionEvent mmev u = Just $ u & uvWorld . cWorld . mousePos .~ V2
handleMouseButtonEvent :: MouseButtonEventData -> World -> World
handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
Released -> cWorld . mouseButtons . at thebutton .~ Nothing
Pressed -> cWorld . mouseButtons . at thebutton ?~ False
Released -> mouseButtons . at thebutton .~ Nothing
Pressed -> mouseButtons . at thebutton ?~ False
where
thebutton = mouseButtonEventButton mbev
@@ -135,9 +135,9 @@ wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
numcombs = length $ combineItemListYou w
yi = round $ signum y
numLocs = (fst . IM.findMax $ _seenLocations (_cWorld w)) + 1
rbDown = ButtonRight `M.member` _mouseButtons (_cWorld w)
lbDown = ButtonLeft `M.member` _mouseButtons (_cWorld w)
invKeyDown = ScancodeCapsLock `S.member` _keys (_cWorld w)
rbDown = ButtonRight `M.member` _mouseButtons w
lbDown = ButtonLeft `M.member` _mouseButtons w
invKeyDown = ScancodeCapsLock `S.member` _keys w
getArguments' :: TerminalCommand -> Terminal -> World -> [String]
getArguments' tc tm = ("" :) . getArguments tc tm
src/Dodge/Event/Keyboard.hs
+2 -2
View File
@@ -60,9 +60,9 @@ see 'handlePressedKeyInGame'.
-}
handleKeyboardEvent :: KeyboardEventData -> Universe -> IO (Maybe Universe)
handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
Released -> return . Just $ u & uvWorld . cWorld . keys %~ S.delete scode
Released -> return . Just $ u & uvWorld . keys %~ S.delete scode
Pressed -> handlePressedKey (keyboardEventRepeat kev) scode
(u & uvWorld . cWorld . keys %~ S.insert scode)
(u & uvWorld . keys %~ S.insert scode)
where
scode = (keysymScancode . keyboardEventKeysym) kev
src/Dodge/Item/Weapon/ExtraEffect.hs
+5 -10
View File
@@ -83,14 +83,9 @@ targetRBCreatureUp it cr w t
& tgPos .~ Nothing
& tgActive .~ False
)
| SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) && isJust (t ^? tgID . _Just)
&& canSeeTarget = (w, t & updatePos
& tgActive .~ True
)
| otherwise = (w, t & tgID .~ fmap _crID newtarg
& updatePos
& tgActive .~ False
)
| SDL.ButtonRight `M.member` _mouseButtons w && isJust (t ^? tgID . _Just)
&& canSeeTarget = (w, t & updatePos & tgActive .~ True)
| otherwise = (w, t & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False )
where
newtarg = safeMinimumOn (dist mwp . _crPos)
. filter (canseepos . _crPos)
@@ -113,7 +108,7 @@ targetUpdateWith f it _ w t
targetCursorUpdate :: World -> Targeting -> Targeting
targetCursorUpdate w t
| SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) = t
| SDL.ButtonRight `M.member` _mouseButtons w = t
& tgPos . _Just .~ mouseWorldPos w
& tgActive .~ True
| otherwise = t & tgPos %~ const Nothing
@@ -121,7 +116,7 @@ targetCursorUpdate w t
targetRBPressUpdate :: World -> Targeting -> Targeting
targetRBPressUpdate w t
| SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) = t
| SDL.ButtonRight `M.member` _mouseButtons w = t
& tgPos %~ maybe (Just $ mouseWorldPos w) Just
& tgActive .~ True
| otherwise = t & tgPos %~ const Nothing
src/Dodge/Luse.hs
-2
View File
@@ -24,10 +24,8 @@ useRewindGun _ _ w = case _rewindWorlds (_cWorld w) of
rewindusing :: CWorld -> [CWorld] -> World
rewindusing w' ws = w
& cWorld . maybeWorld .~ Just' ( w'
& upbuts
& rewindWorlds .~ ws
)
upbuts = (keys .~ _keys (_cWorld w)) . (mouseButtons .~ _mouseButtons (_cWorld w))
-- be careful changing this around; potential problems include updating the
-- creature but using the old crInvSel value
src/Dodge/Projectile/Update.hs
+6 -5
View File
@@ -123,13 +123,14 @@ retireRemoteProj'' itid pjid w = w
& cWorld . props %~ IM.delete pjid
setRemoteDir :: Int -> Int -> Proj -> World -> World
setRemoteDir cid itid pj w = w & cWorld . projectiles . ix i . prjDir .~ newdir
setRemoteDir cid itid pj w = w & cWorld . projectiles . ix (_prjID pj) . prjDir .~ newdir
where
i = _prjID pj
--i = _prjID pj
newdir
| SDL.ButtonRight `M.member` _mouseButtons (_cWorld w)
&& w ^? cWorld . creatures . ix cid . crInvSel . iselPos == w ^? cWorld . itemPositions . ix itid . ipInvID
= _cameraRot (_cWorld w) + argV (_mousePos (_cWorld w))
| SDL.ButtonRight `M.member` _mouseButtons w
&& w ^? cWorld . creatures . ix cid . crInvSel . iselPos
== w ^? cWorld . itemPositions . ix itid . ipInvID
= _cameraRot (_cWorld w) + argV (_mousePos w)
| otherwise = _prjDir pj
doThrust' :: Proj -> World -> World
src/Dodge/Render/HUD.hs
+3 -3
View File
@@ -131,7 +131,7 @@ subInventoryDisplay subinv cfig w = case subinv of
selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it
selcursor = selcursor' selcursortype
selcursortype
| ButtonRight `M.member` _mouseButtons (_cWorld w) = listCursorNESW
| ButtonRight `M.member` _mouseButtons w = listCursorNESW
| otherwise = listCursorNSW
curpos = invSelPos w
cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w)
@@ -140,7 +140,7 @@ subInventoryDisplay subinv cfig w = case subinv of
_ -> mempty
equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
rboptions = if ButtonRight `M.member` _mouseButtons (_cWorld w)
rboptions = if ButtonRight `M.member` _mouseButtons w
then drawRBOptions cfig w (_rbOptions (_cWorld w))
else mempty
@@ -257,7 +257,7 @@ topCursorTypeWidth ctype width cfig w i
determineInvSelCursorWidth :: World -> Int
determineInvSelCursorWidth w = case _rbOptions (_cWorld w) of
NoRightButtonOptions -> topInvW
EquipOptions {} -> if ButtonRight `M.member` _mouseButtons (_cWorld w)
EquipOptions {} -> if ButtonRight `M.member` _mouseButtons w
then 47
else topInvW
src/Dodge/Render/Picture.hs
+1 -1
View File
@@ -23,6 +23,6 @@ fixedCoordPictures u = case _menuLayers u of
customMouseCursor :: Configuration -> World -> Picture
customMouseCursor cfig w = winScale cfig
. uncurryV translate (_mousePos (_cWorld w))
. uncurryV translate (_mousePos w)
. color white
$ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ]
src/Dodge/Save.hs
+1 -1
View File
@@ -62,7 +62,7 @@ doQuicksave :: Universe -> Universe
doQuicksave = saveWorldInSlot QuicksaveSlot
clearKeys :: World -> World
clearKeys = (cWorld . keys .~ mempty) . (cWorld . mouseButtons .~ mempty)
clearKeys = (keys .~ mempty) . (mouseButtons .~ mempty)
saveLevelStartSlot :: Universe -> Universe
--saveLevelStartSlot = id
src/Dodge/SoundLogic.hs
+69 -40
View File
@@ -45,16 +45,16 @@ pauseSound w = w
resumeSound :: Universe -> Universe
resumeSound w = w
soundWithStatusVolume
soundWithStatusVolumeGeneral
:: Float -- ^ Volume factor, 0 - 1
-> PlayStatus
-> SoundOrigin -- ^ \"Creator\" of sound
-> Point2 -- ^ Position of sound
-> (World -> Point2) -- ^ Position of sound
-> SoundID -- ^ ID of sound to be played
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
-> World
-> World
soundWithStatusVolume vol status so pos sType mtime w = w & toPlaySounds %~ M.insertWith f so sound
soundWithStatusVolumeGeneral vol status so fpos sType mtime w = w & toPlaySounds %~ M.insertWith f so sound
where
sound = Sound
{ _soundChunkID = sType
@@ -65,12 +65,40 @@ soundWithStatusVolume vol status so pos sType mtime w = w & toPlaySounds %~ M.in
}
, _soundChannel = Nothing
, _soundAngDist = Just (a,floor (225 * (1 - vol)))
, _soundPos = pos
, _soundPos = fpos w
, _soundVolume = soundToVol sType * vol
, _soundVolumeFraction = vol
}
f _ s = s {_soundTime = mtime }
a = soundAngle pos w
a = soundAngle (fpos w) w
soundWithStatusVolume
:: Float -- ^ Volume factor, 0 - 1
-> PlayStatus
-> SoundOrigin -- ^ \"Creator\" of sound
-> Point2 -- ^ Position of sound
-> SoundID -- ^ ID of sound to be played
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
-> World
-> World
soundWithStatusVolume vol status so pos = soundWithStatusVolumeGeneral vol status so (const pos)
--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
soundWithStatus
:: PlayStatus
@@ -117,23 +145,24 @@ soundFromGeneral
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
-> World
-> World
soundFromGeneral so fpos sType mtime w = over toPlaySounds (M.insertWith f so sound) w
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
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.
@@ -153,30 +182,30 @@ soundAngle p w
{-| Uses the first free origin from a list.
Does nothing if all origins are already creating sounds. -}
soundMultiFrom
:: [SoundOrigin]
:: [SoundOrigin]
-> Point2 -- ^ Position
-> SoundID -- ^ Sound ID
-> Maybe Int -- ^ Frames to play for, Nothing for full length
-> 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] 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.hs
+5 -5
View File
@@ -78,11 +78,11 @@ updateUniverse u = case _menuLayers u of
functionalUpdate :: Universe -> Universe
functionalUpdate w = checkEndGame
-- . updateRandGen
. over uvWorld (cWorld . mouseButtons . each .~ True) -- to determine if the mouse button is held
. over uvWorld (mouseButtons . each .~ True) -- to determine if the mouse button is held
. over uvWorld (cWorld . worldClock +~ 1)
. over uvWorld updateWorldSelect
. over uvWorld doRewind
. over uvWorld (cWorld . hammers . each %~ moveHammerUp)
. over uvWorld (hammers . each %~ moveHammerUp)
. over uvWorld updateDistortions
. over uvWorld updateCreatureSoundPositions
. over uvWorld ppEvents
@@ -148,7 +148,7 @@ zoneClouds w = w
--runIdentity (S.fold_ (flip $ updateZoning (:)) (zn & znObjects .~ mempty) id (_clouds w))
updateWorldSelect :: World -> World
updateWorldSelect w = f . g $ case (w ^? cWorld . mouseButtons . ix ButtonLeft, w ^? cWorld . mouseButtons . ix ButtonRight) of
updateWorldSelect w = f . g $ case (w ^? mouseButtons . ix ButtonLeft, w ^? mouseButtons . ix ButtonRight) of
(Nothing ,Nothing) -> w
(Just False,Nothing) -> w & cWorld . lLine . _1 .~ mwp
(Just True ,Nothing) -> w & cWorld . lLine . _2 .~ mwp
@@ -157,9 +157,9 @@ updateWorldSelect w = f . g $ case (w ^? cWorld . mouseButtons . ix ButtonLeft,
(Just True ,_) -> w & cWorld . rLine . _2 .~ mwp
where
mwp = mouseWorldPos w
f | ButtonLeft `M.member` _mouseButtons (_cWorld w) = cWorld . lSelect .~ mwp
f | ButtonLeft `M.member` _mouseButtons w = cWorld . lSelect .~ mwp
| otherwise = id
g | ButtonRight `M.member` _mouseButtons (_cWorld w) = cWorld . rSelect .~ mwp
g | ButtonRight `M.member` _mouseButtons w = cWorld . rSelect .~ mwp
| otherwise = id
--mcChooseUpdate :: Machine -> Machine -> World -> World
src/Dodge/Update/Camera.hs
+8 -8
View File
@@ -55,13 +55,13 @@ moveZoomCamera uv = uv
vfoffset = do
iscam <- yourItem w ^? _Just . itScope . scopeIsCamera
guard iscam
guard (SDL.ButtonRight `M.member` _mouseButtons (_cWorld w))
guard (SDL.ButtonRight `M.member` _mouseButtons w)
yourItem w ^? _Just . itScope . scopePos
mscopeoffset = do
guard (SDL.ButtonRight `M.member` _mouseButtons (_cWorld w))
guard (SDL.ButtonRight `M.member` _mouseButtons w)
yourItem w ^? _Just . itScope . scopePos
newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
offset = rotateV (_cameraRot (_cWorld w)) $ ((newzoom - newDefaultZoom)/(newDefaultZoom*newzoom)) *.* _mousePos (_cWorld w)
offset = rotateV (_cameraRot (_cWorld w)) $ ((newzoom - newDefaultZoom)/(newDefaultZoom*newzoom)) *.* _mousePos w
--newzoom = changeZoom (_cameraZoom w) idealZoom'
newzoom = case yourItem w ^? _Just . itScope of
Just zs@ZoomScope {} -> _scopeZoom zs
@@ -93,7 +93,7 @@ moveZoomCamera uv = uv
updateScopeZoom :: World -> World
updateScopeZoom w
| SDL.ButtonRight `M.member` _mouseButtons (_cWorld w)
| SDL.ButtonRight `M.member` _mouseButtons w
= case w ^? cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0))
. itScope . scopeZoomChange of
Just x
@@ -127,7 +127,7 @@ zoomInLongGun w
wp = _crInv (_creatures (_cWorld w) IM.! 0) IM.! crSel (_creatures (_cWorld w) IM.! 0)
Just currentZoom = wp ^? itScope . scopeZoom
newzoom = (wp ^?! itScope . scopeZoom) / zoomSpeed
mousep = rotateV (_cameraRot (_cWorld w)) $ _mousePos (_cWorld w)
mousep = rotateV (_cameraRot (_cWorld w)) $ _mousePos w
zoomOutLongGun :: World -> World
zoomOutLongGun w
@@ -146,7 +146,7 @@ zoomOutLongGun w
ifConfigWallRotate :: Configuration -> World -> World
ifConfigWallRotate cfig w
| _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` _mouseButtons (_cWorld w))
| _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` _mouseButtons w)
= rotateToOverlappingWall w
| otherwise = w
@@ -185,8 +185,8 @@ rotateCamera cfig w
| keyr = rotateCameraBy (-0.025) w
| otherwise = ifConfigWallRotate cfig w
where
keyl = SDL.ScancodeQ `Set.member` _keys (_cWorld w) && notAtTerminal w
keyr = SDL.ScancodeE `Set.member` _keys (_cWorld w) && notAtTerminal w
keyl = SDL.ScancodeQ `Set.member` _keys w && notAtTerminal w
keyr = SDL.ScancodeE `Set.member` _keys w && notAtTerminal w
-- TODO check where/how this is used
notAtTerminal :: World -> Bool
src/Dodge/Update/UsingInput.hs
+20 -20
View File
@@ -21,55 +21,55 @@ import Control.Lens
updateUsingInput :: World -> World
updateUsingInput w = case _hudElement $ _hud (_cWorld w) of
DisplayInventory subinv
-> updatePressedButtons subinv (_mouseButtons (_cWorld w)) w
-> updatePressedButtons subinv (_mouseButtons w) w
DisplayCarte
-> updatePressedButtonsCarte (_mouseButtons (_cWorld w)) w
-> updatePressedButtonsCarte (_mouseButtons w) w
updatePressedButtons :: SubInventory -> M.Map MouseButton Bool -> World -> World
updatePressedButtons subinv pkeys w = case subinv of
NoSubInventory
| ButtonLeft `M.member` pkeys && w ^?! cWorld . hammers . ix SubInvHam /= HammerUp
-> w & cWorld . hammers . ix SubInvHam .~ HammerDown
| ButtonLeft `M.member` pkeys && w ^?! hammers . ix SubInvHam /= HammerUp
-> w & hammers . ix SubInvHam .~ HammerDown
| otherwise -> updatePressedButtons' pkeys w
CombineInventory mi
| pkeys ^? ix ButtonLeft == Just False
-> maybeexitcombine (maybe id doCombine mi w) & cWorld . hammers . ix SubInvHam .~ HammerDown
-> maybeexitcombine (maybe id doCombine mi w) & hammers . ix SubInvHam .~ HammerDown
DisplayTerminal tmid
| pkeys ^? ix ButtonLeft == Just False && inTermFocus w
-> doTerminalEffectLB (w ^?! cWorld . terminals . ix tmid) w
& cWorld . hammers . ix SubInvHam .~ HammerDown
& hammers . ix SubInvHam .~ HammerDown
| pkeys ^? ix ButtonLeft == Just False
-> w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
& cWorld . hammers . ix SubInvHam .~ HammerDown
& hammers . ix SubInvHam .~ HammerDown
_ | ButtonLeft `M.member` pkeys
-> w & cWorld . hammers . ix SubInvHam .~ HammerDown
-> w & hammers . ix SubInvHam .~ HammerDown
_ -> w
where
maybeexitcombine
| ButtonRight `M.member` _mouseButtons (_cWorld w) = id
| ButtonRight `M.member` _mouseButtons w = id
| otherwise = cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
updatePressedButtons' :: M.Map MouseButton Bool -> World -> World
updatePressedButtons' pkeys w
| isDown ButtonLeft && isDown ButtonRight && inTopInv
= useItem (you w) w & cWorld . hammers . ix DoubleMouseHam .~ HammerDown
= useItem (you w) w & hammers . ix DoubleMouseHam .~ HammerDown
| isDown ButtonLeft && (inTopInv || _timeFlow (_cWorld w) == RewindingLastFrame)
&& w ^?! cWorld . hammers . ix DoubleMouseHam == HammerUp
&& w ^?! hammers . ix DoubleMouseHam == HammerUp
= useLeftItem (_yourID (_cWorld w)) w
| isDown ButtonLeft && (inTopInv || _timeFlow (_cWorld w) == RewindingLastFrame)
= w & cWorld . hammers . ix DoubleMouseHam .~ HammerDown
= w & hammers . ix DoubleMouseHam .~ HammerDown
| isDown ButtonRight && inTopInv = w
| isDown ButtonMiddle
= w & cWorld . cameraRot -~ rotation
& cWorld . clickMousePos .~ _mousePos (_cWorld w)
| isDown ButtonLeft = w & cWorld . hammers . ix DoubleMouseHam .~ HammerDown
& cWorld . clickMousePos .~ _mousePos w
| isDown ButtonLeft = w & hammers . ix DoubleMouseHam .~ HammerDown
| otherwise = w
where
inTopInv = case _hudElement (_hud (_cWorld w)) of
DisplayInventory NoSubInventory -> True
_ -> False
isDown but = but `M.member` pkeys
rotation = angleBetween (_mousePos (_cWorld w)) (_clickMousePos (_cWorld w))
rotation = angleBetween (_mousePos w) (_clickMousePos (_cWorld w))
-- note "sort" on the inventory indices; otherwise
@@ -90,15 +90,15 @@ doCombine i w = case combineItemListYou w ^? ix i of
updatePressedButtonsCarte :: M.Map MouseButton Bool -> World -> World
updatePressedButtonsCarte pkeys w
| isDown ButtonRight = w
& cWorld . clickMousePos .~ _mousePos (_cWorld w)
& cWorld . clickMousePos .~ _mousePos w
& cWorld . hud . carteCenter %~ (-.- trans)
| isDown ButtonLeft = w
& cWorld . clickMousePos .~ _mousePos (_cWorld w)
& cWorld . clickMousePos .~ _mousePos w
& cWorld . hud . carteRot -~ rot
& cWorld . hud . carteZoom *~ czoom
| otherwise = w
where
isDown but = but `M.member` pkeys
rot = angleBetween (_mousePos (_cWorld w)) (_clickMousePos (_cWorld w))
czoom = magV (_mousePos (_cWorld w)) / magV (_clickMousePos (_cWorld w))
trans = rotateV (_carteRot (_hud (_cWorld w))) $ 1 / _carteZoom (_hud (_cWorld w)) *.* (_mousePos (_cWorld w) -.- _clickMousePos (_cWorld w))
rot = angleBetween (_mousePos w) (_clickMousePos (_cWorld w))
czoom = magV (_mousePos w) / magV (_clickMousePos (_cWorld w))
trans = rotateV (_carteRot (_hud (_cWorld w))) $ 1 / _carteZoom (_hud (_cWorld w)) *.* (_mousePos w -.- _clickMousePos (_cWorld w))
src/Dodge/Zoning.hs
-1
View File
@@ -6,4 +6,3 @@ module Dodge.Zoning
import Dodge.Zoning.Creature
import Dodge.Zoning.Wall
import Dodge.Zoning.Pathing