Graphviz.dcl 9.94 KB
Newer Older
Bas Lijnse's avatar
Bas Lijnse committed
1 2 3 4 5 6 7 8 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
// Peter Divianszky, 2007
// Code extended and adapted by Peter Achten, 2007, Pieter Koopman 2010

definition module Graphviz

from   StdOverloaded import class toString
import StdMaybe
import GenEq

// 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
	= GAtt_Damping        Real
	| GAtt_K              Real
	| GAtt_URL            String
	| GAtt_bb             Rect
	| GAtt_bgcolor        Color
	| GAtt_center         Bool
	| GAtt_charset        String
	| GAtt_clusterrank    ClusterMode
	| GAtt_colorscheme    String
	| GAtt_comment        String
	| GAtt_compound       Bool
	| GAtt_concentrate    Bool
	| GAtt_defaultdist    Real
	| GAtt_dim            Int
//	| GAtt_diredgeconstraints ... PA: ignored, neato only
	| GAtt_dpi            Real
	| GAtt_epsilon        Real
	| GAtt_esep           Real
	| GAtt_fontcolor      Color
	| GAtt_fontname       String
	| GAtt_fontnames      String
	| GAtt_fontpath       String
	| GAtt_fontsize       Real
	| GAtt_label          String
	| GAtt_labeljust      String
	| GAtt_labelloc       String
	| GAtt_landscape      Bool
	| GAtt_layers         LayerList
	| GAtt_layersep       String
	| GAtt_levelsgap      Real
	| GAtt_lp             DotPoint
	| GAtt_margin         Margin
	| GAtt_maxiter        Int
	| GAtt_mclimit        Real
	| GAtt_mindist        Real
	| GAtt_mode           String
	| GAtt_model          String
	| GAtt_mosek          Bool
	| GAtt_nodesep        Real
	| GAtt_nojustify      Bool
	| GAtt_normalize      Bool
	| GAtt_nslimit        Real
	| GAtt_nslimit1       Real
	| GAtt_ordering       String
	| GAtt_orientation    String
	| GAtt_outputorder    OutputMode
	| GAtt_pad            Pad
	| GAtt_page           Pointf
	| GAtt_pagedir        PageDir
	| GAtt_quantum        Real
	| GAtt_rank           RankType
	| GAtt_rankdir        RankDir
	| GAtt_ranksep        Real
	| GAtt_ratio          Ratio
	| GAtt_remincross     Bool
	| GAtt_resolution     Real
	| GAtt_root           String
	| GAtt_rotate         Int
	| GAtt_searchsize     Int
	| GAtt_showboxes      Int
	| GAtt_size           Sizef //Pointf		// PA++
//	| GAtt_splines        PA: skipped for the time being
	| GAtt_start          StartType
	| GAtt_stylesheet     String
	| GAtt_target         String
	| GAtt_truecolor      Bool
	| GAtt_viewport       ViewPort
	| GAtt_voro_margin    Real
:: NodeAttribute
    = NAtt_URL            String
    | NAtt_color          Color
    | NAtt_colorscheme    String
    | NAtt_comment        String
    | NAtt_distortion     Real
    | NAtt_fillcolor      Color
    | NAtt_fixedsize      Bool
    | NAtt_fontcolor      Color
    | NAtt_fontname       String
    | NAtt_fontsize       Real
    | NAtt_group          String
    | NAtt_height         Real
    | NAtt_label          String
    | NAtt_layer          LayerRange
    | NAtt_margin         Margin
    | NAtt_nojustify      Bool
    | NAtt_orientation    Real
    | NAtt_peripheries    Int
    | NAtt_pin            Bool
//  | NAtt_pos ...        PA: ignored for the time being
    | NAtt_rects          Rect
    | NAtt_regular        Bool
    | NAtt_samplepoints   Int
    | NAtt_shape          NodeShape
    | NAtt_shapefile      String
    | NAtt_showboxes      Int
    | NAtt_sides          Int
    | NAtt_skew           Real
    | NAtt_style          NodeStyle
    | NAtt_target         String
    | NAtt_tooltip        String
    | NAtt_width          Real
    | NAtt_z              Real
:: EdgeAttribute
    = EAtt_URL            String
    | EAtt_arrowhead      ArrowType
    | EAtt_arrowsize      Real
    | EAtt_arrowtail      ArrowType
    | EAtt_color          Color
    | EAtt_colorscheme    String
    | EAtt_comment        String
    | EAtt_constraint     Bool
    | EAtt_decorate       Bool
    | EAtt_dir            DirType
    | EAtt_edgeURL        String
    | EAtt_edgehref       String
    | EAtt_edgetarget     String
    | EAtt_edgetooltip    String
    | EAtt_fontcolor      Color
    | EAtt_fontname       String
    | EAtt_fontsize       Real
    | EAtt_headURL        String
    | EAtt_headclip       Bool
    | EAtt_headhref       String
    | EAtt_headlabel      String
    | EAtt_headport       PortPos
    | EAtt_headtarget     String
    | EAtt_headtooltip    String
    | EAtt_href           String
    | EAtt_label          String
    | EAtt_labelURL       String
    | EAtt_labelangle     Real
    | EAtt_labeldistance  Real
    | EAtt_labelfloat     Bool
    | EAtt_labelfontcolor Color
    | EAtt_labelfontname  String
    | EAtt_labelfontsize  Real
    | EAtt_labelhref      String
    | EAtt_labeltarget    String
    | EAtt_labeltooltip   String
    | EAtt_layer          LayerRange
    | EAtt_len            Real
    | EAtt_lhead          String
    | EAtt_lp             DotPoint
    | EAtt_ltail          String
    | EAtt_minlen         Int
    | EAtt_nojustify      Bool
//  | EAtt_pos			PA: ignored for the time being
	| EAtt_samehead       String
	| EAtt_sametail       String
	| EAtt_showboxes      Int
	| EAtt_style          EdgeStyle
	| EAtt_tailURL        String
	| EAtt_tailclip       Bool
	| EAtt_tailhref       String
	| EAtt_taillabel      String
	| EAtt_tailport       PortPos
	| EAtt_tailtarget     String
	| EAtt_tailtooltip    String
	| EAtt_target         String
	| EAtt_tooltip        String
	| EAtt_weight         Real
:: ClusterMode
	= CM_local | CM_global | CM_none
:: CompassPoint
	= CP_n | CP_ne | CP_e | CP_se | CP_s | CP_sw | CP_w | CP_nw
:: 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
	= OM_breadthfirst | OM_nodesfirst | OM_edgesfirst
:: Pad
	= SinglePad Real
	| DoublePad Real Real
:: PageDir
	= PD_BL | PD_BR | PD_TL | PD_TR | PD_RB | PD_RT | PD_LB | PD_LT
:: Pointf
	= Pointf Real Real
:: PortPos				// PA: for now only compass points are supported
	:== CompassPoint
:: RankDir
	= RD_TB | RD_LR | RD_BT | RD_RL
:: RankType
	= RT_same | RT_min | RT_source | RT_max | RT_sink
:: Ratio
	= AspectRatio Real
	| R_fill
	| R_compress
	| R_expand
	| R_auto
:: Rect
    = {llx :: Int,lly :: Int, urx :: Int, ury :: Int}
:: Sizef		// PA++
	= Sizef Real Real Bool
:: StartStyle
	= SS_regular | SS_self | SS_random
:: StartType
	= { startStyle :: Maybe StartStyle
	  , startSeed  :: Maybe Int
	  }
:: ViewPort
	= { vp_W       :: Real
	  , vp_H       :: Real
	  , vp_Z       :: Maybe Real
	  , vp_xy      :: Maybe Pointf
	  }

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


:: NodeShape 
    = NShape_box
    | NShape_circle 
    | NShape_diamond
    | NShape_doublecircle
    | NShape_doubleoctagon
    | NShape_egg
    | NShape_ellipse 
    | NShape_hexagon
    | NShape_house
    | NShape_invtriangle
    | NShape_invtrapezium
    | NShape_invhouse
    | NShape_octagon
    | NShape_Mdiamond
    | NShape_Msquare
    | NShape_Mcircle
    | NShape_parallelogram 
    | NShape_pentagon
    | NShape_plainText
    | NShape_polygon
    | NShape_point 
    | NShape_rect
    | NShape_rectangle
    | NShape_septagon
    | NShape_trapezium
    | NShape_triangle
    | NShape_tripleoctagon
    | NShape_none
instance toString NodeShape
instance ==       NodeShape
derive gEq NodeShape // PK++

::  NodeStyle
    = NStyle_filled
    | NStyle_invis
    | NStyle_diagonals
    | NStyle_rounded
    | NStyle_dashed
    | NStyle_dotted
    | NStyle_solid
    | NStyle_bold
instance toString NodeStyle
instance ==       NodeStyle
derive gEq NodeStyle // PK++

:: EdgeStyle 
    = EStyle_solid 
    | EStyle_bold
    | EStyle_dashed
    | EStyle_dotted
    | EStyle_invis
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

C_black   :== Color "black"
C_white   :== Color "white"
C_gray    :== Color "gray"
C_red     :== Color "red"
C_green   :== Color "green"
C_blue    :== Color "blue"
C_yellow  :== 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
    = Side_l
    | Side_r
:: ArrowShape
    = AShape_box
    | AShape_crow
    | AShape_diamond
    | AShape_dot
    | AShape_inv
    | AShape_none
    | AShape_normal
    | AShape_tee
    | AShape_vee
instance toString ArrowType
instance ==       ArrowType
derive gEq ArrowType // PK++

// direction of the edge
:: DirType
    = DT_forward 
    | DT_back 
    | DT_both 
    | DT_none
instance toString DirType
instance ==       DirType
derive gEq DirType // PK++

layersep :== ":\t"