module Dodge.Item.Equipment where import Dodge.Data import Dodge.Item.Draw import Dodge.Item.Equipment.Shape import Dodge.Item.Weapon.InventoryDisplay import Dodge.LightSource import Dodge.Default import Dodge.Default.Wall import Dodge.Creature.Test import Dodge.Creature.HandPos import Dodge.Wall import Dodge.Wall.ForceField import Dodge.Magnet import Picture import Geometry import ShapePicture import Shape import qualified IntMapHelp as IM import LensHelp --import ShortShow import Data.Maybe magShield :: Item magShield = defaultEquipment { _itEquipPict = \_ _ -> (,) emptySH blank , _itID = Nothing , _itAttachment = ItMInt Nothing } & itUse . eqEq . eqUse .~ useMagShield & itUse . eqEq . eqSite .~ GoesOnWrist & itType . iyBase .~ MAGSHIELD useMagShield :: Item -> Creature -> World -> World useMagShield it cr 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 { _itEquipPict = \cr _ -> (,) emptySH $ setDepth 20 $ pictures [color cyan $ circle (_crRad cr+2)] , _itID = Nothing } & itUse . eqEq . eqSite .~ GoesOnChest & itType . iyBase .~ FLAMESHIELD {- | Slows you down, blocks forward projectiles. -} frontArmour :: Item frontArmour = defaultEquipment { _itEquipPict = pictureOnEquip (emptySH , setDepth 20 $ pictures [color thecol $ thickArc 0 (pi/2) 10 5 ,color thecol $ thickArc (3*pi/2) (2*pi) 10 5 ]) , _itID = Nothing } & itUse . eqEq . eqSite .~ GoesOnChest & itType . iyBase .~ FRONTARMOUR where thecol = yellow -- (greyN 0.1) wristArmour :: Item wristArmour = defaultEquipment { _itEquipPict = spicForWrist mempty , _itID = Nothing } & itUse . eqEq . eqSite .~ GoesOnWrist & itUse . eqEq . eqOnEquip .~ onEquipWristShield & itUse . eqEq . eqUse .~ setWristShieldPos & itUse . eqEq . eqOnRemove .~ onRemoveWristShield & itType . iyBase .~ WRISTARMOUR onEquipWristShield :: Item -> Creature -> World -> World onEquipWristShield itm cr w = w & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqEq . eqParams .~ EquipID i & walls . at i ?~ forceField {_wlID = i} & setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr where i = IM.newKey (_walls w) onRemoveWristShield :: Item -> Creature -> World -> World onRemoveWristShield itm cr w = w & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams & deleteWallID i where i = _eparamID $ _eqParams $ _eqEq $ _itUse itm setWristShieldPos :: Item -> Creature -> World -> World setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline where i = _eparamID $ _eqParams $ _eqEq $ _itUse itm wlline = (f (V3 (-10) 7 0), f (V3 10 7 0)) invid = fromJust (_itInvPos itm) --wlline = (V2 10 0, V2 (-10) 100) 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 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 , _itUse = RightUse { _rUse = \_ _ -> id , _useDelay = NoDelay , _useMods = [] , _useHammer = NoHammer , _useAim = AimParams { _aimWeight = 5 , _aimRange = 0 , _aimZoom = ItZoom 20 0.2 1 , _aimStance = TwoHandFlat } , _heldScroll = \_ _ -> id } , _itInvSize = 3 , _itInvDisplay = \it -> head (basicItemDisplay it) : ["*" ++ replicate 13 ' ' ++ "*" ,"*" ++ replicate 13 ' ' ++ "*" ] } & itType . iyBase .~ FLATSHIELD 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,_wlID = wlid}) 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 { _itEquipPict = \_ _ -> (,) emptySH $ setDepth 20 $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ] , _itEffect = NoItEffect , _itID = Nothing } & itUse . eqEq . eqSite .~ GoesOnBack & itType . iyBase .~ JETPACK brainHat :: Item brainHat = defaultEquipment { _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4) , _itEffect = NoItEffect , _itID = Nothing } & itUse . eqEq . eqSite .~ GoesOnHead & itType . iyBase .~ BRAINHAT headLamp1 :: Item headLamp1 = defaultEquipment { _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ translateSHf 5 2 (upperPrismPoly 8 $ rectWH 4 1) <> translateSHf 5 (-2) (upperPrismPoly 8 $ rectWH 4 1) -- <> (upperPrismPoly 3 $ rectWH 4 4) ) , _itEffect = NoItEffect , _itID = Nothing } & itUse . eqEq . eqUse .~ createHeadLamp & itUse . eqEq . eqSite .~ GoesOnHead & itType . iyBase .~ HEADLAMP1 headLamp :: Item headLamp = defaultEquipment { _itEquipPict = pictureOnEquip (noPic headLampShape) , _itEffect = NoItEffect , _itID = Nothing } & itUse . eqEq . eqUse .~ createHeadLamp & itUse . eqEq . eqSite .~ GoesOnHead & itType . iyBase .~ HEADLAMP headLampShape :: Shape headLampShape = colorSH yellow $ translateSH (V3 5 2 4) (upperPrismPoly 4 $ rectWH 4 1) <> translateSH (V3 5 2 0) (upperPrismPoly 4 $ rectWH 4 1) <> translateSH (V3 5 (-2) 4) (upperPrismPoly 4 $ rectWH 4 1) <> translateSH (V3 5 (-2) 0) (upperPrismPoly 4 $ rectWH 4 1) createHeadLamp :: Item -> Creature -> World -> World createHeadLamp _ cr = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3))) powerLegs :: Item powerLegs = defaultEquipment { _itEquipPict = pictureOnEquip (noPic $ translateSH (V3 0 4 0) $ colorSH yellow $ upperPrismPoly 3 $ rectWH 2 2) , _itEffect = NoItEffect , _itID = Nothing } & itUse . eqEq . eqSite .~ GoesOnLegs & itType . iyBase .~ POWERLEGS speedLegs :: Item speedLegs = powerLegs & itType . iyBase .~ SPEEDLEGS jumpLegs :: Item jumpLegs = powerLegs & itType . iyBase .~ JUMPLEGS wristInvisibility :: Item wristInvisibility = defaultEquipment { _itEquipPict = shapeForWrist (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2) , _itID = Nothing } & itUse . eqEq . eqSite .~ GoesOnWrist & itUse . eqEq . eqOnEquip .~ overCID (crCamouflage .~ Invisible) & itUse . eqEq . eqOnRemove .~ overCID (crCamouflage .~ FullyVisible) & itType . iyBase .~ INVISIBILITYEQUIPMENT GoesOnWrist overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World overCID f _ cr = creatures . ix (_crID cr) %~ f