Start more sensibly separating avatar from ai creatures
This commit is contained in:
File diff suppressed because one or more lines are too long
@@ -1,11 +1,12 @@
|
|||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE StrictData #-}
|
{-# LANGUAGE StrictData #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
module Dodge.Annotation.Data where
|
module Dodge.Annotation.Data where
|
||||||
import Dodge.Data.GenWorld
|
|
||||||
import Dodge.Tree.Compose.Data
|
|
||||||
|
|
||||||
import Control.Monad.State
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
|
import Control.Monad.State
|
||||||
|
import Dodge.Data.GenWorld
|
||||||
|
import Dodge.Data.MetaTree
|
||||||
import System.Random
|
import System.Random
|
||||||
|
|
||||||
type MTRS = MetaTree Room String
|
type MTRS = MetaTree Room String
|
||||||
|
|||||||
+1
-4
@@ -21,10 +21,7 @@ import qualified ListHelp as List
|
|||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
|
|
||||||
updateBullet :: World -> Bullet -> (World, Maybe Bullet)
|
updateBullet :: World -> Bullet -> (World, Maybe Bullet)
|
||||||
updateBullet w bu = mvBullet w bu
|
updateBullet w bu
|
||||||
|
|
||||||
mvBullet :: World -> Bullet -> (World, Maybe Bullet)
|
|
||||||
mvBullet w bu
|
|
||||||
| magV (_buVel bu) < 1 || _buTimer bu <= 0 = (endspawn w, Nothing)
|
| magV (_buVel bu) < 1 || _buTimer bu <= 0 = (endspawn w, Nothing)
|
||||||
| otherwise =
|
| otherwise =
|
||||||
second (fmap updateBulVel)
|
second (fmap updateBulVel)
|
||||||
|
|||||||
@@ -103,7 +103,8 @@ startCr =
|
|||||||
& crFaction .~ PlayerFaction
|
& crFaction .~ PlayerFaction
|
||||||
& crMvType .~ MvWalking yourDefaultSpeed
|
& crMvType .~ MvWalking yourDefaultSpeed
|
||||||
& crType . skinUpper .~ lightx4 black
|
& crType . skinUpper .~ lightx4 black
|
||||||
& crType . humanoidAI .~ YourAI
|
& crType .~ Avatar
|
||||||
|
(greyN 0.9) (lightx4 green) (greyN 0.3)
|
||||||
|
|
||||||
-- | Items you start with.
|
-- | Items you start with.
|
||||||
startInvList :: [Item]
|
startInvList :: [Item]
|
||||||
@@ -115,8 +116,8 @@ startInventory = IM.fromList $ zip [0 ..] startInvList
|
|||||||
inventoryX :: Char -> [Item]
|
inventoryX :: Char -> [Item]
|
||||||
inventoryX c = case c of
|
inventoryX c = case c of
|
||||||
'A' ->
|
'A' ->
|
||||||
[ clickDetector ITEMDETECTOR
|
[ clickDetector x | x <- [minBound .. maxBound]
|
||||||
] <> fold
|
] <> [pulseChecker] <> fold
|
||||||
[ makeTypeCraftNum 1 TRANSFORMER
|
[ makeTypeCraftNum 1 TRANSFORMER
|
||||||
, makeTypeCraftNum 2 CAN
|
, makeTypeCraftNum 2 CAN
|
||||||
, makeTypeCraftNum 2 PIPE
|
, makeTypeCraftNum 2 PIPE
|
||||||
|
|||||||
@@ -1,7 +1,9 @@
|
|||||||
module Dodge.Creature.Update
|
module Dodge.Creature.Update (
|
||||||
( updateCreature
|
updateCreature,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Dodge.Creature.YourControl
|
||||||
|
import Dodge.Creature.State
|
||||||
import Dodge.Barreloid
|
import Dodge.Barreloid
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import Dodge.Humanoid
|
import Dodge.Humanoid
|
||||||
@@ -9,6 +11,7 @@ import Dodge.Lampoid
|
|||||||
|
|
||||||
updateCreature :: Creature -> World -> World
|
updateCreature :: Creature -> World -> World
|
||||||
updateCreature cr = case _crType cr of
|
updateCreature cr = case _crType cr of
|
||||||
|
Avatar{} -> crUpdate yourControl cr
|
||||||
Lampoid{} -> updateLampoid cr
|
Lampoid{} -> updateLampoid cr
|
||||||
Humanoid{} -> updateHumanoid cr
|
Humanoid{} -> updateHumanoid cr
|
||||||
Barreloid{} -> updateBarreloid cr
|
Barreloid{} -> updateBarreloid cr
|
||||||
|
|||||||
@@ -7,7 +7,6 @@ import Data.Foldable
|
|||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Dodge.Base.Coordinate
|
import Dodge.Base.Coordinate
|
||||||
import Dodge.Base.You
|
|
||||||
import Dodge.Creature.Impulse.Movement
|
import Dodge.Creature.Impulse.Movement
|
||||||
import Dodge.Creature.Impulse.UseItem
|
import Dodge.Creature.Impulse.UseItem
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
@@ -163,7 +162,7 @@ mouseActionsCr pkeys
|
|||||||
pressedMBEffectsTopInventory :: M.Map SDL.MouseButton Int -> World -> World
|
pressedMBEffectsTopInventory :: M.Map SDL.MouseButton Int -> World -> World
|
||||||
pressedMBEffectsTopInventory pkeys w
|
pressedMBEffectsTopInventory pkeys w
|
||||||
| isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = youhammerdown $ useRootItem 0 w
|
| isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = youhammerdown $ useRootItem 0 w
|
||||||
| isDown SDL.ButtonLeft && inTopInv = youhammerdown $ useItemLeftClick (you w) w
|
-- | isDown SDL.ButtonLeft && inTopInv = youhammerdown $ useItemLeftClick (you w) w
|
||||||
| isDown SDL.ButtonMiddle = w & wCam . camRot -~ rotation
|
| isDown SDL.ButtonMiddle = w & wCam . camRot -~ rotation
|
||||||
| otherwise = w
|
| otherwise = w
|
||||||
where
|
where
|
||||||
|
|||||||
@@ -46,8 +46,7 @@ data CrMvType
|
|||||||
deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
||||||
|
|
||||||
data HumanoidAI
|
data HumanoidAI
|
||||||
= YourAI
|
= ChaseAI
|
||||||
| ChaseAI
|
|
||||||
| InanimateAI
|
| InanimateAI
|
||||||
| SpreadGunAI
|
| SpreadGunAI
|
||||||
| PistolAI
|
| PistolAI
|
||||||
@@ -62,7 +61,12 @@ data HumanoidAI
|
|||||||
deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
||||||
|
|
||||||
data CreatureType
|
data CreatureType
|
||||||
= Humanoid
|
= Avatar
|
||||||
|
{ _skinHead :: Color
|
||||||
|
, _skinUpper :: Color
|
||||||
|
, _skinLower :: Color
|
||||||
|
}
|
||||||
|
| Humanoid
|
||||||
{ _skinHead :: Color
|
{ _skinHead :: Color
|
||||||
, _skinUpper :: Color
|
, _skinUpper :: Color
|
||||||
, _skinLower :: Color
|
, _skinLower :: Color
|
||||||
|
|||||||
@@ -114,6 +114,7 @@ data EquipItemType
|
|||||||
| BULLETBELTBRACER
|
| BULLETBELTBRACER
|
||||||
| BATTERYPACK
|
| BATTERYPACK
|
||||||
| AUTODETECTOR Detector
|
| AUTODETECTOR Detector
|
||||||
|
| PULSECHECKER
|
||||||
deriving (Eq, Ord, Show, Read)
|
deriving (Eq, Ord, Show, Read)
|
||||||
|
|
||||||
data LeftItemType
|
data LeftItemType
|
||||||
@@ -169,7 +170,7 @@ data Detector
|
|||||||
= ITEMDETECTOR
|
= ITEMDETECTOR
|
||||||
| CREATUREDETECTOR
|
| CREATUREDETECTOR
|
||||||
| WALLDETECTOR
|
| WALLDETECTOR
|
||||||
deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
deriving (Eq, Ord, Show, Read, Enum, Bounded) --Generic, Flat)
|
||||||
|
|
||||||
makeLenses ''ItemType
|
makeLenses ''ItemType
|
||||||
makeLenses ''HeldItemType
|
makeLenses ''HeldItemType
|
||||||
|
|||||||
@@ -37,7 +37,7 @@ data ProjectileUpdate
|
|||||||
deriving (Show, Eq, Ord, Read) --Generic, Flat)
|
deriving (Show, Eq, Ord, Read) --Generic, Flat)
|
||||||
|
|
||||||
data AmmoType
|
data AmmoType
|
||||||
= ProjectileAmmo
|
= LauncherAmmo
|
||||||
| BulletAmmo
|
| BulletAmmo
|
||||||
| BeltBulletAmmo
|
| BeltBulletAmmo
|
||||||
| ElectricalAmmo
|
| ElectricalAmmo
|
||||||
|
|||||||
@@ -6,7 +6,6 @@ module Dodge.HeldUse (
|
|||||||
mcUseHeld,
|
mcUseHeld,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Dodge.Item.HeldOffset
|
|
||||||
import Color
|
import Color
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
@@ -18,6 +17,7 @@ import Dodge.Data.MuzzleEffect
|
|||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import Dodge.Gas
|
import Dodge.Gas
|
||||||
import Dodge.Inventory.Lock
|
import Dodge.Inventory.Lock
|
||||||
|
import Dodge.Item.HeldOffset
|
||||||
import Dodge.Item.Weapon.Radar
|
import Dodge.Item.Weapon.Radar
|
||||||
import Dodge.Item.Weapon.Shatter
|
import Dodge.Item.Weapon.Shatter
|
||||||
import Dodge.Item.Weapon.TriggerType
|
import Dodge.Item.Weapon.TriggerType
|
||||||
@@ -160,8 +160,9 @@ makeMuzzleFlare mz itmtree cr = case mz ^. mzFlareType of
|
|||||||
TeslaGunFlare ->
|
TeslaGunFlare ->
|
||||||
cWorld . lWorld . lights
|
cWorld . lWorld . lights
|
||||||
.:~ LSParam (pos `v2z` 10) 100 (V3 0 0 1)
|
.:~ LSParam (pos `v2z` 10) 100 (V3 0 0 1)
|
||||||
-- .:~ tlsTimeRadColPos 1 100 (V3 0 0 1) (pos `v2z` 10)
|
|
||||||
where
|
where
|
||||||
|
-- .:~ tlsTimeRadColPos 1 100 (V3 0 0 1) (pos `v2z` 10)
|
||||||
|
|
||||||
itm = itmtree ^. ldtValue
|
itm = itmtree ^. ldtValue
|
||||||
(moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
|
(moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
|
||||||
pos = _crPos cr + rotateV (_crDir cr) moff
|
pos = _crPos cr + rotateV (_crDir cr) moff
|
||||||
@@ -522,7 +523,12 @@ createProjectile magtree muz itmtree cr = fromMaybe failsound $ do
|
|||||||
. startthesound
|
. startthesound
|
||||||
where
|
where
|
||||||
-- the sound should be moved to the projectile firing
|
-- the sound should be moved to the projectile firing
|
||||||
startthesound = soundMultiFrom [CrWeaponSound (_crID cr) j | j <- [0 .. 3]] (_crPos cr) tap4S Nothing
|
startthesound =
|
||||||
|
soundMultiFrom
|
||||||
|
[CrWeaponSound (_crID cr) j | j <- [0 .. 3]]
|
||||||
|
(_crPos cr)
|
||||||
|
tap4S
|
||||||
|
Nothing
|
||||||
failsound w' = case w' ^? input . mouseButtons . ix SDL.ButtonLeft of
|
failsound w' = case w' ^? input . mouseButtons . ix SDL.ButtonLeft of
|
||||||
Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
|
Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
|
||||||
_ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
|
_ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
|
||||||
|
|||||||
@@ -9,6 +9,7 @@ import Geometry
|
|||||||
import LensHelp
|
import LensHelp
|
||||||
import RandomHelp
|
import RandomHelp
|
||||||
|
|
||||||
|
|
||||||
updateHumanoid :: Creature -> World -> World
|
updateHumanoid :: Creature -> World -> World
|
||||||
updateHumanoid cr = case cr ^?! crType . humanoidAI of
|
updateHumanoid cr = case cr ^?! crType . humanoidAI of
|
||||||
ChaseAI ->
|
ChaseAI ->
|
||||||
@@ -168,7 +169,6 @@ updateHumanoid cr = case cr ^?! crType . humanoidAI of
|
|||||||
]
|
]
|
||||||
]
|
]
|
||||||
cr
|
cr
|
||||||
YourAI -> crUpdate yourControl cr
|
|
||||||
InanimateAI -> id
|
InanimateAI -> id
|
||||||
where
|
where
|
||||||
drawwp = DoActionIfElse NoAction (WdCrBlfromCrBl CrIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction))
|
drawwp = DoActionIfElse NoAction (WdCrBlfromCrBl CrIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction))
|
||||||
|
|||||||
@@ -72,6 +72,7 @@ itemFromEquipType et = case et of
|
|||||||
BULLETBELTPACK -> bulletBeltPack
|
BULLETBELTPACK -> bulletBeltPack
|
||||||
BULLETBELTBRACER -> bulletBeltBracer
|
BULLETBELTBRACER -> bulletBeltBracer
|
||||||
AUTODETECTOR d -> autoDetector d
|
AUTODETECTOR d -> autoDetector d
|
||||||
|
PULSECHECKER -> pulseChecker
|
||||||
|
|
||||||
itemFromLeftType :: LeftItemType -> Item
|
itemFromLeftType :: LeftItemType -> Item
|
||||||
itemFromLeftType lt = case lt of
|
itemFromLeftType lt = case lt of
|
||||||
|
|||||||
@@ -78,7 +78,7 @@ shellMag =
|
|||||||
{ _iaMax = 1
|
{ _iaMax = 1
|
||||||
, _iaLoaded = 1
|
, _iaLoaded = 1
|
||||||
}
|
}
|
||||||
, _amagType = ProjectileAmmo
|
, _amagType = LauncherAmmo
|
||||||
}
|
}
|
||||||
|
|
||||||
megaBattery :: Item
|
megaBattery :: Item
|
||||||
|
|||||||
@@ -65,6 +65,7 @@ fractionLoadedAmmo rs = fromIntegral (_iaLoaded rs) / fromIntegral (_iaMax rs)
|
|||||||
|
|
||||||
equipItemSPic :: EquipItemType -> Item -> SPic
|
equipItemSPic :: EquipItemType -> Item -> SPic
|
||||||
equipItemSPic et _ = case et of
|
equipItemSPic et _ = case et of
|
||||||
|
PULSECHECKER -> defSPic
|
||||||
MAGSHIELD -> defSPic
|
MAGSHIELD -> defSPic
|
||||||
FLAMESHIELD -> defSPic
|
FLAMESHIELD -> defSPic
|
||||||
FRONTARMOUR -> defSPic
|
FRONTARMOUR -> defSPic
|
||||||
|
|||||||
@@ -15,6 +15,7 @@ module Dodge.Item.Equipment (
|
|||||||
speedLegs,
|
speedLegs,
|
||||||
jumpLegs,
|
jumpLegs,
|
||||||
flameShield,
|
flameShield,
|
||||||
|
pulseChecker,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Geometry.Data
|
import Geometry.Data
|
||||||
@@ -123,3 +124,9 @@ wristInvisibility =
|
|||||||
& itUse . uequipEffect . eeOnEquip .~ ECamouflage Invisible
|
& itUse . uequipEffect . eeOnEquip .~ ECamouflage Invisible
|
||||||
& itUse . uequipEffect . eeOnRemove .~ ECamouflage FullyVisible
|
& itUse . uequipEffect . eeOnRemove .~ ECamouflage FullyVisible
|
||||||
& itType .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
|
& itType .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
|
||||||
|
|
||||||
|
pulseChecker :: Item
|
||||||
|
pulseChecker =
|
||||||
|
defaultEquipment
|
||||||
|
& itUse . uequipEffect . eeSite .~ GoesOnWrist
|
||||||
|
& itType .~ EQUIP PULSECHECKER
|
||||||
|
|||||||
@@ -88,7 +88,7 @@ itemToFunction itm = case itm ^. itType of
|
|||||||
ATTACH REMOTESCREEN -> RemoteScreenSF
|
ATTACH REMOTESCREEN -> RemoteScreenSF
|
||||||
ATTACH BULLETSYNTH -> AmmoModifierSF BulletAmmo
|
ATTACH BULLETSYNTH -> AmmoModifierSF BulletAmmo
|
||||||
ATTACH ZOOMSCOPE -> WeaponScopeSF
|
ATTACH ZOOMSCOPE -> WeaponScopeSF
|
||||||
ATTACH HOMINGMODULE -> AmmoTargetingSF ProjectileAmmo
|
ATTACH HOMINGMODULE -> AmmoTargetingSF LauncherAmmo
|
||||||
ATTACH AUGMENTEDHUD -> AugmentedHUDSF
|
ATTACH AUGMENTEDHUD -> AugmentedHUDSF
|
||||||
BULLETMOD BulletModTrajectory{} -> AmmoTargetingSF BulletAmmo
|
BULLETMOD BulletModTrajectory{} -> AmmoTargetingSF BulletAmmo
|
||||||
BULLETMOD BulletModPayload{} -> AmmoPayloadSF BulletAmmo
|
BULLETMOD BulletModPayload{} -> AmmoPayloadSF BulletAmmo
|
||||||
|
|||||||
@@ -18,7 +18,7 @@ launcher =
|
|||||||
& itUse . heldAim . aimStance .~ TwoHandOver
|
& itUse . heldAim . aimStance .~ TwoHandOver
|
||||||
& itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0
|
& itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0
|
||||||
& itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleLauncher
|
& itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleLauncher
|
||||||
& itAmmoSlots .~ singleAmmo ProjectileAmmo
|
& itAmmoSlots .~ singleAmmo LauncherAmmo
|
||||||
& itType .~ HELD LAUNCHER
|
& itType .~ HELD LAUNCHER
|
||||||
& itUse . heldParams . muzVel .~ ConstFloat 0
|
& itUse . heldParams . muzVel .~ ConstFloat 0
|
||||||
& itUse . heldParams . rifling .~ ConstFloat 0
|
& itUse . heldParams . rifling .~ ConstFloat 0
|
||||||
@@ -36,6 +36,6 @@ launcherX i =
|
|||||||
<*> pure DefaultFlareType
|
<*> pure DefaultFlareType
|
||||||
<*> pure MuzzleLauncher
|
<*> pure MuzzleLauncher
|
||||||
)
|
)
|
||||||
& itAmmoSlots .~ IM.fromList [(j,ProjectileAmmo) | j <- [0..i-1]]
|
& itAmmoSlots .~ IM.fromList [(j,LauncherAmmo) | j <- [0..i-1]]
|
||||||
where
|
where
|
||||||
angles = take i [0,2*pi/ fromIntegral i ..]
|
angles = take i [0,2*pi/ fromIntegral i ..]
|
||||||
|
|||||||
@@ -119,6 +119,7 @@ equipInfo eit = case eit of
|
|||||||
BULLETBELTBRACER -> "A container holding a long belt of bullets."
|
BULLETBELTBRACER -> "A container holding a long belt of bullets."
|
||||||
BATTERYPACK -> "A collection of batteries with a universal adapter."
|
BATTERYPACK -> "A collection of batteries with a universal adapter."
|
||||||
AUTODETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius. Pulses automatically. "
|
AUTODETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius. Pulses automatically. "
|
||||||
|
PULSECHECKER -> "A device that detects heartbeats."
|
||||||
|
|
||||||
--targetingInfo :: TargetingType -> String
|
--targetingInfo :: TargetingType -> String
|
||||||
--targetingInfo tt = case tt of
|
--targetingInfo tt = case tt of
|
||||||
|
|||||||
@@ -40,6 +40,7 @@ worldSPic cfig u =
|
|||||||
|
|
||||||
drawCreature :: Creature -> SPic
|
drawCreature :: Creature -> SPic
|
||||||
drawCreature cr = case _crType cr of
|
drawCreature cr = case _crType cr of
|
||||||
|
Avatar {} -> basicCrPict cr
|
||||||
Humanoid{} -> basicCrPict cr
|
Humanoid{} -> basicCrPict cr
|
||||||
Barreloid{} ->
|
Barreloid{} ->
|
||||||
picAtCrPos1
|
picAtCrPos1
|
||||||
|
|||||||
+12
-11
@@ -1,13 +1,14 @@
|
|||||||
{-| Collects together tree modules. -}
|
-- | Collects together tree modules.
|
||||||
module Dodge.Tree
|
module Dodge.Tree (
|
||||||
( module Dodge.Tree.Shift
|
module Dodge.Tree.Shift,
|
||||||
, module Dodge.Tree.GenerateStructure
|
module Dodge.Tree.GenerateStructure,
|
||||||
, module TreeHelp
|
module TreeHelp,
|
||||||
, module Dodge.Tree.Compose
|
module Dodge.Tree.Compose,
|
||||||
, module Dodge.Tree.Compose.Data
|
module Dodge.Data.MetaTree,
|
||||||
) where
|
) where
|
||||||
import Dodge.Tree.Shift
|
|
||||||
import Dodge.Tree.GenerateStructure
|
import Dodge.Data.MetaTree
|
||||||
import TreeHelp
|
|
||||||
import Dodge.Tree.Compose
|
import Dodge.Tree.Compose
|
||||||
import Dodge.Tree.Compose.Data
|
import Dodge.Tree.GenerateStructure
|
||||||
|
import Dodge.Tree.Shift
|
||||||
|
import TreeHelp
|
||||||
|
|||||||
@@ -16,7 +16,7 @@ module Dodge.Tree.Compose (
|
|||||||
attachOnward,
|
attachOnward,
|
||||||
attachOnward',
|
attachOnward',
|
||||||
showIntsString,
|
showIntsString,
|
||||||
module Dodge.Tree.Compose.Data,
|
module Dodge.Data.MetaTree
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
@@ -24,7 +24,7 @@ import Data.List (intersperse)
|
|||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Tuple
|
import Data.Tuple
|
||||||
import Dodge.Data.GenWorld
|
import Dodge.Data.GenWorld
|
||||||
import Dodge.Tree.Compose.Data
|
import Dodge.Data.MetaTree
|
||||||
import LensHelp
|
import LensHelp
|
||||||
import TreeHelp
|
import TreeHelp
|
||||||
|
|
||||||
|
|||||||
@@ -1,19 +0,0 @@
|
|||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE StrictData #-}
|
|
||||||
module Dodge.Tree.Compose.Data where
|
|
||||||
import Data.Tree
|
|
||||||
import Control.Lens
|
|
||||||
|
|
||||||
|
|
||||||
data MetaTree a b = MTree {_mtLabel :: b , _mtTree :: MetaNode a b, _mtBranches :: [MetaBranch a b] }
|
|
||||||
data MetaNode a b = NodeTree {_nodeTree :: Tree a} | NodeMTree {_nodeMetaTree :: MetaTree a b}
|
|
||||||
data MetaBranch a b = MBranch {_mbAttach :: a -> Maybe a, _mbTree :: MetaTree a b}
|
|
||||||
|
|
||||||
newtype SelfTree a = ST {_unST :: Tree (a,Either (Tree a) (SelfTree a))}
|
|
||||||
|
|
||||||
makeLenses ''MetaTree
|
|
||||||
makeLenses ''MetaBranch
|
|
||||||
makeLenses ''MetaNode
|
|
||||||
|
|
||||||
instance Functor (MetaTree a) where
|
|
||||||
fmap f (MTree b mn bs) = MTree (f b) (mn & nodeMetaTree %~ fmap f) (map (mbTree %~ fmap f) bs)
|
|
||||||
Reference in New Issue
Block a user