ulis, 2005-12-17. Un package rapidement hacké pour afficher dynamiquement des points.
ulis, 2006-01-21. Paramètre %widget%.
Pourquoi
Pour animer Tk.
Comment
Avec le canvas.
Installation
Utilisation
package require ASimplePlot plot .p -cmd myCmd -x:color green
création d'un widget
plot <path> [<option> <value>]...
récupération d'une valeur par défaut
plot get <option>
modification d'une valeur par défaut
plot set [<option> <value>]...
-bg couleur de fond -background couleur de fond -bd largeur de bordure -borderwidth largeur de bordure -height hauteur -relief relief -width largeur -cmd commande -command commande -color couleur des points -delay délai entre deux invocation de la commande -xaxis:c couleur de l'axe des x -xaxis:d delta des graduations de l'axe des x -xaxis:x abscisse de l'origine de l'axe des x -xaxis:y ordonnée de l'origine de l'axe des x -yaxis:c couleur de l'axe des y -yaxis:d delta des graduations de l'axe des y -yaxis:x abscisse de l'origine de l'axe des y -yaxis:y ordonnée de l'origine de l'axe des y
ajout d'un point
<path> append <value>
récupération de la valeur d'une option
<path> cget <option>
réinitialisation des points
<path> clear
modification de la valeur des options
<path> config [<option> <value>]...
invocation de la commande
<path> invoke
démarrage de l'invocation automatique de la commande
<path> start
arrêt de l'invocation automatique de la commande
<path> stop
Package ASimplePlot.tcl
if {[info exists ::plot::version]} { return } namespace eval ::plot \ { # beginning of ::plot namespace definition # #################################### # # plot widget # variable version 1.0 # # ulis, (C) 2005 # # ------------------------------------ # #################################### # ========================== # # package # # ========================== package provide ASimplePlot $version package require Tk # ==================== # # entry point # # ==================== namespace export plot # ==================== # # global variables # # ==================== variable {} array set {} \ { -bd 1 -bg white -cmd "" -color red -delay 100 -height 100 -relief groove -width 100 -xaxis:c navy -xaxis:d 10 -xaxis:x 50 -xaxis:y 50 -yaxis:c navy -yaxis:d 10 -yaxis:x 50 -yaxis:y 50 } # ==================== # # plot proc # # ==================== proc plot {args} \ { set rc [catch \ { set cmd [lindex $args 0] switch -glob -- -$cmd \ { -get { return [uplevel 1 ::plot::plot:get $args] } -set { return [uplevel 1 ::plot::plot:set $args] } default \ { if {[string index $cmd 0] != "."} \ { error "use is 'plot path options' or 'plot set options' or 'plot get key'" } return [uplevel 1 ::plot::plot:create $args] } } } msg] if {$rc == 1} { return -code error $msg } else { return $msg } } # ==================== # # get proc # # ==================== proc plot:get {get args} \ { variable {} if {[llength $args] != 1} \ { return -code error "use is 'plot get key'" } set key [lindex $args 0] switch -glob -- $key \ { -bg - -bac* { set (-bg) } -bd - -bor* { set (-bd) } -cmd - -com* { set (-command) } -col* { set (-color) } -del* { set (-delay) } -hei* { set (-height) } -rel* { set (-relief) } -wid* { set (-width) } -x*:c* { set (-xaxis:c) } -x*:d* { set (-xaxis:d) } -x*:x* { set (-xaxis:x) } -x*:y* { set (-xaxis:y) } -y*:c* { set (-yaxis:c) } -y*:d* { set (-yaxis:d) } -y*:x* { set (-yaxis:x) } -y*:y* { set (-yaxis:y) } default \ { error "unknown plot default option '$key'" } } } # ==================== # # set proc # # ==================== proc plot:set {set args} \ { variable {} if {[llength $args] % 2 != 0} \ { return -code error "use is 'plot set \[key value]...'" } foreach {key value} $args \ { switch -glob -- $key \ { -bg - -bac* { set (-bg) $value } -bd - -bor* { set (-bd) $value } -cmd - -com* { set (-command) $value } -col* { set (-color) $value } -del* { set (-delay) $value } -hei* { set (-height) $value } -rel* { set (-relief) $value } -wid* { set (-width) $value } -x*:c* { set (-xaxis:c) $value } -x*:d* { set (-xaxis:d) $value } -x*:x* { set (-xaxis:x) $value } -x*:y* { set (-xaxis:y) $value } -y*:c* { set (-yaxis:c) $value } -y*:d* { set (-yaxis:d) $value } -y*:x* { set (-yaxis:x) $value } -y*:y* { set (-yaxis:y) $value } default \ { error "unknown plot default option '$key'" } } } } # ==================== # # create proc # # ==================== proc plot:create {w args} \ { variable {} # initial options set initial [list] foreach key [array names {} -*] \ { lappend initial $key $($key) } # create canvas canvas $w -highlightt 1 # build reference rename $w ::plot::_$w interp alias {} ::$w {} ::plot::plot:dispatch $w # set options plot:stop $w if {$initial != ""} { uplevel 1 ::plot::plot:config $w $initial } if {$args != ""} { uplevel 1 ::plot::plot:config $w $args } set ($w:init) 1 set ($w:lastY) 0 plot:clear $w # return reference return $w } # ==================== # # dispatch proc # # ==================== proc plot:dispatch {w args} \ { set cmd [lindex $args 0] set args [lrange $args 1 end] set rc [catch \ { switch -glob -- -$cmd \ { -app* { return [uplevel 1 ::plot::plot:append $w $args] } -cge* { return [uplevel 1 ::plot::plot:cget $w $args] } -cle* { return [uplevel 1 ::plot::plot:clear $w $args] } -con* { return [uplevel 1 ::plot::plot:config $w $args] } -inv* { return [uplevel 1 ::plot::plot:invoke $w $args] } -sta* { return [uplevel 1 ::plot::plot:start $w $args] } -sto* { return [uplevel 1 ::plot::plot:stop $w $args] } default \ { error "unknown plot operation '$cmd'. Should be append, cget, clear, config, invoke, start or stop." } } } msg] if {$rc == 1} { return -code error $msg } else { return $msg } } # ==================== # # cget proc # # ==================== proc plot:cget {w args} \ { variable {} if {[llength $args] != 1} \ { return -code error "use is 'path cget key'" } set _w ::plot::_$w set key [lindex $args 0] switch -glob -- $key \ { -bg - -bac* - -bd - -bor* - -hei* - -rel* - -wid* { $_w cget $key } -cmd - -com* { set ($w:-command) } -col* { set ($w:-color) } -del* { set ($w:-delay) } -x*:c* { set ($w:-xaxis:d) } -x*:d* { set ($w:-xaxis:d) } -x*:x* { set ($w:-xaxis:x) } -x*:y* { set ($w:-xaxis:y) } -y*:c* { set ($w:-yaxis:d) } -y*:d* { set ($w:-yaxis:d) } -y*:x* { set ($w:-yaxis:x) } -y*:y* { set ($w:-yaxis:y) } default \ { error "unknown plot option '$key'" } } } # ==================== # # config proc # # ==================== proc plot:config {w args} \ { variable {} if {[llength $args] % 2 != 0} \ { return -code error "use is 'path config \[key value]...'" } set _w ::plot::_$w set xflag 0 set yflag 0 foreach {key value} $args \ { switch -glob -- $key \ { -bg - -bac* - -bd - -bor* - -hei* - -rel* - -wid* { $_w config $key $value } -cmd - -com* { set ($w:-command) $value } -col* { set ($w:-color) $value } -del* { set ($w:-delay) $value } -x*:c* { set ($w:-xaxis:c) $value; set xflag 1 } -x*:d* { set ($w:-xaxis:d) $value; set xflag 1 } -x*:x* { set ($w:-xaxis:x) $value; set xflag 1 } -x*:y* { set ($w:-xaxis:y) $value; set xflag 1 } -y*:c* { set ($w:-yaxis:c) $value; set yflag 1 } -y*:d* { set ($w:-yaxis:d) $value; set yflag 1 } -y*:x* { set ($w:-yaxis:x) $value; set yflag 1 } -y*:y* { set ($w:-yaxis:y) $value; set yflag 1 } default \ { error "unknown plot option '$key'" } } } set ($w:extra) [expr {[$_w cget -bd] + [$_w cget -highlightt]}] set ($w:maxX) [expr {[$_w cget -width] - 2 * $($w:extra)}] set ($w:maxY) [expr {[$_w cget -height] - 2 * $($w:extra)}] if {$xflag} { plot:xaxis $w } if {$yflag} { plot:yaxis $w } } # ==================== # # xaxis proc # # ==================== proc plot:xaxis {w} \ { variable {} set _w ::plot::_$w $_w delete xaxis set extra $($w:extra) incr extra set c $($w:-xaxis:c) set d $($w:-xaxis:d) set x0 $extra set y [expr {$($w:-xaxis:y) + $extra}] set width [$_w cget -width] set x1 [expr {$width + $extra}] $_w create line $x0 $y $x1 $y \ -fill $c -tags xaxis set y1 [expr {$y - 5}] set y2 [expr {$y + 5}] set x [expr {$($w:-xaxis:x) + $extra}] while {$x >= $x0} \ { $_w create line $x $y1 $x $y2 \ -fill $c -tags xaxis incr x -$d } set x [expr {$($w:-xaxis:x) + $extra}] while {$x <= $x1} \ { $_w create line $x $y1 $x $y2 \ -fill $c -tags xaxis incr x $d } } # ==================== # # yaxis proc # # ==================== proc plot:yaxis {w} \ { variable {} set _w ::plot::_$w $_w delete yaxis set extra $($w:extra) incr extra set c $($w:-yaxis:c) set d $($w:-yaxis:d) set y0 $extra set x [expr {$($w:-yaxis:x) + $extra}] set height [$_w cget -height] set y1 [expr {$height + $extra}] $_w create line $x $y0 $x $y1 \ -fill $c -tags yaxis set x1 [expr {$x - 5}] set x2 [expr {$x + 5}] set y [expr {$($w:-yaxis:y) + $extra}] while {$y >= $y0} \ { $_w create line $x1 $y $x2 $y \ -fill $c -tags yaxis incr y -$d } set y [expr {$($w:-yaxis:y) + $extra}] while {$y <= $y1} \ { $_w create line $x1 $y $x2 $y \ -fill $c -tags yaxis incr y $d } } # ==================== # # stop proc # # ==================== proc plot:stop {w} \ { variable {} set ($w:stop) 1 } # ==================== # # start proc # # ==================== proc plot:start {w} \ { variable {} set ($w:stop) 0 plot:invoke $w } # ==================== # # invoke proc # # ==================== proc plot:invoke {w} \ { variable {} if {$($w:stop)} { return } set script $($w:-command) if {$script != ""} \ { set map [list %widget% $w] eval [string map $map $script] } after $($w:-delay) ::plot::plot:invoke $w } # ==================== # # clear proc # # ==================== proc plot:clear {w} \ { variable {} set _w ::plot::_$w $_w delete graph set ($w:tag) -1 set ($w:lastX) -2 catch { unset ($w:lastY) } } # ==================== # # append proc # # ==================== proc plot:append {w y} \ { variable {} set _w ::plot::_$w if {$($w:lastX) <= $($w:maxX)} { incr ($w:lastX) 2 } \ else { $_w move graph -2 0 } set x0 [expr {$($w:lastX) + $($w:extra)}] set y0 [expr {$y + $($w:extra)}] set x1 [expr {$x0 + 1}] if {[info exists ($w:lastY)]} { set last $($w:lastY) } \ else { set last $y0 } set y1 [expr {$last + 1}] set ($w:lastY) $y0 $_w create rectangle $x0 $y0 $x1 $y1 \ -fill $($w:-color) -outline $($w:-color) \ -tags [list graph t[incr ($w:tag)]] set oldID [expr {($($w:tag) - 1) - $($w:maxX) / 2}] if {$oldID > -1} { $_w delete t$oldID } } } namespace import ::plot::plot
Script pkgIndex.tcl
package ifneeded ASimplePlot 1.0 [list source [file join $dir ASimplePlot.tcl]]
Demo
package require ASimplePlot set ::incr [expr {0.2 / 3.141592}] set ::x 0 proc myCmd {} \ { .p append [expr {sin($::x) * 50 + 51}] set ::x [expr {$::x + $::incr}] } proc myStart {} \ { if {[.f.str cget -text] == ">>"} \ { .f.str config -text || .p start } \ else \ { .f.str config -text >> .p stop } } proc myClear {} \ { set ::x 0 .p clear } wm title . a(Simple)Plot wm protocol . WM_DELETE_WINDOW exit plot .p -width 104 -height 104 -cmd myCmd -x:color green frame .f set font {Courier -12 bold} button .f.str -text >> -width 3 -font $font -command myStart button .f.clr -text <> -width 3 -font $font -command myClear grid .f.str .f.clr -pady 5 -padx 20 grid .p -pady 5 -padx 20 grid .f -pady 5 -padx 20
Voir aussi
Discussion
Catégorie Paquet | Catégorie Interface utilisateur