Partially working change to selected items
This commit is contained in:
@@ -11,10 +11,12 @@ youc :: CWorld -> Creature
|
|||||||
youc w = w ^?! lWorld . creatures . ix 0
|
youc w = w ^?! lWorld . creatures . ix 0
|
||||||
|
|
||||||
yourItem :: World -> Maybe Item
|
yourItem :: World -> Maybe Item
|
||||||
yourItem w = _crInv (you w) IM.!? crSel (you w)
|
yourItem w = do
|
||||||
|
i <- you w ^? crInvSel . isel . ispItem
|
||||||
|
_crInv (you w) IM.!? i
|
||||||
|
|
||||||
yourInv :: World -> IM.IntMap Item
|
yourInv :: World -> IM.IntMap Item
|
||||||
yourInv = _crInv . you
|
yourInv = _crInv . you
|
||||||
|
|
||||||
yourInvSel :: World -> Int
|
--yourInvSel :: World -> Int
|
||||||
yourInvSel = crSel . you
|
--yourInvSel = crSel . you
|
||||||
|
|||||||
@@ -3,9 +3,9 @@
|
|||||||
-- | Actions performed by creatures within the world
|
-- | Actions performed by creatures within the world
|
||||||
module Dodge.Creature.Action (
|
module Dodge.Creature.Action (
|
||||||
performActions,
|
performActions,
|
||||||
stripNoItems,
|
-- stripNoItems,
|
||||||
setMinInvSize,
|
setMinInvSize,
|
||||||
dropUnselected,
|
-- dropUnselected,
|
||||||
dropExcept,
|
dropExcept,
|
||||||
dropItem,
|
dropItem,
|
||||||
blinkActionMousePos,
|
blinkActionMousePos,
|
||||||
@@ -19,7 +19,7 @@ module Dodge.Creature.Action (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
import Data.List (findIndex)
|
--import Data.List (findIndex)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Dodge.Base
|
import Dodge.Base
|
||||||
import Dodge.Creature.Action.Blink
|
import Dodge.Creature.Action.Blink
|
||||||
@@ -36,6 +36,7 @@ import Dodge.WallCreatureCollisions
|
|||||||
import Geometry
|
import Geometry
|
||||||
import qualified IntMapHelp as IM
|
import qualified IntMapHelp as IM
|
||||||
import LensHelp
|
import LensHelp
|
||||||
|
import Control.Monad
|
||||||
|
|
||||||
performActions :: World -> Creature -> Creature
|
performActions :: World -> Creature -> Creature
|
||||||
performActions w cr =
|
performActions w cr =
|
||||||
@@ -147,29 +148,29 @@ performAction cr w ac = case ac of
|
|||||||
setMinInvSize :: Int -> Creature -> World -> World
|
setMinInvSize :: Int -> Creature -> World -> World
|
||||||
setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
|
setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
|
||||||
|
|
||||||
-- maybe this should be removed...
|
---- maybe this should be removed...
|
||||||
stripNoItems :: Creature -> World -> World
|
--stripNoItems :: Creature -> World -> World
|
||||||
stripNoItems cr =
|
--stripNoItems cr =
|
||||||
organiseInvKeys (_crID cr)
|
-- organiseInvKeys (_crID cr)
|
||||||
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just)
|
-- . (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just)
|
||||||
|
--
|
||||||
|
--organiseInvKeys :: Int -> World -> World
|
||||||
|
--organiseInvKeys cid w =
|
||||||
|
-- w & cWorld . lWorld . creatures . ix cid
|
||||||
|
-- %~ ( (crInvSel . iselPos .~ newSelKey)
|
||||||
|
-- . (crInv .~ newInv)
|
||||||
|
-- . (crInvSel . iselAction .~ NoInvSelAction)
|
||||||
|
-- )
|
||||||
|
-- where
|
||||||
|
-- cr = w ^?! cWorld . lWorld . creatures . ix cid -- _creatures (_cWorld w) IM.! cid
|
||||||
|
-- pairs = IM.toList (_crInv cr)
|
||||||
|
-- newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs
|
||||||
|
-- newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs
|
||||||
|
|
||||||
organiseInvKeys :: Int -> World -> World
|
--dropUnselected :: Creature -> World -> World
|
||||||
organiseInvKeys cid w =
|
--dropUnselected cr w =
|
||||||
w & cWorld . lWorld . creatures . ix cid
|
-- foldr (dropItem cr) w . IM.keys $
|
||||||
%~ ( (crInvSel . iselPos .~ newSelKey)
|
-- crSel cr `IM.delete` _crInv cr
|
||||||
. (crInv .~ newInv)
|
|
||||||
. (crInvSel . iselAction .~ NoInvSelAction)
|
|
||||||
)
|
|
||||||
where
|
|
||||||
cr = w ^?! cWorld . lWorld . creatures . ix cid -- _creatures (_cWorld w) IM.! cid
|
|
||||||
pairs = IM.toList (_crInv cr)
|
|
||||||
newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs
|
|
||||||
newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs
|
|
||||||
|
|
||||||
dropUnselected :: Creature -> World -> World
|
|
||||||
dropUnselected cr w =
|
|
||||||
foldr (dropItem cr) w . IM.keys $
|
|
||||||
crSel cr `IM.delete` _crInv cr
|
|
||||||
|
|
||||||
dropExcept :: Creature -> Int -> World -> World
|
dropExcept :: Creature -> Int -> World -> World
|
||||||
dropExcept cr invid w =
|
dropExcept cr invid w =
|
||||||
@@ -188,11 +189,11 @@ dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid -- . maybe
|
|||||||
|
|
||||||
-- | Get your creature to drop the item under the cursor.
|
-- | Get your creature to drop the item under the cursor.
|
||||||
youDropItem :: World -> World
|
youDropItem :: World -> World
|
||||||
youDropItem w
|
youDropItem w = fromMaybe w $ do
|
||||||
| _crInvLock (you w) || cursed = w
|
curpos <- you w ^? crInvSel . isel . ispItem
|
||||||
| otherwise =
|
guard $ not $ _crInvLock (you w) || cursed
|
||||||
w
|
return $ w
|
||||||
& dropItem cr (crSel cr)
|
& dropItem cr curpos
|
||||||
& soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
|
& soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
|
||||||
where
|
where
|
||||||
cr = you w
|
cr = you w
|
||||||
|
|||||||
@@ -47,7 +47,7 @@ followImpulse cr w imp = case imp of
|
|||||||
TurnTo p -> crup $ creatureTurnTo p cr
|
TurnTo p -> crup $ creatureTurnTo p cr
|
||||||
ChangePosture post -> crup $ cr & crStance . posture .~ post
|
ChangePosture post -> crup $ cr & crStance . posture .~ post
|
||||||
UseItem -> (useItem cr, cr)
|
UseItem -> (useItem cr, cr)
|
||||||
SwitchToItem i -> crup $ cr & crInvSel .~ InvSel i NoInvSelAction
|
SwitchToItem i -> crup $ cr & crInvSel .~ InvSel (SelItem i NoInvSelAction)
|
||||||
Melee cid' ->
|
Melee cid' ->
|
||||||
( hitCr cid'
|
( hitCr cid'
|
||||||
, crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20
|
, crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20
|
||||||
|
|||||||
@@ -4,6 +4,7 @@ module Dodge.Creature.Impulse.UseItem (
|
|||||||
itemEffect,
|
itemEffect,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Monad
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
@@ -22,7 +23,8 @@ import qualified SDL
|
|||||||
useItem :: Creature -> World -> World
|
useItem :: Creature -> World -> World
|
||||||
useItem cr' w = fromMaybe (f w) $ do
|
useItem cr' w = fromMaybe (f w) $ do
|
||||||
cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr')
|
cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr')
|
||||||
it <- cr ^? crInv . ix (crSel cr)
|
itRef <- cr ^? crInvSel . isel . ispItem
|
||||||
|
it <- cr ^? crInv . ix itRef
|
||||||
return $ itemEffect cr it w
|
return $ itemEffect cr it w
|
||||||
where
|
where
|
||||||
f = cWorld . lWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
|
f = cWorld . lWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
|
||||||
@@ -34,9 +36,10 @@ itemEffect cr it w = case it ^. itUse of
|
|||||||
LeftUse{} -> doequipmentchange
|
LeftUse{} -> doequipmentchange
|
||||||
EquipUse{} -> doequipmentchange
|
EquipUse{} -> doequipmentchange
|
||||||
-- ConsumeUse will cause problems if the item is not selected
|
-- ConsumeUse will cause problems if the item is not selected
|
||||||
(ConsumeUse eff _) -> setuhamdown $ hammerTest $ useC eff it cr . rmInvItem (_crID cr) (crSel cr)
|
(ConsumeUse eff _) -> setuhamdown $ hammerTest $ useC eff it cr . rmInvItem (_crID cr) itRef
|
||||||
CraftUse{} -> setuhamdown w
|
CraftUse{} -> setuhamdown w
|
||||||
where
|
where
|
||||||
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
hammerTest f = case _crHammerPosition cr of
|
hammerTest f = case _crHammerPosition cr of
|
||||||
HammerUp -> f w
|
HammerUp -> f w
|
||||||
_ -> w & setuhamdown
|
_ -> w & setuhamdown
|
||||||
@@ -44,7 +47,7 @@ itemEffect cr it w = case it ^. itUse of
|
|||||||
doequipmentchange =
|
doequipmentchange =
|
||||||
setuhamdown $
|
setuhamdown $
|
||||||
hammerTest
|
hammerTest
|
||||||
( toggleEquipmentAt (_rbOptions w) (crSel cr) cr
|
( toggleEquipmentAt (_rbOptions w) itRef cr
|
||||||
. activateEquipmentAt (_rbOptions w) cr
|
. activateEquipmentAt (_rbOptions w) cr
|
||||||
)
|
)
|
||||||
|
|
||||||
@@ -105,29 +108,34 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
|
|||||||
where
|
where
|
||||||
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
|
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
|
||||||
itmat i = _crInv cr IM.! i
|
itmat i = _crInv cr IM.! i
|
||||||
itm = itmat (crSel cr)
|
itm = itmat itRef
|
||||||
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
|
onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
|
||||||
onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm'
|
onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm'
|
||||||
|
|
||||||
useLeftItem :: Int -> World -> World
|
useLeftItem :: Int -> World -> World
|
||||||
useLeftItem cid w
|
useLeftItem cid w = fromMaybe w $ do
|
||||||
| _crInvLock cr = w
|
cr <- w ^? cWorld . lWorld . creatures . ix cid
|
||||||
| itmIsConsumable = useItem cr w -- I believe this ONLY sets equipment options
|
guard . not $ _crInvLock cr
|
||||||
| itmIsEquipable = useItem cr w -- I believe this ONLY sets equipment options
|
let mitRef = cr ^? crInvSel . isel . ispItem
|
||||||
| otherwise = fromMaybe w $ do
|
itmIsConsumable = isJust $ do
|
||||||
invid <- cr ^. crLeftInvSel . lisMPos
|
itRef <- mitRef
|
||||||
itm <- cr ^? crInv . ix invid
|
cr ^? crInv . ix itRef . itUse . cUse
|
||||||
f <- cr ^? crInv . ix invid . itUse . leftUse
|
itmIsEquipable = isJust $ do
|
||||||
return
|
itRef <- mitRef
|
||||||
. (runIdentity . pointerToItemLocation (_itLocation itm) (return . (itUse . leftHammer .~ HammerDown)))
|
guard . not $ cr ^. crLeftInvSel . lisMPos /= Just itRef
|
||||||
. useL f itm cr
|
cr ^? crInv . ix itRef . itUse . equipEffect . eeUse
|
||||||
$ w
|
if itmIsConsumable || itmIsEquipable
|
||||||
|
then return $ useItem cr w -- I believe this ONLY sets equipment options
|
||||||
|
else do
|
||||||
|
invid <- cr ^. crLeftInvSel . lisMPos
|
||||||
|
itm <- cr ^? crInv . ix invid
|
||||||
|
f <- cr ^? crInv . ix invid . itUse . leftUse
|
||||||
|
return
|
||||||
|
. (runIdentity . pointerToItemLocation (_itLocation itm) (return . (itUse . leftHammer .~ HammerDown)))
|
||||||
|
. useL f itm cr
|
||||||
|
$ w
|
||||||
|
|
||||||
where
|
where
|
||||||
cr = w ^?! cWorld . lWorld . creatures . ix cid-- _creatures (_cWorld w) IM.! cid
|
|
||||||
itmIsConsumable =
|
|
||||||
isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
|
|
||||||
itmIsEquipable =
|
|
||||||
isJust (cr ^? crInv . ix (crSel cr) . itUse . equipEffect . eeUse)
|
|
||||||
&& cr ^. crLeftInvSel . lisMPos /= Just (crSel cr)
|
|
||||||
|
|
||||||
-- TODO determine itmShouldBeUsed with reference to config options
|
-- TODO determine itmShouldBeUsed with reference to config options
|
||||||
|
|||||||
@@ -26,6 +26,7 @@ import Dodge.Data.World
|
|||||||
import Dodge.Zoning.Creature
|
import Dodge.Zoning.Creature
|
||||||
import FoldableHelp
|
import FoldableHelp
|
||||||
import Geometry
|
import Geometry
|
||||||
|
import Control.Monad
|
||||||
|
|
||||||
overrideMeleeCloseTarget :: Creature -> Creature
|
overrideMeleeCloseTarget :: Creature -> Creature
|
||||||
overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
|
overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
|
||||||
@@ -150,11 +151,11 @@ doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
|
|||||||
_ -> cr
|
_ -> cr
|
||||||
|
|
||||||
reloadOverride :: Creature -> Creature
|
reloadOverride :: Creature -> Creature
|
||||||
reloadOverride cr
|
reloadOverride cr = fromMaybe cr $ do
|
||||||
| cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded == Just 0
|
guard $ cr ^. crStance . posture == Aiming
|
||||||
&& cr ^. crStance . posture == Aiming =
|
itRef <- cr ^? crInvSel . isel . ispItem
|
||||||
cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
|
guard $ cr ^? crInv . ix itRef . itUse . heldConsumption . laLoaded == Just 0
|
||||||
| otherwise = cr
|
return $ cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
|
||||||
where
|
where
|
||||||
reloadActions =
|
reloadActions =
|
||||||
[ holsterWeapon
|
[ holsterWeapon
|
||||||
|
|||||||
@@ -68,7 +68,7 @@ stateUpdate f =
|
|||||||
heldAimEffects :: Creature -> World -> World
|
heldAimEffects :: Creature -> World -> World
|
||||||
heldAimEffects cr = fromMaybe id $ do
|
heldAimEffects cr = fromMaybe id $ do
|
||||||
guard (crIsAiming cr)
|
guard (crIsAiming cr)
|
||||||
ipos <- cr ^? crInvSel . iselPos
|
ipos <- cr ^? crInvSel . isel . ispItem
|
||||||
itm <- cr ^? crInv . ix ipos
|
itm <- cr ^? crInv . ix ipos
|
||||||
f <- itm ^? itEffect . ieWhileAiming
|
f <- itm ^? itEffect . ieWhileAiming
|
||||||
return $ doInvEffect f itm cr
|
return $ doInvEffect f itm cr
|
||||||
@@ -258,15 +258,12 @@ createAttachLight cr it = createTorchLightOffset cr it attachoff
|
|||||||
attachoff = it ^?! itDimension . dimAttachPos
|
attachoff = it ^?! itDimension . dimAttachPos
|
||||||
|
|
||||||
itemUpdate :: Creature -> Int -> Item -> Item
|
itemUpdate :: Creature -> Int -> Item -> Item
|
||||||
itemUpdate cr i
|
itemUpdate cr i = updateAutoRecharge
|
||||||
| i == crSel cr = baseupdate True
|
|
||||||
| otherwise = baseupdate False
|
|
||||||
where
|
|
||||||
baseupdate bool =
|
|
||||||
updateAutoRecharge
|
|
||||||
. (itUse %~ useUpdate)
|
. (itUse %~ useUpdate)
|
||||||
. (itLocation .~ InInv (_crID cr) i)
|
. (itLocation .~ InInv (_crID cr) i)
|
||||||
. (itIsHeld .~ bool)
|
. (itIsHeld .~ itmisheld)
|
||||||
|
where
|
||||||
|
itmisheld = Just i == (cr ^? crInvSel . isel . ispItem)
|
||||||
|
|
||||||
updateAutoRecharge :: Item -> Item
|
updateAutoRecharge :: Item -> Item
|
||||||
updateAutoRecharge it = case it ^? itUse . leftConsumption of
|
updateAutoRecharge it = case it ^? itUse . leftConsumption of
|
||||||
@@ -282,12 +279,12 @@ crGetTargeting cr = do
|
|||||||
where
|
where
|
||||||
hastargeting itm = isJust (itm ^? itUse . useTargeting . _Just)
|
hastargeting itm = isJust (itm ^? itUse . useTargeting . _Just)
|
||||||
helditem = fromMaybe [] $ do
|
helditem = fromMaybe [] $ do
|
||||||
i <- cr ^? crInvSel . iselPos
|
i <- cr ^? crInvSel . isel . ispItem
|
||||||
itm <- cr ^? crInv . ix i
|
itm <- cr ^? crInv . ix i
|
||||||
return [itm]
|
return [itm]
|
||||||
|
|
||||||
weaponReloadSounds :: Creature -> World -> World
|
weaponReloadSounds :: Creature -> World -> World
|
||||||
weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of
|
weaponReloadSounds cr w = case cr ^? crInvSel . isel . iselAction of
|
||||||
Just ReloadAction{_reloadAction = la} ->
|
Just ReloadAction{_reloadAction = la} ->
|
||||||
soundContinue
|
soundContinue
|
||||||
(CrReloadSound cid)
|
(CrReloadSound cid)
|
||||||
|
|||||||
@@ -37,5 +37,7 @@ crCurrentEquipment cr =
|
|||||||
strFromHeldItem :: Creature -> Int
|
strFromHeldItem :: Creature -> Int
|
||||||
strFromHeldItem cr
|
strFromHeldItem cr
|
||||||
| _posture (_crStance cr) == Aiming || crIsReloading cr =
|
| _posture (_crStance cr) == Aiming || crIsReloading cr =
|
||||||
negate $ fromMaybe 0 $ cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimWeight
|
negate $ fromMaybe 0 $ cr ^? crInv . ix itRef . itUse . heldAim . aimWeight
|
||||||
| otherwise = 0
|
| otherwise = 0
|
||||||
|
where
|
||||||
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
|
|||||||
@@ -32,13 +32,14 @@ import Dodge.Data.World
|
|||||||
import Geometry
|
import Geometry
|
||||||
|
|
||||||
crIsReloading :: Creature -> Bool
|
crIsReloading :: Creature -> Bool
|
||||||
crIsReloading cr = case cr ^? crInvSel . iselAction of
|
crIsReloading cr = case cr ^? crInvSel . isel . iselAction of
|
||||||
Just ReloadAction{} -> True
|
Just ReloadAction{} -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
crWeaponReady :: Creature -> Bool
|
crWeaponReady :: Creature -> Bool
|
||||||
crWeaponReady cr = fromMaybe False $ do
|
crWeaponReady cr = fromMaybe False $ do
|
||||||
ic <- cr ^? crInv . ix (crSel cr) . itUse . heldConsumption
|
i <- cr ^? crInvSel . isel . ispItem
|
||||||
|
ic <- cr ^? crInv . ix i . itUse . heldConsumption
|
||||||
return (_laLoaded ic > 0 && _laPrimed ic)
|
return (_laLoaded ic > 0 && _laPrimed ic)
|
||||||
|
|
||||||
crCanSeeCr :: Creature -> (World, Creature) -> Bool
|
crCanSeeCr :: Creature -> (World, Creature) -> Bool
|
||||||
@@ -79,7 +80,11 @@ crCanShoot cr = crIsAiming cr && crWeaponReady cr
|
|||||||
crInAimStance :: AimStance -> Creature -> Bool
|
crInAimStance :: AimStance -> Creature -> Bool
|
||||||
crInAimStance as cr =
|
crInAimStance as cr =
|
||||||
crIsAiming cr
|
crIsAiming cr
|
||||||
&& cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance == Just as
|
&& mitstance == Just as
|
||||||
|
where
|
||||||
|
mitstance = do
|
||||||
|
i <- cr ^? crInvSel . isel . ispItem
|
||||||
|
cr ^? crInv . ix i . itUse . heldAim . aimStance
|
||||||
|
|
||||||
oneH :: Creature -> Bool
|
oneH :: Creature -> Bool
|
||||||
oneH = crInAimStance OneHand
|
oneH = crInAimStance OneHand
|
||||||
|
|||||||
@@ -51,10 +51,14 @@ wasdWithAiming w speed cr
|
|||||||
cr'
|
cr'
|
||||||
& crDir +~ _crTwist cr'
|
& crDir +~ _crTwist cr'
|
||||||
& crTwist .~ 0
|
& crTwist .~ 0
|
||||||
addAnyTwist = case (cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance, cr^. crTwist) of
|
addAnyTwist = fromMaybe id $ do
|
||||||
(Just TwoHandTwist, 0) -> (crTwist .~ twistamount * pi)
|
itRef <- cr ^? crInvSel . isel . ispItem
|
||||||
|
astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
|
||||||
|
let currenttwistamount = cr ^. crTwist
|
||||||
|
case (astance,currenttwistamount) of
|
||||||
|
( TwoHandTwist, 0) -> return $ (crTwist .~ twistamount * pi)
|
||||||
. (crDir -~ twistamount * pi)
|
. (crDir -~ twistamount * pi)
|
||||||
_ -> id
|
_ -> Nothing
|
||||||
theMovement
|
theMovement
|
||||||
| movDir == V2 0 0 = id
|
| movDir == V2 0 0 = id
|
||||||
| otherwise = crMvAbsolute (speed *.* movAbs)
|
| otherwise = crMvAbsolute (speed *.* movAbs)
|
||||||
@@ -66,14 +70,19 @@ wasdWithAiming w speed cr
|
|||||||
dir = fmap ((w ^. cWorld . camPos . camRot) +) (safeArgV movDir)
|
dir = fmap ((w ^. cWorld . camPos . camRot) +) (safeArgV movDir)
|
||||||
movAbs = rotateV (w ^. cWorld . camPos . camRot) $ normalizeV movDir
|
movAbs = rotateV (w ^. cWorld . camPos . camRot) $ normalizeV movDir
|
||||||
isAiming = _posture (_crStance cr) == Aiming
|
isAiming = _posture (_crStance cr) == Aiming
|
||||||
mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of
|
mouseDir = fromMaybe
|
||||||
Just _ -> argV $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- _crPos cr
|
(argV (_mousePos (_input w)) + (w ^. cWorld . camPos . camRot) )
|
||||||
_ -> argV (_mousePos (_input w)) + (w ^. cWorld . camPos . camRot)
|
$ do
|
||||||
|
itRef <- cr ^? crInvSel . isel . ispItem
|
||||||
|
_ <- cr ^? crInv . ix itRef . itScope . scopePos
|
||||||
|
return . argV $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- _crPos cr
|
||||||
|
|
||||||
aimTurn :: Float -> Creature -> Creature
|
aimTurn :: Float -> Creature -> Creature
|
||||||
aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
|
aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
|
||||||
where
|
where
|
||||||
x = fromMaybe 1 $ cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimTurnSpeed
|
x = fromMaybe 1 $ do
|
||||||
|
itRef <- cr ^? crInvSel . isel . ispItem
|
||||||
|
cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed
|
||||||
|
|
||||||
wasdM :: SDL.Scancode -> Point2
|
wasdM :: SDL.Scancode -> Point2
|
||||||
wasdM scancode = case scancode of
|
wasdM scancode = case scancode of
|
||||||
@@ -89,8 +98,11 @@ wasdDir = foldl' (flip $ (+.+) . wasdM) (V2 0 0) . M.keys . _pressedKeys . _inpu
|
|||||||
-- | Set posture according to mouse presses.
|
-- | Set posture according to mouse presses.
|
||||||
mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature
|
mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature
|
||||||
mouseActionsCr pkeys cr
|
mouseActionsCr pkeys cr
|
||||||
| rbPressed && cr ^?! crInvSel . iselAction == NoInvSelAction =
|
| rbPressed && noaction =
|
||||||
cr & crStance . posture .~ Aiming
|
cr & crStance . posture .~ Aiming
|
||||||
| otherwise = cr & crStance . posture .~ AtEase
|
| otherwise = cr & crStance . posture .~ AtEase
|
||||||
where
|
where
|
||||||
rbPressed = SDL.ButtonRight `M.member` pkeys
|
rbPressed = SDL.ButtonRight `M.member` pkeys
|
||||||
|
noaction = fromMaybe True $ do
|
||||||
|
theaction <- cr ^? crInvSel . isel . iselAction
|
||||||
|
return $ theaction == NoInvSelAction
|
||||||
|
|||||||
@@ -97,8 +97,8 @@ data Intention = Intention
|
|||||||
|
|
||||||
--deriving (Eq, Show, Read) --Generic, Flat)
|
--deriving (Eq, Show, Read) --Generic, Flat)
|
||||||
|
|
||||||
crSel :: Creature -> Int
|
crSel :: Creature -> ManipulatedObject
|
||||||
crSel = _iselPos . _crInvSel
|
crSel = _isel . _crInvSel
|
||||||
|
|
||||||
makeLenses ''Creature
|
makeLenses ''Creature
|
||||||
makeLenses ''CreatureTargeting
|
makeLenses ''CreatureTargeting
|
||||||
|
|||||||
@@ -18,14 +18,16 @@ data LoadAction
|
|||||||
deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
||||||
|
|
||||||
data InvSel -- should be ManipulatedObject?
|
data InvSel -- should be ManipulatedObject?
|
||||||
= InvSel {_iselPos :: Int, _iselAction :: InvSelAction}
|
-- = InvSel {_isel :: SelPos}
|
||||||
|
= InvSel {_isel :: ManipulatedObject}
|
||||||
| Brute
|
| Brute
|
||||||
deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
||||||
|
|
||||||
data SelPos
|
data ManipulatedObject
|
||||||
= SelItem Int
|
= SelItem { _ispItem :: Int
|
||||||
|
, _iselAction :: InvSelAction}
|
||||||
| SelNothing
|
| SelNothing
|
||||||
| SelCloseObject Int
|
| SelCloseObject {_ispCloseObject :: Int}
|
||||||
deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
||||||
|
|
||||||
data InvSelAction
|
data InvSelAction
|
||||||
@@ -39,10 +41,12 @@ data LeftInvSel = LeftInvSel
|
|||||||
}
|
}
|
||||||
|
|
||||||
makeLenses ''LoadAction
|
makeLenses ''LoadAction
|
||||||
|
makeLenses ''ManipulatedObject
|
||||||
makeLenses ''InvSel
|
makeLenses ''InvSel
|
||||||
makeLenses ''LeftInvSel
|
makeLenses ''LeftInvSel
|
||||||
makeLenses ''InvSelAction
|
makeLenses ''InvSelAction
|
||||||
deriveJSON defaultOptions ''LoadAction
|
deriveJSON defaultOptions ''LoadAction
|
||||||
deriveJSON defaultOptions ''InvSelAction
|
deriveJSON defaultOptions ''InvSelAction
|
||||||
|
deriveJSON defaultOptions ''ManipulatedObject
|
||||||
deriveJSON defaultOptions ''InvSel
|
deriveJSON defaultOptions ''InvSel
|
||||||
deriveJSON defaultOptions ''LeftInvSel
|
deriveJSON defaultOptions ''LeftInvSel
|
||||||
|
|||||||
@@ -26,7 +26,7 @@ defaultCreature =
|
|||||||
, _crHP = 100
|
, _crHP = 100
|
||||||
, _crMaxHP = 150
|
, _crMaxHP = 150
|
||||||
, _crInv = IM.empty
|
, _crInv = IM.empty
|
||||||
, _crInvSel = InvSel 0 NoInvSelAction
|
, _crInvSel = InvSel SelNothing
|
||||||
, _crInvCapacity = 25
|
, _crInvCapacity = 25
|
||||||
, _crInvLock = False
|
, _crInvLock = False
|
||||||
, _crInvEquipped = mempty
|
, _crInvEquipped = mempty
|
||||||
|
|||||||
+2
-2
@@ -37,8 +37,8 @@ useE eo = case eo of
|
|||||||
trySiphonFuel :: Item -> Creature -> World -> World
|
trySiphonFuel :: Item -> Creature -> World -> World
|
||||||
trySiphonFuel itm cr w = fromMaybe w $ do
|
trySiphonFuel itm cr w = fromMaybe w $ do
|
||||||
eix <- itm ^? itLocation . ipInvID
|
eix <- itm ^? itLocation . ipInvID
|
||||||
hix <- cr ^? crInvSel . iselPos
|
hix <- cr ^? crInvSel . isel . ispItem
|
||||||
guard (cr ^? crInvSel . iselAction == Just NoInvSelAction)
|
guard (cr ^? crInvSel . isel . iselAction == Just NoInvSelAction)
|
||||||
la <- cr ^? crInv . ix hix . itUse . heldConsumption
|
la <- cr ^? crInv . ix hix . itUse . heldConsumption
|
||||||
atype <- la ^? laAmmoType
|
atype <- la ^? laAmmoType
|
||||||
guard (isGas atype)
|
guard (isGas atype)
|
||||||
|
|||||||
@@ -8,6 +8,7 @@ import Data.Sequence
|
|||||||
import Dodge.Data.Creature
|
import Dodge.Data.Creature
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import Dodge.Item.Weapon.ZoomScope
|
import Dodge.Item.Weapon.ZoomScope
|
||||||
|
import Data.Maybe
|
||||||
--import LensHelp hiding ((|>), (<|))
|
--import LensHelp hiding ((|>), (<|))
|
||||||
-- should be able to just import data.item
|
-- should be able to just import data.item
|
||||||
|
|
||||||
@@ -17,7 +18,9 @@ doHeldScroll hs = case hs of
|
|||||||
HeldScrollZoom -> overYourItem (const . setZoomScopeChange)
|
HeldScrollZoom -> overYourItem (const . setZoomScopeChange)
|
||||||
HeldScrollCharMode{} -> overYourItem $ \x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x
|
HeldScrollCharMode{} -> overYourItem $ \x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x
|
||||||
where
|
where
|
||||||
overYourItem f x cr w = w & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ f x cr
|
overYourItem f x cr w = fromMaybe w $ do
|
||||||
|
i <- cr ^? crInvSel . isel . ispItem
|
||||||
|
return $ w & cWorld . lWorld . creatures . ix 0 . crInv . ix i %~ f x cr
|
||||||
|
|
||||||
cycleSignum :: Float -> Seq a -> Seq a
|
cycleSignum :: Float -> Seq a -> Seq a
|
||||||
cycleSignum x
|
cycleSignum x
|
||||||
|
|||||||
@@ -408,7 +408,7 @@ overNozzles' ::
|
|||||||
overNozzles' eff it cr w = neww & cWorld . lWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
|
overNozzles' eff it cr w = neww & cWorld . lWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
i = crSel $ w ^?! cWorld . lWorld . creatures . ix cid
|
i = w ^?! cWorld . lWorld . creatures . ix cid . crInvSel . isel . ispItem
|
||||||
(neww, newNozzles) = mapAccumR (eff it cr) w $ _sprayNozzles (_itParams it)
|
(neww, newNozzles) = mapAccumR (eff it cr) w $ _sprayNozzles (_itParams it)
|
||||||
|
|
||||||
overNozzle ::
|
overNozzle ::
|
||||||
@@ -461,7 +461,7 @@ fireRemoteShell it cr w =
|
|||||||
, PJThrust 330 0
|
, PJThrust 330 0
|
||||||
, PJRemoteDirection 340 0 cid itid
|
, PJRemoteDirection 340 0 cid itid
|
||||||
]
|
]
|
||||||
j = crSel cr
|
j = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
|
|
||||||
caneStickSoundChoice :: Item -> SoundID
|
caneStickSoundChoice :: Item -> SoundID
|
||||||
caneStickSoundChoice it
|
caneStickSoundChoice it
|
||||||
@@ -500,8 +500,9 @@ mcShootLaser it mc = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParam
|
|||||||
shootTeslaArc :: Item -> Creature -> World -> World
|
shootTeslaArc :: Item -> Creature -> World -> World
|
||||||
shootTeslaArc it cr w =
|
shootTeslaArc it cr w =
|
||||||
w'
|
w'
|
||||||
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip
|
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip
|
||||||
where
|
where
|
||||||
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
(w', ip) = makeTeslaArc (_itParams it) pos dir w
|
(w', ip) = makeTeslaArc (_itParams it) pos dir w
|
||||||
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
|
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
|
||||||
dir = _crDir cr
|
dir = _crDir cr
|
||||||
|
|||||||
+111
-93
@@ -3,7 +3,7 @@
|
|||||||
module Dodge.Inventory (
|
module Dodge.Inventory (
|
||||||
checkInvSlotsYou,
|
checkInvSlotsYou,
|
||||||
rmSelectedInvItem,
|
rmSelectedInvItem,
|
||||||
invSelPos,
|
--invSelPos,
|
||||||
invSelSize,
|
invSelSize,
|
||||||
selNumPos,
|
selNumPos,
|
||||||
selNumTextPos,
|
selNumTextPos,
|
||||||
@@ -59,7 +59,8 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
|
|||||||
w
|
w
|
||||||
& pointcid . crInv %~ f
|
& pointcid . crInv %~ f
|
||||||
& pointcid %~ crCancelReloading
|
& pointcid %~ crCancelReloading
|
||||||
& pointcid . crInvSel . iselPos %~ g
|
-- & pointcid . crInvSel . iselPos %~ g THIS NEEDS CHECKING
|
||||||
|
& pointcid . crInvSel . isel . ispItem %~ g
|
||||||
& pointcid . crLeftInvSel . lisMPos %~ g'
|
& pointcid . crLeftInvSel . lisMPos %~ g'
|
||||||
& removeAnySlotEquipment
|
& removeAnySlotEquipment
|
||||||
& dounequipfunction
|
& dounequipfunction
|
||||||
@@ -97,7 +98,9 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
|
|||||||
| otherwise = Just x
|
| otherwise = Just x
|
||||||
|
|
||||||
rmSelectedInvItem :: Int -> World -> World
|
rmSelectedInvItem :: Int -> World -> World
|
||||||
rmSelectedInvItem cid w = rmInvItem cid (crSel (w ^?! cWorld . lWorld . creatures . ix cid)) w
|
rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crInvSel . isel . ispItem of
|
||||||
|
Just i -> rmInvItem cid i w
|
||||||
|
Nothing -> w
|
||||||
|
|
||||||
augmentedInvSizes :: World -> IM.IntMap Int
|
augmentedInvSizes :: World -> IM.IntMap Int
|
||||||
augmentedInvSizes = trimapAugmentInv itSlotsTaken 1 closeObjectSize
|
augmentedInvSizes = trimapAugmentInv itSlotsTaken 1 closeObjectSize
|
||||||
@@ -146,8 +149,8 @@ selNumMidHeight cfig w i = V2 (150 - hw) (hh + bump - (20 * fromIntegral ipos +
|
|||||||
selNumCol :: Int -> World -> Color
|
selNumCol :: Int -> World -> Color
|
||||||
selNumCol i w = fromMaybe white $ trimapAugmentInv _itInvColor invDimColor closeObjectCol w IM.!? i
|
selNumCol i w = fromMaybe white $ trimapAugmentInv _itInvColor invDimColor closeObjectCol w IM.!? i
|
||||||
|
|
||||||
invSelPos :: World -> Int
|
--invSelPos :: World -> Int
|
||||||
invSelPos w = sum . fst $ IM.split (yourInvSel w) (augmentedInvSizes w)
|
--invSelPos w = sum . fst $ IM.split (yourInvSel w) (augmentedInvSizes w)
|
||||||
|
|
||||||
updateTerminal :: World -> World
|
updateTerminal :: World -> World
|
||||||
updateTerminal = checkTermDist
|
updateTerminal = checkTermDist
|
||||||
@@ -164,12 +167,14 @@ checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
|
|||||||
updateCloseObjects :: World -> World
|
updateCloseObjects :: World -> World
|
||||||
updateCloseObjects w =
|
updateCloseObjects w =
|
||||||
w
|
w
|
||||||
& hud . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
|
& hud . closeObjects .~ newcloseobjects
|
||||||
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselPos %~ updateinvsel
|
& updatecursorposifnecessary
|
||||||
where
|
where
|
||||||
updateinvsel curinvsel
|
newcloseobjects = unionBy closeObjEq oldCloseFiltered currentClose
|
||||||
| length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1
|
updatecursorposifnecessary
|
||||||
| otherwise = curinvsel
|
= case w ^? cWorld . lWorld . creatures . ix 0 . crInvSel . isel . ispCloseObject of
|
||||||
|
Just i | i >= length newcloseobjects -> changeAugInvSel 1
|
||||||
|
_ -> id
|
||||||
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
|
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
|
||||||
ypos = _crPos $ you w
|
ypos = _crPos $ you w
|
||||||
activeButtons =
|
activeButtons =
|
||||||
@@ -188,7 +193,8 @@ updateRBList w
|
|||||||
| w ^? rbOptions . opItemID == mcurrentitemid =
|
| w ^? rbOptions . opItemID == mcurrentitemid =
|
||||||
w & setEquipAllocation & setEquipActivation
|
w & setEquipAllocation & setEquipActivation
|
||||||
| otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
|
| otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
|
||||||
esite <- cr ^? crInv . ix curinvid . itUse . equipEffect . eeSite
|
i <- cr ^? crInvSel . isel . ispItem
|
||||||
|
esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite
|
||||||
itid <- mcurrentitemid
|
itid <- mcurrentitemid
|
||||||
return $
|
return $
|
||||||
w
|
w
|
||||||
@@ -203,13 +209,16 @@ updateRBList w
|
|||||||
& setEquipAllocation
|
& setEquipAllocation
|
||||||
& setEquipActivation
|
& setEquipActivation
|
||||||
where
|
where
|
||||||
mcurrentitemid = cr ^? crInv . ix curinvid . itID
|
mcurrentitemid = do
|
||||||
curinvid = crSel cr
|
i <- cr ^? crInvSel . isel . ispItem
|
||||||
|
cr ^? crInv . ix i . itID
|
||||||
|
--curinvid = crSel cr
|
||||||
cr = you w
|
cr = you w
|
||||||
|
|
||||||
chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int
|
chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int
|
||||||
chooseEquipmentPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
|
chooseEquipmentPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
|
||||||
ep <- cr ^? crInvEquipped . ix (crSel cr)
|
i <- cr ^? crInvSel . isel . ispItem
|
||||||
|
ep <- cr ^? crInvEquipped . ix i
|
||||||
elemIndex ep eps
|
elemIndex ep eps
|
||||||
|
|
||||||
chooseFreeSite :: Creature -> [EquipPosition] -> Int
|
chooseFreeSite :: Creature -> [EquipPosition] -> Int
|
||||||
@@ -218,42 +227,44 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
|
|||||||
hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
|
hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
|
||||||
|
|
||||||
setEquipAllocation :: World -> World
|
setEquipAllocation :: World -> World
|
||||||
setEquipAllocation w = case _rbOptions w of
|
setEquipAllocation w = fromMaybe w $ do
|
||||||
EquipOptions{_opEquip = es, _opSel = i} ->
|
curpos <- you w ^? crInvSel . isel . ispItem
|
||||||
case you w ^? crInvEquipped . ix (crSel (you w)) of
|
return $ case _rbOptions w of
|
||||||
Just epos
|
EquipOptions{_opEquip = es, _opSel = i} ->
|
||||||
| es !! i == epos ->
|
case you w ^? crInvEquipped . ix curpos of
|
||||||
|
Just epos
|
||||||
|
| es !! i == epos ->
|
||||||
|
w & rbOptions . opAllocateEquipment
|
||||||
|
.~ RemoveEquipment
|
||||||
|
{ _allocOldPos = epos
|
||||||
|
}
|
||||||
|
Just epos
|
||||||
|
| isJust (you w ^? crEquipment . ix (es !! i)) ->
|
||||||
|
w & rbOptions . opAllocateEquipment
|
||||||
|
.~ SwapEquipment
|
||||||
|
{ _allocOldPos = epos
|
||||||
|
, _allocNewPos = es !! i
|
||||||
|
, _allocSwapID = _crEquipment (you w) M.! (es !! i)
|
||||||
|
}
|
||||||
|
Just epos ->
|
||||||
w & rbOptions . opAllocateEquipment
|
w & rbOptions . opAllocateEquipment
|
||||||
.~ RemoveEquipment
|
.~ MoveEquipment
|
||||||
{ _allocOldPos = epos
|
|
||||||
}
|
|
||||||
Just epos
|
|
||||||
| isJust (you w ^? crEquipment . ix (es !! i)) ->
|
|
||||||
w & rbOptions . opAllocateEquipment
|
|
||||||
.~ SwapEquipment
|
|
||||||
{ _allocOldPos = epos
|
{ _allocOldPos = epos
|
||||||
, _allocNewPos = es !! i
|
, _allocNewPos = es !! i
|
||||||
, _allocSwapID = _crEquipment (you w) M.! (es !! i)
|
|
||||||
}
|
}
|
||||||
Just epos ->
|
Nothing
|
||||||
w & rbOptions . opAllocateEquipment
|
| isJust (you w ^? crEquipment . ix (es !! i)) ->
|
||||||
.~ MoveEquipment
|
w & rbOptions . opAllocateEquipment
|
||||||
{ _allocOldPos = epos
|
.~ ReplaceEquipment
|
||||||
, _allocNewPos = es !! i
|
{ _allocNewPos = es !! i
|
||||||
}
|
, _allocRemoveID = _crEquipment (you w) M.! (es !! i)
|
||||||
Nothing
|
}
|
||||||
| isJust (you w ^? crEquipment . ix (es !! i)) ->
|
Nothing ->
|
||||||
w & rbOptions . opAllocateEquipment
|
w & rbOptions . opAllocateEquipment
|
||||||
.~ ReplaceEquipment
|
.~ PutOnEquipment
|
||||||
{ _allocNewPos = es !! i
|
{ _allocNewPos = es !! i
|
||||||
, _allocRemoveID = _crEquipment (you w) M.! (es !! i)
|
|
||||||
}
|
}
|
||||||
Nothing ->
|
_ -> w
|
||||||
w & rbOptions . opAllocateEquipment
|
|
||||||
.~ PutOnEquipment
|
|
||||||
{ _allocNewPos = es !! i
|
|
||||||
}
|
|
||||||
_ -> w
|
|
||||||
|
|
||||||
setEquipActivation :: World -> World
|
setEquipActivation :: World -> World
|
||||||
setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
|
setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
|
||||||
@@ -261,7 +272,7 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
|
|||||||
Just RemoveEquipment{} ->
|
Just RemoveEquipment{} ->
|
||||||
case you w ^. crLeftInvSel . lisMPos of
|
case you w ^. crLeftInvSel . lisMPos of
|
||||||
Just i
|
Just i
|
||||||
| i == invsel ->
|
| Just i == minvsel ->
|
||||||
w & rbOptions . opActivateEquipment
|
w & rbOptions . opActivateEquipment
|
||||||
.~ DeactivateEquipment
|
.~ DeactivateEquipment
|
||||||
{ _deactivateEquipment = i
|
{ _deactivateEquipment = i
|
||||||
@@ -269,12 +280,12 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
|
|||||||
_ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
|
_ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
|
||||||
Just rbos ->
|
Just rbos ->
|
||||||
case you w ^. crLeftInvSel . lisMPos of
|
case you w ^. crLeftInvSel . lisMPos of
|
||||||
Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
|
Just i | Just i == minvsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
|
||||||
Just i
|
Just i
|
||||||
| invselcanactivate ->
|
| invselcanactivate ->
|
||||||
w & rbOptions . opActivateEquipment
|
w & rbOptions . opActivateEquipment
|
||||||
.~ ActivateDeactivateEquipment
|
.~ ActivateDeactivateEquipment
|
||||||
{ _activateEquipment = invsel
|
{ _activateEquipment = fromJust minvsel
|
||||||
, _deactivateEquipment = i
|
, _deactivateEquipment = i
|
||||||
}
|
}
|
||||||
Just i
|
Just i
|
||||||
@@ -285,13 +296,17 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
|
|||||||
| invselcanactivate ->
|
| invselcanactivate ->
|
||||||
w & rbOptions . opActivateEquipment
|
w & rbOptions . opActivateEquipment
|
||||||
.~ ActivateEquipment
|
.~ ActivateEquipment
|
||||||
{ _activateEquipment = invsel
|
{ _activateEquipment = fromJust minvsel
|
||||||
}
|
}
|
||||||
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
|
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
|
||||||
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
|
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
|
||||||
where
|
where
|
||||||
invsel = crSel (you w)
|
--invsel = crSel (you w)
|
||||||
invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . leftUse)
|
minvsel = cr ^? crInvSel . isel . ispItem
|
||||||
|
cr = you w
|
||||||
|
invselcanactivate = isJust $ do
|
||||||
|
i <- minvsel
|
||||||
|
return $ cr ^? crInv . ix i . itUse . leftUse
|
||||||
|
|
||||||
equipSiteToPositions :: EquipSite -> [EquipPosition]
|
equipSiteToPositions :: EquipSite -> [EquipPosition]
|
||||||
equipSiteToPositions es = case es of
|
equipSiteToPositions es = case es of
|
||||||
@@ -310,14 +325,10 @@ closeObjScrollDir x
|
|||||||
changeInvSel :: Int -> World -> World
|
changeInvSel :: Int -> World -> World
|
||||||
changeInvSel i w
|
changeInvSel i w
|
||||||
| i == 0 || n == 0 = w
|
| i == 0 || n == 0 = w
|
||||||
| yourInvSel w < n =
|
| otherwise = w
|
||||||
w
|
& pointcrInvSel . isel . ispItem %~ (`mod` n) . subtract i
|
||||||
& pointcrInvSel . iselPos %~ (`mod` n) . subtract i
|
& pointcrInvSel . isel . iselAction .~ NoInvSelAction
|
||||||
& pointcrInvSel . iselAction .~ NoInvSelAction
|
& pointcrInvSel . isel . ispCloseObject %~ (`mod` numCO) . subtract i
|
||||||
| otherwise =
|
|
||||||
w
|
|
||||||
& pointcrInvSel . iselPos %~ ((+ n) . (`mod` numCO) . subtract (i + n))
|
|
||||||
& pointcrInvSel . iselAction .~ NoInvSelAction
|
|
||||||
where
|
where
|
||||||
-- arguably this should jump the invpos into the inventory proper
|
-- arguably this should jump the invpos into the inventory proper
|
||||||
pointcrInvSel = cWorld . lWorld . creatures . ix 0 . crInvSel
|
pointcrInvSel = cWorld . lWorld . creatures . ix 0 . crInvSel
|
||||||
@@ -325,47 +336,58 @@ changeInvSel i w
|
|||||||
numCO = length $ w ^. hud . closeObjects
|
numCO = length $ w ^. hud . closeObjects
|
||||||
|
|
||||||
changeSwapInvSel :: Int -> World -> World
|
changeSwapInvSel :: Int -> World -> World
|
||||||
changeSwapInvSel k w
|
changeSwapInvSel k w = case you w ^? crInvSel . isel of
|
||||||
| k == 0 = w
|
Just (SelItem i _) -> w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i
|
||||||
| yourInvSel w < n =
|
Just (SelCloseObject i) -> w
|
||||||
w
|
& cWorld . lWorld . creatures . ix 0 . crInvSel . isel . ispCloseObject
|
||||||
& cWorld . lWorld . creatures . ix 0 %~ updatecreature
|
.~ ((i - k) `mod` numCO)
|
||||||
| yourInvSel w > n =
|
& hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO)
|
||||||
w
|
_ -> w
|
||||||
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselPos .~ ico'
|
|
||||||
& hud . closeObjects %~ swapIndices (i - (n + 1)) (ico' - (n + 1))
|
|
||||||
| otherwise = w
|
|
||||||
where
|
where
|
||||||
updatecreature =
|
updatecreature i =
|
||||||
(crInv %~ IM.safeSwapKeys (i `mod` n) swapi)
|
(crInv %~ IM.safeSwapKeys (i `mod` n) (swapi i))
|
||||||
. (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel)
|
. (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel i)
|
||||||
. (crInvSel . iselPos %~ (`mod` n) . subtract k)
|
. (crInvSel . isel . ispItem %~ (`mod` n) . subtract k)
|
||||||
. (crInvEquipped %~ IM.safeSwapKeys i swapi)
|
. (crInvEquipped %~ IM.safeSwapKeys i (swapi i))
|
||||||
. swapSite i swapi
|
. swapSite i (swapi i)
|
||||||
. swapSite swapi i
|
. swapSite (swapi i) i
|
||||||
swapSite a b = case cr ^? crInvEquipped . ix a of
|
swapSite a b = case cr ^? crInvEquipped . ix a of
|
||||||
Just epos -> crEquipment . ix epos .~ b
|
Just epos -> crEquipment . ix epos .~ b
|
||||||
Nothing -> id
|
Nothing -> id
|
||||||
cr = you w
|
cr = you w
|
||||||
swapi = (i - k) `mod` n
|
swapi i = (i - k) `mod` n
|
||||||
updateLeftInvSel li
|
updateLeftInvSel i li
|
||||||
| i == li = swapi
|
| i == li = swapi i
|
||||||
| swapi == li = i
|
| swapi i == li = i
|
||||||
| otherwise = li
|
| otherwise = li
|
||||||
i = crSel cr
|
|
||||||
ico' = ((i - (k + n + 1)) `mod` numCO) + n + 1
|
|
||||||
n = length $ _crInv cr
|
n = length $ _crInv cr
|
||||||
numCO = length $ w ^. hud . closeObjects
|
numCO = length $ w ^. hud . closeObjects
|
||||||
|
|
||||||
changeAugInvSel :: Int -> World -> World
|
changeAugInvSel :: Int -> World -> World
|
||||||
changeAugInvSel i w
|
changeAugInvSel yi w
|
||||||
| i == 0 = w
|
| yi == 0 = w
|
||||||
| otherwise =
|
| otherwise =
|
||||||
w
|
w & cWorld . lWorld . creatures . ix 0 . crInvSel . isel %~ f
|
||||||
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselPos %~ (`mod` n) . subtract i
|
|
||||||
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselAction .~ NoInvSelAction
|
|
||||||
where
|
where
|
||||||
n = length (yourInv w) + length (w ^. hud . closeObjects) + 1
|
f = fromAugSelPos w . (`mod` (ninv + nclose + 1)) . subtract yi . toAugSelPos w
|
||||||
|
ninv = length (yourInv w)
|
||||||
|
nclose = length (w ^. hud . closeObjects)
|
||||||
|
|
||||||
|
toAugSelPos :: World -> ManipulatedObject -> Int
|
||||||
|
toAugSelPos w mo = case mo of
|
||||||
|
SelItem i _ -> i
|
||||||
|
SelNothing -> ninv
|
||||||
|
SelCloseObject i -> ninv + i + 1
|
||||||
|
where
|
||||||
|
ninv = length (yourInv w)
|
||||||
|
|
||||||
|
fromAugSelPos :: World -> Int -> ManipulatedObject
|
||||||
|
fromAugSelPos w i
|
||||||
|
| i > ninv = SelCloseObject (i - ninv - 1)
|
||||||
|
| i == ninv = SelNothing
|
||||||
|
| otherwise = SelItem i NoInvSelAction
|
||||||
|
where
|
||||||
|
ninv = length (yourInv w)
|
||||||
|
|
||||||
bestCloseObjectIndex :: World -> Maybe Int
|
bestCloseObjectIndex :: World -> Maybe Int
|
||||||
bestCloseObjectIndex w = findIndex f $ w ^. hud . closeObjects
|
bestCloseObjectIndex w = findIndex f $ w ^. hud . closeObjects
|
||||||
@@ -375,13 +397,9 @@ bestCloseObjectIndex w = findIndex f $ w ^. hud . closeObjects
|
|||||||
ycr = you w
|
ycr = you w
|
||||||
|
|
||||||
selectedCloseObject :: World -> Maybe (Int, Either FloorItem Button)
|
selectedCloseObject :: World -> Maybe (Int, Either FloorItem Button)
|
||||||
selectedCloseObject w
|
selectedCloseObject w = case you w ^? crInvSel . isel . ispCloseObject of
|
||||||
| invsel >= (length inv + 1) = selectNthCloseObject w (invsel - (length inv + 1))
|
Just i -> selectNthCloseObject w i
|
||||||
| otherwise = selectNthCloseObject w =<< bestCloseObjectIndex w
|
Nothing -> selectNthCloseObject w =<< bestCloseObjectIndex w
|
||||||
where
|
|
||||||
invsel = crSel cr
|
|
||||||
cr = you w
|
|
||||||
inv = _crInv cr
|
|
||||||
|
|
||||||
selectNthCloseObject :: World -> Int -> Maybe (Int, Either FloorItem Button)
|
selectNthCloseObject :: World -> Int -> Maybe (Int, Either FloorItem Button)
|
||||||
selectNthCloseObject w n = (length (yourInv w) + n + 1,) <$> (_closeObjects (_hud w) !? n)
|
selectNthCloseObject w n = (length (yourInv w) + n + 1,) <$> (_closeObjects (_hud w) !? n)
|
||||||
|
|||||||
@@ -37,7 +37,8 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
|
|||||||
|
|
||||||
createAndSelectItem :: Item -> World -> World
|
createAndSelectItem :: Item -> World -> World
|
||||||
createAndSelectItem itm w = case createPutItem itm w of
|
createAndSelectItem itm w = case createPutItem itm w of
|
||||||
(Just i, w') -> w' & cWorld . lWorld . creatures . ix 0 . crInvSel .~ InvSel i NoInvSelAction
|
(Just i, w') -> w'
|
||||||
|
& cWorld . lWorld . creatures . ix 0 . crInvSel .~ InvSel (SelItem i NoInvSelAction)
|
||||||
(Nothing, w') -> w'
|
(Nothing, w') -> w'
|
||||||
|
|
||||||
createPutItem :: Item -> World -> (Maybe Int, World)
|
createPutItem :: Item -> World -> (Maybe Int, World)
|
||||||
|
|||||||
@@ -1,6 +1,10 @@
|
|||||||
module Dodge.Inventory.SelectionList where
|
module Dodge.Inventory.SelectionList
|
||||||
|
( invSelectionItem
|
||||||
|
, closeObjectToSelectionItem
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Dodge.Default.SelectionList
|
--import Dodge.Default.SelectionList
|
||||||
import Dodge.Inventory.Color
|
import Dodge.Inventory.Color
|
||||||
import Dodge.Item.Display
|
import Dodge.Item.Display
|
||||||
import Dodge.Inventory.ItemSpace
|
import Dodge.Inventory.ItemSpace
|
||||||
@@ -12,11 +16,11 @@ import Dodge.Data.World
|
|||||||
import qualified Data.IntMap.Strict as IM
|
import qualified Data.IntMap.Strict as IM
|
||||||
import LensHelp
|
import LensHelp
|
||||||
|
|
||||||
makeInventorySelectionList :: World -> SelectionList ()
|
--makeInventorySelectionList :: World -> SelectionList ()
|
||||||
makeInventorySelectionList w = defaultSelectionList
|
--makeInventorySelectionList w = defaultSelectionList
|
||||||
& slItems .~ inventorySelectionList w
|
-- & slItems .~ inventorySelectionList w
|
||||||
& slSelPos .~ inventoryCursorPos w
|
-- & slSelPos .~ inventoryCursorPos w
|
||||||
|
--
|
||||||
inventorySelectionList :: World -> [SelectionItem ()]
|
inventorySelectionList :: World -> [SelectionItem ()]
|
||||||
inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
|
inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
|
||||||
++ [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()]
|
++ [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()]
|
||||||
@@ -29,12 +33,12 @@ inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
|
|||||||
0 -> " INVENTORY FULL"
|
0 -> " INVENTORY FULL"
|
||||||
1 -> " +1 FREE SLOT"
|
1 -> " +1 FREE SLOT"
|
||||||
x -> " +" ++ show x ++ " FREE SLOTS"
|
x -> " +" ++ show x ++ " FREE SLOTS"
|
||||||
|
--
|
||||||
inventoryCursorPos :: World -> Maybe Int
|
--inventoryCursorPos :: World -> Maybe Int
|
||||||
inventoryCursorPos w = case w ^? hud . hudElement . subInventory of
|
--inventoryCursorPos w = case w ^? hud . hudElement . subInventory of
|
||||||
Just CombineInventory{} -> Nothing
|
-- Just CombineInventory{} -> Nothing
|
||||||
_ -> Just $ yourInvSel w
|
-- _ -> Just $ yourInvSel w
|
||||||
|
--
|
||||||
invSelectionItem :: Creature -> (Int,Item) -> SelectionItem ()
|
invSelectionItem :: Creature -> (Int,Item) -> SelectionItem ()
|
||||||
invSelectionItem cr (i,it) = SelectionItem
|
invSelectionItem cr (i,it) = SelectionItem
|
||||||
{ _siPictures = pics
|
{ _siPictures = pics
|
||||||
@@ -49,9 +53,9 @@ invSelectionItem cr (i,it) = SelectionItem
|
|||||||
col = _itInvColor it
|
col = _itInvColor it
|
||||||
pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of
|
pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of
|
||||||
UndroppableIdentified -> itemDisplay it
|
UndroppableIdentified -> itemDisplay it
|
||||||
_ | crSel cr == i -> selectedItemDisplay cr it
|
_ | cr ^? crInvSel . isel . ispItem == Just i -> selectedItemDisplay cr it
|
||||||
_ -> itemDisplay it
|
_ -> itemDisplay it
|
||||||
|
--
|
||||||
closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem ()
|
closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem ()
|
||||||
closeObjectToSelectionItem n e = SelectionItem
|
closeObjectToSelectionItem n e = SelectionItem
|
||||||
{ _siPictures = pics
|
{ _siPictures = pics
|
||||||
@@ -64,7 +68,7 @@ closeObjectToSelectionItem n e = SelectionItem
|
|||||||
}
|
}
|
||||||
where
|
where
|
||||||
(pics,col) = closeObjectToTextPictures' n e
|
(pics,col) = closeObjectToTextPictures' n e
|
||||||
|
--
|
||||||
closeObjectToTextPictures' :: Int -> Either FloorItem Button -> ([String],Color)
|
closeObjectToTextPictures' :: Int -> Either FloorItem Button -> ([String],Color)
|
||||||
closeObjectToTextPictures' nfreeslots e = case e of
|
closeObjectToTextPictures' nfreeslots e = case e of
|
||||||
Left flit -> let it = _flIt flit
|
Left flit -> let it = _flIt flit
|
||||||
@@ -75,9 +79,9 @@ closeObjectToTextPictures' nfreeslots e = case e of
|
|||||||
thecol it
|
thecol it
|
||||||
| nfreeslots >= itSlotsTaken it = _itInvColor it
|
| nfreeslots >= itSlotsTaken it = _itInvColor it
|
||||||
| otherwise = invDimColor
|
| otherwise = invDimColor
|
||||||
|
--
|
||||||
clObjIntIn :: Int
|
clObjIntIn :: Int
|
||||||
clObjIntIn = 2
|
clObjIntIn = 2
|
||||||
|
--
|
||||||
clObjFloatIn :: Float
|
--clObjFloatIn :: Float
|
||||||
clObjFloatIn = fromIntegral clObjIntIn * 9
|
--clObjFloatIn = fromIntegral clObjIntIn * 9
|
||||||
|
|||||||
@@ -65,7 +65,7 @@ showAutoRechargeProgress lc = case lc of
|
|||||||
ChargeableAmmo{} -> show (_wpCharge lc)
|
ChargeableAmmo{} -> show (_wpCharge lc)
|
||||||
|
|
||||||
showReloadProgress :: Creature -> HeldConsumption -> String
|
showReloadProgress :: Creature -> HeldConsumption -> String
|
||||||
showReloadProgress cr ic = case cr ^? crInvSel . iselAction of
|
showReloadProgress cr ic = case cr ^? crInvSel . isel . iselAction of
|
||||||
Just (ReloadAction i la) -> show i ++ showLoadActionType la (_laLoaded ic)
|
Just (ReloadAction i la) -> show i ++ showLoadActionType la (_laLoaded ic)
|
||||||
_ -> case ic ^? laProgress . _Just . ix 0 of
|
_ -> case ic ^? laProgress . _Just . ix 0 of
|
||||||
Nothing -> show $ _laLoaded ic
|
Nothing -> show $ _laLoaded ic
|
||||||
|
|||||||
@@ -136,7 +136,8 @@ shootLaser it cr = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams
|
|||||||
where
|
where
|
||||||
pos = _crPos cr
|
pos = _crPos cr
|
||||||
dir = _crDir cr
|
dir = _crDir cr
|
||||||
phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr
|
phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
|
||||||
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
dam = _lasDamage $ _itParams it
|
dam = _lasDamage $ _itParams it
|
||||||
|
|
||||||
-- this has the feel of a left click item
|
-- this has the feel of a left click item
|
||||||
@@ -151,7 +152,8 @@ circleLaser it cr w
|
|||||||
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
|
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
|
||||||
pos = _crPos cr +.+ rotateV dir (V2 0 (max 70 $ dist cpos mwp))
|
pos = _crPos cr +.+ rotateV dir (V2 0 (max 70 $ dist cpos mwp))
|
||||||
dir = fromIntegral (_lasCycle (_itParams it)) * pi / 1000
|
dir = fromIntegral (_lasCycle (_itParams it)) * pi / 1000
|
||||||
phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr
|
phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
|
||||||
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
dam = _lasDamage $ _itParams it
|
dam = _lasDamage $ _itParams it
|
||||||
|
|
||||||
shootDualLaser :: Item -> Creature -> World -> World
|
shootDualLaser :: Item -> Creature -> World -> World
|
||||||
@@ -173,7 +175,8 @@ shootDualLaser it cr w =
|
|||||||
| otherwise = mwp
|
| otherwise = mwp
|
||||||
dirl = argV $ mwp' -.- posl
|
dirl = argV $ mwp' -.- posl
|
||||||
dirr = argV $ mwp' -.- posr
|
dirr = argV $ mwp' -.- posr
|
||||||
phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr
|
phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
|
||||||
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
dam = _lasDamage $ _itParams it
|
dam = _lasDamage $ _itParams it
|
||||||
|
|
||||||
basicBeamAt :: Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
|
basicBeamAt :: Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
|
||||||
@@ -207,7 +210,8 @@ aTractorBeam _ cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos
|
|||||||
xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
|
xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
|
||||||
dir = _crDir cr
|
dir = _crDir cr
|
||||||
outpos = fst $ collidePointWallsFilter (const True) cpos xpos w
|
outpos = fst $ collidePointWallsFilter (const True) cpos xpos w
|
||||||
power = _attractionPower . _itParams $ _crInv cr IM.! crSel cr
|
power = _attractionPower . _itParams $ _crInv cr IM.! itRef
|
||||||
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
|
|
||||||
tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
|
tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
|
||||||
tractorBeamAt pos outpos dir power =
|
tractorBeamAt pos outpos dir power =
|
||||||
|
|||||||
@@ -191,7 +191,7 @@ rateIncAB exeffFirst exeffCont eff item cr w
|
|||||||
fastRate = _rateMinMax . _heldDelay $ _itUse item
|
fastRate = _rateMinMax . _heldDelay $ _itUse item
|
||||||
startRate = _rateMaxMax . _heldDelay $ _itUse item
|
startRate = _rateMaxMax . _heldDelay $ _itUse item
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
itRef = crSel cr
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
pointItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
|
pointItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
|
||||||
currentRate = _rateMax (_heldDelay (_itUse item))
|
currentRate = _rateMax (_heldDelay (_itUse item))
|
||||||
repeatFire = crWeaponReady cr && _rateTime (_heldDelay (_itUse item)) == 1
|
repeatFire = crWeaponReady cr && _rateTime (_heldDelay (_itUse item)) == 1
|
||||||
@@ -215,7 +215,7 @@ withWarmUp soundID f item cr w
|
|||||||
& f item cr
|
& f item cr
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
itRef = crSel cr
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
|
pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
|
||||||
curWarmUp = _warmTime . _heldDelay $ _itUse item
|
curWarmUp = _warmTime . _heldDelay $ _itUse item
|
||||||
maxWarmUp = _warmMax . _heldDelay $ _itUse item
|
maxWarmUp = _warmMax . _heldDelay $ _itUse item
|
||||||
@@ -341,19 +341,25 @@ withSidePushAfterI maxSide eff item cr w =
|
|||||||
useAllAmmo :: ChainEffect
|
useAllAmmo :: ChainEffect
|
||||||
useAllAmmo eff item cr =
|
useAllAmmo eff item cr =
|
||||||
eff item cr
|
eff item cr
|
||||||
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded .~ 0)
|
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itUse . heldConsumption . laLoaded .~ 0)
|
||||||
|
where
|
||||||
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
|
|
||||||
useAmmoUpTo :: Int -> ChainEffect
|
useAmmoUpTo :: Int -> ChainEffect
|
||||||
useAmmoUpTo amAmount eff item cr =
|
useAmmoUpTo amAmount eff item cr =
|
||||||
eff item cr
|
eff item cr
|
||||||
. ( cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded
|
. ( cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itUse . heldConsumption . laLoaded
|
||||||
%~ (max 0 . subtract amAmount)
|
%~ (max 0 . subtract amAmount)
|
||||||
)
|
)
|
||||||
|
where
|
||||||
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
|
|
||||||
useAmmoAmount :: Int -> ChainEffect
|
useAmmoAmount :: Int -> ChainEffect
|
||||||
useAmmoAmount amAmount eff item cr =
|
useAmmoAmount amAmount eff item cr =
|
||||||
eff item cr
|
eff item cr
|
||||||
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded -~ amAmount)
|
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itUse . heldConsumption . laLoaded -~ amAmount)
|
||||||
|
where
|
||||||
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
|
|
||||||
{- |
|
{- |
|
||||||
Applies a world effect after an item use cooldown check.
|
Applies a world effect after an item use cooldown check.
|
||||||
@@ -364,7 +370,8 @@ useTimeCheck f item cr w = case item ^? itUse . heldDelay . rateTime of
|
|||||||
_ -> w
|
_ -> w
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
setUseTime = cWorld . lWorld . creatures . ix cid . crInv . ix (crSel cr) . itUse . heldDelay . rateTime +~ userate
|
setUseTime = cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . rateTime +~ userate
|
||||||
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
userate = fromMaybe 0 $ item ^? itUse . heldDelay . rateMax
|
userate = fromMaybe 0 $ item ^? itUse . heldDelay . rateMax
|
||||||
|
|
||||||
-- | Applies a world effect after a hammer position check.
|
-- | Applies a world effect after a hammer position check.
|
||||||
@@ -389,7 +396,7 @@ ammoUseCheck f item cr w
|
|||||||
| otherwise = w
|
| otherwise = w
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
itRef = crSel cr
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
|
pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
|
||||||
fireCondition =
|
fireCondition =
|
||||||
crWeaponReady cr
|
crWeaponReady cr
|
||||||
@@ -444,10 +451,14 @@ withItem g f it = g it f it
|
|||||||
|
|
||||||
-- not ideal
|
-- not ideal
|
||||||
withItemUpdate' :: (Item -> Item) -> ChainEffect
|
withItemUpdate' :: (Item -> Item) -> ChainEffect
|
||||||
withItemUpdate' up f it cr = f (up it) cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
|
withItemUpdate' up f it cr = f (up it) cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef %~ up)
|
||||||
|
where
|
||||||
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
|
|
||||||
withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
|
withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
|
||||||
withItemUpdate up g f it cr = g it f it cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
|
withItemUpdate up g f it cr = g it f it cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef %~ up)
|
||||||
|
where
|
||||||
|
itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change
|
||||||
|
|
||||||
withTempLight :: Int -> Float -> V3 Float -> ChainEffect
|
withTempLight :: Int -> Float -> V3 Float -> ChainEffect
|
||||||
withTempLight time rad col eff item cr =
|
withTempLight time rad col eff item cr =
|
||||||
|
|||||||
+2
-1
@@ -58,7 +58,8 @@ useRewindGun itm _ w = w
|
|||||||
-- 22.05.23 this has been changed from using invids to items
|
-- 22.05.23 this has been changed from using invids to items
|
||||||
useShrinkGun :: Item -> Creature -> World -> World
|
useShrinkGun :: Item -> Creature -> World -> World
|
||||||
useShrinkGun it cr w = case it ^? itParams . shrinkGunStatus of
|
useShrinkGun it cr w = case it ^? itParams . shrinkGunStatus of
|
||||||
Just FullSize -> tryResize 0.5 $ stripNoItems cr . f Shrunk UndroppableIdentified . dropExcept cr invid
|
--Just FullSize -> tryResize 0.5 $ stripNoItems cr . f Shrunk UndroppableIdentified . dropExcept cr invid
|
||||||
|
Just FullSize -> tryResize 0.5 $ f Shrunk UndroppableIdentified . dropExcept cr invid
|
||||||
Just Shrunk -> tryResize 1 $ f FullSize Uncursed . setMinInvSize defaultInvSize cr
|
Just Shrunk -> tryResize 1 $ f FullSize Uncursed . setMinInvSize defaultInvSize cr
|
||||||
Nothing -> error "useShrinkGun applied to item with incorrect ItParam"
|
Nothing -> error "useShrinkGun applied to item with incorrect ItParam"
|
||||||
where
|
where
|
||||||
|
|||||||
@@ -95,7 +95,7 @@ setRemoteDir cid itid pj w = w & cWorld . lWorld . projectiles . ix (_prjID pj)
|
|||||||
--i = _prjID pj
|
--i = _prjID pj
|
||||||
newdir
|
newdir
|
||||||
| SDL.ButtonRight `M.member` _mouseButtons (_input w)
|
| SDL.ButtonRight `M.member` _mouseButtons (_input w)
|
||||||
&& w ^? cWorld . lWorld . creatures . ix cid . crInvSel . iselPos
|
&& w ^? cWorld . lWorld . creatures . ix cid . crInvSel . isel . ispItem
|
||||||
== w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID
|
== w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID
|
||||||
= (w ^. cWorld . camPos . camRot) + argV (_mousePos (_input w))
|
= (w ^. cWorld . camPos . camRot) + argV (_mousePos (_input w))
|
||||||
| otherwise = _prjDir pj
|
| otherwise = _prjDir pj
|
||||||
|
|||||||
+32
-22
@@ -5,57 +5,67 @@ module Dodge.Reloading (
|
|||||||
tryStartLoading,
|
tryStartLoading,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Dodge.Data.Item.Use.Consumption.LoadAction
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Dodge.Data.Creature
|
import Dodge.Data.Creature
|
||||||
|
import Data.Maybe
|
||||||
|
|
||||||
crCancelReloading :: Creature -> Creature
|
crCancelReloading :: Creature -> Creature
|
||||||
crCancelReloading cr =
|
crCancelReloading cr =
|
||||||
cr
|
cr
|
||||||
& crInv . ix (crSel cr) . itUse . heldConsumption . laProgress %~ const Nothing
|
& updateProgress
|
||||||
& crInvSel . iselAction .~ NoInvSelAction
|
& crInvSel . isel . iselAction .~ NoInvSelAction
|
||||||
|
where
|
||||||
|
updateProgress = case crSel cr of
|
||||||
|
SelItem i _ -> crInv . ix i . itUse . heldConsumption . laProgress %~ const Nothing
|
||||||
|
_ -> id
|
||||||
|
|
||||||
stepReloading :: Creature -> Creature
|
stepReloading :: Creature -> Creature
|
||||||
stepReloading cr = case cr ^?! crInvSel . iselAction of
|
stepReloading cr = case cr ^?! crInvSel . isel of
|
||||||
ReloadAction x la
|
SelItem i (ReloadAction x la)
|
||||||
| x > 0 ->
|
| x > 0 ->
|
||||||
cr & crInvSel . iselAction . actionProgress -~ 1
|
cr & crInvSel . isel . iselAction . actionProgress -~ 1
|
||||||
| otherwise ->
|
| otherwise ->
|
||||||
cr
|
cr
|
||||||
& crInv . ix (crSel cr) . itUse . heldConsumption %~ doLoadAction la
|
& crInv . ix i . itUse . heldConsumption %~ doLoadAction la
|
||||||
& crInv . ix (crSel cr) . itUse . heldConsumption %~ rotateActionProgress
|
& crInv . ix i . itUse . heldConsumption %~ rotateActionProgress
|
||||||
& tryNextLoadAction
|
& tryNextLoadAction
|
||||||
_ -> cr
|
_ -> cr
|
||||||
|
|
||||||
tryNextLoadAction :: Creature -> Creature
|
tryNextLoadAction :: Creature -> Creature
|
||||||
tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laProgress . _Just . ix 0 of
|
tryNextLoadAction cr = case cr ^? crInvSel . isel of
|
||||||
Nothing -> cr & crInvSel . iselAction .~ NoInvSelAction
|
Just (SelItem i _) -> case cr ^? crInv . ix i . itUse . heldConsumption . laProgress . _Just . ix 0 of
|
||||||
Just la ->
|
Nothing -> cr & crInvSel . isel . iselAction .~ NoInvSelAction
|
||||||
cr & crInvSel . iselAction . actionProgress .~ _actionTime la
|
Just la ->
|
||||||
& crInvSel . iselAction . reloadAction .~ la
|
cr & crInvSel . isel . iselAction . actionProgress .~ _actionTime la
|
||||||
|
& crInvSel . isel . iselAction . reloadAction .~ la
|
||||||
|
_ -> cr
|
||||||
|
|
||||||
crToggleReloading :: Creature -> Creature
|
crToggleReloading :: Creature -> Creature
|
||||||
crToggleReloading cr = case cr ^? crInvSel . iselAction of
|
crToggleReloading cr = case cr ^? crInvSel . isel . iselAction of
|
||||||
Just ReloadAction{} -> cr & crInvSel . iselAction .~ NoInvSelAction
|
Just ReloadAction{} -> cr & crInvSel . isel . iselAction .~ NoInvSelAction
|
||||||
_ -> cr & tryStartLoading
|
_ -> cr & tryStartLoading
|
||||||
|
|
||||||
tryStartLoading :: Creature -> Creature
|
tryStartLoading :: Creature -> Creature
|
||||||
tryStartLoading cr = case cr ^? crInv . ix (crSel cr) . itUse . heldConsumption of
|
tryStartLoading cr = fromMaybe cr $ do
|
||||||
Just hc -> startLoading hc cr
|
i <- cr ^? crInvSel . isel . ispItem
|
||||||
Nothing -> cr
|
hc <- cr ^? crInv . ix i . itUse . heldConsumption
|
||||||
|
return $ startLoading hc cr
|
||||||
|
|
||||||
startLoading :: HeldConsumption -> Creature -> Creature
|
startLoading :: HeldConsumption -> Creature -> Creature
|
||||||
startLoading ic cr = case ic ^? laProgress . _Just . ix 0 of
|
startLoading ic cr = case ic ^? laProgress . _Just . ix 0 of
|
||||||
Just la -> cr & startLoadingStep la
|
Just la -> cr & startLoadingStep la
|
||||||
Nothing -> case ic ^? laCycle of
|
Nothing -> case ic ^? laCycle of
|
||||||
Nothing -> cr
|
Nothing -> cr
|
||||||
Just [] -> error ("item has empty load cycle" ++ show (cr ^?! crInv . ix (crSel cr) . itType))
|
Just [] -> error ("item has empty load cycle")
|
||||||
Just _ | _laLoaded ic >= _laMax ic -> cr
|
Just _ | _laLoaded ic >= _laMax ic -> cr
|
||||||
Just (la : las) ->
|
Just (la : las) -> fromMaybe (error "item loading error") $ do
|
||||||
cr & startLoadingStep la
|
i <- cr ^? crInvSel . isel . ispItem
|
||||||
& crInv . ix (crSel cr) . itUse . heldConsumption . laProgress ?~ (la : las)
|
return $ cr & startLoadingStep la
|
||||||
|
& crInv . ix i . itUse . heldConsumption . laProgress ?~ (la : las)
|
||||||
|
|
||||||
startLoadingStep :: LoadAction -> Creature -> Creature
|
startLoadingStep :: LoadAction -> Creature -> Creature
|
||||||
startLoadingStep la cr = cr & crInvSel . iselAction .~ ReloadAction (_actionTime la) la
|
startLoadingStep la cr = cr & crInvSel . isel . iselAction .~ ReloadAction (_actionTime la) la
|
||||||
|
|
||||||
rotateActionProgress :: HeldConsumption -> HeldConsumption
|
rotateActionProgress :: HeldConsumption -> HeldConsumption
|
||||||
rotateActionProgress ic = case ic ^? laProgress . _Just of
|
rotateActionProgress ic = case ic ^? laProgress . _Just of
|
||||||
|
|||||||
+34
-32
@@ -143,32 +143,33 @@ floorItemPickupInfo n itm
|
|||||||
| n >= ceiling (_itInvSize itm) = ", but you have space to pick it up."
|
| n >= ceiling (_itInvSize itm) = ", but you have space to pick it up."
|
||||||
| otherwise = ", and you don't have space to pick it up."
|
| otherwise = ", and you don't have space to pick it up."
|
||||||
|
|
||||||
|
-- this should not produce Nothing, and the logic should be changed to reflect
|
||||||
|
-- this
|
||||||
yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a
|
yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a
|
||||||
yourAugmentedItem f x g w
|
yourAugmentedItem f x g w = case you w ^? crInvSel . isel of
|
||||||
| i < n = f $ yourInv w ^?! ix i
|
Just (SelItem i _) -> f $ yourInv w ^?! ix i
|
||||||
| i == n = x
|
Just (SelCloseObject i) -> g $ w ^?! hud . closeObjects . ix (i - n - 1)
|
||||||
| otherwise = g $ w ^?! hud . closeObjects . ix (i - n - 1)
|
_ -> x
|
||||||
where
|
where
|
||||||
i = crSel (you w)
|
|
||||||
n = length $ yourInv w
|
n = length $ yourInv w
|
||||||
|
|
||||||
drawNoSubInventory :: Configuration -> World -> Picture
|
drawNoSubInventory :: Configuration -> World -> Picture
|
||||||
drawNoSubInventory cfig w =
|
drawNoSubInventory cfig w =
|
||||||
pictures
|
pictures
|
||||||
[ closeobjectcursor
|
[ --closeobjectcursor
|
||||||
, equipcursors
|
equipcursors
|
||||||
, equipcursor -- the order is important, this should go on top of the other equipcursors
|
, equipcursor -- the order is important, this should go on top of the other equipcursors
|
||||||
, rboptions
|
, rboptions
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
closeobjectcursor = case selectedCloseObject w of
|
-- closeobjectcursor = case selectedCloseObject w of
|
||||||
Nothing -> mempty
|
-- Nothing -> mempty
|
||||||
Just (i, _) ->
|
-- Just (i, _) ->
|
||||||
drawCursorAt
|
-- drawCursorAt
|
||||||
(invDisplayParams w & ldpCursorType .~ BorderCursor [North, South])
|
-- (invDisplayParams w & ldpCursorType .~ BorderCursor [North, South])
|
||||||
cfig
|
-- cfig
|
||||||
(Just i)
|
-- (Just i)
|
||||||
(inventorySelectionList w)
|
-- (inventorySelectionList w)
|
||||||
equipcursor = case cr ^. crLeftInvSel . lisMPos of
|
equipcursor = case cr ^. crLeftInvSel . lisMPos of
|
||||||
Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
|
Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
|
||||||
_ -> mempty
|
_ -> mempty
|
||||||
@@ -267,27 +268,28 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
|
|||||||
| otherwise = []
|
| otherwise = []
|
||||||
|
|
||||||
drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
|
drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
|
||||||
drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} =
|
drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae}
|
||||||
listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es)
|
= fromMaybe mempty $ do
|
||||||
<> case ae of
|
curpos <- you w ^? crInvSel . isel . ispItem
|
||||||
DoNotMoveEquipment -> mempty
|
let midtext str = listTextPictureAt 252 0 cfig curpos (text str)
|
||||||
PutOnEquipment{} ->
|
let extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
|
||||||
midtext "PUT ONTO"
|
return $ listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es)
|
||||||
MoveEquipment{} ->
|
<> case ae of
|
||||||
midtext "MOVE TO" <> extratext []
|
DoNotMoveEquipment -> mempty
|
||||||
SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
|
PutOnEquipment{} ->
|
||||||
midtext "MOVE TO" <> extratext ("SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp)
|
midtext "PUT ONTO"
|
||||||
ReplaceEquipment{_allocRemoveID = rid} ->
|
MoveEquipment{} ->
|
||||||
midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid)
|
midtext "MOVE TO" <> extratext []
|
||||||
RemoveEquipment{} ->
|
SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
|
||||||
midtext "TAKE OFF"
|
midtext "MOVE TO" <> extratext ("SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp)
|
||||||
|
ReplaceEquipment{_allocRemoveID = rid} ->
|
||||||
|
midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid)
|
||||||
|
RemoveEquipment{} ->
|
||||||
|
midtext "TAKE OFF"
|
||||||
where
|
where
|
||||||
midtext str = listTextPictureAt 252 0 cfig curpos (text str)
|
|
||||||
extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
|
|
||||||
deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
|
deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
|
||||||
Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
|
Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
|
||||||
Nothing -> ""
|
Nothing -> ""
|
||||||
curpos = invSelPos w
|
|
||||||
otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j)
|
otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j)
|
||||||
drawRBOptions _ _ _ = mempty
|
drawRBOptions _ _ _ = mempty
|
||||||
|
|
||||||
|
|||||||
@@ -43,7 +43,9 @@ moveZoomCamera cfig theinput cr campos =
|
|||||||
& camItemZoom .~ newItemZoom
|
& camItemZoom .~ newItemZoom
|
||||||
where
|
where
|
||||||
cpos = _crPos cr
|
cpos = _crPos cr
|
||||||
mitm = cr ^? crInv . ix (crSel cr)
|
mitm = do
|
||||||
|
i <- cr ^? crInvSel . isel . ispItem
|
||||||
|
cr ^? crInv . ix i
|
||||||
newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
|
newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
|
||||||
vfoffset = do
|
vfoffset = do
|
||||||
iscam <- mitm ^? _Just . itScope . scopeIsCamera
|
iscam <- mitm ^? _Just . itScope . scopeIsCamera
|
||||||
@@ -83,11 +85,16 @@ moveZoomCamera cfig theinput cr campos =
|
|||||||
zoomOutSpeed = 15
|
zoomOutSpeed = 15
|
||||||
|
|
||||||
updateScopeZoom :: World -> World
|
updateScopeZoom :: World -> World
|
||||||
updateScopeZoom w
|
updateScopeZoom w = fromMaybe w $ do
|
||||||
|
i <- w ^? cWorld . lWorld . creatures . ix 0 . crInvSel . isel . ispItem
|
||||||
|
return $ updateScopeZoom' i w
|
||||||
|
|
||||||
|
updateScopeZoom' :: Int -> World -> World
|
||||||
|
updateScopeZoom' i w
|
||||||
| SDL.ButtonRight `M.member` _mouseButtons (_input w) = w & wppointer %~ doScopeZoom mp
|
| SDL.ButtonRight `M.member` _mouseButtons (_input w) = w & wppointer %~ doScopeZoom mp
|
||||||
| otherwise = w & wppointer %~ resetscope
|
| otherwise = w & wppointer %~ resetscope
|
||||||
where
|
where
|
||||||
wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0)) . itScope
|
wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itScope
|
||||||
resetscope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl
|
resetscope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl
|
||||||
resetscope otherAtt = otherAtt
|
resetscope otherAtt = otherAtt
|
||||||
mp = rotateV (w ^. cWorld . camPos . camRot) $ _mousePos (_input w)
|
mp = rotateV (w ^. cWorld . camPos . camRot) $ _mousePos (_input w)
|
||||||
@@ -170,10 +177,13 @@ rotateCameraBy :: Float -> CWorld -> CWorld
|
|||||||
rotateCameraBy x w =
|
rotateCameraBy x w =
|
||||||
w
|
w
|
||||||
& camPos . camRot +~ x
|
& camPos . camRot +~ x
|
||||||
& lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! lWorld . creatures . ix 0))
|
& fromMaybe id (do
|
||||||
. itScope
|
i <- w ^? lWorld . creatures . ix 0 . crInvSel . isel . ispItem
|
||||||
. scopePos
|
return $ lWorld . creatures . ix 0 . crInv . ix i
|
||||||
%~ rotateV x
|
. itScope
|
||||||
|
. scopePos
|
||||||
|
%~ rotateV x
|
||||||
|
)
|
||||||
|
|
||||||
rotateCamera :: Configuration -> World -> World
|
rotateCamera :: Configuration -> World -> World
|
||||||
rotateCamera cfig w
|
rotateCamera cfig w
|
||||||
|
|||||||
@@ -105,11 +105,12 @@ moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
|
|||||||
|
|
||||||
changeTweakParam :: Maybe Int -> Int -> World -> World
|
changeTweakParam :: Maybe Int -> Int -> World -> World
|
||||||
changeTweakParam mi i w = fromMaybe w $ do
|
changeTweakParam mi i w = fromMaybe w $ do
|
||||||
|
curpos <- you w ^? crInvSel . isel . ispItem
|
||||||
paramid <- mi
|
paramid <- mi
|
||||||
params <- yourItem w ^? _Just . itTweaks . tweakParams . ix paramid
|
params <- yourItem w ^? _Just . itTweaks . tweakParams . ix paramid
|
||||||
let x = (_tweakVal params + i) `mod` _tweakMax params
|
let x = (_tweakVal params + i) `mod` _tweakMax params
|
||||||
return $
|
return $
|
||||||
w & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (you w))
|
w & cWorld . lWorld . creatures . ix 0 . crInv . ix curpos
|
||||||
%~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
|
%~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
|
||||||
. doTweak (_tweakType params) x
|
. doTweak (_tweakType params) x
|
||||||
)
|
)
|
||||||
|
|||||||
Reference in New Issue
Block a user