Record whether a mouse click is continued or not

This commit is contained in:
2022-06-22 17:02:57 +01:00
parent ac0948cb64
commit 698ccb414d
18 changed files with 350 additions and 335 deletions
Binary file not shown.
Binary file not shown.
+1
View File
@@ -4,6 +4,7 @@ module Dodge.Creature.Impulse.UseItem
) where ) where
import Dodge.Data import Dodge.Data
import Dodge.Inventory import Dodge.Inventory
import Dodge.Reloading
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
--import qualified Data.IntSet as IS --import qualified Data.IntSet as IS
+5 -4
View File
@@ -12,7 +12,8 @@ import Geometry
import Control.Lens import Control.Lens
import qualified SDL import qualified SDL
import qualified Data.Set as S --import qualified Data.Set as S
import qualified Data.Map.Strict as M
--import qualified Data.IntMap.Strict as IM --import qualified Data.IntMap.Strict as IM
--import Data.Maybe --import Data.Maybe
{- | The AI equivalent for your control. -} {- | The AI equivalent for your control. -}
@@ -34,7 +35,7 @@ wasdWithAiming
-> Creature -> Creature
wasdWithAiming w speed cr wasdWithAiming w speed cr
| isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr | isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr
| crIsReloading cr && SDL.ButtonRight `S.member` _mouseButtons w | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons w
= addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr = addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr
| otherwise = theMovement $ theTurn $ removeTwist cr | otherwise = theMovement $ theTurn $ removeTwist cr
where where
@@ -70,9 +71,9 @@ wasdDir :: World -> Point2
wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys
{- | Set posture according to mouse presses. -} {- | Set posture according to mouse presses. -}
mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature
mouseActionsCr pkeys cr mouseActionsCr pkeys cr
| rbPressed = cr & crStance . posture .~ Aiming | rbPressed = cr & crStance . posture .~ Aiming
| otherwise = cr & crStance . posture .~ AtEase | otherwise = cr & crStance . posture .~ AtEase
where where
rbPressed = SDL.ButtonRight `S.member` pkeys rbPressed = SDL.ButtonRight `M.member` pkeys
+2 -1
View File
@@ -88,7 +88,7 @@ data Universe = Universe
} }
data World = World data World = World
{ _keys :: S.Set Scancode { _keys :: S.Set Scancode
, _mouseButtons :: S.Set MouseButton , _mouseButtons :: M.Map MouseButton Bool
, _mousePos :: Point2 , _mousePos :: Point2
, _cameraCenter :: Point2 , _cameraCenter :: Point2
, _cameraRot :: Float , _cameraRot :: Float
@@ -487,6 +487,7 @@ data ItemConsumption
{ _laAmmoType :: AmmoType { _laAmmoType :: AmmoType
, _laMax :: Int , _laMax :: Int
, _laLoaded :: Int , _laLoaded :: Int
, _laPrimed :: Bool
, _laCycle :: [LoadAction] , _laCycle :: [LoadAction]
, _laProgress :: Maybe [LoadAction] , _laProgress :: Maybe [LoadAction]
} }
+1
View File
@@ -20,6 +20,7 @@ defaultLoadable = LoadableAmmo
{ _laAmmoType = GenericAmmo { _laAmmoType = GenericAmmo
, _laMax = 15 , _laMax = 15
, _laLoaded = 0 , _laLoaded = 0
, _laPrimed = True
, _laCycle = [loadEject 10, loadInsert 10, loadPrime 10] , _laCycle = [loadEject 10, loadInsert 10, loadPrime 10]
, _laProgress = Nothing , _laProgress = Nothing
} }
+1 -1
View File
@@ -21,7 +21,7 @@ defaultWorld :: World
defaultWorld = World defaultWorld = World
{ _keys = S.empty { _keys = S.empty
, _magnets = IM.empty , _magnets = IM.empty
, _mouseButtons = S.empty , _mouseButtons = mempty
, _cameraCenter = V2 0 0 , _cameraCenter = V2 0 0
, _cameraRot = 0 , _cameraRot = 0
, _cameraZoom = 1 , _cameraZoom = 1
+7 -5
View File
@@ -67,10 +67,12 @@ handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
handleMouseButtonEvent :: MouseButtonEventData -> World -> World handleMouseButtonEvent :: MouseButtonEventData -> World -> World
handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
Released -> mouseButtons %~ S.delete thebutton Released -> mouseButtons . at thebutton .~ Nothing
Pressed -> handlePressedMouseButton thebutton . (mouseButtons %~ S.insert thebutton) Pressed -> handlePressedMouseButton thebutton . (mouseButtons . at thebutton %~ f)
where where
thebutton = mouseButtonEventButton mbev thebutton = mouseButtonEventButton mbev
f Nothing = Just False
f _ = Just True
{- | Sets window position in config. -} {- | Sets window position in config. -}
handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe
@@ -106,7 +108,7 @@ handlePressedMouseButton but w = case (_hudElement (_hud w), but) of
_ -> w _ -> w
where where
maybeexitcombine maybeexitcombine
| ButtonRight `S.member` _mouseButtons w = id | ButtonRight `M.member` _mouseButtons w = id
| otherwise = hud . hudElement .~ DisplayInventory NoSubInventory | otherwise = hud . hudElement .~ DisplayInventory NoSubInventory
-- note "sort" on the inventory indices; otherwise -- note "sort" on the inventory indices; otherwise
@@ -177,8 +179,8 @@ wheelEvent y w = case _hudElement $ _hud w of
numcombs = length $ combineItemListYou w numcombs = length $ combineItemListYou w
yi = round $ signum y yi = round $ signum y
numLocs = (fst . IM.findMax $ _seenLocations w) + 1 numLocs = (fst . IM.findMax $ _seenLocations w) + 1
rbDown = ButtonRight `S.member` _mouseButtons w rbDown = ButtonRight `M.member` _mouseButtons w
lbDown = ButtonLeft `S.member` _mouseButtons w lbDown = ButtonLeft `M.member` _mouseButtons w
invKeyDown = ScancodeCapsLock `S.member` _keys w invKeyDown = ScancodeCapsLock `S.member` _keys w
getArguments' :: TerminalCommand -> Terminal -> World -> [String] getArguments' :: TerminalCommand -> Terminal -> World -> [String]
+1 -1
View File
@@ -149,7 +149,7 @@ repeater :: Item
repeater = rifle repeater = rifle
& itType . iyModules . at ModRifleMag ?~ EMPTYMODULE & itType . iyModules . at ModRifleMag ?~ EMPTYMODULE
& itType . iyBase .~ REPEATER & itType . iyBase .~ REPEATER
& itConsumption . laCycle .~ [loadEject 20, loadInsert 20 ,loadPrime 20] & itConsumption . laCycle .~ [loadEject 50, loadInsert 40 ,loadPrime 20]
& itConsumption . laMax .~ 15 & itConsumption . laMax .~ 15
& itDimension . dimSPic .~ (\it -> noPic $ baseRifleShape & itDimension . dimSPic .~ (\it -> noPic $ baseRifleShape
<> makeTinClipAt 0 (V3 10 (-2) 0) it <> makeTinClipAt 0 (V3 10 (-2) 0) it
+5 -4
View File
@@ -32,10 +32,11 @@ import qualified FoldlHelp as L
import Sound.Data import Sound.Data
import ShortShow import ShortShow
import qualified Data.Map.Strict as M
--import Data.Bifunctor --import Data.Bifunctor
import Data.Maybe import Data.Maybe
--import qualified Control.Foldl as L --import qualified Control.Foldl as L
import qualified Data.Set as S --import qualified Data.Set as S
import qualified SDL import qualified SDL
autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
autoEffect eff t sid itm cr w autoEffect eff t sid itm cr w
@@ -119,7 +120,7 @@ targetRBCreatureUp it cr w t
& tgPos .~ Nothing & tgPos .~ Nothing
& tgActive .~ False & tgActive .~ False
) )
| SDL.ButtonRight `S.member` _mouseButtons w && isJust (t ^? tgID . _Just) | SDL.ButtonRight `M.member` _mouseButtons w && isJust (t ^? tgID . _Just)
&& canSeeTarget = (w, t & updatePos && canSeeTarget = (w, t & updatePos
& tgActive .~ True & tgActive .~ True
) )
@@ -171,7 +172,7 @@ targetUpdateWith f it _ w t
targetCursorUpdate :: World -> Targeting -> Targeting targetCursorUpdate :: World -> Targeting -> Targeting
targetCursorUpdate w t targetCursorUpdate w t
| SDL.ButtonRight `S.member` _mouseButtons w = t | SDL.ButtonRight `M.member` _mouseButtons w = t
& tgPos . _Just .~ mouseWorldPos w & tgPos . _Just .~ mouseWorldPos w
& tgActive .~ True & tgActive .~ True
| otherwise = t & tgPos %~ const Nothing | otherwise = t & tgPos %~ const Nothing
@@ -179,7 +180,7 @@ targetCursorUpdate w t
targetRBPressUpdate :: World -> Targeting -> Targeting targetRBPressUpdate :: World -> Targeting -> Targeting
targetRBPressUpdate w t targetRBPressUpdate w t
| SDL.ButtonRight `S.member` _mouseButtons w = t | SDL.ButtonRight `M.member` _mouseButtons w = t
& tgPos %~ maybe (Just $ mouseWorldPos w) Just & tgPos %~ maybe (Just $ mouseWorldPos w) Just
& tgActive .~ True & tgActive .~ True
| otherwise = t & tgPos %~ const Nothing | otherwise = t & tgPos %~ const Nothing
+3 -2
View File
@@ -28,7 +28,8 @@ import qualified IntMapHelp as IM
import ShapePicture import ShapePicture
import Shape import Shape
import qualified Data.Set as S --import qualified Data.Set as S
import qualified Data.Map.Strict as M
import qualified SDL import qualified SDL
import Data.Maybe import Data.Maybe
import Control.Lens import Control.Lens
@@ -320,7 +321,7 @@ moveRemoteShell cid itid pj w
vel = _pjVel pj vel = _pjVel pj
newPos = oldPos +.+ vel newPos = oldPos +.+ vel
newdir newdir
| SDL.ButtonRight `S.member` _mouseButtons w | SDL.ButtonRight `M.member` _mouseButtons w
&& w ^? creatures . ix cid . crInvSel . iselPos == w ^? itemPositions . ix itid . ipInvId && w ^? creatures . ix cid . crInvSel . iselPos == w ^? itemPositions . ix itid . ipInvId
= _cameraRot w + argV (_mousePos w) = _cameraRot w + argV (_mousePos w)
| otherwise = _pjDir pj | otherwise = _pjDir pj
+3 -2
View File
@@ -133,12 +133,13 @@ ammoCheckI eff item cr w
-- hammer is down? -- hammer is down?
ammoHammerCheck :: ChainEffect ammoHammerCheck :: ChainEffect
ammoHammerCheck eff it cr w ammoHammerCheck eff it cr w
| _laLoaded (_itConsumption it) <= 0 = w -- fromMaybe w (startReloadingWeapon cr w) | _laLoaded ic <= 0 || _laPrimed ic == False = w -- fromMaybe w (startReloadingWeapon cr w)
& setHammerDown & setHammerDown
| otherwise = case it ^? itUse . useHammer . hammerPosition of | otherwise = case it ^? itUse . useHammer . hammerPosition of
Just HammerUp -> eff it cr $ setHammerDown w & creatures . ix (_crID cr) %~ crCancelReloading Just HammerUp -> eff it cr $ setHammerDown w & creatures . ix (_crID cr) %~ crCancelReloading
_ -> setHammerDown w _ -> setHammerDown w
where where
ic = _itConsumption it
cid = _crID cr cid = _crID cr
setHammerDown = creatures . ix cid . crInv . ix (crSel cr) . itUse setHammerDown = creatures . ix cid . crInv . ix (crSel cr) . itUse
. useHammer . hammerPosition .~ HammerDown . useHammer . hammerPosition .~ HammerDown
@@ -304,7 +305,7 @@ useTimeCheck f item cr w = case item ^? itUse . useDelay . rateTime of
{- | Applies a world effect after a hammer position check. -} {- | Applies a world effect after a hammer position check. -}
hammerCheckI :: ChainEffect hammerCheckI :: ChainEffect
hammerCheckI f it cr w = case it ^? itUse . useHammer . hammerPosition of hammerCheckI f it cr w = case it ^? itUse . useHammer . hammerPosition of
Just HammerUp -> f it cr $ setHammerDown w Just HammerUp | _laPrimed (_itConsumption it) -> f it cr $ setHammerDown w
_ -> setHammerDown w _ -> setHammerDown w
where where
cid = _crID cr cid = _crID cr
+8 -3
View File
@@ -1,7 +1,9 @@
module Dodge.Reloading module Dodge.Reloading
( crCancelReloading ( crCancelReloading
, crToggleReloading , crToggleReloading
, crHoldReloading
, stepReloading , stepReloading
, tryStartLoading
) where ) where
import Dodge.Data import Dodge.Data
import Dodge.Hammer import Dodge.Hammer
@@ -33,12 +35,15 @@ tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itConsumption . laProg
Just la -> cr & crInvSel . iselAction . actionProgress .~ _actionTime la Just la -> cr & crInvSel . iselAction . actionProgress .~ _actionTime la
& crInvSel . iselAction . reloadAction .~ la & crInvSel . iselAction . reloadAction .~ la
crToggleReloading :: Creature -> World -> World crToggleReloading :: Creature -> World -> World
crToggleReloading cr w = case cr ^?! crInvSel . iselAction of crToggleReloading cr w = case cr ^?! crInvSel . iselAction of
ReloadAction {} -> w & creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction ReloadAction {} -> w & creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction
_ -> w & creatures . ix (_crID cr) %~ tryStartLoading _ -> w & creatures . ix (_crID cr) %~ tryStartLoading
crHoldReloading :: Creature -> World -> World
crHoldReloading cr w = w
& creatures . ix (_crID cr) . crInvSel . iselAction . actionHammer .~ HasHammer HammerDown
tryStartLoading :: Creature -> Creature tryStartLoading :: Creature -> Creature
tryStartLoading cr = case ic ^? laProgress . _Just . ix 0 of tryStartLoading cr = case ic ^? laProgress . _Just . ix 0 of
Just la -> cr & startLoadAction la Just la -> cr & startLoadAction la
@@ -63,11 +68,11 @@ rotateActionProgress ic = case ic ^? laProgress . _Just of
doLoadAction :: LoadAction -> ItemConsumption -> ItemConsumption doLoadAction :: LoadAction -> ItemConsumption -> ItemConsumption
doLoadAction la ic = case la of doLoadAction la ic = case la of
LoadEject {} -> ic & laLoaded .~ 0 LoadEject {} -> ic & laLoaded .~ 0 & laPrimed .~ False
LoadInsert {} -> ic & laLoaded .~ _laMax ic LoadInsert {} -> ic & laLoaded .~ _laMax ic
LoadAdd {_insertMax = x} LoadAdd {_insertMax = x}
-> ic & laLoaded +~ min x (_laMax ic - _laLoaded ic) -> ic & laLoaded +~ min x (_laMax ic - _laLoaded ic)
LoadPrime {} -> ic LoadPrime {} -> ic & laPrimed .~ True
--{- | Start reloading if clip is empty. -} --{- | Start reloading if clip is empty. -}
--crAutoReload :: Creature -> Creature --crAutoReload :: Creature -> Creature
+4 -4
View File
@@ -23,7 +23,7 @@ import qualified Data.Vector as V
import Data.Maybe import Data.Maybe
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Set as S --import qualified Data.Set as S
--import qualified Data.IntSet as IS --import qualified Data.IntSet as IS
import Control.Lens import Control.Lens
import SDL (MouseButton (..)) import SDL (MouseButton (..))
@@ -125,7 +125,7 @@ subInventoryDisplay subinv cfig w = case subinv of
selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it
selcursor = selcursor' selcursortype selcursor = selcursor' selcursortype
selcursortype selcursortype
| ButtonRight `S.member` _mouseButtons w = listCursorNESW | ButtonRight `M.member` _mouseButtons w = listCursorNESW
| otherwise = listCursorNSW | otherwise = listCursorNSW
curpos = invSelPos w curpos = invSelPos w
cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w) cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w)
@@ -134,7 +134,7 @@ subInventoryDisplay subinv cfig w = case subinv of
_ -> mempty _ -> mempty
equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr) equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
rboptions = if ButtonRight `S.member` _mouseButtons w rboptions = if ButtonRight `M.member` _mouseButtons w
then drawRBOptions cfig w (_rbOptions w) then drawRBOptions cfig w (_rbOptions w)
else mempty else mempty
@@ -251,7 +251,7 @@ topCursorTypeWidth ctype width cfig w i
determineInvSelCursorWidth :: World -> Int determineInvSelCursorWidth :: World -> Int
determineInvSelCursorWidth w = case _rbOptions w of determineInvSelCursorWidth w = case _rbOptions w of
NoRightButtonOptions -> topInvW NoRightButtonOptions -> topInvW
EquipOptions {} -> if ButtonRight `S.member` _mouseButtons w EquipOptions {} -> if ButtonRight `M.member` _mouseButtons w
then 47 then 47
else topInvW else topInvW
+2 -2
View File
@@ -9,7 +9,7 @@ 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
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
@@ -28,7 +28,7 @@ doQuicksave :: Universe -> Universe
doQuicksave = saveWorldInSlot QuicksaveSlot doQuicksave = saveWorldInSlot QuicksaveSlot
clearKeys :: World -> World clearKeys :: World -> World
clearKeys = (keys .~ S.empty) . (mouseButtons .~ S.empty) clearKeys = (keys .~ mempty) . (mouseButtons .~ mempty)
saveLevelStartSlot :: World -> World saveLevelStartSlot :: World -> World
--saveLevelStartSlot = id --saveLevelStartSlot = id
+296 -296
View File
@@ -1,171 +1,172 @@
-- generated at 2022-06-21 17:36:17.190436966 UTC -- generated at 2022-06-22 13:32:00.899109782 UTC
module Dodge.SoundLogic.ExternallyGeneratedSounds where module Dodge.SoundLogic.ExternallyGeneratedSounds where
import Sound.Data import Sound.Data
soundToVol :: SoundID -> Float soundToVol :: SoundID -> Float
soundToVol v = case _getSoundID v of soundToVol v = case _getSoundID v of
0 -> 500 0 -> 500
1 -> 500 1 -> 500
2 -> 2000 2 -> 500
3 -> 500 3 -> 2000
4 -> 1000 4 -> 500
5 -> 40 5 -> 1000
6 -> 100 6 -> 40
7 -> 500 7 -> 100
8 -> 500 8 -> 500
9 -> 300 9 -> 500
10 -> 40 10 -> 300
11 -> 2000 11 -> 40
12 -> 50 12 -> 2000
13 -> 50 13 -> 50
14 -> 2000 14 -> 50
15 -> 200 15 -> 2000
16 -> 40 16 -> 200
17 -> 300 17 -> 40
18 -> 500 18 -> 300
19 -> 2000 19 -> 500
20 -> 500 20 -> 2000
21 -> 100 21 -> 500
22 -> 1000 22 -> 100
23 -> 100 23 -> 1000
24 -> 1000 24 -> 100
25 -> 40 25 -> 1000
26 -> 2000 26 -> 40
27 -> 50 27 -> 2000
28 -> 2000 28 -> 50
29 -> 50 29 -> 2000
30 -> 1000 30 -> 50
31 -> 8000 31 -> 1000
32 -> 2000 32 -> 8000
33 -> 2000 33 -> 2000
34 -> 1000 34 -> 2000
35 -> 2000 35 -> 1000
36 -> 100 36 -> 2000
37 -> 40 37 -> 100
38 -> 40 38 -> 40
39 -> 2000 39 -> 40
40 -> 100 40 -> 2000
41 -> 40 41 -> 100
42 -> 300 42 -> 500
43 -> 300 43 -> 40
44 -> 2000 44 -> 300
45 -> 1000 45 -> 300
46 -> 1000 46 -> 2000
47 -> 1000 47 -> 1000
48 -> 40 48 -> 1000
49 -> 50 49 -> 1000
50 -> 500 50 -> 40
51 -> 500 51 -> 50
52 -> 1000 52 -> 500
53 -> 20 53 -> 500
54 -> 500 54 -> 1000
55 -> 300 55 -> 20
56 -> 500 56 -> 500
57 -> 500 57 -> 300
58 -> 1000 58 -> 500
59 -> 500 59 -> 1000
60 -> 2000 60 -> 500
61 -> 2000 61 -> 2000
62 -> 500 62 -> 2000
63 -> 2000 63 -> 500
64 -> 100 64 -> 2000
65 -> 300 65 -> 100
66 -> 1000 66 -> 300
67 -> 100 67 -> 1000
68 -> 2000 68 -> 100
69 -> 1000 69 -> 2000
70 -> 200 70 -> 1000
71 -> 500 71 -> 200
72 -> 100 72 -> 500
73 -> 2000 73 -> 100
74 -> 2000 74 -> 2000
75 -> 2000 75 -> 2000
76 -> 500 76 -> 2000
77 -> 100 77 -> 100
_ -> 50 _ -> 50
soundToOnomato :: SoundID -> String soundToOnomato :: SoundID -> String
soundToOnomato v = case _getSoundID v of soundToOnomato v = case _getSoundID v of
0 -> "DEDUM" 0 -> "DEDUM"
1 -> "SCREE" 1 -> "CUHRUP"
2 -> "BRDBRDBRD" 2 -> "SCREE"
3 -> "DEDEDA" 3 -> "BRDBRDBRD"
4 -> "CRNK" 4 -> "DEDEDA"
5 -> "CLNK" 5 -> "CRNK"
6 -> "WRR" 6 -> "CLNK"
7 -> "TINKLE" 7 -> "WRR"
8 -> "TRINKL" 8 -> "TINKLE"
9 -> "BWAAH" 9 -> "TRINKL"
10 -> "TIP" 10 -> "BWAAH"
11 -> "TATATA" 11 -> "TIP"
12 -> "BLIH" 12 -> "TATATA"
13 -> "HMM" 13 -> "BLIH"
14 -> "PEW" 14 -> "HMM"
15 -> "CRAKLE" 15 -> "PEW"
16 -> "TAP" 16 -> "CRAKLE"
17 -> "DWAAH" 17 -> "TAP"
18 -> "PRUM" 18 -> "DWAAH"
19 -> "BANGG" 19 -> "PRUM"
20 -> "CRTINK" 20 -> "BANGG"
21 -> "PHF" 21 -> "CRTINK"
22 -> "ZHM" 22 -> "PHF"
23 -> "THUD" 23 -> "ZHM"
24 -> "CRASH" 24 -> "THUD"
25 -> "TAPTIP" 25 -> "CRASH"
26 -> "CHUGUGUG" 26 -> "TAPTIP"
27 -> "HSSS" 27 -> "CHUGUGUG"
28 -> "BOOM" 28 -> "HSSS"
29 -> "HSS" 29 -> "BOOM"
30 -> "TAKH" 30 -> "HSS"
31 -> "RINGGG" 31 -> "TAKH"
32 -> "CRH" 32 -> "RINGGG"
33 -> "UGGAUGGA" 33 -> "CRH"
34 -> "CRUMPLE" 34 -> "UGGAUGGA"
35 -> "CREUH" 35 -> "CRUMPLE"
36 -> "SMACK" 36 -> "CREUH"
37 -> "CLICK" 37 -> "SMACK"
38 -> "TIPTOP" 38 -> "CLICK"
39 -> "CRUH" 39 -> "TIPTOP"
40 -> "CHNKCHNKCHUNK" 40 -> "CRUH"
41 -> "TIPTAP" 41 -> "CHNKCHNKCHUNK"
42 -> "TNKTNKTNK" 42 -> "CLKCLK"
43 -> "CHPCHPCHP" 43 -> "TIPTAP"
44 -> "SCREE" 44 -> "TNKTNKTNK"
45 -> "BRAP" 45 -> "CHPCHPCHP"
46 -> "CRSK" 46 -> "SCREE"
47 -> "CRNKL" 47 -> "BRAP"
48 -> "TAPP" 48 -> "CRSK"
49 -> "SHUHP" 49 -> "CRNKL"
50 -> "DEDEDUM" 50 -> "TAPP"
51 -> "TAK" 51 -> "SHUHP"
52 -> "CRISH" 52 -> "DEDEDUM"
53 -> "SWSH" 53 -> "TAK"
54 -> "BIPBIPBIP" 54 -> "CRISH"
55 -> "BEP" 55 -> "SWSH"
56 -> "CLIKCLIK" 56 -> "BIPBIPBIP"
57 -> "KRTNKL" 57 -> "BEP"
58 -> "CRSNK" 58 -> "KRTNKL"
59 -> "DUDURAH" 59 -> "CRSNK"
60 -> "CHUGUGUG" 60 -> "DUDURAH"
61 -> "BANG" 61 -> "CHUGUGUG"
62 -> "DEDA" 62 -> "BANG"
63 -> "WHSSH" 63 -> "DEDA"
64 -> "HNH" 64 -> "WHSSH"
65 -> "BWAH" 65 -> "HNH"
66 -> "CRUNK" 66 -> "BWAH"
67 -> "DRR" 67 -> "CRUNK"
68 -> "BRAP" 68 -> "DRR"
69 -> "BLPCHCH" 69 -> "BRAP"
70 -> "ZMM" 70 -> "BLPCHCH"
71 -> "WRRR" 71 -> "ZMM"
72 -> "FWUMP" 72 -> "WRRR"
73 -> "BRAHCHCH" 73 -> "FWUMP"
74 -> "BRPBRPBRP" 74 -> "BRAHCHCH"
75 -> "WE-OH" 75 -> "BRPBRPBRP"
76 -> "CUHRAM" 76 -> "WE-OH"
77 -> "FHP" 77 -> "FHP"
_ -> error "unitialised sound" _ -> error "unitialised sound"
soundPathList :: [String] soundPathList :: [String]
soundPathList = soundPathList =
[ "dedum.DEDUM.500.wav" [ "dedum.DEDUM.500.wav"
, "insert.CUHRUP.500.wav"
, "tone440sawtoothquiet.SCREE.500.wav" , "tone440sawtoothquiet.SCREE.500.wav"
, "mini1.BRDBRDBRD.2000.wav" , "mini1.BRDBRDBRD.2000.wav"
, "dededa.DEDEDA.500.wav" , "dededa.DEDEDA.500.wav"
@@ -206,6 +207,7 @@ soundPathList =
, "twoStepSlow.TIPTOP.40.wav" , "twoStepSlow.TIPTOP.40.wav"
, "seagullCry.CRUH.2000.wav" , "seagullCry.CRUH.2000.wav"
, "crankSlow.CHNKCHNKCHUNK.100.wav" , "crankSlow.CHNKCHNKCHUNK.100.wav"
, "prime.CLKCLK.500.wav"
, "twoStep.TIPTAP.40.wav" , "twoStep.TIPTAP.40.wav"
, "reload.TNKTNKTNK.300.wav" , "reload.TNKTNKTNK.300.wav"
, "reload1.CHPCHPCHP.300.wav" , "reload1.CHPCHPCHP.300.wav"
@@ -221,7 +223,6 @@ soundPathList =
, "knife.SWSH.20.wav" , "knife.SWSH.20.wav"
, "computerBeeping.BIPBIPBIP.500.wav" , "computerBeeping.BIPBIPBIP.500.wav"
, "tone440.BEP.300.wav" , "tone440.BEP.300.wav"
, "prime.CLIKCLIK.500.wav"
, "smallGlass2.KRTNKL.500.wav" , "smallGlass2.KRTNKL.500.wav"
, "glassShat1.CRSNK.1000.wav" , "glassShat1.CRSNK.1000.wav"
, "eject.DUDURAH.500.wav" , "eject.DUDURAH.500.wav"
@@ -241,162 +242,161 @@ soundPathList =
, "shotgun.BRAHCHCH.2000.wav" , "shotgun.BRAHCHCH.2000.wav"
, "mini.BRPBRPBRP.2000.wav" , "mini.BRPBRPBRP.2000.wav"
, "seagullWhistle.WE-OH.2000.wav" , "seagullWhistle.WE-OH.2000.wav"
, "insert.CUHRAM.500.wav"
, "whiteNoiseFadeIn.FHP.100.wav" , "whiteNoiseFadeIn.FHP.100.wav"
] ]
dedumS :: SoundID dedumS :: SoundID
dedumS = SoundID 0 dedumS = SoundID 0
tone440sawtoothquietS :: SoundID
tone440sawtoothquietS = SoundID 1
mini1S :: SoundID
mini1S = SoundID 2
dededaS :: SoundID
dededaS = SoundID 3
glassShat3S :: SoundID
glassShat3S = SoundID 4
tapQuietS :: SoundID
tapQuietS = SoundID 5
fireS :: SoundID
fireS = SoundID 6
smallGlass4S :: SoundID
smallGlass4S = SoundID 7
smallGlass1S :: SoundID
smallGlass1S = SoundID 8
sineRaisePitchTwoSecS :: SoundID
sineRaisePitchTwoSecS = SoundID 9
foot1S :: SoundID
foot1S = SoundID 10
autoBS :: SoundID
autoBS = SoundID 11
healS :: SoundID
healS = SoundID 12
fridgeHumS :: SoundID
fridgeHumS = SoundID 13
seagullWhistle1S :: SoundID
seagullWhistle1S = SoundID 14
elecCrackleS :: SoundID
elecCrackleS = SoundID 15
foot2S :: SoundID
foot2S = SoundID 16
skwareFadeTwoSecS :: SoundID
skwareFadeTwoSecS = SoundID 17
insertOneS :: SoundID
insertOneS = SoundID 18
bangEchoS :: SoundID
bangEchoS = SoundID 19
smallGlass3S :: SoundID
smallGlass3S = SoundID 20
whiteNoiseFadeOutS :: SoundID
whiteNoiseFadeOutS = SoundID 21
teleS :: SoundID
teleS = SoundID 22
hitS :: SoundID
hitS = SoundID 23
stone1S :: SoundID
stone1S = SoundID 24
twoStep1S :: SoundID
twoStep1S = SoundID 25
seagullChatterS :: SoundID
seagullChatterS = SoundID 26
foamSprayLoopS :: SoundID
foamSprayLoopS = SoundID 27
explosionS :: SoundID
explosionS = SoundID 28
foamSprayFadeOutS :: SoundID
foamSprayFadeOutS = SoundID 29
tap2S :: SoundID
tap2S = SoundID 30
tinitusS :: SoundID
tinitusS = SoundID 31
seagullCry1S :: SoundID
seagullCry1S = SoundID 32
seagullBarkS :: SoundID
seagullBarkS = SoundID 33
stone3S :: SoundID
stone3S = SoundID 34
seagullCry2S :: SoundID
seagullCry2S = SoundID 35
hit1S :: SoundID
hit1S = SoundID 36
click1S :: SoundID
click1S = SoundID 37
twoStepSlowS :: SoundID
twoStepSlowS = SoundID 38
seagullCryS :: SoundID
seagullCryS = SoundID 39
crankSlowS :: SoundID
crankSlowS = SoundID 40
twoStepS :: SoundID
twoStepS = SoundID 41
reloadS :: SoundID
reloadS = SoundID 42
reload1S :: SoundID
reload1S = SoundID 43
tone440sawtoothS :: SoundID
tone440sawtoothS = SoundID 44
tap3S :: SoundID
tap3S = SoundID 45
glassShat4S :: SoundID
glassShat4S = SoundID 46
glassShat2S :: SoundID
glassShat2S = SoundID 47
foot3S :: SoundID
foot3S = SoundID 48
pickUpS :: SoundID
pickUpS = SoundID 49
dededumS :: SoundID
dededumS = SoundID 50
tap1S :: SoundID
tap1S = SoundID 51
metal4S :: SoundID
metal4S = SoundID 52
knifeS :: SoundID
knifeS = SoundID 53
computerBeepingS :: SoundID
computerBeepingS = SoundID 54
tone440S :: SoundID
tone440S = SoundID 55
primeS :: SoundID
primeS = SoundID 56
smallGlass2S :: SoundID
smallGlass2S = SoundID 57
glassShat1S :: SoundID
glassShat1S = SoundID 58
ejectS :: SoundID
ejectS = SoundID 59
seagullChatter1S :: SoundID
seagullChatter1S = SoundID 60
bangS :: SoundID
bangS = SoundID 61
dedaS :: SoundID
dedaS = SoundID 62
missileLaunchS :: SoundID
missileLaunchS = SoundID 63
gruntS :: SoundID
gruntS = SoundID 64
sineRaisePitchOneSecS :: SoundID
sineRaisePitchOneSecS = SoundID 65
metal2S :: SoundID
metal2S = SoundID 66
slideDoorS :: SoundID
slideDoorS = SoundID 67
autoGunS :: SoundID
autoGunS = SoundID 68
oldMachineBootS :: SoundID
oldMachineBootS = SoundID 69
buzzS :: SoundID
buzzS = SoundID 70
fireLoudS :: SoundID
fireLoudS = SoundID 71
tap4S :: SoundID
tap4S = SoundID 72
shotgunS :: SoundID
shotgunS = SoundID 73
miniS :: SoundID
miniS = SoundID 74
seagullWhistleS :: SoundID
seagullWhistleS = SoundID 75
insertS :: SoundID insertS :: SoundID
insertS = SoundID 76 insertS = SoundID 1
tone440sawtoothquietS :: SoundID
tone440sawtoothquietS = SoundID 2
mini1S :: SoundID
mini1S = SoundID 3
dededaS :: SoundID
dededaS = SoundID 4
glassShat3S :: SoundID
glassShat3S = SoundID 5
tapQuietS :: SoundID
tapQuietS = SoundID 6
fireS :: SoundID
fireS = SoundID 7
smallGlass4S :: SoundID
smallGlass4S = SoundID 8
smallGlass1S :: SoundID
smallGlass1S = SoundID 9
sineRaisePitchTwoSecS :: SoundID
sineRaisePitchTwoSecS = SoundID 10
foot1S :: SoundID
foot1S = SoundID 11
autoBS :: SoundID
autoBS = SoundID 12
healS :: SoundID
healS = SoundID 13
fridgeHumS :: SoundID
fridgeHumS = SoundID 14
seagullWhistle1S :: SoundID
seagullWhistle1S = SoundID 15
elecCrackleS :: SoundID
elecCrackleS = SoundID 16
foot2S :: SoundID
foot2S = SoundID 17
skwareFadeTwoSecS :: SoundID
skwareFadeTwoSecS = SoundID 18
insertOneS :: SoundID
insertOneS = SoundID 19
bangEchoS :: SoundID
bangEchoS = SoundID 20
smallGlass3S :: SoundID
smallGlass3S = SoundID 21
whiteNoiseFadeOutS :: SoundID
whiteNoiseFadeOutS = SoundID 22
teleS :: SoundID
teleS = SoundID 23
hitS :: SoundID
hitS = SoundID 24
stone1S :: SoundID
stone1S = SoundID 25
twoStep1S :: SoundID
twoStep1S = SoundID 26
seagullChatterS :: SoundID
seagullChatterS = SoundID 27
foamSprayLoopS :: SoundID
foamSprayLoopS = SoundID 28
explosionS :: SoundID
explosionS = SoundID 29
foamSprayFadeOutS :: SoundID
foamSprayFadeOutS = SoundID 30
tap2S :: SoundID
tap2S = SoundID 31
tinitusS :: SoundID
tinitusS = SoundID 32
seagullCry1S :: SoundID
seagullCry1S = SoundID 33
seagullBarkS :: SoundID
seagullBarkS = SoundID 34
stone3S :: SoundID
stone3S = SoundID 35
seagullCry2S :: SoundID
seagullCry2S = SoundID 36
hit1S :: SoundID
hit1S = SoundID 37
click1S :: SoundID
click1S = SoundID 38
twoStepSlowS :: SoundID
twoStepSlowS = SoundID 39
seagullCryS :: SoundID
seagullCryS = SoundID 40
crankSlowS :: SoundID
crankSlowS = SoundID 41
primeS :: SoundID
primeS = SoundID 42
twoStepS :: SoundID
twoStepS = SoundID 43
reloadS :: SoundID
reloadS = SoundID 44
reload1S :: SoundID
reload1S = SoundID 45
tone440sawtoothS :: SoundID
tone440sawtoothS = SoundID 46
tap3S :: SoundID
tap3S = SoundID 47
glassShat4S :: SoundID
glassShat4S = SoundID 48
glassShat2S :: SoundID
glassShat2S = SoundID 49
foot3S :: SoundID
foot3S = SoundID 50
pickUpS :: SoundID
pickUpS = SoundID 51
dededumS :: SoundID
dededumS = SoundID 52
tap1S :: SoundID
tap1S = SoundID 53
metal4S :: SoundID
metal4S = SoundID 54
knifeS :: SoundID
knifeS = SoundID 55
computerBeepingS :: SoundID
computerBeepingS = SoundID 56
tone440S :: SoundID
tone440S = SoundID 57
smallGlass2S :: SoundID
smallGlass2S = SoundID 58
glassShat1S :: SoundID
glassShat1S = SoundID 59
ejectS :: SoundID
ejectS = SoundID 60
seagullChatter1S :: SoundID
seagullChatter1S = SoundID 61
bangS :: SoundID
bangS = SoundID 62
dedaS :: SoundID
dedaS = SoundID 63
missileLaunchS :: SoundID
missileLaunchS = SoundID 64
gruntS :: SoundID
gruntS = SoundID 65
sineRaisePitchOneSecS :: SoundID
sineRaisePitchOneSecS = SoundID 66
metal2S :: SoundID
metal2S = SoundID 67
slideDoorS :: SoundID
slideDoorS = SoundID 68
autoGunS :: SoundID
autoGunS = SoundID 69
oldMachineBootS :: SoundID
oldMachineBootS = SoundID 70
buzzS :: SoundID
buzzS = SoundID 71
fireLoudS :: SoundID
fireLoudS = SoundID 72
tap4S :: SoundID
tap4S = SoundID 73
shotgunS :: SoundID
shotgunS = SoundID 74
miniS :: SoundID
miniS = SoundID 75
seagullWhistleS :: SoundID
seagullWhistleS = SoundID 76
whiteNoiseFadeInS :: SoundID whiteNoiseFadeInS :: SoundID
whiteNoiseFadeInS = SoundID 77 whiteNoiseFadeInS = SoundID 77
+5 -4
View File
@@ -16,6 +16,7 @@ import Geometry
import Dodge.GameRoom import Dodge.GameRoom
import LensHelp import LensHelp
import qualified Data.Map.Strict as M
--import qualified Data.List.NonEmpty as NEL --import qualified Data.List.NonEmpty as NEL
--import Control.Applicative --import Control.Applicative
import Data.Foldable import Data.Foldable
@@ -48,10 +49,10 @@ moveZoomCamera cfig w = w
vfoffset = do vfoffset = do
iscam <- yourItem w ^? _Just . itScope . scopeIsCamera iscam <- yourItem w ^? _Just . itScope . scopeIsCamera
guard iscam guard iscam
guard (SDL.ButtonRight `S.member` _mouseButtons w) guard (SDL.ButtonRight `M.member` _mouseButtons w)
yourItem w ^? _Just . itScope . scopePos yourItem w ^? _Just . itScope . scopePos
mscopeoffset = do mscopeoffset = do
guard (SDL.ButtonRight `S.member` _mouseButtons w) guard (SDL.ButtonRight `M.member` _mouseButtons w)
yourItem w ^? _Just . itScope . scopePos yourItem w ^? _Just . itScope . scopePos
newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
offset = rotateV (_cameraRot w) $ ((newzoom - newDefaultZoom)/(newDefaultZoom*newzoom)) *.* _mousePos w offset = rotateV (_cameraRot w) $ ((newzoom - newDefaultZoom)/(newDefaultZoom*newzoom)) *.* _mousePos w
@@ -80,7 +81,7 @@ moveZoomCamera cfig w = w
updateScopeZoom :: World -> World updateScopeZoom :: World -> World
updateScopeZoom w updateScopeZoom w
| SDL.ButtonRight `S.member` _mouseButtons w | SDL.ButtonRight `M.member` _mouseButtons w
= case w ^? creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0)) = case w ^? creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0))
. itScope . scopeZoomChange of . itScope . scopeZoomChange of
Just x Just x
@@ -133,7 +134,7 @@ zoomOutLongGun w
ifConfigWallRotate :: Configuration -> World -> World ifConfigWallRotate :: Configuration -> World -> World
ifConfigWallRotate cfig w ifConfigWallRotate cfig w
| _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `S.member` _mouseButtons w) | _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` _mouseButtons w)
= rotateToOverlappingWall w = rotateToOverlappingWall w
| otherwise = w | otherwise = w
+6 -6
View File
@@ -8,7 +8,8 @@ import Dodge.Creature.Impulse.UseItem
import Geometry import Geometry
import SDL import SDL
import qualified Data.Set as S --import qualified Data.Set as S
import qualified Data.Map.Strict as M
import Control.Lens import Control.Lens
updateUsingInput :: World -> World updateUsingInput :: World -> World
@@ -16,7 +17,7 @@ updateUsingInput w = case _hudElement $ _hud w of
DisplayInventory {} -> updatePressedButtons (_mouseButtons w) w DisplayInventory {} -> updatePressedButtons (_mouseButtons w) w
DisplayCarte -> updatePressedButtonsCarte (_mouseButtons w) w DisplayCarte -> updatePressedButtonsCarte (_mouseButtons w) w
updatePressedButtons :: S.Set MouseButton -> World -> World updatePressedButtons :: M.Map MouseButton Bool -> World -> World
updatePressedButtons pkeys w updatePressedButtons pkeys w
| isDown ButtonLeft && isDown ButtonRight && inTopInv | isDown ButtonLeft && isDown ButtonRight && inTopInv
= useItem (you w) w & doubleMouseHammer .~ HammerDown = useItem (you w) w & doubleMouseHammer .~ HammerDown
@@ -34,11 +35,10 @@ updatePressedButtons pkeys w
inTopInv = case _hudElement (_hud w) of inTopInv = case _hudElement (_hud w) of
DisplayInventory NoSubInventory -> True DisplayInventory NoSubInventory -> True
_ -> False _ -> False
isDown but = but `S.member` pkeys isDown but = but `M.member` pkeys
rotation = angleBetween (_mousePos w) (_clickMousePos w) rotation = angleBetween (_mousePos w) (_clickMousePos w)
updatePressedButtonsCarte :: M.Map MouseButton Bool -> World -> World
updatePressedButtonsCarte :: S.Set MouseButton -> World -> World
updatePressedButtonsCarte pkeys w updatePressedButtonsCarte pkeys w
| isDown ButtonRight = w | isDown ButtonRight = w
& clickMousePos .~ _mousePos w & clickMousePos .~ _mousePos w
@@ -49,7 +49,7 @@ updatePressedButtonsCarte pkeys w
& hud . carteZoom *~ czoom & hud . carteZoom *~ czoom
| otherwise = w | otherwise = w
where where
isDown but = but `S.member` pkeys isDown but = but `M.member` pkeys
rot = angleBetween (_mousePos w) (_clickMousePos w) rot = angleBetween (_mousePos w) (_clickMousePos w)
czoom = magV (_mousePos w) / magV (_clickMousePos w) czoom = magV (_mousePos w) / magV (_clickMousePos w)
trans = rotateV (_carteRot (_hud w)) $ 1 / _carteZoom (_hud w) *.* (_mousePos w -.- _clickMousePos w) trans = rotateV (_carteRot (_hud w)) $ 1 / _carteZoom (_hud w) *.* (_mousePos w -.- _clickMousePos w)