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

Broken commit (removed loadKeyConfig)

Browse Source
This commit is contained in:
justin
2021-08-27 11:58:11 +01:00
parent c4df048d31
commit 3ff04576ab
25 changed files with 122 additions and 200 deletions
Download Patch File Download Diff File Expand all files Collapse all files
package.yaml
+5
View File
@@ -74,6 +74,11 @@ executables:
- -funfolding-keeness-factor1000
- -fllvm
- -optlo-O3
- -Wall
#- -Wincomplete-uni-patterns
- -Widentities
- -Wredundant-constraints
# - -Wmissing-export-lists
# - -fwrite-ide-info
# - -hiedir=.hie
dependencies:
src/Dodge/Combine.hs
+26 -24
View File
@@ -1,35 +1,37 @@
module Dodge.Combine
(
)
where
--import Dodge.Data
import Dodge.Combine.Data
--import Dodge.Combine.Data
--import qualified Data.IntMap.Strict as IM
--import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
--import qualified Data.Map.Strict as M
--combineList :: IM.IntMap Item -> [(Item , IS.IntSet)]
--combineList
invert :: (Ord a) => M.Map b a -> M.Map a [b]
invert = M.foldrWithKey (\k val -> M.insertWith (++) val [k]) M.empty
combineList :: [([ItemType], ItemType)]
combineList =
[ ( [ TPistol, TPipe, THardware ] , TRifle )
, ( [ TRifle, THardware ] , TPistol )
, ( [ TPistol, TPistol, THardware ] , TSpreadGun 2 )
, ( [ TSpreadGun 2, TPistol, THardware ] , TSpreadGun 3 )
, ( [ TSpreadGun 3, TPistol, THardware ] , TSpreadGun 4 )
, ( [ TSpreadGun 4, TPistol, THardware ] , TSpreadGun 5 )
, ( [ TPistol, TAutoGun, THardware ] , TLtAutoGun )
, ( [ TLtAutoGun, TPipe, THardware ] , TAutoGun )
, ( [ TRifle, TRifle, THardware ] , TMultGun 2 )
, ( [ TMultGun 2, TRifle, THardware ] , TMultGun 3 )
, ( [ TMultGun 3, TRifle, THardware ] , TMultGun 4 )
, ( [ TMultGun 4, TRifle, THardware ] , TMultGun 5 )
, ( [ TLtAutoGun, TPipe, THardware ] , TAutoGun )
, ( [ TPistol, TBigTube, THardware] , TLauncher 1 )
, ( [ TLauncher 1, TBigTube, TPistol, THardware] , TLauncher 2)
, ( [ TLauncher 2, TBigTube, TPistol, THardware] , TLauncher 3)
]
--invert :: (Ord a) => M.Map b a -> M.Map a [b]
--invert = M.foldrWithKey (\k val -> M.insertWith (++) val [k]) M.empty
--
--combineList :: [([ItemType], ItemType)]
--combineList =
-- [ ( [ TPistol, TPipe, THardware ] , TRifle )
-- , ( [ TRifle, THardware ] , TPistol )
-- , ( [ TPistol, TPistol, THardware ] , TSpreadGun 2 )
-- , ( [ TSpreadGun 2, TPistol, THardware ] , TSpreadGun 3 )
-- , ( [ TSpreadGun 3, TPistol, THardware ] , TSpreadGun 4 )
-- , ( [ TSpreadGun 4, TPistol, THardware ] , TSpreadGun 5 )
-- , ( [ TPistol, TAutoGun, THardware ] , TLtAutoGun )
-- , ( [ TLtAutoGun, TPipe, THardware ] , TAutoGun )
-- , ( [ TRifle, TRifle, THardware ] , TMultGun 2 )
-- , ( [ TMultGun 2, TRifle, THardware ] , TMultGun 3 )
-- , ( [ TMultGun 3, TRifle, THardware ] , TMultGun 4 )
-- , ( [ TMultGun 4, TRifle, THardware ] , TMultGun 5 )
-- , ( [ TLtAutoGun, TPipe, THardware ] , TAutoGun )
-- , ( [ TPistol, TBigTube, THardware] , TLauncher 1 )
-- , ( [ TLauncher 1, TBigTube, TPistol, THardware] , TLauncher 2)
-- , ( [ TLauncher 2, TBigTube, TPistol, THardware] , TLauncher 3)
-- ]
src/Dodge/Combine/Data.hs
+2
View File
@@ -1,4 +1,6 @@
module Dodge.Combine.Data
(ItemType (..)
)
where
data ItemType
= TPipe
src/Dodge/Config/KeyConfig.hs
+3 -103
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE OverloadedStrings #-}
module Dodge.Config.KeyConfig
( KeyConfigSDL (..)
, defaultKeyConfigSDL
)
where
--import Data.Aeson
--import Foreign.C.Types
@@ -10,26 +13,6 @@ import qualified SDL
--import qualified SDL.Internal.Numbered
--import System.Directory
data KeyConfig = KeyConfig
{ moveUpBinding :: Int,
moveDownBinding :: Int,
moveLeftBinding :: Int,
moveRightBinding :: Int,
pauseBinding :: Int,
escapeBinding :: Int,
dropItemBinding :: Int,
toggleMapBinding :: Int,
reloadBinding :: Int,
testEventBinding :: Int,
spaceActionBinding :: Int,
rotateCameraPlusBinding :: Int,
rotateCameraMinusBinding :: Int,
zoomInBinding :: Int,
zoomOutBinding :: Int,
newBinding :: Int
}
deriving (Generic, Show)
data KeyConfigSDL = KeyConfigSDL
{ moveUpKey :: SDL.Scancode
, moveDownKey :: SDL.Scancode
@@ -72,86 +55,3 @@ defaultKeyConfigSDL =
, newMapKey = SDL.ScancodeN
, modifierKey = SDL.ScancodeCapsLock
}
--instance ToJSON KeyConfig where
-- toEncoding = genericToEncoding defaultOptions
--
--instance FromJSON KeyConfig where
-- parseJSON = withObject "KeyConfig" $ \o -> do
-- moveUpBinding <- o .:? "moveUp" .!= 119
-- moveDownBinding <- o .:? "moveDown" .!= 115
-- moveLeftBinding <- o .:? "moveLeft" .!= 97
-- moveRightBinding <- o .:? "moveRight" .!= 100
-- pauseBinding <- o .:? "pause" .!= 112
-- escapeBinding <- o .:? "escape" .!= 27
-- dropItemBinding <- o .:? "dropItem" .!= 102
-- toggleMapBinding <- o .:? "toggleMap" .!= 109
-- reloadBinding <- o .:? "reload" .!= 114
-- testEventBinding <- o .:? "testEvent" .!= 116
-- spaceActionBinding <- o .:? "spaceAction" .!= 32
-- rotateCameraPlusBinding <- o .:? "rotateCameraPlus" .!= 113
-- rotateCameraMinusBinding <- o .:? "rotateCameraMinus" .!= 101
-- zoomInBinding <- o .:? "zoomIn" .!= 106
-- zoomOutBinding <- o .:? "zoomOut" .!= 107
-- newBinding <- o .:? "new" .!= 110
-- return
-- KeyConfig
-- { moveUpBinding = moveUpBinding,
-- moveDownBinding = moveDownBinding,
-- moveLeftBinding = moveLeftBinding,
-- moveRightBinding = moveRightBinding,
-- pauseBinding = pauseBinding,
-- escapeBinding = escapeBinding,
-- dropItemBinding = dropItemBinding,
-- toggleMapBinding = toggleMapBinding,
-- reloadBinding = reloadBinding,
-- testEventBinding = testEventBinding,
-- spaceActionBinding = spaceActionBinding,
-- rotateCameraPlusBinding = rotateCameraPlusBinding,
-- rotateCameraMinusBinding = rotateCameraMinusBinding,
-- zoomInBinding = zoomInBinding,
-- zoomOutBinding = zoomOutBinding,
-- newBinding = newBinding
-- }
loadKeyConfig :: IO KeyConfigSDL
loadKeyConfig = return defaultKeyConfigSDL
--loadKeyConfig' :: IO KeyConfigSDL
--loadKeyConfig' = do
-- fExists <- doesFileExist "keys.json"
-- if fExists
-- then do
-- mayConfig <- decodeFileStrict "keys.json"
-- print mayConfig
-- case mayConfig of
-- Just config ->
-- return
-- KeyConfigSDL
-- { moveUpKey = getSdlScancode $ moveUpBinding config,
-- moveDownKey = getSdlScancode $ moveDownBinding config,
-- moveLeftKey = getSdlScancode $ moveLeftBinding config,
-- moveRightKey = getSdlScancode $ moveRightBinding config,
-- pauseKey = getSdlScancode $ pauseBinding config,
-- escapeKey = getSdlScancode $ escapeBinding config,
-- dropItemKey = getSdlScancode $ dropItemBinding config,
-- toggleMapKey = getSdlScancode $ toggleMapBinding config,
-- reloadKey = getSdlScancode $ reloadBinding config,
-- testEventKey = getSdlScancode $ testEventBinding config,
-- spaceActionKey = getSdlScancode $ spaceActionBinding config,
-- rotateCameraPlusKey = getSdlScancode $ rotateCameraPlusBinding config,
-- rotateCameraMinusKey = getSdlScancode $ rotateCameraMinusBinding config,
-- zoomInKey = getSdlScancode $ zoomInBinding config,
-- zoomOutKey = getSdlScancode $ zoomOutBinding config,
-- newKey = getSdlScancode $ newBinding config
-- }
-- Nothing -> do
-- putStrLn "invalid keys.json, loading default config"
-- -- This is duplicated but not sure how to reduce
-- return defaultKeyConfigSDL
-- else do
-- putStrLn "No keys.json found, loading default config"
-- return defaultKeyConfigSDL
--
--getSdlScancode :: Int -> SDL.Scancode
--getSdlScancode x = SDL.Internal.Numbered.fromNumber (fromIntegral x) :: SDL.Scancode
src/Dodge/Creature/AlertLevel/Data.hs
+9 -3
View File
@@ -1,7 +1,13 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Creature.AlertLevel.Data
where
( AwakeLevel (..)
, AttentionDir (..)
, AwarenessLevel (..)
-- lenses
, getAttentiveTo
, getFixated
) where
import Control.Lens
data AwakeLevel
@@ -12,8 +18,8 @@ data AwakeLevel
| Overstrung
data AttentionDir
= AttentiveTo {_unAttentiveTo :: [Int]}
| Fixated {_unFixated :: Int }
= AttentiveTo {_getAttentiveTo :: [Int]}
| Fixated {_getFixated :: Int }
data AwarenessLevel
= AwarenessInt Int
src/Dodge/Creature/Rationality.hs
+1 -1
View File
@@ -87,7 +87,7 @@ followImpulse cr w imp = case imp of
posFromID cid = _crPos $ _creatures w IM.! cid
rr a = fst $ randomR (-a,a) $ _randGen w
hitCr i = over (creatures . ix i . crState . crDamage) (addDam i)
. soundOnce (fromIntegral hitSound)
. soundOnce hitSound
addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams
actionUpdateAI
src/Dodge/Graph.hs
+7 -3
View File
@@ -1,12 +1,16 @@
module Dodge.Graph
where
( pairsToSCC
, incidenceToFunction
, pairsToIncidence
) where
-- this deserves tests
import Data.List.Extra
import Data.Bifunctor (first)
import Data.Graph
import Data.Maybe
pairsToIncidence :: (Eq a,Ord a) => [(a,a)] -> [(a,[a])]
pairsToIncidence :: Ord a => [(a,a)] -> [(a,[a])]
pairsToIncidence
= map (first head . unzip)
. groupOn fst
@@ -18,5 +22,5 @@ incidenceToFunction xs a = fromMaybe [] $ lookup a xs
mkNode :: (a,[a]) -> (a,a,[a])
mkNode (x,xs) = (x,x,xs)
pairsToSCC :: (Eq a, Ord a) => [(a,a)] -> [SCC a]
pairsToSCC :: Ord a => [(a,a)] -> [SCC a]
pairsToSCC = stronglyConnComp . map mkNode . pairsToIncidence
src/Dodge/Item/Weapon.hs
+17 -14
View File
@@ -275,7 +275,7 @@ hvAutoGun = defaultAutoGun
, _wpAmmo = hvBullet
}
where
mkHvBul it = withSound (fromIntegral longGunSound)
mkHvBul it = withSound longGunSound
. withThinSmoke
. withMuzFlare
$ useAmmoParams it
@@ -322,21 +322,24 @@ miniGun = defaultAutoGun
, _wpReloadTime = 200
, _wpReloadState = 0
, _wpMaxWarmUp = 100
, _itUseRate = 2
, _itUseRate = 1
, _itUseTime = 0
, _itUse = \_ -> withWarmUp 50
, _itUse = \it -> withWarmUp 26
. shootWithSoundFor 28 2
. torqueBefore 0.03 . withSidePush 50 . withRecoil 15
. withRandomDir 0.1
. torqueBefore 0.1
-- . torqueBefore 0.03
. withSidePush 50
. withRecoil 15
-- . withRandomDir 0.1
. withRandomOffset 9
. withMuzFlare
. withVelWthHiteff (V2 30 0) 2
$ destroyOnImpact bulBounceArmCr' bulHitWall' bulHitFF'
$ useAmmoParams it
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer miniGunPict
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim miniGunPict
, _wpAmmo = basicBullet
}
miniGunPict :: Picture
miniGunPict = pictures
@@ -354,7 +357,7 @@ spreadGun = defaultGun
, _wpReloadState = 0
, _itUseRate = 20
, _itUseTime = 0
, _itUse = \_ -> shootWithSound (fromIntegral shotgunSound)
, _itUse = \_ -> shootWithSound shotgunSound
. withRecoil 100
. withMuzFlare
$ spreadNumVelWthHiteff spreadGunSpread 9 (V2 30 0) 2 basicBulletEffect
@@ -375,7 +378,7 @@ multGun = defaultGun
, _wpReloadState = 0
, _itUseRate = 20
, _itUseTime = 0
, _itUse = \_ -> shootWithSound (fromIntegral shotgunSound)
, _itUse = \_ -> shootWithSound shotgunSound
. withRecoil 200
. withMuzFlare
$ numVelWthHitEff 5 (V2 50 0) 5 basicBulletEffect
@@ -411,7 +414,7 @@ longGun = defaultGun
, _wpReloadType = PassiveReload skwareFadeTwoSecSound
, _itUseRate = 100
, _itUseTime = 0
, _itUse = shootWithSound (fromIntegral longGunSound)
, _itUse = shootWithSound longGunSound
. withThickSmoke
. torqueAfter 0.05
. withMuzFlare
@@ -640,10 +643,10 @@ moveRemoteBomb itid time pID w
$ set (projectiles .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (f time) pID)
w
| time < 2 = case hitWl of
Just _ -> soundOnce (fromIntegral tapQuiet) $ halfV updatedWorld
Just _ -> soundOnce tapQuiet $ halfV updatedWorld
_ -> halfV updatedWorld
| otherwise = case hitWl of
Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld
Just _ -> soundOnce tapQuiet updatedWorld
_ -> updatedWorld
where
updatedWorld
@@ -757,7 +760,7 @@ fireRemoteLauncher :: Creature -> World -> World
fireRemoteLauncher cr w = setLocation
$ resetFire
$ resetName
$ soundOnce (fromIntegral launcherSound)
$ soundOnce launcherSound
$ over projectiles remRocket w
where
i = IM.newKey $ _projectiles w
@@ -805,7 +808,7 @@ moveRemoteShell cid itid pj w
( ( pjVel %~ ( (accel +.+) . (frict *.*) ) )
. ( pjDir .~ newdir )
)
& soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
& soundFromPos (ShellSound i) newPos smokeTrailSound 1 250
& smokeGen
& makeFlameletTimed oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
| time > -200 = case thingHit of
src/Dodge/Item/Weapon/AutoGun.hs
+2 -2
View File
@@ -49,10 +49,10 @@ autoGun = defaultAutoGun
, _wpAmmo = basicBullet
}
autoFireMode, singleFireMode, autoGunNonTwistEff :: Creature -> World -> World
autoFireMode = shootWithSound (fromIntegral autoGunSound)
autoFireMode = shootWithSound autoGunSound
. torqueBefore 0.05
$ autoGunNonTwistEff
singleFireMode = hammerCheck $ shootWithSound (fromIntegral autoGunSound) autoGunNonTwistEff
singleFireMode = hammerCheck $ shootWithSound autoGunSound autoGunNonTwistEff
autoGunNonTwistEff = withRecoil 40
. withRandomDir (autogunSpread/2)
. withMuzFlare
src/Dodge/Item/Weapon/Grenade.hs
+1 -1
View File
@@ -32,7 +32,7 @@ moveGrenade 0 _ pID w = over projectiles (IM.delete pID)
pj = _projectiles w IM.! pID
explosion = _pjPayload pj
moveGrenade time dir pID w = case hitWl of
Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld
Just _ -> soundOnce tapQuiet updatedWorld
_ -> updatedWorld
where
updatedWorld = updateV $ set (projectiles . ix pID . pjPos) finalPos
src/Dodge/Item/Weapon/Launcher.hs
+3 -3
View File
@@ -37,7 +37,7 @@ launcher = defaultGun
, _wpReloadState = 0
, _itUseRate = 20
, _itUseTime = 0
, _itUse = shootWithSound (fromIntegral launcherSound) . aRocketWithItemParams
, _itUse = shootWithSound launcherSound . aRocketWithItemParams
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer launcherPic
@@ -92,14 +92,14 @@ pjThrust :: Int -> Projectile -> World -> World
pjThrust i = pjEffTimeRange (st,et) doThrust
where
et | i == 0 = 36
| otherwise = 40 - (fromIntegral i * 20)
| otherwise = 40 - (i * 20)
st = et - 100
doThrust :: Projectile -> World -> World
doThrust pj w = w
& randGen .~ g
& projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
& soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
& soundFromPos (ShellSound i) newPos smokeTrailSound 1 250
& makeFlameletTimed (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
& smokeGen
where
src/Dodge/Item/Weapon/TriggerType.hs
+4 -6
View File
@@ -83,22 +83,21 @@ rateIncAB startRate fastRate shooteff1 shooteff2 cr w
Shoot a weapon rapidly after a warm up.
Applies ammo check as well. -}
withWarmUp
:: Int -- ^ Warm up time (in frames)
:: Int -- ^ warm up sound id
-> (Creature -> World -> World)
-- ^ Shoot effect
-- ^ underlying effect
-> Creature
-> World
-> World
withWarmUp t f cr w
withWarmUp soundID f cr w
| reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| _wpReloadState item /= 0 = w
| curWarmUp < maxWarmUp = w
& pointerToItem . wpCurWarmUp +~ 2
& soundFrom (CrWeaponSound cid) 26 2 0
& soundFrom (CrWeaponSound cid) soundID 2 0
| otherwise = w
& pointerToItem . wpCurWarmUp .~ maxWarmUp
& f cr
-- & soundFrom (CrWeaponSound cid) 28 2 0
where
cid = _crID cr
itRef = _crInvSel cr
@@ -106,7 +105,6 @@ withWarmUp t f cr w
pointerToItem = creatures . ix cid . crInv . ix itRef
curWarmUp = _wpCurWarmUp item
maxWarmUp = _wpMaxWarmUp item
fState = _itUseTime item
reloadCondition = _wpLoadedAmmo item == 0
{- | Adds a sound to a creature based world effect.
The sound is emitted from the creature's position. -}
src/Dodge/LevelGen/Data.hs
+16 -3
View File
@@ -1,7 +1,22 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.LevelGen.Data
where
( PSType (..)
, PlacementSpot (..)
, Placement (..)
, sPS
-- lenses
, placementSpot
, psType
, psPos
, psRot
, putID
, pwPoly
, pwWall
, unPutCrit
, groupPlacementID
, groupUpdate
) where
import Dodge.Data
import Picture
import Polyhedra.Data
@@ -36,9 +51,7 @@ data Placement
= SinglePlacement {_placementSpot :: PlacementSpot }
| GroupedPlacement
{_groupPlacementID :: Int
-- ,_groupPlacementUpdate :: World -> Placement -> (World, Placement)
,_groupUpdate :: World -> [Placement] -> World
-- ,_groupPlacementFunc :: [PSType] -> PSType -> World -> World
,_placementSpot :: PlacementSpot
}
sPS :: Point2 -> Float -> PSType -> Placement
src/Dodge/LevelGen/MoveDoor.hs
+1 -1
View File
@@ -65,7 +65,7 @@ addSoundToDoor i pld hwd (x:ys) = f x : ys
where
g dm w
| dist wp pld > 2 && dist wp hwd > 2
= soundFrom (WallSound i) (fromIntegral doorSound) 1 0 $ dm w
= soundFrom (WallSound i) doorSound 1 0 $ dm w
| otherwise = dm w
where
wp = snd $ _wlLine (_walls w IM.! i)
src/Dodge/LevelGen/Pathing.hs
+1 -1
View File
@@ -12,7 +12,7 @@ import qualified Data.IntMap.Strict as IM
import Data.Graph.Inductive hiding ((&))
--import Data.Graph.Inductive.NodeMap
pairsToGraph :: (Ord a, Eq a, Eq b) => (a -> a -> b) -> [(a,a)] -> Gr a b
pairsToGraph :: (Ord a, Eq b) => (a -> a -> b) -> [(a,a)] -> Gr a b
pairsToGraph f pairs =
let nodes' = nub (map fst pairs ++ map snd pairs)
pairs' = map (\(x,y)->(x,y,f x y)) pairs
src/Dodge/Lock.hs
-2
View File
@@ -1,2 +0,0 @@
module Dodge.Lock
where
src/Dodge/Lock/Data.hs
-15
View File
@@ -1,15 +0,0 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Lock.Data
where
import Dodge.Data
import Control.Lens
newtype Lock = Lock
{ _lkUnlocker :: Unlocker
}
newtype Unlocker
= ItemUnlocker Item
makeLenses ''Lock
src/Dodge/Room/CheckConsistency.hs
+1 -1
View File
@@ -13,5 +13,5 @@ linksOnPath r = all pointOnPath linkPoints
pathConnected :: Room -> Bool
pathConnected = isSingleton . pairsToSCC . _rmPath
where
isSingleton [] = True
isSingleton [_] = True
isSingleton _ = False
src/Dodge/Room/Data.hs
+8 -2
View File
@@ -1,14 +1,20 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Room.Data
where
( Room (..)
, rmPolys
, rmLinks
, rmPath
, rmPS
, rmBound
, rmFloor
) where
import Dodge.LevelGen.Data
--import Geometry
import Geometry.Data
import Data.Tile
import Control.Lens
{-
The '_rmPolys' list states which polygons should be cut out to form the indestructible walls of the room.
Link pairs contain a position and rotation to attach to another room;
src/Dodge/Room/Link.hs
+1 -2
View File
@@ -33,8 +33,7 @@ randomiseAllLinks r = do
return $ r {_rmLinks = newLinks}
randomiseLinksBy
:: RandomGen g
=> ( [(Point2,Float)] -> State g [(Point2,Float)] )
:: ( [(Point2,Float)] -> State g [(Point2,Float)] )
-> Room
-> State g Room
randomiseLinksBy f r = do
src/Dodge/Room/Procedural.hs
+1 -2
View File
@@ -231,8 +231,7 @@ randomFourCornerRoom = do
{- | Creates room with a central vault with doors around it.
-}
centerVaultRoom
:: RandomGen g
=> Int -- ^ Door id
:: Int -- ^ Door id
-> Float -- ^ Width
-> Float -- ^ Height
-> Float -- ^ Vault dimensions
src/Dodge/Room/RoadBlock.hs
+1 -1
View File
@@ -51,7 +51,7 @@ litCorridor90 = do
, _rmBound = [poly]
}
noWeaponTest :: RandomGen g => State g (Tree (Either Room Room))
noWeaponTest :: State g (Tree (Either Room Room))
noWeaponTest = do
undefined
src/Dodge/Room/Treasure.hs
+2 -2
View File
@@ -14,7 +14,7 @@ import Geometry
--import Data.List
import Control.Monad.State
--import Control.Lens
import System.Random
--import System.Random
{- | A triangular room with loot at the top (with 'PutID' 2),
creatures in the bottom two corners (with 'PutID' 0),
and (single) entrance bottom middle. -}
@@ -50,7 +50,7 @@ triLootRoom w h = pure $ defaultRoom
]
base = rectNSWE 20 (-80) (-20) 20
{- | Create a random room with one entrance containing given creatures and items. -}
lootRoom :: RandomGen g => [Creature] -> [Item] -> State g Room
lootRoom :: [Creature] -> [Item] -> State g Room
lootRoom crs itms = do
let w = 300
h = 700
src/Sound.hs
+6 -8
View File
@@ -39,8 +39,8 @@ New sounds with the same keys as
already playing sounds are merged as follows:
* '_soundChannel' is set to the old value
* if the old '_soundStatus' was 'FadingOut', it is set to the new value (can restart playback with 'ToStart')
* other fields are set to the new value.
* if the old sound is not fading and the chunk is the same, '_soundStatus' is set to the old value
* all other values are set to the new values
In the update:
@@ -51,18 +51,16 @@ In the update:
-}
playAndUpdate :: Ord a => SoundData a -> M.Map a Sound -> IO (M.Map a Sound)
playAndUpdate sData newSounds
= updateSounds (_loadedChunks sData) (M.unionWith mergeSound newSounds (_playingSounds sData))
= updateSounds (_loadedChunks sData) (M.unionWith mergeSound (_playingSounds sData) newSounds)
mergeSound :: Sound -> Sound -> Sound
mergeSound newS oldS
| _soundStatus oldS == FadingOut
= newS & soundChannel .~ _soundChannel oldS
| _soundChunkID newS == _soundChunkID oldS
mergeSound oldS newS
| _soundChunkID newS == _soundChunkID oldS && _soundStatus oldS /= FadingOut
= newS & soundChannel .~ _soundChannel oldS
& soundStatus .~ _soundStatus oldS
| otherwise = newS & soundChannel .~ _soundChannel oldS
updateSounds :: Ord a => IM.IntMap Mix.Chunk -> M.Map a Sound -> IO (M.Map a Sound)
updateSounds :: IM.IntMap Mix.Chunk -> M.Map a Sound -> IO (M.Map a Sound)
updateSounds sd ss = do
may <- mapM (runMaybeT . updateSound sd) ss
return $ M.mapMaybe id may
test/Spec.hs
+4
View File
@@ -1,4 +1,6 @@
import Test.QuickCheck
import Test.HUnit
import Dodge.Room.CheckConsistency
import Dodge.LevelGen.StaticWalls
import Geometry
@@ -51,3 +53,5 @@ genTris = listOf genTri
--
--[[(0.0,1.0),(3.0,4.0),(5.0,5.0)],[(2.0,0.0),(2.0,4.0),(1.0,1.0)],[(5.0,5.0),(2.0,2.0),(1.0,3.0)]]
--
testRoom rm = TestCase "Room links connected" (linksOnPath rm)