Remove graphviz dependency
This commit is contained in:
@@ -1,149 +0,0 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Dodge.Combine.Graph (combinationsDotGraph) where
|
||||
|
||||
import Dodge.Data.CombAmount
|
||||
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 [(CombAmount, 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 (RLAUNCHERX _) -> 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, _getCombAmount 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 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)]
|
||||
+1
-3
@@ -8,9 +8,7 @@ import Control.Monad
|
||||
import qualified Data.Aeson.Encode.Pretty as AEP
|
||||
import Data.ByteString.Lazy.Char8 (unpack)
|
||||
import Data.Maybe
|
||||
import qualified Data.Text.IO as TIO
|
||||
import Dodge.Base.Coordinate
|
||||
import Dodge.Combine.Graph
|
||||
import Dodge.Concurrent
|
||||
import Dodge.Config
|
||||
import Dodge.Data.Universe
|
||||
@@ -149,7 +147,7 @@ logOptions =
|
||||
generateGraphs :: IO ()
|
||||
generateGraphs = do
|
||||
createDirectoryIfMissing True "generated/graph"
|
||||
TIO.writeFile "generated/graph/itemCombinations.gv" combinationsDotGraph
|
||||
print "Placeholder for graph generation activated"
|
||||
|
||||
gameplayMenu :: Universe -> ScreenLayer
|
||||
gameplayMenu = titleOptionsMenu "OPTIONS:GAMEPLAY" gameplayMenuOptions
|
||||
|
||||
@@ -1,9 +0,0 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module GraphVizHelp
|
||||
( module GraphVizHelp
|
||||
, module Data.GraphViz
|
||||
) where
|
||||
import Data.GraphViz
|
||||
import ThirdPartyLens
|
||||
|
||||
mkCustomLenses ''GraphvizParams
|
||||
+1
-3
@@ -1,6 +1,4 @@
|
||||
module Picture.Arc
|
||||
( arcFull
|
||||
) where
|
||||
module Picture.Arc (arcFull) where
|
||||
|
||||
import Color
|
||||
import Geometry
|
||||
|
||||
Reference in New Issue
Block a user