124 lines
4.0 KiB
Haskell
124 lines
4.0 KiB
Haskell
module Dodge.Placement.Instance.Turret where
|
|
import Color
|
|
import Dodge.Data
|
|
--import Dodge.Reloading
|
|
import Dodge.Creature.State
|
|
import Dodge.Creature.Impulse
|
|
import Dodge.Creature.Picture
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Default
|
|
import Dodge.Movement.Turn
|
|
--import Dodge.Creature.Impulse.UseItem
|
|
import Dodge.FloorItem
|
|
import Dodge.Wall.Delete
|
|
import Dodge.WorldEvent.Explosion
|
|
import Dodge.Item.Weapon.BatteryGuns
|
|
--import Dodge.Item.Weapon.BulletGun.Cane
|
|
--import Dodge.SoundLogic.LoadSound
|
|
--import Dodge.SoundLogic
|
|
--import Dodge.Item.Draw
|
|
import Geometry
|
|
import ShapePicture
|
|
import Shape
|
|
import Dodge.Base
|
|
import Dodge.Base.Collide
|
|
import LensHelp
|
|
import qualified IntMapHelp as IM
|
|
|
|
import Data.List
|
|
import Data.Maybe
|
|
|
|
putLasTurret :: Float -> Placement
|
|
putLasTurret rotSpeed = sps0 $ PutMachine blue (reverse $ square wdth) defaultMachine
|
|
{ _mcDraw = drawTurret
|
|
, _mcUpdate = updateTurret rotSpeed
|
|
, _mcType = lasTurret
|
|
, _mcHP = 50000
|
|
}
|
|
lasTurret :: MachineType
|
|
lasTurret = Turret
|
|
{ _tuWeapon = lasGun
|
|
-- { _tuWeapon = autoRifle
|
|
, _tuTurnSpeed = 0.1
|
|
, _tuFireTime = 0
|
|
, _tuMCrID = Nothing
|
|
}
|
|
|
|
-- this needs a major cleanup
|
|
updateTurret :: Float -> Machine -> World -> World
|
|
updateTurret rotSpeed mc w
|
|
| _mcHP mc < 1 = w & machines %~ IM.delete mcid
|
|
& deleteWallIDs (_mcWallIDs mc)
|
|
& makeExplosionAt mcpos
|
|
& copyItemToFloor mcpos lasGun
|
|
& deleteHomonculus
|
|
| otherwise = w
|
|
& initHomonculus
|
|
& dodamage
|
|
& maybeFire
|
|
& elecDamBranch
|
|
where
|
|
deleteHomonculus = case _tuMCrID (_mcType mc) of
|
|
Nothing -> id
|
|
Just cid -> creatures . at cid .~ Nothing
|
|
initHomonculus w' = case w' ^? machines . ix mcid . mcType . tuMCrID . _Just of
|
|
Nothing -> w' & machines . ix mcid . mcType . tuMCrID ?~ cid
|
|
& creatures . at cid ?~ thecreature
|
|
where
|
|
cid = IM.newKey (_creatures w')
|
|
thecreature = defaultCreature
|
|
& crID .~ cid
|
|
& crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itDimension . dimPortage . handlePos -~ 10
|
|
& itConsumption . ammoLoaded .~ 1
|
|
)
|
|
& crPos .~ mcpos
|
|
& crOldPos .~ mcpos
|
|
& crRad .~ 1
|
|
& crDir .~ mcdir
|
|
& crPict .~ (\cr _ _ -> drawCrEquipment cr)
|
|
& crUpdate .~ stateUpdateDamage clearDamage (flip followThenClearImpulses)
|
|
& crStance . posture .~ Aiming
|
|
Just cid -> w'
|
|
& creatures . ix cid . crPos .~ mcpos
|
|
& creatures . ix cid . crDir .~ mcdir
|
|
dodamage = machines . ix mcid %~
|
|
( (mcDamage .~ [Electrical (min 2500 $ max 0 (elecDam - 10)) 0 0 0])
|
|
. (mcHP -~ dam)
|
|
)
|
|
elecDamBranch
|
|
| elecDam < 10 = updateFiringStatus . doTurn
|
|
| otherwise = id
|
|
maybeFire
|
|
| _tuFireTime (_mcType mc) > 0
|
|
= fromMaybe id $ do
|
|
cid <- _tuMCrID (_mcType mc)
|
|
return $ creatures . ix cid . crActionPlan . crImpulse .~ [UseItem]
|
|
| otherwise = id
|
|
mcid = _mcID mc
|
|
ypos = _crPos $ you w
|
|
mcpos = _mcPos mc
|
|
mcdir = _mcDir mc
|
|
seesYou = hasLOSIndirect mcpos ypos w
|
|
(elecDams, dams) = partition isElectrical $ _mcDamage mc
|
|
dam = sum $ map _dmAmount dams
|
|
elecDam = sum $ map _dmAmount elecDams
|
|
doTurn
|
|
| seesYou = machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos
|
|
| otherwise = id
|
|
closeFireAngle = seesYou && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
|
|
updateFiringStatus
|
|
| closeFireAngle = machines . ix mcid . mcType . tuFireTime .~ 20
|
|
| otherwise = machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
|
|
|
|
|
|
drawTurret :: Machine -> SPic
|
|
drawTurret mc = (rotateSH (-_mcDir mc) . colorSH blue $ upperPrismPoly 20 (square wdth)
|
|
, mempty -- setLayer 5 $ scale 0.5 0.5 $ text $ show $ _mcDir mc )
|
|
)
|
|
-- <> translateSPz 20 (itSPic it)
|
|
-- where
|
|
-- it = _tuWeapon $ _mcType mc
|
|
|
|
wdth :: Float
|
|
wdth = 10
|