loop/src/Dodge/Euse.hs

module Dodge.Euse 
    where

import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Color
--import Control.Monad
import Data.Maybe
import Dodge.Creature.HandPos
import Dodge.Creature.Test
import Dodge.Data.World
import Dodge.Default.Wall
import Dodge.Item.HeldOffset
import Dodge.Item.Location
import Dodge.Wall.Create
import Dodge.Wall.Delete
import Dodge.Wall.ForceField
import Dodge.Wall.Move
import Geometry
import qualified IntMapHelp as IM
import LensHelp

doItmCrWdWd :: ItmCrWdWd -> Item -> Creature -> World -> World
doItmCrWdWd x itm cr = case x of
    (ECamouflage vis) -> overCID (crCamouflage .~ vis) itm cr
    EonWristShield -> onEquipWristShield itm cr
    EoffWristShield -> onRemoveWristShield itm cr
    _ -> id

useE :: Euse -> LocationLDT ItemLink ComposedItem -> Creature -> World -> World
useE eo loc cr = case eo of
    EDoNothing -> id
    EMagShield -> useMagShield itm cr
    EWristShield -> setWristShieldPos itm cr
    EHeadLamp -> createHeadLamp itm cr
    EBatterySource{} -> tryChargeBattery itm cr
    EAmmoSource{} -> tryAttachBulletBelt itm cr
  where
    itm = loc ^. locLDT . ldtValue . _1

tryAttachBulletBelt :: Item -> Creature -> World -> World
tryAttachBulletBelt _ _ w = w

tryChargeBattery :: Item -> Creature -> World -> World
tryChargeBattery _ _ w = w

trySiphonFuel :: Item -> Creature -> World -> World
trySiphonFuel _ _ = id
--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 ^? laSource . _InternalSource . iaMax
--    acur <- la ^? laSource . _InternalSource . iaLoaded
--    guard (amax > acur)
--    return $
--        w & cWorld . lWorld . creatures . ix (_crID cr) . crInv
--            %~ ( (ix hix . itUse . heldConsumption . laSource . _InternalSource . iaLoaded +~ 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 . uequipEffect . eeParams .~ EquipID i
        & cWorld . lWorld . walls . at i ?~ forceField{_wlID = i}
        & setWristShieldPos (itm & itUse . uequipEffect . eeParams .~ EquipID i) cr
  where
    i = IM.newKey (w ^. cWorld . lWorld . walls)

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

setWristShieldPos :: Item -> Creature -> World -> World
setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
  where
    i = _eparamID $ _eeParams $ _uequipEffect $ _itUse itm
    wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
    invid = _ilInvID (_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 . lights .:~ LSParam             
            ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
            200 
            0.7

--    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