) I felt the need for a library that supports diagrams on tk. So i wrote diagram.tclLV 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. MarchesiJosé 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 at:
http://es.gnu.org/~jemarch/downloads/diagram.tclYou 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:
