loop/src/Dodge/Euse.hs

module Dodge.Euse where

import Control.Monad
import Data.Maybe
import Dodge.LightSource
import Dodge.Item.HeldOffset
import Dodge.Wall.Create
import Color
import Dodge.Default.Wall
import Dodge.Creature.Test
import Dodge.Creature.HandPos
import Geometry
import Dodge.Wall.Move
import Dodge.Wall.Delete
import Dodge.Wall.ForceField
import Dodge.Item.Location
import Dodge.Data.World
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.Radar
import Dodge.SoundLogic.ExternallyGeneratedSounds
import qualified IntMapHelp as IM
import LensHelp

useE :: Euse -> Item -> Creature -> World -> World
useE eo = case eo of
    EDoNothing -> const $ const id
    EDetector dt -> autoEffect (detectorEffect dt) 100 click1S
    EMagShield -> useMagShield
    EWristShield -> setWristShieldPos
    EHeadLamp -> createHeadLamp
    ECamouflage vis -> overCID (crCamouflage .~ vis)
    EonWristShield -> onEquipWristShield
    EoffWristShield -> onRemoveWristShield
    EFuelSource 0 _ -> const . const id
    EFuelSource {} -> trySiphonFuel

trySiphonFuel :: Item -> Creature -> World -> World
trySiphonFuel itm cr w = fromMaybe w $ do
    eix <- itm ^? itLocation . ipInvID
    hix <- cr ^? crManipulation . manObject . inInventory . ispItem
    guard (cr ^? crManipulation . manObject . inInventory . iselAction == Just NoInvSelAction)
    la <- cr ^? crInv . ix hix . itUse . heldConsumption
    atype <- la ^? laAmmoType
    guard (isGas atype)
    amax <- la ^? laMax
    acur <- la ^? laLoaded
    guard (amax > acur)
    return $ w & cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ 
            ( (ix hix . itUse . heldConsumption . laLoaded +~ 1)
            . (ix eix . itUse . equipEffect . eeUse . euseFuelAmount -~ 1)
            )

isGas :: AmmoType -> Bool
isGas a = case a of
    GasAmmo {} -> True
    _ -> False

useMagShield :: Item -> Creature -> World -> World
useMagShield it cr w = w & cWorld . lWorld . magnets . at mgid ?~ themagnet
  where
    themagnet =
        Magnet
            { _mgID = mgid
            , _mgUpdate = MagnetUpdateTimer 1
            , _mgPos = _crPos cr
            , _mgField = MagnetBuBuCurveAroundField 50 200
            }
    mgid = case it ^? itParams . magShieldMgMIX . _Just of
        Just mgid' -> mgid'
        Nothing -> IM.newKey $ w ^. cWorld . lWorld . magnets

onEquipWristShield :: Item -> Creature -> World -> World
onEquipWristShield itm cr w =
    w
        & pointerToItem itm . itUse . equipEffect . eeParams .~ EquipID i
        & cWorld . lWorld . walls . at i ?~ forceField{_wlID = i}
        & setWristShieldPos (itm & itUse . equipEffect . eeParams .~ EquipID i) cr
  where
    i = IM.newKey (w ^. cWorld . lWorld . walls)

onRemoveWristShield :: Item -> Creature -> World -> World
onRemoveWristShield itm _ =
    (pointerToItem itm . itUse . equipEffect . eeParams .~ NoEquipParams) . mremovewall
  where
    mremovewall = fromMaybe id $ do
        i <- itm ^? itUse . equipEffect . eeParams . eparamID
        return $ deleteWallID i

setWristShieldPos :: Item -> Creature -> World -> World
setWristShieldPos itm cr w =
    w
        & moveWallIDUnsafe i wlline
  where
    i = _eparamID $ _eeParams $ _equipEffect $ _itUse itm
    wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
    invid = _ipInvID (_itLocation itm)
    handtrans = case cr ^? crInvEquipped . ix invid of
        Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
        _ -> translatePointToRightHand
    g
        | twists cr = (+.+.+ V3 (-5) 10 0)
        | otherwise = id
    f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr

shieldWall :: Int -> Wall
shieldWall crid =
    defaultWall
        { _wlColor = yellow
        , _wlOpacity = SeeAbove
        , _wlPathable = True
        , _wlWalkable = True
        , _wlFireThrough = True
        , _wlReflect = True
        , _wlRotateTo = False
        , _wlStructure = CreaturePart crid -- shieldWallDamage
        }

-- TODO the reflection should be controled by the particle
--shieldWallDamage :: Damage -> Wall -> Int -> World -> World
--shieldWallDamage dm _ crid w = case _dmType dm of
----    Lasering -> w
--    _ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
--    _ -> w

createShieldWall :: Item -> Creature -> World -> World
createShieldWall it cr w = case it ^? itParams . flatShieldWlMIX . _Just of
    Nothing ->
        let (wlid, w') = createWall ((shieldWall crid){_wlLine = wlline, _wlID = wlid}) w
         in w' & pointerToItem it . itParams .~ FlatShieldParams (Just wlid)
    Just wid -> moveWallID wid wlline w
  where
    crid = _crID cr
    wlline = (a, b)
    crdirv = unitVectorAtAngle $ _crDir cr
    crpos = _crPos cr
    rad = _crRad cr + 2
    a = crpos +.+ rad *.* crdirv -.- 10 *.* therot crdirv
    b = crpos +.+ rad *.* crdirv +.+ 10 *.* therot crdirv
    therot
        | crIsAiming cr = vNormal
        | otherwise = rotateV (twoFlatHRot cr) . vNormal

removeShieldWall :: Item -> Creature -> World -> World
removeShieldWall it _ w = case it ^? itParams . flatShieldWlMIX . _Just of
    Nothing -> w
    Just wid ->
        w & deleteWallID wid
            & pointerToItem it . itParams . flatShieldWlMIX .~ Nothing

createHeadLamp :: Item -> Creature -> World -> World
createHeadLamp _ cr =
    cWorld . lWorld . tempLightSources
        .:~ tlsTimeRadColPos
            1
            200
            0.7
            ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))

overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
overCID f _ cr = cWorld . lWorld . creatures . ix (_crID cr) %~ f