From f301a6bae59dbaf205fd1f56c1e5c8afab3b4ace Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 25 May 2022 20:25:08 +0100 Subject: [PATCH] Partial implementation of wrist shields --- src/Dodge/Item/Equipment.hs | 12 +++++++----- src/Dodge/Render/ShapePicture.hs | 18 +++++++++++++++++- 2 files changed, 24 insertions(+), 6 deletions(-) diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 455fddbd2..5c4d32f56 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -15,6 +15,7 @@ import ShapePicture import Shape import qualified IntMapHelp as IM import LensHelp +--import ShortShow import Data.Maybe magShield :: Item @@ -80,19 +81,21 @@ wristArmour = defaultEquipment onEquipWristShield :: Item -> Creature -> World -> World onEquipWristShield itm cr w = w & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqParams .~ EquipID i - & walls . at i ?~ (shieldWall (_crID cr)) {_wlDraw = True} + & walls . at i ?~ (shieldWall (_crID cr)) {_wlDraw = True,_wlID = i} & setWristShieldPos (itm & itUse . eqParams .~ EquipID i) cr where - i = IM.newKey $ _walls w + 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 . eqParams .~ NoEquipParams --- & walls . at i .~ Nothing + & deleteWallID i where i = _eparamID $ _eqParams $ _itUse itm setWristShieldPos :: Item -> Creature -> World -> World setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline +-- & testString .~ (\w' -> [shortShow $ _wlLine (_walls w' IM.! i)]) -- & tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 (fst wlline `v2z` 40) where i = _eparamID $ _eqParams $ _itUse itm @@ -104,7 +107,6 @@ setWristShieldPos itm cr w = w _ -> translatePointToRightHand f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr - spicForWrist :: SPic -> Creature -> Item -> SPic spicForWrist = pictureOnEquip . translateSP (V3 0 4 (-4)) pictureOnEquip :: SPic -> Creature -> Item -> SPic @@ -188,7 +190,7 @@ shieldWallDamage dm _ crid w = case _dmType dm of createShieldWall :: Creature -> Int -> World -> World createShieldWall cr invid w = case _itEffectID $ _itEffect it of - Nothing -> let (wlid,w') = createWall ((shieldWall crid) {_wlLine = wlline}) w + 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 diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index e800bcded..1152fac54 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -59,11 +59,13 @@ extraPics cfig w = pictures (_decorations w) <> viewBoundaries cfig w <> viewClipBounds cfig w <> drawMousePosition cfig w + <> drawWallIDs cfig w <> drawPathing cfig w <> drawCrInfo cfig w testPic :: World -> Picture -testPic _ = [] +testPic _ = mempty + clDraw :: Cloud -> Picture clDraw c = translate3 (_clPos c) (_clPict c c) ppDraw :: PressPlate -> Picture @@ -111,6 +113,20 @@ drawMousePosition cfig w p = worldPosToScreen w mwp mwp = mouseWorldPos w +drawWallIDs :: Configuration -> World -> Picture +drawWallIDs cfig w = setLayer FixedCoordLayer + $ foldMap f (_walls w) + where + f wl + | dist (_crPos $ you w) (fst (_wlLine wl)) > 200 = mempty -- this should be improved with a better "on screen test" + | otherwise = winScale cfig + . uncurryV translate p + . scale 0.1 0.1 + . text + $ show $ _wlID wl + where + p = worldPosToScreen w $ 0.5 *.* ( uncurry (+.+) $ _wlLine wl) + drawPathing :: Configuration -> World -> Picture drawPathing cfig w | _debug_pathing cfig