152 lines
4.7 KiB
Haskell
152 lines
4.7 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.Combine.Graph
|
|
( combinationsDotGraph
|
|
) where
|
|
|
|
import Data.Bifunctor
|
|
import qualified Data.Graph.Inductive as FGL
|
|
import Data.GraphViz.Attributes.Complete
|
|
import Data.Text (Text)
|
|
import Data.Text.Lazy (pack, toStrict)
|
|
import Dodge.Combine.Combinations
|
|
import Dodge.Data.Item
|
|
import GraphHelp
|
|
import GraphVizHelp
|
|
import LensHelp
|
|
|
|
data CombClust
|
|
= CraftClust
|
|
| ItemClust
|
|
| JoinClust
|
|
deriving (Eq, Ord, Show, Enum, Bounded)
|
|
|
|
newtype CombNode = CombNode {_unCombNode :: Either ItemType [(ItAmount, ItemType)]}
|
|
deriving (Eq, Ord, Show)
|
|
|
|
instance Labellable CombNode where
|
|
toLabelValue (CombNode Right{}) = StrLabel (pack "")
|
|
toLabelValue (CombNode (Left ibt)) = StrLabel (pack $ show ibt)
|
|
|
|
newtype CombEdge = CombEdge {_unCombEdge :: Int}
|
|
deriving (Eq, Ord, Show)
|
|
|
|
instance Labellable CombEdge where
|
|
toLabelValue (CombEdge 0) = StrLabel (pack "")
|
|
toLabelValue (CombEdge x) = StrLabel (pack $ show x)
|
|
|
|
--bulletCombinations :: [([(ItAmount, ItemType)], Item)]
|
|
--bulletCombinations =
|
|
-- filter
|
|
-- ( (`elem` map totype bulletWeapons)
|
|
-- . totype
|
|
-- . snd
|
|
-- )
|
|
-- itemCombinations
|
|
-- where
|
|
-- totype = _itType
|
|
|
|
maxShowX :: ItemType -> Maybe Int
|
|
maxShowX = \case
|
|
HELD (BANGSTICK _) -> Just 2
|
|
HELD (VOLLEYGUN _) -> Just 3
|
|
HELD (MINIGUNX _) -> Just 3
|
|
HELD (GRAPECANNON _) -> Just 1
|
|
HELD (LAUNCHERX _) -> Just 2
|
|
-- HELD (LASWIDE _) -> Just 2
|
|
-- LASGUNFOCUS _ -> Just 2
|
|
_ -> Nothing
|
|
|
|
itemCombinationsEdges :: [(CombNode, CombNode, Int)]
|
|
itemCombinationsEdges = concatMap (f . over _2 _itType) itemCombinations
|
|
where
|
|
--itemCombinationsEdges = concatMap (f . over _2 (_iyBase . _itType)) bulletCombinations
|
|
|
|
f (abts, bt)
|
|
| bt `elem` bts = []
|
|
| (not . all belowNumX) bts = []
|
|
| otherwise = (CombNode $ Right abts, CombNode $ Left bt, 0) : map g abts
|
|
where
|
|
bts = map snd abts
|
|
g (am, bt') = (CombNode $ Left bt', CombNode $ Right abts, _getItAmount am)
|
|
|
|
combinationsGraph :: FGL.Gr CombNode CombEdge
|
|
combinationsGraph =
|
|
FGL.labnfilter (f . _unCombNode . snd)
|
|
. second CombEdge
|
|
$ mkGraphFromEdges itemCombinationsEdges
|
|
where
|
|
f Right{} = True
|
|
f (Left (CRAFT _)) = False
|
|
f (Left bt) = case maxShowX bt of
|
|
Nothing -> True
|
|
Just i -> _xNum (_ibtHeld bt) <= i
|
|
|
|
belowNumX :: ItemType -> Bool
|
|
belowNumX bt = case maxShowX bt of
|
|
Nothing -> True
|
|
Just i -> _xNum (_ibtHeld bt) <= i
|
|
|
|
--toCombNodeLabel :: CombNode -> String
|
|
--toCombNodeLabel (CombNode (Left ibt)) = show ibt
|
|
--toCombNodeLabel (CombNode Right{}) = ""
|
|
|
|
combinationsDotGraph :: Text
|
|
--combinationsDotGraph = toStrict . printDotGraph . graphToDot nonClusteredParams $ combinationsGraph
|
|
combinationsDotGraph =
|
|
toStrict . printDotGraph . graphToDot myParams $
|
|
combinationsGraph
|
|
|
|
-- $ first toCombNodeLabel combinationsGraph
|
|
|
|
myParams :: GraphvizParams Int CombNode CombEdge CombClust CombNode
|
|
myParams =
|
|
defaultParams -- {globalAttributes = [GraphAttrs [RankDir FromLeft]]}
|
|
& isDirectedL .~ True
|
|
-- & globalAttributesL .~ [GraphAttrs [RankDir FromLeft,Splines PolyLine]]
|
|
& globalAttributesL .~ [GraphAttrs [RankDir FromLeft]]
|
|
& clusterByL .~ clusterFunc
|
|
& isDotClusterL .~ const False
|
|
& clusterIDL .~ setClusterID
|
|
& fmtClusterL .~ clusterFormatting
|
|
& fmtEdgeL .~ edgeFormatting
|
|
& fmtNodeL .~ nodeFormatting
|
|
|
|
setClusterID :: CombClust -> GraphID
|
|
setClusterID = Num . Int . fromEnum
|
|
|
|
clusterFunc :: (Int, CombNode) -> NodeCluster CombClust (Int, CombNode)
|
|
clusterFunc n@(_, CombNode (Left bt)) = case bt of
|
|
CRAFT _ -> C CraftClust (N n)
|
|
_ -> C ItemClust (N n)
|
|
clusterFunc n = C JoinClust (N n)
|
|
|
|
clusterFormatting :: CombClust -> [GlobalAttributes]
|
|
clusterFormatting cl = case cl of
|
|
-- CraftClust -> [GraphAttrs [Rank SameRank]]
|
|
CraftClust -> []
|
|
_ -> []
|
|
|
|
edgeFormatting :: (Int, Int, CombEdge) -> Attributes
|
|
--edgeFormatting (_,_,CombEdge 0) = []
|
|
-- [ArrowHead (AType [(ArrMod OpenArrow BothSides ,NoArrow)])
|
|
-- ,SameTail (pack "b")
|
|
-- ]
|
|
edgeFormatting (_, _, ce) = case _unCombEdge ce of
|
|
0 ->
|
|
[ xLabel ce
|
|
, TailPort (CompassPoint East)
|
|
]
|
|
_ ->
|
|
[ xLabel ce
|
|
, ArrowHead (AType [(ArrMod OpenArrow BothSides, NoArrow)])
|
|
, HeadPort (CompassPoint West)
|
|
]
|
|
|
|
nodeFormatting :: (Int, CombNode) -> Attributes
|
|
nodeFormatting (_, CombNode Right{}) = [Shape PointShape]
|
|
nodeFormatting (_, CombNode cn@(Left bt)) = case bt of
|
|
--CRAFT _ -> [Shape DiamondShape,toLabel (CombNode cn)]
|
|
CRAFT _ -> [Color [WC (X11Color Green) Nothing], toLabel (CombNode cn)]
|
|
_ -> [Shape BoxShape, toLabel (CombNode cn)]
|