  -*- coding : utf-8 -*-
;;;;****************************************************************************
FILE :                graph-dot.lisp
;;;;LANGUAGE:           Common-Lisp
;;;;SYSTEM:             Common-Lisp
USER - INTERFACE :      
;;;;DESCRIPTION
;;;;
;;;;    Generate dot files from graphs (graph-class).
;;;;

     < PJB >    <  >
MODIFICATIONS
     2004 - 08 - 06 < PJB > Added defgeneric .
     2003 - 05 - 16 < PJB > Converted from emacs lisp .
     2003 - 05 - 14 < PJB > Extracted from pjb - cvs .

;;;;LEGAL
     AGPL3
;;;;
     Copyright    2003 - 2016
;;;;
;;;;    This program is free software: you can redistribute it and/or modify
     it under the terms of the GNU Affero General Public License as published by
     the Free Software Foundation , either version 3 of the License , or
;;;;    (at your option) any later version.
;;;;
;;;;    This program is distributed in the hope that it will be useful,
;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     GNU Affero General Public License for more details .
;;;;
     You should have received a copy of the GNU Affero General Public License
;;;;    along with this program.  If not, see </>
;;;;****************************************************************************
(eval-when (:compile-toplevel :load-toplevel :execute)
  (setf *readtable* (copy-readtable nil)))
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.GRAPHVIZ.GRAPH-DOT"
  (:use "COMMON-LISP"
        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST"
        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.GRAPH")
  (:export "GENERATE-DOT")
  (:documentation
   "
This package exports methods for GRAPH to generate dot(1) files.



License:

    AGPL3

    Copyright Pascal J. Bourguignon 2003 - 2012

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.
    If not, see </>

"))
(in-package "COM.INFORMATIMAGO.COMMON-LISP.GRAPHVIZ.GRAPH-DOT")




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Generating dot files

(defun dot-ident (ident)
  "
RETURN: A string containing the ident with the dash removed.
"
  (remove (character "-") (string ident)))


(defgeneric generate-dot (graph)
  (:documentation "RETURN: a string containing the dot file contents for the GRAPH."))

(defmethod generate-dot ((self element-class))
  "
RETURN: A string containing the dot file data for this ELEMENT-CLASS node.
"
  (let ((style     (or (get-property self :dot-style) "filled"))
        (color     (or (get-property self :dot-color) "black"))
        (fillcolor (or (get-property self :dot-fill-color) "LightYellow"))
        (label     (or (get-property self :dot-label)
                       (let ((pnames (property-names self)))
                         (cond
                           ((null pnames) nil)
                           ((= 1 (length pnames))
                            (format nil "~A" (get-property self (car pnames))))
                           (t (unsplit-string
                               (mapcar
                                (lambda (prop-name)
                                  (if (let ((name (symbol-name prop-name)))
                                        (and (< 4 (length name) )
                                             (string-equal
                                              "DOT-"
                                              (subseq
                                               (symbol-name prop-name) 0 4))))
                                      ""
                                      (format nil "~A = ~A" prop-name
                                              (get-property self prop-name))))
                                pnames)
                               #\Newline))))
                       (dot-ident (ident self)))))
    (format nil "~A [ style=~A color=~A fillcolor=~A label=\"~A\" ];~%"
            (dot-ident (ident self)) style color fillcolor label)))




(defmethod generate-dot ((self edge-class))
  "
RETURN: A string containing the dot file data for this edge.
"
  (format nil "~A -> ~A ;~%"
          (dot-ident (ident (car (nodes self))))
          (dot-ident (ident (cdr (nodes self))))))




(defmethod generate-dot ((self directed-edge-class))
  "
RETURN: A string containing the dot file data for this edge.
"
  (format nil "~A -> ~A ;~%"
          (dot-ident (ident (from self)))
          (dot-ident (ident (to self)))))



(defmethod generate-dot ((self weighted-directed-edge-class))
  "
RETURN: A string containing the dot file data for this edge.
"
  (format nil "~A -> ~A [ weight=~D, style=~A, color=~A ];~%"
          (dot-ident (ident (from self)))
          (dot-ident (ident (to   self)))
          (weight self)
          (cond
            ((< (weight self) 3)  "dotted")
            ((< (weight self) 10) "dashed")
            ((< (weight self) 15) "solid")
            (t                    "bold"))
          "black"))




  ( DESCRIPTION ( car ( element - list (   ) ) ) )
;;; (MAP-ELEMENTS (NODES g) (lambda (elem) (ident elem)))
  ( car ( element - list (   ) ) )


(defmethod generate-dot ((self graph-class))
  "
RETURN: A string containing the dot file data for this graph.
NOTE:   dot graphs are directed.
"
  (apply
   (function concatenate) 'string
   (flatten
    (list
     (format nil "digraph ~A~%" (or (get-property self :name) "Untitled"))
     (format
         nil
       (concatenate 'string
         "{~%"
         (format nil "rankdir=~A;~%" (or (get-property self :dot-rankdir) "TB"))
         (format nil "concentrate=~:[false~;true~];~%" (get-property self :dot-concentrate))

         "// attributes of graph:~%"
         "// page=8,11.4;    // page size (NeXTprinter:A4).~%"
         "// size=30,8;     // graph size (please edit to fit).~%"
         "// rotate=90;    // graph orientation (please edit to fit).~%"
         "page=300;~%"
         "size=300;~%"
         "rotate=90;~%"
         "// ratio=fill;  // fill the size (or compress, auto, aspect/ratio).~%"
         "nodesep=0.3;~%"
         "ranksep=0.3;~%"
         "center=1;~%"
         "splines=true;~%"
         "// common attributes of NODES:~%"
         "node [height=0.2 width=0.5 shape=box fontsize=8 fontname=Futura] ;~%"))
     (map-elements 'list (nodes self) (lambda (node) (generate-dot node)))
     (format nil "// common attributes of edges:~%edge [style=solid];~%")
     (map-elements 'list (edges self) (lambda (edge) (generate-dot edge)))
     (format nil "}~%")))))


;;;; THE END ;;;;

****************************************************************************
LANGUAGE:           Common-Lisp
SYSTEM:             Common-Lisp
DESCRIPTION

    Generate dot files from graphs (graph-class).

LEGAL


    This program is free software: you can redistribute it and/or modify
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    along with this program.  If not, see </>
****************************************************************************
 without even the implied warranty of

 Generating dot files
 (MAP-ELEMENTS (NODES g) (lambda (elem) (ident elem)))
 THE END ;;;;
  -*- coding : utf-8 -*-
FILE :                graph-dot.lisp
USER - INTERFACE :      

     < PJB >    <  >
MODIFICATIONS
     2004 - 08 - 06 < PJB > Added defgeneric .
     2003 - 05 - 16 < PJB > Converted from emacs lisp .
     2003 - 05 - 14 < PJB > Extracted from pjb - cvs .

     AGPL3
     Copyright    2003 - 2016
     it under the terms of the GNU Affero General Public License as published by
     the Free Software Foundation , either version 3 of the License , or
     GNU Affero General Public License for more details .
     You should have received a copy of the GNU Affero General Public License
(eval-when (:compile-toplevel :load-toplevel :execute)
  (setf *readtable* (copy-readtable nil)))
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.GRAPHVIZ.GRAPH-DOT"
  (:use "COMMON-LISP"
        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST"
        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.GRAPH")
  (:export "GENERATE-DOT")
  (:documentation
   "
This package exports methods for GRAPH to generate dot(1) files.



License:

    AGPL3

    Copyright Pascal J. Bourguignon 2003 - 2012

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.
    If not, see </>

"))
(in-package "COM.INFORMATIMAGO.COMMON-LISP.GRAPHVIZ.GRAPH-DOT")





(defun dot-ident (ident)
  "
RETURN: A string containing the ident with the dash removed.
"
  (remove (character "-") (string ident)))


(defgeneric generate-dot (graph)
  (:documentation "RETURN: a string containing the dot file contents for the GRAPH."))

(defmethod generate-dot ((self element-class))
  "
RETURN: A string containing the dot file data for this ELEMENT-CLASS node.
"
  (let ((style     (or (get-property self :dot-style) "filled"))
        (color     (or (get-property self :dot-color) "black"))
        (fillcolor (or (get-property self :dot-fill-color) "LightYellow"))
        (label     (or (get-property self :dot-label)
                       (let ((pnames (property-names self)))
                         (cond
                           ((null pnames) nil)
                           ((= 1 (length pnames))
                            (format nil "~A" (get-property self (car pnames))))
                           (t (unsplit-string
                               (mapcar
                                (lambda (prop-name)
                                  (if (let ((name (symbol-name prop-name)))
                                        (and (< 4 (length name) )
                                             (string-equal
                                              "DOT-"
                                              (subseq
                                               (symbol-name prop-name) 0 4))))
                                      ""
                                      (format nil "~A = ~A" prop-name
                                              (get-property self prop-name))))
                                pnames)
                               #\Newline))))
                       (dot-ident (ident self)))))
    (format nil "~A [ style=~A color=~A fillcolor=~A label=\"~A\" ];~%"
            (dot-ident (ident self)) style color fillcolor label)))




(defmethod generate-dot ((self edge-class))
  "
RETURN: A string containing the dot file data for this edge.
"
  (format nil "~A -> ~A ;~%"
          (dot-ident (ident (car (nodes self))))
          (dot-ident (ident (cdr (nodes self))))))




(defmethod generate-dot ((self directed-edge-class))
  "
RETURN: A string containing the dot file data for this edge.
"
  (format nil "~A -> ~A ;~%"
          (dot-ident (ident (from self)))
          (dot-ident (ident (to self)))))



(defmethod generate-dot ((self weighted-directed-edge-class))
  "
RETURN: A string containing the dot file data for this edge.
"
  (format nil "~A -> ~A [ weight=~D, style=~A, color=~A ];~%"
          (dot-ident (ident (from self)))
          (dot-ident (ident (to   self)))
          (weight self)
          (cond
            ((< (weight self) 3)  "dotted")
            ((< (weight self) 10) "dashed")
            ((< (weight self) 15) "solid")
            (t                    "bold"))
          "black"))




  ( DESCRIPTION ( car ( element - list (   ) ) ) )
  ( car ( element - list (   ) ) )


(defmethod generate-dot ((self graph-class))
  "
RETURN: A string containing the dot file data for this graph.
NOTE:   dot graphs are directed.
"
  (apply
   (function concatenate) 'string
   (flatten
    (list
     (format nil "digraph ~A~%" (or (get-property self :name) "Untitled"))
     (format
         nil
       (concatenate 'string
         "{~%"
         (format nil "rankdir=~A;~%" (or (get-property self :dot-rankdir) "TB"))
         (format nil "concentrate=~:[false~;true~];~%" (get-property self :dot-concentrate))

         "// attributes of graph:~%"
         "// page=8,11.4;    // page size (NeXTprinter:A4).~%"
         "// size=30,8;     // graph size (please edit to fit).~%"
         "// rotate=90;    // graph orientation (please edit to fit).~%"
         "page=300;~%"
         "size=300;~%"
         "rotate=90;~%"
         "// ratio=fill;  // fill the size (or compress, auto, aspect/ratio).~%"
         "nodesep=0.3;~%"
         "ranksep=0.3;~%"
         "center=1;~%"
         "splines=true;~%"
         "// common attributes of NODES:~%"
         "node [height=0.2 width=0.5 shape=box fontsize=8 fontname=Futura] ;~%"))
     (map-elements 'list (nodes self) (lambda (node) (generate-dot node)))
     (format nil "// common attributes of edges:~%edge [style=solid];~%")
     (map-elements 'list (edges self) (lambda (edge) (generate-dot edge)))
     (format nil "}~%")))))


