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.Creature.Test
import Dodge.Creature.HandPos
import Dodge.Wall
import Dodge.Magnet
import Picture
import Geometry
import ShapePicture
import Shape
import qualified IntMapHelp as IM
import LensHelp

import Data.Maybe
magShield :: Item
magShield = defaultEquipment
    { _itType = MAGSHIELD
    , _itName = "MAGSHIELD"
    , _itUse = EquipUse useMagShield GoesOnWrist
    , _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"
    , _itUse = EquipUse 
        {_eqUse = \_ _ -> id
        ,_eqSite = GoesOnChest
        }
    , _itEquipPict = \cr _ -> (,) emptySH $ setDepth 20 $ pictures [color cyan $ circle (_crRad cr+2)]
    , _itID = Nothing
    }
{- | Slows you down, blocks forward projectiles. -}
frontArmour :: Item
frontArmour = defaultEquipment
    { _itType = FRONTARMOUR
    , _itName = "FARMOUR"
    , _itUse = EquipUse 
        {_eqUse = \_ _ -> id
        ,_eqSite = GoesOnChest
        }
    , _itEquipPict = pictureOnEquip (emptySH , setDepth 20 $ 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
    }
pictureOnEquip :: SPic -> Creature -> Item -> SPic
pictureOnEquip sp cr itm = fromMaybe mempty $ do
    i <- _itInvPos itm
    epos <- cr^? crInvEquipped . ix i
    return $ equipPosition epos cr sp
equipPosition :: EquipPosition -> Creature -> SPic -> SPic
equipPosition epos cr sh = case epos of
    OnLeftWrist -> translateToLeftHand cr sh
    OnRightWrist -> translateToRightHand cr $ mirrorSPxz sh
    _ -> sh

flatShield :: Item
flatShield = defaultEquipment
    { _itEquipPict = pictureWeaponAim flatShieldEquipSPic
    , _itEffect = effectOnOffHeld 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
            { _aimWeight = 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' itm cr w 
        | _crInvSel cr == invid = f' cr (_crInv (_creatures w IM.! _crID cr) IM.! invid) w
        | otherwise = w
      where
        invid = fromJust $ _itInvPos itm

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
    }

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

effectOnOffHeld 
    :: (Creature -> Int -> World -> World)     -- ^ effect when held
    -> (Creature -> Int -> World -> World)     -- ^ effect when not held
    -> ItEffect
effectOnOffHeld f f' = ItInvEffectID
    { _itInvEffect = g
    , _itEffectID = Nothing
    }
  where
    g itm cr w 
        | _crInvSel cr == invid = f  cr invid w
        | otherwise             = f' cr invid w
      where
        invid = fromJust $ _itInvPos itm

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

powerLegs :: Item
powerLegs = defaultEquipment
    { _itType = POWERLEGS
    , _itName = "POWERLEGS"
    , _itUse = EquipUse 
        {_eqUse = \_ _ -> id
        ,_eqSite = GoesOnLegs
        }
    , _itEffect = NoItEffect
    , _itID = Nothing
    }
speedLegs :: Item
speedLegs = powerLegs
    { _itType = SPEEDLEGS
    , _itName = "SPEEDLEGS"
    }
jumpLegs :: Item
jumpLegs = powerLegs
    { _itType = JUMPLEGS
    , _itName = "JUMPLEGS"
    }