"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tltcl/lib/tk8.6/demos/aniwave.tcl" (17 Mar 2020, 3494 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 # aniwave.tcl --
    2 #
    3 # This demonstration script illustrates how to adjust canvas item
    4 # coordinates in a way that does something fairly similar to waveform
    5 # display.
    6 
    7 if {![info exists widgetDemo]} {
    8     error "This script should be run from the \"widget\" demo."
    9 }
   10 
   11 package require Tk
   12 
   13 set w .aniwave
   14 catch {destroy $w}
   15 toplevel $w
   16 wm title $w "Animated Wave Demonstration"
   17 wm iconname $w "aniwave"
   18 positionWindow $w
   19 
   20 label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration contains a canvas widget with a line item inside it. The animation routines work by adjusting the coordinates list of the line; a trace on a variable is used so updates to the variable result in a change of position of the line."
   21 pack $w.msg -side top
   22 
   23 ## See Code / Dismiss buttons
   24 set btns [addSeeDismiss $w.buttons $w]
   25 pack $btns -side bottom -fill x
   26 
   27 # Create a canvas large enough to hold the wave. In fact, the wave
   28 # sticks off both sides of the canvas to prevent visual glitches.
   29 pack [canvas $w.c -width 300 -height 200 -background black] -padx 10 -pady 10 -expand yes
   30 
   31 # Ensure that this this is an array
   32 array set animationCallbacks {}
   33 
   34 # Creates a coordinates list of a wave. This code does a very sketchy
   35 # job and relies on Tk's line smoothing to make things look better.
   36 set waveCoords {}
   37 for {set x -10} {$x<=300} {incr x 5} {
   38     lappend waveCoords $x 100
   39 }
   40 lappend waveCoords $x 0 [incr x 5] 200
   41 
   42 # Create a smoothed line and arrange for its coordinates to be the
   43 # contents of the variable waveCoords.
   44 $w.c create line $waveCoords -tags wave -width 1 -fill green -smooth 1
   45 proc waveCoordsTracer {w args} {
   46     global waveCoords
   47     # Actual visual update will wait until we have finished
   48     # processing; Tk does that for us automatically.
   49     $w.c coords wave $waveCoords
   50 }
   51 trace add variable waveCoords write [list waveCoordsTracer $w]
   52 
   53 # Basic motion handler. Given what direction the wave is travelling
   54 # in, it advances the y coordinates in the coordinate-list one step in
   55 # that direction.
   56 proc basicMotion {} {
   57     global waveCoords direction
   58     set oc $waveCoords
   59     for {set i 1} {$i<[llength $oc]} {incr i 2} {
   60     if {$direction eq "left"} {
   61         lset waveCoords $i [lindex $oc \
   62             [expr {$i+2>[llength $oc] ? 1 : $i+2}]]
   63     } else {
   64         lset waveCoords $i \
   65             [lindex $oc [expr {$i-2<0 ? "end" : $i-2}]]
   66     }
   67     }
   68 }
   69 
   70 # Oscillation handler. This detects whether to reverse the direction
   71 # of the wave by checking to see if the peak of the wave has moved off
   72 # the screen (whose size we know already.)
   73 proc reverser {} {
   74     global waveCoords direction
   75     if {[lindex $waveCoords 1] < 10} {
   76     set direction "right"
   77     } elseif {[lindex $waveCoords end] < 10} {
   78     set direction "left"
   79     }
   80 }
   81 
   82 # Main animation "loop". This calls the two procedures that handle the
   83 # movement repeatedly by scheduling asynchronous calls back to itself
   84 # using the [after] command. This procedure is the fundamental basis
   85 # for all animated effect handling in Tk.
   86 proc move {} {
   87     basicMotion
   88     reverser
   89 
   90     # Theoretically 100 frames-per-second (==10ms between frames)
   91     global animationCallbacks
   92     set animationCallbacks(simpleWave) [after 10 move]
   93 }
   94 
   95 # Initialise our remaining animation variables
   96 set direction "left"
   97 set animateAfterCallback {}
   98 # Arrange for the animation loop to stop when the canvas is deleted
   99 bind $w.c <Destroy> {
  100     after cancel $animationCallbacks(simpleWave)
  101     unset animationCallbacks(simpleWave)
  102 }
  103 # Start the animation processing
  104 move