loop/src/Dodge/Item/Equipment.hs

module Dodge.Item.Equipment where
import Dodge.Data
import Dodge.Item.Draw
import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Default
import Dodge.Default.Wall
import Dodge.Picture.Layer
import Dodge.Item.Weapon.BatteryGuns
import Dodge.Creature.Test
import Dodge.Wall.Reflect
import Dodge.Wall
import Dodge.Magnet
import Picture
import Geometry
import ShapePicture
import Shape
import qualified IntMapHelp as IM
import LensHelp

magShield :: Item
magShield = defaultEquipment
    { _itType = MAGSHIELD
    , _itName = "MAGSHIELD"
    , _itUse = EquipUse useMagShield
    , _itEquipPict = \_ _ -> (,) emptySH blank
    , _itID = Nothing
    , _itAttachment = ItMInt Nothing
    }
useMagShield :: Creature -> Int -> World -> World
useMagShield cr invid w = w & magnets . at mgid ?~ themagnet
  where
    themagnet = Magnet
        {_mgID = mgid
        ,_mgUpdate = Just . (mgUpdate .~ const Nothing)
        ,_mgPos = _crPos cr
        ,_mgField = curveAroundField 50 200
        }
    mgid = case it ^? itAttachment . itMInt . _Just of
        Just mgid' -> mgid'
        Nothing -> IM.newKey $ _magnets w
    it = _crInv cr IM.! invid


flameShield :: Item 
flameShield = defaultEquipment
    { _itType = FLAMESHIELD
    , _itName = "FLAMESHIELD"
    , _itEquipPict = \cr _ -> (,) emptySH $ onLayer CrLayer $ pictures [color cyan $ circle (_crRad cr+2)]
    , _itID = Nothing
    }
{- | Slows you down, blocks forward projectiles. -}
frontArmour :: Item
frontArmour = defaultEquipment
    { _itType = FRONTARMOUR
    , _itName = "FARMOUR"
--    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ translate 0 (-5) $ pictures 
--        [color (greyN 0.1) $ thickArc 0        (pi/2) 10 5
--        ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5
--        ]
    , _itEquipPict = \_ _ -> (,) emptySH $ onLayer CrLayer $ pictures 
        [color (greyN 0.1) $ thickArc 0        (pi/2) 10 5
        ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5
        ]
    , _itEffect = NoItEffect
    , _itID = Nothing
    }
flatShield :: Item
flatShield = defaultEquipment
    { _itEquipPict = pictureWeaponAim flatShieldEquipSPic
    , _itEffect = effectOnOffEquip createShieldWall removeShieldWall
        -- the above seems to work, but I am not sure why: it may break on edge
        -- cases
    , _itName   = "FLATSHIELD"
    , _itType = FLATSHIELD
    , _itUse  = RightUse
        { _rUse = \_ _ -> id
        , _useDelay = NoDelay
        , _useMods = []
        , _useHammer = NoHammer
        , _useAim = AimParams
            { _aimSpeed = 0.5
            , _aimRange = 0
            , _aimZoom = ItZoom 20 0.2 1
            , _aimStance = TwoHandFlat
            }
        }
    , _itInvSize = 3
    , _itInvDisplay = \it -> head (basicItemDisplay it) : 
        ["*" ++ replicate 13 ' ' ++ "*"
        ,"*" ++ replicate 13 ' ' ++ "*"
        ]
    }
flatShieldEquipSPic :: Item -> SPic
flatShieldEquipSPic _ = 
    ( colorSH yellow $ upperPrismPoly 10 (rectWH 2 10)
    , mempty
    )
effectOnEquip :: (Creature -> Item -> World -> World) -> ItEffect
effectOnEquip f = ItInvEffectID
    { _itInvEffect = g f
    , _itEffectID = Nothing
    }
  where
    g f' _ cr invid w 
        | _crInvSel cr == invid = f' cr (_crInv (_creatures w IM.! _crID cr) IM.! invid) w
        | otherwise = w

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

shieldWallDamage :: Damage -> Wall -> Int -> World -> World
shieldWallDamage dm wl crid w = case _dmType dm of
    Lasering -> 
        w & instantParticles .:~ lasRayAt 5 (da +.+ normalizeV (df -.- da)) (reflDirWall df da wl)
    d | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
    _ -> w
  where
    df = _dmFrom dm
    da = _dmAt dm

createShieldWall :: Creature -> Int -> World -> World
createShieldWall cr invid w = case _itEffectID $ _itEffect it of
    Nothing -> let (wlid,w') = createWall ((shieldWall crid) {_wlLine = wlline}) w
        in w' & creatures . ix crid . crInv . ix invid . itEffect . itEffectID ?~ wlid
    Just wid -> moveWallID wid wlline w
  where
    crid = _crID cr
    it = _crInv (_creatures w IM.! crid) IM.! invid
    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 :: Creature -> Int -> World -> World
removeShieldWall cr invid w = case _itEffectID $ _itEffect it of
    Nothing -> w
    Just wid -> w & deleteWallID wid 
        & creatures . ix crid . crInv . ix invid . itEffect . itEffectID .~ Nothing
  where
    crid = _crID cr
    it = _crInv (_creatures w IM.! crid) IM.! invid

effectOnOffEquip 
    :: (Creature -> Int -> World -> World)     -- ^ effect when equiped
    -> (Creature -> Int -> World -> World)     -- ^ effect when not equiped
    -> ItEffect
effectOnOffEquip f f' = ItInvEffectID
    { _itInvEffect = g
    , _itEffectID = Nothing
    }
  where
    g _ cr invid w 
        | _crInvSel cr == invid = f  cr invid w
        | otherwise             = f' cr invid w

{- | Increases speed, reduces friction, cannot only move forwards. -}
jetPack :: Item
jetPack = defaultEquipment
    { _itType = JETPACK
    , _itName = "JETPACK"
    , _itEquipPict = \_ _ -> (,) emptySH $ onLayer CrLayer 
        $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ]
    , _itEffect = NoItEffect
    , _itID = Nothing
    }