286 lines
10 KiB
Haskell
286 lines
10 KiB
Haskell
module Dodge.Item.Weapon.Grenade where
|
|
import Dodge.Data
|
|
import Dodge.WorldEvent.Explosion
|
|
--import Dodge.Item.Weapon.TriggerType
|
|
import Dodge.Item.Weapon.Remote
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Dodge.SoundLogic
|
|
import Dodge.Item.Draw
|
|
--import Dodge.Item.Weapon.InventoryDisplay
|
|
--import Dodge.Item.Attachment
|
|
import Picture
|
|
import Geometry
|
|
import ShapePicture
|
|
import Shape
|
|
import qualified IntMapHelp as IM
|
|
|
|
import Data.Maybe
|
|
import Control.Lens
|
|
|
|
--grenade :: Item
|
|
--grenade = Item
|
|
-- { _itName = "GRENADE " ++ show fuseTime
|
|
-- , _itType = GRENADE
|
|
-- , _itInvSize = 1
|
|
-- , _itDimension = defaultItemDimension
|
|
-- , _itCurseStatus = Uncursed
|
|
-- , _itConsumption = ItemItselfConsumable 1
|
|
---- , _itMaxStack = 8
|
|
-- , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
|
|
-- , _twMaxRange = 150
|
|
-- , _twAccuracy = 30
|
|
-- , _itUse = ruseRate 25 (\_ -> throwGrenade makeExplosionAt) upHammer
|
|
-- [ useTimeCheck
|
|
-- ]
|
|
-- & useAim . aimZoom .~ defaultItZoom {_itZoomMax = f fuseTime, _itZoomMin = f fuseTime}
|
|
---- , _itZoom = defaultItZoom
|
|
-- , _itEquipPict = pictureWeaponOnAim' $ \_ -> grenadePic fuseTime
|
|
-- , _itID = Nothing
|
|
-- , _itAttachment = ItFuse fuseTime
|
|
-- , _itInvColor = white
|
|
-- , _itInvDisplay = basicItemDisplay
|
|
-- , _itEffect = NoItEffect
|
|
-- , _itScroll = changeFuse
|
|
-- }
|
|
-- where
|
|
-- fuseTime = 50
|
|
-- f x = 50 / fromIntegral x
|
|
|
|
moveGrenade :: Prop -> World -> World
|
|
moveGrenade pj w
|
|
| _pjTimer pj <= 0 = w
|
|
& props %~ IM.delete pID
|
|
& _pjPayload pj (_prPos (_props w IM.! pID))
|
|
-- this should maybe
|
|
-- be wallsAlongLine
|
|
-- or something vvv
|
|
| otherwise = case bounceBall 1 oldPos newPos 4 $ wlsNearPoint newPos w of
|
|
Nothing -> w & props . ix pID %~ normalUpdate
|
|
Just (p,v) -> w
|
|
& soundStart (Tap 0) p tapQuietS Nothing
|
|
& props . ix pID %~ ( ( prPos .~ p ) . ( pjTimer -~ 1 ) . (pjVel .~ v) )
|
|
where
|
|
pID = _pjID pj
|
|
normalUpdate = (pjTimer -~ 1)
|
|
. (pjZ %~ (max 0 . (+ _pjVelZ pj)))
|
|
. (pjVelZ -~ 0.1)
|
|
. ( prPos .~ newPos )
|
|
oldPos = _prPos pj
|
|
newPos = _pjVel pj +.+ oldPos
|
|
|
|
grenadePic :: Int -> SPic
|
|
grenadePic time =
|
|
( colorSH (dark $ dark green) $ upperPrismPolyHalf 5 $ polyCirc 3 5
|
|
, pictures
|
|
[ color green $ arc (degToRad $ (179 * fromIntegral time / 50) - 180 )
|
|
(degToRad $ 180 - (179 * fromIntegral time / 50) )
|
|
5
|
|
]
|
|
)
|
|
|
|
grenadeDraw :: Float -> Prop -> SPic
|
|
grenadeDraw dir prop = translateSPz (_pjZ prop) $ uncurryV translateSPf (_prPos prop)
|
|
$ rotateSP dir $ grenadePic $ _pjTimer prop
|
|
|
|
throwGrenade
|
|
:: (Point2 -> World -> World) -- ^ Payload
|
|
-> Creature
|
|
-> World
|
|
-> World
|
|
throwGrenade thePayload cr w = setWp $ removePict $ over props addG w
|
|
where
|
|
n = _crID cr
|
|
addG = IM.insert i $ Bomb
|
|
{ _prPos = p
|
|
, _pjZ = 10
|
|
, _pjVelZ = 2
|
|
, _pjVel = v
|
|
, _prDraw = grenadeDraw dir
|
|
, _pjID = i
|
|
, _pjUpdate = moveGrenade
|
|
, _pjPayload = thePayload
|
|
, _pjTimer = fuseTime
|
|
}
|
|
j = crSel cr
|
|
removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> (,) emptySH blank
|
|
i = IM.newKey $ _props w
|
|
v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w)
|
|
v | magV v' > 6 = 6 *.* normalizeV v'
|
|
| otherwise = v'
|
|
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'
|
|
dir = argV v
|
|
setWp :: World -> World
|
|
setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20
|
|
fuseTime = _atFuseTime $ _itAttachment $ _crInv cr IM.! j
|
|
|
|
throwArmReset :: Int -> ItEffect
|
|
throwArmReset x = ItInvEffect {_ieInv = f ,_ieCounter = x }
|
|
where
|
|
f itm cr = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i
|
|
where
|
|
i = fromJust $ _itInvPos itm
|
|
counterDown it
|
|
| _ieCounter (_itEffect it) == 0 = it
|
|
& itUse . useHammer . hammerPosition .~ HammerUp
|
|
& itEquipPict .~ pictureWeaponAim (\_ -> grenadePic 50)
|
|
| otherwise = it & itEffect . ieCounter -~ 1
|
|
|
|
--flameGrenade :: Item
|
|
--flameGrenade = grenade {
|
|
-- _itName = "FLMGREN " ++ show fuseTime
|
|
-- , _itUse = \_ -> throwGrenade makeFlameExplosionAt
|
|
-- }
|
|
-- where
|
|
-- fuseTime = 50 :: Int
|
|
--
|
|
--teslaGrenade :: Item
|
|
--teslaGrenade = grenade {
|
|
-- _itName = "TLSGREN " ++ show fuseTime
|
|
-- , _itUse = \_ -> throwGrenade makeTeslaExplosionAt
|
|
-- }
|
|
-- where
|
|
-- fuseTime = 50 :: Int
|
|
--
|
|
--retireRemoteBomb :: Int -> Int -> Int -> World -> World
|
|
--retireRemoteBomb itid 0 pjid w = w
|
|
-- & pointToItem (_itemPositions w IM.! itid) %~
|
|
-- ( (itAttachment . scopePos .~ V2 0 0)
|
|
-- . (itZoom .~ defaultItZoom)
|
|
-- . (itUse .~ const throwRemoteBomb)
|
|
-- )
|
|
-- & props %~ IM.delete pjid
|
|
--retireRemoteBomb itid t pjid w = setScope w
|
|
-- & props . ix pjid . pjUpdate .~ (\_ -> retireRemoteBomb itid (t-1) pjid)
|
|
-- where
|
|
-- setScope w' = case _itemPositions w' IM.! itid of
|
|
-- InInv cid invid -> w'
|
|
-- & creatures . ix cid . crInv . ix invid . itAttachment
|
|
-- . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
|
|
-- _ -> w'
|
|
-- pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . pjPos
|
|
|
|
-- TODO hive out movement and share with moveGrenade
|
|
moveRemoteBomb :: Int -> Int -> Int -> World -> World
|
|
moveRemoteBomb itid time pID w
|
|
| time < -4 = updatePicture
|
|
$ set (props .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (f time) pID)
|
|
w
|
|
| time < 2 = case hitWl of
|
|
Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing $ halfV updatedWorld
|
|
_ -> halfV updatedWorld
|
|
| otherwise = case hitWl of
|
|
Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing updatedWorld
|
|
_ -> updatedWorld
|
|
where
|
|
updatedWorld = w
|
|
& updateV
|
|
& props . ix pID . prPos .~ finalPos
|
|
& updatePicture
|
|
& props . ix pID . pjUpdate .~ (\_ -> moveRemoteBomb itid (time-1) pID)
|
|
pj = _props w IM.! pID
|
|
oldPos = _prPos pj
|
|
newPos = _pjVel pj +.+ oldPos
|
|
-- this is hacky, should use a version of collidePointWalls' that collides
|
|
-- circles and walls
|
|
invShift x = x -.- 5 *.* normalizeV (_pjVel pj)
|
|
hitWl = bounceBall 1 oldPos newPos 4 $ wlsNearPoint newPos w
|
|
finalPos = maybe newPos (invShift . fst) hitWl
|
|
setV v = set (props . ix pID . pjVel) v
|
|
updateV = maybe id (setV . snd) hitWl
|
|
halfV = props . ix pID . pjVel %~ (0.5 *.*)
|
|
f x | x < -369 = -10
|
|
| otherwise = x - 1
|
|
updatePicture =
|
|
set (props . ix pID . prDraw)
|
|
(\_ -> (,) mempty $ setDepth 20 $ uncurryV translate newPos $ remoteBombPic time)
|
|
|
|
|
|
|
|
--defaultThrowable :: Item
|
|
--defaultThrowable = grenade
|
|
--remoteBomb :: Item
|
|
--remoteBomb = defaultThrowable
|
|
-- { _itName = "REMOTEBOMB"
|
|
-- , _itType = REMOTEBOMB
|
|
-- , _itMaxStack = 1
|
|
-- , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2
|
|
-- [(-3,-3),(-3,3),(3,3),(3,-3)]
|
|
-- , _twMaxRange = 150
|
|
-- , _twAccuracy = 30
|
|
-- , _itUse = ruseRate 25 (const throwRemoteBomb) upHammer
|
|
-- [ hammerCheckI ]
|
|
-- , _itAttachment = ItScope (V2 0 0) 0 1 True
|
|
-- , _itEquipPict = pictureWeaponOnAim' $ \_ -> (,) emptySH remoteBombUnarmedPic
|
|
-- }
|
|
|
|
|
|
throwRemoteBomb :: Creature -> World -> World
|
|
throwRemoteBomb cr w = setLocation
|
|
$ removePict
|
|
$ resetFire
|
|
-- $ resetName
|
|
$ over props addG w
|
|
where
|
|
cid = _crID cr
|
|
addG = IM.insert i $ Projectile
|
|
{ _prPos = p
|
|
, _pjStartPos = p
|
|
, _pjVel = v
|
|
, _prDraw = const mempty
|
|
, _pjID = i
|
|
, _pjUpdate = \_ -> moveRemoteBomb itid 50 i
|
|
}
|
|
i = IM.newKey $ _props w
|
|
v' = 0.02 / _cameraZoom w *.* rotateV (_cameraRot w) ( _mousePos w)
|
|
v | magV v' > 6 = 6 *.* normalizeV v'
|
|
| otherwise = v'
|
|
j = crSel cr
|
|
-- resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTE"
|
|
removePict = set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> mempty
|
|
resetFire = set (creatures . ix cid . crInv . ix j . itUse . rUse)
|
|
$ \_ -> explodeRemoteBomb itid i
|
|
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
|
|
setLocation w' = case maybeitid of
|
|
Nothing -> w' & creatures . ix cid . crInv . ix j . itID ?~ newitid
|
|
& itemPositions %~ IM.insert newitid (InInv cid j)
|
|
_ -> w'
|
|
newitid = IM.newKey $ _itemPositions w
|
|
itid = fromMaybe newitid maybeitid
|
|
|
|
explodeRemoteBomb :: Int -> Int -> Creature -> World -> World
|
|
explodeRemoteBomb itid pjid cr w
|
|
= set (props . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid)
|
|
-- $ set (props . ix pjid . pjDraw) (\_ -> blank)
|
|
$ set (creatures . ix cid . crInv . ix j . itUse . rUse) (\_ -> const id)
|
|
-- $ resetName
|
|
$ resetPict
|
|
-- $ resetScope
|
|
$ makeExplosionAt (_prPos (_props w IM.! pjid)) w
|
|
-- - $ makeShrapnelBombAt (_pjPos (_props w IM.! pjid)) w
|
|
where
|
|
cid = _crID cr
|
|
-- resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB"
|
|
resetPict = set (creatures . ix cid . crInv . ix j . itEquipPict )
|
|
(pictureWeaponAim $ \_ -> (,) emptySH remoteBombUnarmedPic)
|
|
-- resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
|
|
j = crSel $ _creatures w IM.! cid
|
|
remoteBombPic
|
|
:: Int -- ^ time
|
|
-> Picture
|
|
remoteBombPic _ = pictures
|
|
[ color (dark $ dark orange) $ circleSolid 5
|
|
]
|
|
|
|
remoteBombUnarmedPic :: Picture
|
|
remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
|
|
|
|
retireRemoteBomb :: Int -> Int -> Int -> World -> World
|
|
retireRemoteBomb = retireRemoteProj $ const throwRemoteBomb
|