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::plotScript 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 20Voir aussi
Discussion
Catégorie Paquet | Catégorie Interface utilisateur