diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs index e8a72c6e2..45d115c4e 100644 --- a/src/Dodge/Combine/Data.hs +++ b/src/Dodge/Combine/Data.hs @@ -78,6 +78,8 @@ data CombineType | MAGSHIELD | FLAMESHIELD | FRONTARMOUR + | WRISTARMOUR + | BRAINHAT | POWERLEGS | SPEEDLEGS | JUMPLEGS diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index a45a7f30e..f0054eaba 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -174,14 +174,14 @@ inventoryA = IM.fromList $ zip [0..] testInventory :: IM.IntMap Item testInventory = IM.fromList $ zip [0..] [ makeTypeCraftNum 9 PIPE + , brainHat , autoSonar , autoRadar , magShield , frontArmour - , flameShield + , wristArmour + , flatShield , makeTypeCraftNum 1 MOTOR - , speedLegs - , jumpLegs , makeModule INCENDIARYMODULE , makeModule STATICMODULE , makeModule CONCUSSMODULE diff --git a/src/Dodge/Creature/HandPos.hs b/src/Dodge/Creature/HandPos.hs index 08fb2c9c5..84cb89eef 100644 --- a/src/Dodge/Creature/HandPos.hs +++ b/src/Dodge/Creature/HandPos.hs @@ -1,9 +1,9 @@ module Dodge.Creature.HandPos where import Dodge.Data import Dodge.Creature.Test -import Shape +--import Shape import ShapePicture -import Geometry +--import Geometry import Control.Lens import Data.Maybe @@ -65,12 +65,23 @@ translateToRightLeg cr = rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStanc Just (Walking sa RightForward) -> translateSPf ( f sa) (-off) _ -> translateSPf 0 (-off) where - aFoot :: Shape - aFoot = upperPrismPoly 10 $ polyCirc 3 4 off = 5 sLen = _strideLength $ _crStance cr f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen +translateToHead :: Creature -> SPic -> SPic +translateToHead cr + | twists cr = translateSPz 20 . translateSPf 0 5 . rotateSP (-1) . translateSPf (negate 2.5) 0.25 + | oneH cr = translateSPz 20 . rotateSP 0.5 . translateSPf 2.5 0 + | otherwise = translateSPz 20 . translateSPf 2.5 0 + +translateToChest :: Creature -> SPic -> SPic +translateToChest cr + | oneH cr = rotateSP 0.5 +-- | twists cr = translateSPf 0 5 . rotateSP (-1) + | twists cr = rotateSP (-1) + | otherwise = id + oneH :: Creature -> Bool oneH = crInStance OneHand diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index a9759f4d8..f1dfed7b5 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -184,9 +184,9 @@ arms cr = fst $ translateToRightHand cr aHand where aHand :: SPic aHand = noPic $ translateSHz (-4) . upperPrismPolyHalf 4 $ polyCirc 3 4 - off = 8 - sLen = _strideLength $ _crStance cr - f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen +-- off = 8 +-- sLen = _strideLength $ _crStance cr +-- f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen scalp :: Creature -> Shape {-# INLINE scalp #-} @@ -209,8 +209,8 @@ crInStance as cr = crIsAiming' cr -- || (_posture (_crStance cr) == Reloading && oneH :: Creature -> Bool oneH = crInStance OneHand -twoFlat :: Creature -> Bool -twoFlat = crInStance TwoHandFlat +--twoFlat :: Creature -> Bool +--twoFlat = crInStance TwoHandFlat twists :: Creature -> Bool twists = crInStance TwoHandTwist @@ -248,8 +248,8 @@ upperBody col cr = colorSH (light4 col) $ mconcat shoulderSH :: Shape -> Shape shoulderSH = translateSHz 20 -waistSH :: Shape -> Shape -waistSH = translateSHz 10 +--waistSH :: Shape -> Shape +--waistSH = translateSHz 10 light4 :: Color -> Color light4 = light . light . light . light diff --git a/src/Dodge/Creature/Property.hs b/src/Dodge/Creature/Property.hs index a697cb276..712f46dc6 100644 --- a/src/Dodge/Creature/Property.hs +++ b/src/Dodge/Creature/Property.hs @@ -4,6 +4,7 @@ module Dodge.Creature.Property , crNearPoint ) where import Dodge.Data +import Dodge.Creature.HandPos import Geometry import Data.Maybe @@ -13,18 +14,21 @@ import Control.Lens -- previous frame -- Not sure if it is a good idea crIsArmouredFrom :: Point2 -> Creature -> Bool -crIsArmouredFrom p cr - = p /= _crOldPos cr - -- && any (\it -> it ^? itType == Just FRONTARMOUR) (_crInv cr) - && hasFrontArmour cr - && angleVV (unitVectorAtAngle $ _crDir cr) (p -.- _crOldPos cr) < pi/2 --- even though angleVV can generate NaN, the comparison seems to deal with it +crIsArmouredFrom p cr = hasFrontArmour p cr -hasFrontArmour :: Creature -> Bool -hasFrontArmour cr = fromMaybe False $ do +hasFrontArmour :: Point2 -> Creature -> Bool +hasFrontArmour p cr = fromMaybe False $ do invid <- cr ^? crEquipment . ix OnChest ittype <- cr ^? crInv . ix invid . itType return $ FRONTARMOUR == ittype + && p /= _crOldPos cr + && angleVV (unitVectorAtAngle (_crDir cr + frontarmdirection)) (p -.- _crOldPos cr) < pi/2 +-- even though angleVV can generate NaN, the comparison seems to deal with it + where + frontarmdirection + | crInStance OneHand cr = 0.5 + | crInStance TwoHandTwist cr = negate 1 + | otherwise = 0 --crOnSeg :: Point2 -> Point2 -> Creature -> Bool --crOnSeg p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index ea1ece92a..8d5746bad 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -382,8 +382,10 @@ data ItemUse { _cUse :: Item -> Creature -> World -> World } | EquipUse - { _eqUse :: Creature -> Int -> World -> World - , _eqSite :: EquipSite + { _eqUse :: Creature -> Int -> World -> World + , _eqOnEquip :: Creature -> Int -> World -> World + , _eqOnRemove :: Creature -> Int -> World -> World + , _eqSite :: EquipSite } | NoUse data EquipSite diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 2dc0d4499..ce1de23a4 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -160,6 +160,8 @@ defaultEquipment = Item , _itConsumption = NoConsumption , _itUse = EquipUse {_eqUse = \_ _ -> id + ,_eqOnEquip = \_ _ -> id + ,_eqOnRemove = \_ _ -> id ,_eqSite = GoesOnSpecial } , _itScroll = \ _ _ -> id diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index c703d6bd5..2a1fc5cbc 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -20,11 +20,12 @@ magShield :: Item magShield = defaultEquipment { _itType = MAGSHIELD , _itName = "MAGSHIELD" - , _itUse = EquipUse useMagShield GoesOnWrist , _itEquipPict = \_ _ -> (,) emptySH blank , _itID = Nothing , _itAttachment = ItMInt Nothing } + & itUse . eqUse .~ useMagShield + & itUse . eqSite .~ GoesOnWrist useMagShield :: Creature -> Int -> World -> World useMagShield cr invid w = w & magnets . at mgid ?~ themagnet where @@ -43,29 +44,42 @@ 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 - } + } & itUse . eqSite .~ GoesOnChest {- | 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 + [color thecol $ thickArc 0 (pi/2) 10 5 + ,color thecol $ thickArc (3*pi/2) (2*pi) 10 5 ]) , _itEffect = NoItEffect , _itID = Nothing } + & itUse . eqSite .~ GoesOnChest + where + thecol = yellow -- (greyN 0.1) + +wristArmour :: Item +wristArmour = defaultEquipment + { _itType = WRISTARMOUR + , _itName = "WRISTARMOUR" + , _itEquipPict = spicForWrist (emptySH , setDepth 20 $ pictures + [color thecol $ thickArc 0 (pi/2) 10 5 + ,color thecol $ thickArc (3*pi/2) (2*pi) 10 5 + ]) + , _itEffect = NoItEffect + , _itID = Nothing + } + & itUse . eqSite .~ GoesOnWrist + where + thecol = yellow -- (greyN 0.1) + +spicForWrist :: SPic -> Creature -> Item -> SPic +spicForWrist = pictureOnEquip . translateSP (V3 0 4 (-4)) pictureOnEquip :: SPic -> Creature -> Item -> SPic pictureOnEquip sp cr itm = fromMaybe mempty $ do i <- _itInvPos itm @@ -77,6 +91,8 @@ equipPosition epos cr sh = case epos of OnRightWrist -> translateToRightHand cr $ mirrorSPxz sh OnLegs -> translateToLeftLeg cr sh <> translateToRightLeg cr (mirrorSPxz sh) + OnHead -> translateToHead cr sh + OnChest -> translateToChest cr sh _ -> sh flatShield :: Item @@ -191,20 +207,27 @@ jetPack = defaultEquipment $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ] , _itEffect = NoItEffect , _itID = Nothing + } & itUse . eqSite .~ GoesOnBack + +brainHat :: Item +brainHat = defaultEquipment + { _itType = BRAINHAT + , _itName = "BRAINHAT" + , _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4) + , _itEffect = NoItEffect + , _itID = Nothing } + & itUse . eqSite .~ GoesOnHead powerLegs :: Item powerLegs = defaultEquipment { _itType = POWERLEGS , _itName = "POWERLEGS" - , _itUse = EquipUse - {_eqUse = \_ _ -> id - ,_eqSite = GoesOnLegs - } , _itEquipPict = pictureOnEquip (noPic $ translateSH (V3 0 4 0) $ colorSH yellow $ upperPrismPoly 3 $ rectWH 2 2) , _itEffect = NoItEffect , _itID = Nothing } + & itUse . eqSite .~ GoesOnLegs speedLegs :: Item speedLegs = powerLegs { _itType = SPEEDLEGS diff --git a/src/ShapePicture.hs b/src/ShapePicture.hs index 625820a00..f1a22ffc0 100644 --- a/src/ShapePicture.hs +++ b/src/ShapePicture.hs @@ -1,6 +1,7 @@ {-# LANGUAGE TupleSections #-} module ShapePicture ( emptyBlank + , translateSP , translateSPf , translateSPz , rotateSP @@ -41,6 +42,9 @@ translateSPf x y = bimap (translateSH (V3 x y 0)) (translate x y) translateSPz :: Float -> SPic -> SPic translateSPz z = bimap (translateSH (V3 0 0 z)) (translate3 (V3 0 0 z)) +translateSP :: Point3 -> SPic -> SPic +translateSP v = bimap (translateSH v) (translate3 v) + rotateSP :: Float -> SPic -> SPic rotateSP a = bimap (rotateSH a) (rotate a)