UP | HOME

diagram.tcl

Table of Contents

Introduction

./images/diagram_sample.png

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.

Downloads

If you use diagram.tcl on your programs, i would like to heard any constructive comment about the library. Please, tell me about it at jemarch(at)gnu.org. Thanks! ;)

Usage example

The following tcl script makes use of the diagram package. Please note that, by now, the BWidget package is a prerequisite for running a diagram (i plan to eliminate this restriction in a near future. After all, the BWidget package is only used to provide the scrolled-window widget, easy replaceable). While running the example, try to double-click over connector lines in order to edit it.

# 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

Author: Jose E. Marchesi

Date: 2013-11-20 20:15:15 CET

HTML generated by org-mode 7.4 in emacs 24

Copyright (C) 2010 Jose E. Marchesi. Verbatim copying and redistribution of this entire page are permitted provided this notice is preserved.