Allow to determine new substructural function based on ldt
This commit is contained in:
@@ -32,7 +32,8 @@ data ComposeLinkType
|
|||||||
deriving (Eq, Ord, Show, Read)
|
deriving (Eq, Ord, Show, Read)
|
||||||
|
|
||||||
data ItemStructuralFunction
|
data ItemStructuralFunction
|
||||||
= HeldPlatformSF
|
= UnloadedWeaponSF
|
||||||
|
| HeldPlatformSF
|
||||||
| EquipmentPlatformSF
|
| EquipmentPlatformSF
|
||||||
| GadgetPlatformSF
|
| GadgetPlatformSF
|
||||||
| WeaponScopeSF
|
| WeaponScopeSF
|
||||||
|
|||||||
+23
-14
@@ -10,6 +10,7 @@ module Dodge.Item.Grammar (
|
|||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import qualified Data.IntMap.Strict as IM
|
import qualified Data.IntMap.Strict as IM
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
import qualified Data.Set as S
|
||||||
import Dodge.Data.ComposedItem
|
import Dodge.Data.ComposedItem
|
||||||
import Dodge.Data.DoubleTree
|
import Dodge.Data.DoubleTree
|
||||||
import Dodge.Data.Item
|
import Dodge.Data.Item
|
||||||
@@ -17,7 +18,6 @@ import Dodge.DoubleTree
|
|||||||
import Dodge.Item.Orientation
|
import Dodge.Item.Orientation
|
||||||
import LensHelp
|
import LensHelp
|
||||||
import ListHelp
|
import ListHelp
|
||||||
--import qualified Data.Set as S
|
|
||||||
|
|
||||||
tryAttachItems ::
|
tryAttachItems ::
|
||||||
LabelDoubleTree ItemLink ComposedItem ->
|
LabelDoubleTree ItemLink ComposedItem ->
|
||||||
@@ -39,12 +39,18 @@ useBreakListsLinkTest ::
|
|||||||
LinkTest
|
LinkTest
|
||||||
useBreakListsLinkTest llist rlist = LTest ltest rtest
|
useBreakListsLinkTest llist rlist = LTest ltest rtest
|
||||||
where
|
where
|
||||||
ltest (LDT (_, sf, _) _ _) = do
|
ltest ldt = do
|
||||||
let xs = dropWhile ((/= sf) . fst) llist
|
let xs =
|
||||||
|
dropWhile
|
||||||
|
((\s -> not $ S.member s (structureToPotentialFunction ldt)) . fst)
|
||||||
|
llist
|
||||||
(_, linktype) <- safeHead xs
|
(_, linktype) <- safeHead xs
|
||||||
return $ LUpdate linktype (set _3 (useBreakListsLinkTest (tail xs) rlist)) id
|
return $ LUpdate linktype (set _3 (useBreakListsLinkTest (tail xs) rlist)) id
|
||||||
rtest (LDT (_, sf, _) _ _) = do
|
rtest ldt = do
|
||||||
let xs = dropWhile ((/= sf) . fst) rlist
|
let xs =
|
||||||
|
dropWhile
|
||||||
|
((\s -> not $ S.member s (structureToPotentialFunction ldt)) . fst)
|
||||||
|
rlist
|
||||||
(_, linktype) <- safeHead xs
|
(_, linktype) <- safeHead xs
|
||||||
return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
|
return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
|
||||||
|
|
||||||
@@ -66,23 +72,25 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
|
|||||||
(_, AmmoMagSF{}) -> fromMaybe ([], []) $ do
|
(_, AmmoMagSF{}) -> fromMaybe ([], []) $ do
|
||||||
atype <- itm ^? itConsumables . magType
|
atype <- itm ^? itConsumables . magType
|
||||||
let screenanddet = case atype of
|
let screenanddet = case atype of
|
||||||
LauncherAmmo -> [ (RemoteScreenSF, RemoteScreenLink)
|
LauncherAmmo ->
|
||||||
|
[ (RemoteScreenSF, RemoteScreenLink)
|
||||||
, (RemoteDetonatorSF, RemoteDetonatorLink)
|
, (RemoteDetonatorSF, RemoteDetonatorLink)
|
||||||
]
|
]
|
||||||
_ -> []
|
_ -> []
|
||||||
return
|
return
|
||||||
(
|
( [ (AmmoModifierSF atype, AmmoModLink)
|
||||||
[ (AmmoModifierSF atype, AmmoModLink)
|
|
||||||
, (AmmoTargetingSF atype, AmmoTargetingLink)
|
, (AmmoTargetingSF atype, AmmoTargetingLink)
|
||||||
, (AmmoPayloadSF atype, AmmoPayloadLink)
|
, (AmmoPayloadSF atype, AmmoPayloadLink)
|
||||||
, (AmmoEffectSF atype, AmmoEffectLink)
|
, (AmmoEffectSF atype, AmmoEffectLink)
|
||||||
, (SmokeReducerSF, SmokeReducerLink)
|
, (SmokeReducerSF, SmokeReducerLink)
|
||||||
] <> screenanddet
|
]
|
||||||
|
<> screenanddet
|
||||||
, []
|
, []
|
||||||
)
|
)
|
||||||
(_, RemoteScreenSF) ->
|
(_, RemoteScreenSF) ->
|
||||||
( [(JoystickSF, JoystickLink)]
|
( [(JoystickSF, JoystickLink)]
|
||||||
, [])
|
, []
|
||||||
|
)
|
||||||
(_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [(AugmentedHUDSF, AugmentedHUDLink)], [])
|
(_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [(AugmentedHUDSF, AugmentedHUDLink)], [])
|
||||||
(ATTACH BULLETSYNTH, _) ->
|
(ATTACH BULLETSYNTH, _) ->
|
||||||
([(AmmoMagSF ElectricalAmmo, AmmoInLink 0 ElectricalAmmo)], [])
|
([(AmmoMagSF ElectricalAmmo, AmmoInLink 0 ElectricalAmmo)], [])
|
||||||
@@ -104,6 +112,7 @@ itemToFunction itm = case itm ^. itType of
|
|||||||
HELD LASER -> WeaponTargetingSF
|
HELD LASER -> WeaponTargetingSF
|
||||||
HELD{} -> case itm ^? itUseCondition of
|
HELD{} -> case itm ^? itUseCondition of
|
||||||
Just MustBeHeld -> HeldPlatformSF
|
Just MustBeHeld -> HeldPlatformSF
|
||||||
|
--Just MustBeHeld -> UnloadedWeaponSF
|
||||||
_ -> GadgetPlatformSF
|
_ -> GadgetPlatformSF
|
||||||
_
|
_
|
||||||
| Just amtype <- itm ^? itConsumables . magType
|
| Just amtype <- itm ^? itConsumables . magType
|
||||||
@@ -127,10 +136,10 @@ itemToFunction itm = case itm ^. itType of
|
|||||||
ATTACH SHELLPAYLOAD{} -> AmmoPayloadSF LauncherAmmo
|
ATTACH SHELLPAYLOAD{} -> AmmoPayloadSF LauncherAmmo
|
||||||
_ -> NoSF
|
_ -> NoSF
|
||||||
|
|
||||||
--structureToPotentialFunction
|
structureToPotentialFunction ::
|
||||||
-- :: LabelDoubleTree ComposedItem ItemLink
|
LabelDoubleTree ItemLink ComposedItem ->
|
||||||
-- -> S.Set ItemStructuralFunction
|
S.Set ItemStructuralFunction
|
||||||
--structureToPotentialFunction _ = mempty
|
structureToPotentialFunction = S.singleton . (^. ldtValue . _2)
|
||||||
|
|
||||||
baseCI :: Item -> ComposedItem
|
baseCI :: Item -> ComposedItem
|
||||||
baseCI itm = (itm, itemToFunction itm, itemBaseConnections itm)
|
baseCI itm = (itm, itemToFunction itm, itemBaseConnections itm)
|
||||||
|
|||||||
@@ -8,6 +8,7 @@ import Dodge.Data.ComposedItem
|
|||||||
|
|
||||||
itemInvColor :: ComposedItem -> Color
|
itemInvColor :: ComposedItem -> Color
|
||||||
itemInvColor ci = case ci ^. _2 of
|
itemInvColor ci = case ci ^. _2 of
|
||||||
|
UnloadedWeaponSF -> mixColorsLinear 0.5 0.5 red white
|
||||||
HeldPlatformSF -> white
|
HeldPlatformSF -> white
|
||||||
MakeAutoSF -> white
|
MakeAutoSF -> white
|
||||||
EquipmentPlatformSF -> yellow
|
EquipmentPlatformSF -> yellow
|
||||||
|
|||||||
Reference in New Issue
Block a user