Version 19 of Diagram

The tk canvas is a great widget: it is extremely flexible and allows you to implement all-you-could-imagine on top of it.

Consider a graphical editor in which the user edits a diagram composed of some objects (UML entities, ER entities, etc) and connectors that links these objects. In these situations, the implementor can write the diagram code directly in a tk canvas. While writing GNU Ferret (http://www.gnu.org/software/ferret ) I felt the need for a library that supports diagrams on tk. So i wrote diagram.tcl

A diagram is composed of objects and connectors. Objects are composed of an arbitrary number of tagged canvas elements (text, lines, rectangles, etc). When you declare a new object, you also set a shape for it: rectangle, ovoid, romboid, etc. The shape does not need to be visible. Connectors are orthogonal editable paths of lines connecting diagram objects.

Download the diagram package at:

 http://es.gnu.org/~jemarch/downloads/diagram.tcl

There are several screenshots of diagrams made with diagram.tcl there:

 http://www.gnu.org/software/ferret/gallery/newdiag.html

and there:

  http://www.gnu.org/software/ferret/gallery/ferret1-newdiag.html

You can download some documentation from http://es.gnu.org/~jemarch/downloads/diagram.pdf

Usage example (double click on the connector line to modify it):

  lappend auto_path .
  package require BWidget
  package require diagram

  # Draw proc
  proc object_drawproc {dname oname location type} {

    set canvas [diagram::get_canvas $dname]

    # Draw some elements on this object
    $canvas create text \
        [expr [diagram::px $location] + 30] [expr [diagram::py $location] + 30] \
        -text "Object $oname at ([diagram::px $location],[diagram::py $location])" \
        -anchor w \
        -tags [list $dname $oname]

    # Bind for movement
    $canvas bind ${oname} <Button-1> \
        [list diagram::mark_drag_object $dname $oname %x %y]
    $canvas bind ${oname} <B1-Motion> \
        [list diagram::drag_object $dname $oname %x %y]


    # Return the new geometry of this object
    set bbox [$canvas bbox $oname]
    return [list \
                $location \
                [diagram::point [expr [lindex $bbox 2] + 30] [expr [lindex $bbox 3] + 30]]]
   }



  # Create a new diagram on .d
  diagram::create_diagram my_diagram .d
  pack .d -fill both -expand true

  # Create two objects
  diagram::create_object my_diagram object1 rectangle object_drawproc [diagram::point 10 10]
  diagram::update_object my_diagram object1
  diagram::create_object my_diagram object2 romboid object_drawproc [diagram::point 300 300]
  diagram::update_object my_diagram object2


  # Create a connector
  diagram::create_connector my_diagram my_connector object2 object1 "connector" {} -
  diagram::redraw_connector my_diagram my_connector