[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.
[https://web.archive.org/web/20151017182225if_/http://es.gnu.org/~jemarch/images/diagram_sample.png]
----Download the diagram [package] archived at [https://web.archive.org/web/20151017183245/http://es.gnu.org/~jemarch/downloads/diagram.tcl]
You can download some documentation archived at [https://web.archive.org/web/20151017181720/http://es.gnu.org/~jemarch/downloads/diagram.tclpdf]
You can download some documentation from http://es.gnu.org/~jemarch/downloads/diagram.pdf
----
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.
----
'''See also:'''
* [Simple editor for diagrams]
* [Playing UML]
<<categories>> Package | Graphics