More strictifiiiying

This commit is contained in:
2021-07-30 01:25:11 +02:00
parent 2d8b27746c
commit 7b7fd302d8
37 changed files with 459 additions and 448 deletions
+3 -3
View File
@@ -13,7 +13,7 @@ magShield = defaultEquipment
, _itName = "MAGSHIELD"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank
, _itID = Nothing
}
@@ -23,7 +23,7 @@ flameShield = defaultEquipment
, _itName = "FLAMESHIELD"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \cr _ -> onLayer CrLayer $ pictures [color cyan $ circle (_crRad cr+2)]
, _itID = Nothing
}
@@ -52,7 +52,7 @@ jetPack = defaultEquipment
, _itName = "JETPACK"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> onLayer CrLayer
$ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ]
, _itEffect = NoItEffect
+33 -33
View File
@@ -188,7 +188,7 @@ forceFieldGun = defaultGun
, _itUse = undefined
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
, _itAimingSpeed = 0.4
, _itAimingRange = 0.5
}
@@ -253,7 +253,7 @@ remoteLauncher = defaultGun
, _itAimingSpeed = 0.2
, _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAttachment = Just $ ItScope (0,0) 0 1 True
, _itAttachment = Just $ ItScope (V2 0 0) 0 1 True
}
hvAutoGun :: Item
hvAutoGun = defaultAutoGun
@@ -292,7 +292,7 @@ ltAutoGun = defaultAutoGun
, _itUseRate = 3
, _itUseTime = 0
, _itUse = \_ -> shootWithSound 0 . withRandomDir 0.3 . withSidePush 50
. withMuzFlare $ withVelWthHiteff (30,0) 2 basicBulletEffect
. withMuzFlare $ withVelWthHiteff (V2 30 0) 2 basicBulletEffect
, _wpSpread = 0.5
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer ltAutoGunPic
@@ -321,7 +321,7 @@ miniGun = defaultAutoGun
. withRandomDir 0.1
. withRandomOffset 9
. withMuzFlare
. withVelWthHiteff (30,0) 2
. withVelWthHiteff (V2 30 0) 2
$ destroyOnImpact bulBounceArmCr' bulHitWall' bulHitFF'
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer miniGunPict
@@ -348,13 +348,13 @@ spreadGun = defaultGun
, _itUse = \_ -> shootWithSound (fromIntegral shotgunSound)
. withRecoil 100
. withMuzFlare
$ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 basicBulletEffect
$ spreadNumVelWthHiteff spreadGunSpread 9 (V2 30 0) 2 basicBulletEffect
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ]
, _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon $ map toV2[(-3,0),(3,6),(3,-6)] ]
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ]
, _itEquipPict = pictureWeaponOnAim $ color green $ pictures [ polygon $ map toV2[(-3,0),(3,6),(3,-6)] ]
}
multGun :: Item
multGun = defaultGun
@@ -369,7 +369,7 @@ multGun = defaultGun
, _itUse = \_ -> shootWithSound (fromIntegral shotgunSound)
. withRecoil 200
. withMuzFlare
$ numVelWthHitEff 5 (50,0) 5 basicBulletEffect
$ numVelWthHitEff 5 (V2 50 0) 5 basicBulletEffect
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer multGunPic
@@ -388,7 +388,7 @@ multGunPic = color red $ pictures
, polygon $ rectNSEW 2 (-2) 2 (-2)
, polygon $ rectNSEW (-3) (-7) 2 (-2)
, polygon $ rectNSEW (-8) (-12) 2 (-2)
, polygon [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)]
, polygon $ map toV2 [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)]
]
]
longGun :: Item
@@ -414,7 +414,7 @@ longGun = defaultGun
, _itZoom = defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}
, _itEquipPict = pictureWeaponOnAim longGunPic
, _itScroll = zoomLongGun
, _itAttachment = Just $ ItScope (0,0) 0 1 False
, _itAttachment = Just $ ItScope (V2 0 0) 0 1 False
, _itEffect = itemLaserScopeEffect
, _wpAmmo = hvBullet
, _itAimStance = TwoHandTwist
@@ -492,7 +492,7 @@ blinkGun = defaultGun
, _itLeftClickUse = Just $ hammerCheckL $ shootL aSelfL
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itAimingSpeed = 1
, _itAimingRange = 0
}
@@ -510,7 +510,7 @@ boosterGun = defaultGun
, _itLeftClickUse = Just $ boostSelfL 10
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itEffect = resetAttachmentID
@@ -536,8 +536,8 @@ aTeslaArc' cr w
remoteShellPic' :: Projectile -> Picture
remoteShellPic' pj
| t > 40 = onLayerL [levLayer CrLayer - 2]
$ uncurry translate pos $ rotate dir $ remoteShellPic t
| otherwise = uncurry translate pos $ rotate dir $ remoteShellPic t
$ uncurryV translate pos $ rotate dir $ remoteShellPic t
| otherwise = uncurryV translate pos $ rotate dir $ remoteShellPic t
where
t = _pjTimer pj
pos = _pjPos pj
@@ -547,9 +547,9 @@ remoteShellPic
:: Int -- ^ Timer
-> Picture
remoteShellPic t
| rem (t+200) 20 < 9 = setDepth 20 $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
| rem (t+200) 20 < 9 = setDepth 20 $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
| otherwise = pictures
[ setDepth 20 $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
[ setDepth 20 $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
, setLayer 1 . setDepth 20.5 . color col $ circleSolid 3
]
where
@@ -594,7 +594,7 @@ pointToItem (OnFloor flid) = floorItems . ix flid . flIt
retireRemoteRocket :: Int -> Int -> Int -> World -> World
retireRemoteRocket itid 0 pjid w =
set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0)
set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (V2 0 0)
$ set (pointToItem (_itemPositions w IM.! itid) . itUse) (\_ -> hammerCheck fireRemoteLauncher)
(w & projectiles %~ IM.delete pjid)
retireRemoteRocket itid t pjid w = setScope w
@@ -605,12 +605,12 @@ retireRemoteRocket itid t pjid w = setScope w
& creatures . ix cid . crInv . ix invid . itAttachment
. _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
_ -> w'
pos = fromMaybe (0,0) $ w ^? projectiles . ix pjid . pjPos
pos = fromMaybe (V2 0 0) $ w ^? projectiles . ix pjid . pjPos
retireRemoteBomb :: Int -> Int -> Int -> World -> World
retireRemoteBomb itid 0 pjid w = w
& pointToItem (_itemPositions w IM.! itid) %~
( (itAttachment . _Just . scopePos .~ (0,0))
( (itAttachment . _Just . scopePos .~ (V2 0 0))
. (itZoom .~ defaultItZoom)
. (itUse .~ (\_ -> hammerCheck throwRemoteBomb))
)
@@ -623,7 +623,7 @@ retireRemoteBomb itid t pjid w = setScope w
& creatures . ix cid . crInv . ix invid . itAttachment
. _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
_ -> w'
pos = fromMaybe (0,0) $ w ^? projectiles . ix pjid . pjPos
pos = fromMaybe (V2 0 0) $ w ^? projectiles . ix pjid . pjPos
moveRemoteBomb :: Int -> Int -> Int -> World -> World
moveRemoteBomb itid time pID w
@@ -657,7 +657,7 @@ moveRemoteBomb itid time pID w
| otherwise = x - 1
updatePicture =
set (projectiles . ix pID . pjDraw)
(\_ -> onLayer PtLayer $ uncurry translate newPos $ remoteBombPic time)
(\_ -> onLayer PtLayer $ uncurryV translate newPos $ remoteBombPic time)
. lowLightDirected
(withAlpha 0.1 red)
newPos
@@ -686,7 +686,7 @@ grenade = Throwable
, _itIdentity = Grenade
, _itMaxStack = 8
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150
, _twAccuracy = 30
, _itUse = \_ -> useTimeCheck $ throwGrenade makeExplosionAt
@@ -736,11 +736,11 @@ remoteBomb = defaultThrowable
, _itIdentity = RemoteBomb
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150
, _twAccuracy = 30
, _itUse = \_ -> hammerCheck throwRemoteBomb
, _itAttachment = Just $ ItScope (0,0) 0 1 True
, _itAttachment = Just $ ItScope (V2 0 0) 0 1 True
, _itEquipPict = pictureWeaponOnAim remoteBombUnarmedPic
}
@@ -754,15 +754,15 @@ fireRemoteLauncher cr w = setLocation
i = IM.newKey $ _projectiles w
cid = _crID cr
dir = _crDir cr
pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) (0))
remRocket = IM.insert i $ Shell
{ _pjPos = pos
, _pjStartPos = pos
, _pjVel = rotateV dir (1,0)
, _pjVel = rotateV dir (V2 1 0)
, _pjDraw = remoteShellPic'
, _pjID = i
, _pjUpdate = \pj -> decTimMvVel pj . setRemoteScope itid pj . moveRemoteShell cid itid pj
, _pjAcc = (0,0)
, _pjAcc = (V2 0 0)
, _pjDir = dir
, _pjSpin = 0
, _pjPayload = makeExplosionAt
@@ -814,7 +814,7 @@ moveRemoteShell cid itid pj w
&& w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . itInvId
= _cameraRot w + argV (_mousePos w)
| otherwise = _pjDir pj
accel = rotateV newdir (2,0)
accel = rotateV newdir (V2 2 0)
(frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.5,0.5) $ _randGen w
hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w
@@ -864,8 +864,8 @@ throwRemoteBomb cr w = setLocation
removePict = set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> blank
resetFire = set (creatures . ix cid . crInv . ix j . itUse)
$ \_ -> hammerCheck $ explodeRemoteBomb itid i
p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0)
p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0)
p' = _crPos cr +.+ rotateV (_crDir cr) (V2 (_crRad cr) (0))
p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (V2 (_crRad cr-4) (0))
| otherwise = p'
maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just
setLocation :: World -> World
@@ -912,7 +912,7 @@ pipe = Craftable
, _itName = "PIPE"
, _itMaxStack = 3
, _itAmount = 3
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank
, _itID = Nothing
, _itInvDisplay = _itName
@@ -972,7 +972,7 @@ autoSonar = defaultEquipment
, _itName = "AUTOSONAR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank
, _itEffect = autoSonarEffect
, _itID = Nothing
@@ -988,7 +988,7 @@ autoRadar = defaultEquipment
, _itName = "AUTORADAR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank
, _itEffect = autoRadarEffect
, _itID = Nothing
+1 -1
View File
@@ -56,7 +56,7 @@ singleFireMode = hammerCheck $ shootWithSound (fromIntegral autoGunSound) autoGu
autoGunNonTwistEff = withRecoil 40
. withRandomDir (autogunSpread/2)
. withMuzFlare
. withVelWthHiteff (50,0) 3
. withVelWthHiteff (V2 50 0) 3
$ destroyOnImpact bulHitCr bulHitWall' bulHitFF'
autoGunPic :: Picture
+1 -1
View File
@@ -59,7 +59,7 @@ shootBezier targetp cr w = w & particles %~ (theBullet :)
controlp = mouseWorldPos w
cid = _crID cr
dir = _crDir cr
startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
startp = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) (0))
(randPos,randPos') = flip evalState (_randGen w) $ do
a <- randInCirc 10
b <- randInCirc 20
+4 -2
View File
@@ -3,17 +3,19 @@ module Dodge.Item.Weapon.Bullet
import Dodge.Data
import Dodge.WorldEvent.HitEffect
import Dodge.Particle.Bullet.HitEffect
import Geometry.Data
basicBullet :: Ammo
basicBullet = BulletAmmo
{ _amString = "BULLET"
, _amBulEff = destroyOnImpact bulHitCr bulHitWall' bulHitFF'
, _amBulWth = 2
, _amBulVel = (30,0)
, _amBulVel = (V2 30 0)
}
hvBullet :: Ammo
hvBullet = BulletAmmo
{ _amString = "HVBULLET"
, _amBulEff = penWalls hvBulHitCr hvBulHitWall' bulHitFF'
, _amBulWth = 6
, _amBulVel = (80,0)
, _amBulVel = (V2 80 0)
}
+4 -3
View File
@@ -16,6 +16,7 @@ import Dodge.Picture.Layer
import Dodge.Creature.Test
import Picture
import Geometry.Vector
import Geometry.Data
import Data.Maybe
import Control.Lens
@@ -123,11 +124,11 @@ targetRBMousePos w = (f, \_ _ _ w' -> cursorPic w')
where
f _ = Just mwp
mwp = mouseWorldPos w
cursorPic w' = setLayer 1 $ onLayer InvLayer $ uncurry translate mwp
cursorPic w' = setLayer 1 $ onLayer InvLayer $ uncurryV translate mwp
$ rotate (_cameraRot w')
$ pictures
[line [( x,x), (-x,-x)]
,line [(-x,x), ( x,-x)]
[line [( V2 (x) (x)), (V2 (-x) (-x))]
,line [(V2 (-x) (x)), (V2 ( x) (-x))]
]
where
x = 5 / _cameraZoom w'
+4 -4
View File
@@ -134,8 +134,8 @@ aRocketWithItemParams it cr w = over projectiles (IM.insert i theShell) w
theShell = defaultShell
{ _pjPos = pos
, _pjStartPos = pos
, _pjVel = rotateV dir (1,0)
, _pjAcc = rotateV dir (3,0)
, _pjVel = rotateV dir (V2 1 0)
, _pjAcc = rotateV dir (V2 3 0)
, _pjDraw = _amPjDraw am
, _pjID = i
, _pjUpdate = \pj -> ammoMvs pj . decTimMvVel pj . moveShell pj
@@ -173,9 +173,9 @@ reduceSpinBy :: Float -> Projectile -> World -> World
reduceSpinBy x pj = projectiles . ix (_pjID pj) . pjSpin *~ x
shellPic :: Projectile -> Picture
shellPic pj = setDepth 20 . uncurry translate pos $ rotate (argV accel) basePic
shellPic pj = setDepth 20 . uncurryV translate pos $ rotate (argV accel) basePic
where
basePic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
basePic = color black $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
accel = _pjAcc pj
pos = _pjPos pj
+6 -5
View File
@@ -128,7 +128,7 @@ withRecoil
withRecoil recoilAmount eff cr = eff cr . over (creatures . ix cid) pushback
where
cid = _crID cr
pushback = over crPos (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0))
pushback = over crPos (+.+ rotateV (_crDir cr) (V2 ((-recoilAmount) / _crMass cr ) (0)))
{- | Pushes a creature sideways by a random amount.
Applied before the underlying effect. -}
withSidePush
@@ -140,8 +140,9 @@ withSidePush
withSidePush maxSide eff cr w = eff cr . over (creatures . ix cid) push $ w
where
cid = _crID cr
push = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr))
push = over crPos (+.+ rotateV (_crDir cr) (V2 (0) (pushAmount / _crMass cr)))
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
-- consider unifying the pushes using a direction vector
{- | Pushes a creature sideways by a random amount.
Applied after the underlying effect. -}
withSidePushAfter
@@ -153,7 +154,7 @@ withSidePushAfter
withSidePushAfter maxSide eff cr w = over (creatures . ix cid) push . eff cr $ w
where
cid = _crID cr
push = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr))
push = over crPos (+.+ rotateV (_crDir cr) (V2 (0) (pushAmount / _crMass cr)))
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
{- | Applies a world effect and sound effect after an ammo check. -}
shootWithSound
@@ -369,7 +370,7 @@ withRandomOffset
withRandomOffset offsetAmount f cr w = f (cr & crPos %~ (+.+ offV)) $ set randGen g w
where
(offsetVal , g) = randomR (-offsetAmount,offsetAmount) $ _randGen w
offV = rotateV (_crDir cr) (0,offsetVal)
offV = rotateV (_crDir cr) (V2 0 offsetVal)
-- | Rotates a creature with minimum rotation at least 0.1.
-- Rotates the player creature before applying the effect, other creatures after.
torqueBeforeForced
@@ -461,7 +462,7 @@ numVelWthHitEff num vel wth eff cr = over particles (newbuls ++)
d = _crDir cr
poss = map (+.+ pos) $ take num offsets
maxOffset = fromIntegral num * 2.5 - 2.5
offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..]
offsets = map (\y -> rotateV d (V2 0 y)) [-maxOffset,5-maxOffset..]
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d
{- | Uses '_wpSpread' as a parameter for the current offset angle. -}
randWalkAngle
+2 -2
View File
@@ -42,7 +42,7 @@ mvBlip p col maxt t w pt =
& ptDraw .~ ( const
. setDepth (-0.5)
. setLayer 1
. uncurry translate p
. uncurryV translate p
. color (withAlpha (fromIntegral t / fromIntegral maxt) col)
$ circleSolid 2 )
)
@@ -64,7 +64,7 @@ mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic
crBlips = mapMaybe crBlip $ IM.elems $ _creatures w
crBlip cr | dist cpos p < r + crad && dist cpos p > r - (crad + 100)
= Just $ colHelper (0.5 * (1 - (r - dist cpos p) /100))
$ uncurry translate cpos $ circleSolid crad
$ uncurryV translate cpos $ circleSolid crad
| otherwise = Nothing
where crad = _crRad cr
cpos = _crPos cr