Diagram

José E. Marchesi: 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

LV 2007 Aug 30 What ever happened to ferret? The web page you mention seems to have almost no information from the mailing list archives, promises of a new release in November of 2006, discussions of a rewrite and work towards version 1.0.0, etc.)

Is the Tk library for ferret distributed with ferret?

I dont have too much time now to work in Ferret (I devote most of my time to http://www.gnupdf.org ). But I continue working on it from time to time! I definitely want to finish the program. -- José E. Marchesi

José E. Marchesi: 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 archived at [L1 ]

You can download some documentation archived at [L2 ]

If you use diagram.tcl on your programs, i would like to hear any constructive comment about the library. Please, tell me about it at jemarch(at)gnu.org or drop a note on this wiki page. Thanks! ;)

Usage example (double click on the connector lines ;)):

  # This code is in the public domain
  
  lappend auto_path .
  package require BWidget
  package require diagram
  
  
  ### Global Variables
  
  set object_counter 0
  set connector_counter 0
  set connected_object_1 {}
  set minimap_visible 0

  ### The minimap (or scroll map)
  proc toggle_mini_map_view {} {

    variable minimap_visible

    if {$minimap_visible} then {
       ;# Make the minimap
       diagram::create_scroll_minimap test_diag
       diagram::update_scroll_minimap test_diag
    } else {
       ;# Destroy the minimap
       diagram::destroy_scroll_minimap test_diag 
    }
  }
  
  ### Drawing routines (object contents) 
  proc rectangle_drawproc {dname oname location type} {
  
    set canvas [diagram::get_canvas $dname]
  
    # Draw some elements on this object
    $canvas create rectangle \
        [expr [diagram::px $location] + 5] [expr [diagram::py $location] + 5] \
        [expr [diagram::px $location] + 95] [expr [diagram::py $location] + 95] \
        -fill grey \
        -tags [list $dname $oname ${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
    return [list \
                $location \
                [diagram::point [expr [diagram::px $location] + 100] \
                     [expr [diagram::py $location] + 100]]]
  }

  proc circle_drawproc {dname oname location type} {

    set canvas [diagram::get_canvas $dname]
  
    # Draw some elements on this object
    $canvas create oval \
        [expr [diagram::px $location] + 5] [expr [diagram::py $location] + 5] \
        [expr [diagram::px $location] + 95] [expr [diagram::py $location] + 95] \
        -fill grey \
        -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
    return [list \
                $location \
                [diagram::point [expr [diagram::px $location] + 100] \
                     [expr [diagram::py $location] + 100]]]
  }
  
  proc romboid_drawproc {dname oname location type} {

    set canvas [diagram::get_canvas $dname]

    # Get the diagram canvas
    set c [diagram::get_canvas test_diag]

    # Draw some elements on this object
    set ulp [diagram::point \
                 [expr [diagram::px $location] + 5] \
                 [expr [diagram::py $location] + 5]]
    set lrp [diagram::point \
                 [expr [diagram::px $location] + 95] \
                 [expr [diagram::py $location] + 95]]
    $c create polygon \
            [expr [diagram::px $ulp] + (([diagram::px $lrp] - [diagram::px $ulp]) / 2)] [diagram::py $ulp] \
            [diagram::px $ulp] [expr [diagram::py $lrp] + (([diagram::py $ulp] - [diagram::py $lrp]) / 2)] \
            [diagram::px $ulp] [expr [diagram::py $lrp] + (([diagram::py $ulp] - [diagram::py $lrp]) / 2)] \
            [expr [diagram::px $ulp] + (([diagram::px $lrp] - [diagram::px $ulp]) / 2)] [diagram::py $lrp] \
            [expr [diagram::px $ulp] + (([diagram::px $lrp] - [diagram::px $ulp]) / 2)] [diagram::py $lrp] \
            [diagram::px $lrp] [expr [diagram::py $ulp] + (([diagram::py $lrp] - [diagram::py $ulp]) / 2)] \
            [diagram::px $lrp] [expr [diagram::py $ulp] + (([diagram::py $lrp] - [diagram::py $ulp]) / 2)] \
            [expr [diagram::px $ulp] + (([diagram::px $lrp] - [diagram::px $ulp]) / 2)] [diagram::py $ulp] \
        -fill grey -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
    return [list \
                $location \
                [diagram::point [expr [diagram::px $location] + 100] \
                     [expr [diagram::py $location] + 100]]]
  } 
  
  
  ### Manipulation of the modal state of the diagram
  
  proc select_mode {} {
  
    ;# Get the canvas of the diagram
    set c [diagram::get_canvas test_diag]

    ;# Remove any canvas-level binding
    bind $c <Button-1> {}

    ;# Change the cursor
    $c configure -cursor ""
  }
  
  proc new_connector_mode1 {} {
  
    ;# Get the canvas of the diagram
    set c [diagram::get_canvas test_diag]

    ;# Bind the diagram to select the first connected object
    bind $c <Button-1> [list new_connector_1 %x %y]

    ;# Change the cursor
    $c configure -cursor left_side
  } 
  
  proc new_connector_mode2 {} {
  
    ;# Get the canvas of the diagram
    set c [diagram::get_canvas test_diag]
  
    ;# Bind the diagram to select the second connected object
    bind $c <Button-1> [list new_connector_2 %x %y]
  
    ;# Change the cursor
    $c configure -cursor right_side
  }
  
  proc new_element_mode {element_type} {

    ;# Get the canvas of the diagram
    set c [diagram::get_canvas test_diag]
  
    ;# Bind the insert procedure depending of the element type
    bind $c <Button-1> [list new_object %x %y $element_type]
  
    ;# Change the cursor
    $c configure -cursor crosshair
  }
  
  ### Inserting new elements
  
  proc new_connector_1 {xpos ypos} {
  
    variable connected_object_1
  
    ;# Get the canvas of the diagram
    set c [diagram::get_canvas test_diag]
  
    ;# Correct coords
    set xpos [$c canvasx $xpos]
    set ypos [$c canvasy $ypos]
  
    ;# Get the canvas object behind the mouse pointer
    set selected_object [lindex [$c find overlapping $xpos $ypos $xpos $ypos] 0]
    if {$selected_object == ""} then {
        ;# No object => do nothing
        return
    }
  
    set object_name {}
    set sotags [$c gettags $selected_object]
    foreach tag $sotags {
        if {[string match {rectangle*} $tag] ||
            [string match {circle*} $tag] ||
            [string match {romboid*} $tag]} then {
            ;# This is an object
            set object_name $tag
        }
    }
    if {$object_name == ""} {
  
        ;# No object
        return

    }
  
    ;# Save the name of the first object to connect on
    ;# global data
    set connected_object_1 $object_name
    
    ;# Change the state
    new_connector_mode2
  }
  
  proc new_connector_2 {xpos ypos} {
  
    variable connected_object_1
    variable connector_counter
  
    ;# Get the canvas of the diagram
    set c [diagram::get_canvas test_diag]
  
    ;# Correct coords
    set xpos [$c canvasx $xpos]
    set ypos [$c canvasy $ypos]
  
    ;# Get the canvas object behind the mouse pointer
    set selected_object [lindex [$c find overlapping $xpos $ypos $xpos $ypos] 0]
    if {$selected_object == ""} then {
        ;# No object => do nothing
        return
    }
  
    set object_name {}
    set sotags [$c gettags $selected_object]
    foreach tag $sotags {
        if {[string match {rectangle*} $tag] ||
            [string match {circle*} $tag] ||
            [string match {romboid*} $tag]} then {
            ;# This is an object
            set object_name $tag
        }
    }
  
    if {$object_name == ""} {
  
        ;# No object
        return
  
    }
  
    ;# Create a new connector between object1 and object2
    set cname "connector[incr connector_counter]"
  
    diagram::create_connector test_diag \
        $cname \
        $connected_object_1 $object_name \
        $cname {} {}
  
    ;# Redraw it
    diagram::redraw_connector test_diag $cname
  
    ;# Change the state
    select_mode
  }

  
  proc new_object {xpos ypos type} {
  
    variable object_counter
  
    ;# Get the diagram canvas
    set c [diagram::get_canvas test_diag]
  
    ;# Correct coords
    set xpos [$c canvasx $xpos]
    set ypos [$c canvasy $ypos]
  
    ;# Create a new diagram object
    set object_name "$type[incr object_counter]"
    diagram::create_object test_diag \
        $object_name \
        $type \
        ${type}_drawproc \
        [list $xpos $ypos]
  
    ;# Make the object visible
    diagram::update_object test_diag $object_name
  
    ;# Return to selection mode
    select_mode
  }


  ### Saving and loading diagrams

  proc save_diagram {} {

    set filetypes {{"Diagram demo file" {.ddf}}}
    set save_file [tk_getSaveFile -initialdir "." \
                       -filetypes $filetypes -title "Save diagram"]

    if {$save_file == ""} then {
        return
    }

    ;# Output the diagram as xml
    set fout [open $save_file w]
    puts -nonewline $fout [diagram::export_xml test_diag]
    close $fout
  }


  proc load_diagram {} {

    set filetypes {{"Diagram demo file" {.ddf}}}
    set load_file [tk_getOpenFile -initialdir "." \
                       -filetypes $filetypes -title "Load diagram"]

    if {$load_file == ""} then {
        return
    }
    
    ;# Destroy the actual diagram
    diagram::destroy_diagram test_diag
    destroy .d

    ;# Import the xml of the loaded diagram
    set fin [open $load_file r]
    diagram::import_xml .d [read -nonewline $fin]
    close $fin

    pack .d -fill both -expand true
  }

  ### Launch the demo
  
  # Set up the GUI
  frame .buttonbar
  button .buttonbar.insert_rectangle \
    -text "Rectangle" \
    -command [list new_element_mode rectangle]
  button .buttonbar.insert_circle \
    -text "Circle" \
    -command [list new_element_mode circle]
  button .buttonbar.insert_romboid \
    -text "Romboid" \
    -command [list new_element_mode romboid]
  button .buttonbar.insert_connector \
    -text "Connect two objects" \
    -command [list new_connector_mode1]
  checkbutton .buttonbar.minimap_check \
    -variable minimap_visible \
    -command toggle_mini_map_view
  label .buttonbar.minimap_label \
    -text "toggle mini map"
  button .buttonbar.save_diagram \
    -text "Save this diagram to a file" \
    -command [list save_diagram]
  button .buttonbar.load_diagram \
    -text "Load a diagram from a file" \
    -command [list load_diagram]

  pack .buttonbar.insert_rectangle \
    .buttonbar.insert_circle \
    .buttonbar.insert_romboid \
    .buttonbar.insert_connector \
    .buttonbar.minimap_check \
    .buttonbar.minimap_label \
    .buttonbar.save_diagram \
    .buttonbar.load_diagram \
    -side left
  pack .buttonbar -side top

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

ARR (30 august 2007) Fixed two bugs in example: removed double lines in save and load procs. It works fine now.

See http://tcllib.sourceforge.net/doc/draw_diagram.html for info on the tklib diagram module.

Are there demos for it?

AM (18 january 2007) Yes, there are a couple of examples in the examples/diagram directory.

AD (07 february 2024) I've tried the example listed here using the package linked [https://web.archive.org/web/20151017183245/http://es.gnu.org/~jemarch/downloads/diagram.tcl ] and it doesn't work in my system (MagicSplat), after successfully requiring the package it doesn't knows any proc in the diagram namespace

% ::diagram::create_diagram
invalid command name "::diagram::create_diagram"

don't know the reason but querying the procs and vars of namespace I get strange results

% info vars ::diagram::*
::diagram::Snit_typemethodInfo ::diagram::Snit_info ::diagram::Snit_optionInfo ::diagram::Snit_methodInfo
% info procs ::diagram::*
::diagram::Snit_methodreset ::diagram::Snit_destructor ::diagram::Snit_constructor ::diagram::Snit_typeconstructor ::diagram::Snit_instanceVars

See also:

Category Package

Category Graphics