Graphviz.dcl 9.42 KB
Newer Older
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
1 2 3 4 5
// Peter Divianszky, 2007
// Code extended and adapted by Peter Achten, 2007, Pieter Koopman 2010

definition module Data.Graphviz

6
from StdOverloaded import class toString, class ==
7
from Data.Maybe import :: Maybe
Camil Staps's avatar
Camil Staps committed
8
from Data.GenEq import generic gEq
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373

// A digraph contains a title and a list of node definitions
:: Digraph
  = Digraph String [GraphAttribute] [NodeDef] (Maybe SelectedItem)
:: SelectedItem
  = SelectedItem Int

digraphTitle        :: !Digraph -> String
digraphAtts         :: !Digraph -> [GraphAttribute]
digraphNodes        :: !Digraph -> [NodeDef]
digraphSelectedItem :: !Digraph -> Maybe SelectedItem

// A node definition contains a unique identifier (an integer), a list of node attributes and a list of edge definitions.
// An edge definition contains an identifier (the id of the end node and edge attributes).
:: NodeDef
   = NodeDef !Int ![NodeState] ![NodeAttribute] [EdgeDef]

:: EdgeDef
  :== (!Int,![EdgeAttribute])

:: NodeState
  = NStAllEdgesFound !Bool // all edges of this node are known

// Convert digraph into list of strings.
// The strings are lines of the graphviz representation of the graph.
printDigraph :: !Digraph -> [String]

:: GraphAttribute
  = GAttDamping        Real
  | GAttK              Real
  | GAttURL            String
  | GAttBB             Rect
  | GAttBGColor        Color
  | GAttCenter         Bool
  | GAttCharset        String
  | GAttClusterRank    ClusterMode
  | GAttColorScheme    String
  | GAttComment        String
  | GAttCompound       Bool
  | GAttConcentrate    Bool
  | GAttDefaultDist    Real
  | GAttDim            Int
//  | GAttDirEdgeConstraints ... PA: ignored, neato only
  | GAttDPI            Real
  | GAttEpsilon        Real
  | GAttESep           Real
  | GAttFontColor      Color
  | GAttFontName       String
  | GAttFontNames      String
  | GAttFontPath       String
  | GAttFontSize       Real
  | GAttLabel          String
  | GAttLabelJust      String
  | GAttLabelLoc       String
  | GAttLandscape      Bool
  | GAttLayers         LayerList
  | GAttLayerSep       String
  | GAttLevelsGap      Real
  | GAttLP             DotPoint
  | GAttMargin         Margin
  | GAttMaxIter        Int
  | GAttMCLimit        Real
  | GAttMinDist        Real
  | GAttMode           String
  | GAttModeL          String
  | GAttMosek          Bool
  | GAttNodeSep        Real
  | GAttNoJustify      Bool
  | GAttNormalize      Bool
  | GAttNSLimit        Real
  | GAttNSLimit1       Real
  | GAttOrdering       String
  | GAttOrientation    String
  | GAttOutputOrder    OutputMode
  | GAttPad            Pad
  | GAttPage           Pointf
  | GAttPageDir        PageDir
  | GAttQuantum        Real
  | GAttRank           RankType
  | GAttRankDir        RankDir
  | GAttRankSep        Real
  | GAttRatio          Ratio
  | GAttRemInCross     Bool
  | GAttResolution     Real
  | GAttRoot           String
  | GAttRotate         Int
  | GAttSearchSize     Int
  | GAttShowBoxes      Int
  | GAttSize           Sizef //Pointf    // PA++
//  | GAttSplines        PA: skipped for the time being
  | GAttStart          StartType
  | GAttStylesheet     String
  | GAttTarget         String
  | GAttTrueColor      Bool
  | GAttViewport       ViewPort
  | GAttVoroMargin     Real

:: NodeAttribute
  = NAttURL            String
  | NAttColor          Color
  | NAttColorScheme    String
  | NAttComment        String
  | NAttDistortion     Real
  | NAttFillColor      Color
  | NAttFixedSize      Bool
  | NAttFontColor      Color
  | NAttFontName       String
  | NAttFontSize       Real
  | NAttGroup          String
  | NAttHeight         Real
  | NAttLabel          String
  | NAttLayer          LayerRange
  | NAttMargin         Margin
  | NAttNoJustify      Bool
  | NAttOrientation    Real
  | NAttPeripheries    Int
  | NAttPin            Bool
//  | NAttPos ...        PA: ignored for the time being
  | NAttRects          Rect
  | NAttRegular        Bool
  | NAttSamplePoints   Int
  | NAttShape          NodeShape
  | NAttShapeFile      String
  | NAttShowBoxes      Int
  | NAttSides          Int
  | NAttSkew           Real
  | NAttStyle          NodeStyle
  | NAttTarget         String
  | NAttTooltip        String
  | NAttWidth          Real
  | NAttZ              Real

:: EdgeAttribute
  = EAttURL            String
  | EAttArrowHead      ArrowType
  | EAttArrowSize      Real
  | EAttArrowTail      ArrowType
  | EAttColor          Color
  | EAttColorScheme    String
  | EAttComment        String
  | EAttConstraint     Bool
  | EAttDecorate       Bool
  | EAttDir            DirType
  | EAttEdgeURL        String
  | EAttEdgeHRef       String
  | EAttEdgeTarget     String
  | EAttEdgeTooltip    String
  | EAttFontColor      Color
  | EAttFontName       String
  | EAttFontSize       Real
  | EAttHeadURL        String
  | EAttHeadClip       Bool
  | EAttHeadHRef       String
  | EAttHeadLabel      String
  | EAttHeadPort       PortPos
  | EAttHeadTarget     String
  | EAttHeadTooltip    String
  | EAttHRef           String
  | EAttLabel          String
  | EAttLabelURL       String
  | EAttLabelAngle     Real
  | EAttLabelDistance  Real
  | EAttLabelFloat     Bool
  | EAttLabelFontColor Color
  | EAttLabelFontName  String
  | EAttLabelFontSize  Real
  | EAttLabelHref      String
  | EAttLabelTarget    String
  | EAttLabelTooltip   String
  | EAttLayer          LayerRange
  | EAttLen            Real
  | EAttLHead          String
  | EAttLP             DotPoint
  | EAttLTail          String
  | EAttMinLen         Int
  | EAttNoJustify      Bool
//  | EAttPos      PA: ignored for the time being
  | EAttSameHead       String
  | EAttSameTail       String
  | EAttShowBoxes      Int
  | EAttStyle          EdgeStyle
  | EAttTailURL        String
  | EAttTailClip       Bool
  | EAttTailHRef       String
  | EAttTailLabel      String
  | EAttTailPort       PortPos
  | EAttTailTarget     String
  | EAttTailTooltip    String
  | EAttTarget         String
  | EAttTooltip        String
  | EAttWeight         Real

:: ClusterMode
  = CMLocal
  | CMGlobal
  | CMNone

:: CompassPoint
  = CPN
  | CPNE
  | CPE
  | CPSE
  | CPS
  | CPSW
  | CPW
  | CPNW

:: DotPoint
  = DotPoint Real Real Bool

:: LayerId
  = LayerAll
  | LayerNr   Int
  | LayerName String

:: LayerList
  = LayerList [String]

:: LayerRange
  = LayerRange LayerId [LayerId]

:: Margin
  = SingleMargin Real
  | DoubleMargin Real Real

:: OutputMode
  = OMBreadthFirst
  | OMNodesFirst
  | OMEdgesFirst

:: Pad
  = SinglePad Real
  | DoublePad Real Real

:: PageDir
  = PDBL
  | PDBR
  | PDTL
  | PDTR
  | PDRB
  | PDRT
  | PDLB
  | PDLT

:: Pointf
  = Pointf Real Real

:: PortPos        // PA: for now only compass points are supported
  :== CompassPoint

:: RankDir
  = RDTB
  | RDLR
  | RDBT
  | RDRL

:: RankType
  = RTSame
  | RTMin
  | RTSource
  | RTMax
  | RTSink

:: Ratio
  = AspectRatio Real
  | RFill
  | RCompress
  | RExpand
  | RAuto

:: Rect
  = { llx :: Int
    , lly :: Int
    , urx :: Int
    , ury :: Int
    }

:: Sizef    // PA++
  = Sizef Real Real Bool

:: StartStyle
  = SSRegular
  | SSSelf
  | SSRandom

:: StartType
  = { startStyle :: Maybe StartStyle
    , startSeed  :: Maybe Int
    }

:: ViewPort
  = { vpW       :: Real
    , vpH       :: Real
    , vpZ       :: Maybe Real
    , vpXY      :: Maybe Pointf
    }

pointNode           :: [NodeAttribute] // attributes of a point-shaped node
hiddenNode          :: [NodeAttribute] // attributes of a hidden node


:: NodeShape
  = NShapeBox
  | NShapeCircle
  | NShapeDiamond
  | NShapeDoubleCircle
  | NShapeDoubleOctagon
  | NShapeEgg
  | NShapeEllipse
  | NShapeHexagon
  | NShapeHouse
  | NShapeInvTriangle
  | NShapeInvTrapezium
  | NShapeInvHouse
  | NShapeOctagon
  | NShapeMDiamond
  | NShapeMSquare
  | NShapeMCircle
  | NShapeParallelogram
  | NShapePentagon
  | NShapePlainText
  | NShapePolygon
  | NShapePoint
  | NShapeRect
  | NShapeRectangle
  | NShapeSeptagon
  | NShapeTrapezium
  | NShapeTriangle
  | NShapeTripleOctagon
  | NShapeNone

instance toString NodeShape
instance ==       NodeShape
derive gEq NodeShape // PK++

:: NodeStyle
  = NStyleFilled
  | NStyleInvis
  | NStyleDiagonals
  | NStyleRounded
  | NStyleDashed
  | NStyleDotted
  | NStyleSolid
  | NStyleBold

instance toString NodeStyle
instance ==       NodeStyle
derive gEq NodeStyle // PK++

:: EdgeStyle
  = EStyleSolid
  | EStyleBold
  | EStyleDashed
  | EStyleDotted
  | EStyleInvis

instance toString EdgeStyle
instance ==       EdgeStyle
derive gEq EdgeStyle // PK++

:: Color
  = RGB   Int  Int  Int
  | HSV   Real Real Real
  | Color String          // X11 1.2 color names; see rgb.txt

374
//* @type Color
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
375
CBlack   :== Color "black"
376
//* @type Color
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
377
CWhite   :== Color "white"
378
//* @type Color
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
379
CGray    :== Color "gray"
380
//* @type Color
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
381
CRed     :== Color "red"
382
//* @type Color
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
383
CGreen   :== Color "green"
384
//* @type Color
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
385
CBlue    :== Color "blue"
386
//* @type Color
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435
CYellow  :== Color "yellow"

instance toString Color
instance ==       Color
derive gEq Color // PK++

:: ArrowType =
  { closest       :: Arrow
  , furthest      :: Maybe Arrow
  }

:: Arrow =
  { open          :: Bool
  , side          :: Maybe Side
  , shape         :: ArrowShape
  }

:: Side
  = SideL
  | SideR

:: ArrowShape
  = AShapeBox
  | AShapeCrow
  | AShapeDiamond
  | AShapeDot
  | AShapeInv
  | AShapeNone
  | AShapeNormal
  | AShapeTee
  | AShapeVee

instance toString ArrowType
instance ==       ArrowType
derive gEq ArrowType // PK++

// direction of the edge
:: DirType
    = DTForward
    | DTBack
    | DTBoth
    | DTNone

instance toString DirType
instance ==       DirType
derive gEq DirType // PK++

layersep :== ":\t"