a(Simple)Plot

 

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