# these simple samples have been developped by C. Mertz mertz@cena.fr in perl # tcl version by Jean-Paul Imbert imbert@cena.fr if {![info exists zincDemo]} { error "This script should be run from the zinc-widget demo." } set w .allOptions catch {destroy $w} toplevel $w wm title $w "Zinc All Option Demonstration" wm iconname $w "All options" frame $w.buttons pack $w.buttons -side bottom -fill x -pady 2m button $w.buttons.dismiss -text Dismiss -command "destroy $w" button $w.buttons.code -text "See Code" -command "showCode $w" pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 # The explanation displayed when running this demo label $w.label -text "Click on one of the following\nbuttons to get a list of Item\nattributes (or zinc options)\nwith their types.\n" -justify "left" pack $w.label -padx 10 -pady 10 # Creating the zinc widget zinc $w.zinc -width 1 -height 1 -font "10x20" -borderwidth 0 -relief "sunken" pack $w.zinc # Creating an instance of every item type #my %itemtypes; # These Items have fields! So the number of fields must be given at creation time foreach type {tabular track waypoint} { set itemtypes($type) [$w.zinc add $type 1 0] } # These items needs no specific initial values foreach type {group icon map reticle text window} { set itemtypes($type) [$w.zinc add $type 1] } # These items needs some coordinates at creation time # However curves usually needs more than 2 points. foreach type {arc curve rectangle} { set itemtypes($type) [$w.zinc add $type 1 "0 0 1 1"] } # Triangles item needs at least 3 points for the coordinates foreach type {triangles} { set itemtypes($type) [$w.zinc add $type 1 "0 0 1 1 2 2"] } proc showAllOptions { w type} { global itemtypes if [winfo exists .tl] {destroy .tl} toplevel .tl set title "All options of an item $type" #my @option return if {[string compare $type "zinc"]==0} { set options [$w.zinc configure] set typeopt "optionClass" set readopt "defaultValue" set title "All options of zinc widget" } else { set options [$w.zinc itemconfigure $itemtypes($type)]; set title "All attributes of an item $type" set typeopt "Type" set readopt "ReadOnly" } #.tl configure -title $title frame .tl.f1 set bgcolor "ivory" label .tl.f1.opt -text "Option" -background $bgcolor -relief "ridge" -width 20 label .tl.f1.typ -text $typeopt -background $bgcolor -relief "ridge" -width 20 label .tl.f1.rd -text $readopt -background $bgcolor -relief "ridge" -width 21 pack .tl.f1.opt .tl.f1.typ .tl.f1.rd -side left set nbelem [llength $options] frame .tl.f2 listbox .tl.f2.l1 -width 20 -height $nbelem listbox .tl.f2.l2 -width 20 -height $nbelem listbox .tl.f2.l3 -width 20 -height $nbelem pack .tl.f2.l1 .tl.f2.l2 .tl.f2.l3 -side left pack .tl.f1 .tl.f2 -side top -anchor "nw" # Remplissage des list box foreach elem $options { .tl.f2.l1 insert end [lindex $elem 0] .tl.f2.l2 insert end [lindex $elem 1] .tl.f2.l3 insert end [lindex $elem 3] } } pack [frame $w.col] set width 0; foreach type [lsort [array names itemtypes]] { if {[string length $type] > $width} { set width [string length $type] } } foreach type [lsort [array names itemtypes]] { button $w.col.$type -text "$type" -width $width -command {showAllOptions $w $type} pack $w.col.$type -pady 4 } button $w.col.b -text "zinc widget options" -command {showAllOptions $w "zinc"} pack $w.col.b -pady 4