Changeset af9a0af in tol for tolbase/lib


Ignore:
Timestamp:
Dec 4, 2011, 1:58:58 PM (15 years ago)
Author:
Jorge Pérez <josp.jorge@…>
Branches:
1941-docker-image-to-test, devel, master
Children:
8d0dffc
Parents:
5c67e4e
Message:

patch for a bug in BLT 2.4 related to blt::busy command

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@3884 be4846ae-f051-483a-831f-b64e7d08527f

File:
1 edited

Legend:

Unmodified
Added
Removed

  • tolbase/lib/toltk/graph.tcl

    r5c67e4e raf9a0af  
    44#/////////////////////////////////////////////////////////////////////////////
    55
    6 proc Blt_ActiveLegend { graph } {
    7     $graph legend bind all <Enter> [list blt::ActivateLegend $graph ]
    8     $graph legend bind all <Leave> [list blt::DeactivateLegend $graph]
    9     $graph legend bind all <ButtonPress-1> [list blt::HighlightLegend $graph]
    10 }
    11 
    12 proc Blt_Crosshairs { graph } {
    13     blt::Crosshairs $graph
    14 }
    15 
    16 proc Blt_ZoomStack { graph } {
    17     blt::ZoomStack $graph
    18 }
     6# force blt load
     7
     8if { [ info command "Blt_ZoomStack" ] eq "" } {
     9  blt::graph .__g__
     10  Blt_ZoomStack .__g__
     11  destroy .__g__
     12  rename blt::InitStack _blt_InitStack
     13}
     14
     15proc Busy_Patched { cmd args } {
     16    puts "-- Busy $cmd $args --"
     17    switch $cmd {
     18      patched {
     19        return 1
     20      }
     21      default {
     22       
     23      }
     24    }
     25}
     26
     27if { [ catch { blt::busy patched } ] } {
     28  rename ::blt::busy _blt_busy
     29  interp alias {} ::blt::busy {} Busy_Patched
     30  puts "interp alias {} ::blt::busy {} Busy_Patched"
     31}
     32
    1933
    2034# Cambia el ViewMode
    … …  
    6175}
    6276
     77proc blt::InitStack { graph {mode zoom-frame} } {
     78    global zoomInfo
     79 
     80    _blt_InitStack $graph
     81    # this is to allow zoom in, out scroll
     82 
     83    set zoomInfo($graph,mode) $mode
     84}
     85
     86
    6387proc blt::SetZoomScale { graph scale } {
    6488  global zoomInfo
    … …  
    86110  }
    87111  return 1
    88 }
    89 
    90 proc Blt_PrintKey { graph } {
    91     blt::PrintKey $graph
    92 }
    93 
    94 proc Blt_ClosestPoint { graph } {
    95     blt::ClosestPoint $graph
    96 }
    97 
    98 #
    99 # The following procedures that reside in the "blt" namespace are
    100 # supposed to be private.
    101 #
    102 
    103 proc blt::ActivateLegend { graph } {
    104     set elem [$graph legend get current]
    105     $graph legend activate $elem
    106 }
    107 proc blt::DeactivateLegend { graph } {
    108     set elem [$graph legend get current]
    109     $graph legend deactivate $elem
    110 }
    111 
    112 proc blt::HighlightLegend { graph } {
    113     set elem [$graph legend get current]
    114     set relief [$graph element cget $elem -labelrelief]
    115     if { $relief == "flat" } {
    116         $graph element configure $elem -labelrelief raised
    117         $graph element activate $elem
    118     } else {
    119         $graph element configure $elem -labelrelief flat
    120         $graph element deactivate $elem
    121     }
    122 }
    123 
    124 proc blt::Crosshairs { graph { event "Any-Motion" } } {
    125     $graph crosshairs on
    126     bind crosshairs-$graph <$event>   {
    127         %W crosshairs configure -position @%x,%y
    128     }
    129     bind crosshairs-$graph <Leave>   {
    130         %W crosshairs off
    131     }
    132     bind crosshairs-$graph <Enter>   {
    133         %W crosshairs on
    134     }
    135     $graph crosshairs configure -color red
    136     blt::AddBindTag $graph crosshairs-$graph
    137 }
    138 
    139 proc blt::ClearCrosshairs { graph } {
    140   blt::RemoveBindTag $graph crosshairs-$graph
    141   $graph crosshairs off
    142 }
    143 
    144 proc blt::InitStack { graph {mode zoom-frame} } {
    145     global zoomInfo
    146     set zoomInfo($graph,interval) 100
    147     set zoomInfo($graph,afterId) 0
    148   set zoomInfo($graph,afterId1) 0
    149     set zoomInfo($graph,A,x) {}
    150     set zoomInfo($graph,A,y) {}
    151     set zoomInfo($graph,B,x) {}
    152     set zoomInfo($graph,B,y) {}
    153     set zoomInfo($graph,stack) {}
    154     set zoomInfo($graph,corner) A
    155  
    156   # this is to allow zoom in, out scroll
    157  
    158   set zoomInfo($graph,mode) $mode
    159 }
    160 
    161 proc blt::DeleteStack { graph } {
    162   global zoomInfo
    163 
    164   foreach it [array names zoomInfo $graph,*] {
    165     unset zoomInfo($it)
    166   }
    167 }
    168 
    169 proc blt::ZoomStack { graph {start "ButtonPress-1"} {reset "ButtonPress-3"} } {
    170   global zoomInfo zoomMod
    171    
    172   blt::InitStack $graph
    173    
    174   if { [info exists zoomMod] } {
    175     set modifier $zoomMod
    176   } else {
    177     set modifier ""
    178   }
    179   bind zoom-$graph <${modifier}${start}> { blt::SetZoomPoint %W %x %y }
    180   bind zoom-$graph <${modifier}${reset}> {
    181     if { [%W inside %x %y] } {
    182       blt::ResetZoom %W
    183     }
    184   }
    185   blt::AddBindTag $graph zoom-$graph
    186 }
    187 
    188 proc blt::PrintKey { graph {event "Shift-ButtonRelease-3"} } {
    189     bind print-$graph <$event>  { Blt_PostScriptDialog %W }
    190     blt::AddBindTag $graph print-$graph
    191 }
    192 
    193 proc blt::ClosestPoint { graph {event "Control-ButtonPress-2"} } {
    194     bind closest-point-$graph <$event>  {
    195         blt::FindElement %W %x %y
    196     }
    197     blt::AddBindTag $graph closest-point-$graph
    198 }
    199 
    200 proc blt::AddBindTag { widget tag } {
    201     set oldTagList [bindtags $widget]
    202     if { [lsearch $oldTagList $tag] < 0 } {
    203         bindtags $widget [linsert $oldTagList 0  $tag]
    204     }
    205 }
    206 
    207 proc blt::RemoveBindTag { widget args } {
    208     set oldTagList [bindtags $widget]
    209   foreach tag $args {
    210     set index [lsearch $oldTagList $tag]
    211     if { $index >= 0 } {
    212         bindtags $widget [lreplace $oldTagList $index $index]
    213     }
    214   }
    215 }
    216 
    217 proc blt::FindElement { graph x y } {
    218     if ![$graph element closest $x $y info -interpolate yes] {
    219         beep
    220         return
    221     }
    222     # --------------------------------------------------------------
    223     # find(name)                - element Id
    224     # find(index)               - index of closest point
    225     # find(x) find(y)           - coordinates of closest point
    226     #                             or closest point on line segment.
    227     # find(dist)                - distance from sample coordinate
    228     # --------------------------------------------------------------
    229     set markerName "bltClosest_$info(name)"
    230     catch { $graph marker delete $markerName }
    231     $graph marker create text -coords { $info(x) $info(y) } \
    232         -name $markerName \
    233         -text "$info(name): $info(dist)\nindex $info(index)" \
    234         -font *lucida*-r-*-10-* \
    235         -anchor center -justify left \
    236         -yoffset 0 -bg {}
    237 
    238     set coords [$graph invtransform $x $y]
    239     set nx [lindex $coords 0]
    240     set ny [lindex $coords 1]
    241 
    242     $graph marker create line -coords "$nx $ny $info(x) $info(y)" \
    243         -name line.$markerName
    244 
    245     blt::FlashPoint $graph $info(name) $info(index) 10
    246     blt::FlashPoint $graph $info(name) [expr $info(index) + 1] 10
    247 }
    248 
    249 proc blt::FlashPoint { graph name index count } {
    250     if { $count & 1 } {
    251         $graph element deactivate $name
    252     } else {
    253         $graph element activate $name $index
    254     }
    255     incr count -1
    256     if { $count > 0 } {
    257         after 200 blt::FlashPoint $graph $name $index $count
    258         update
    259     } else {
    260         eval $graph marker delete [$graph marker names "bltClosest_*"]
    261     }
    262 }
    263 
    264 proc blt::GetCoords { graph x y index } {
    265     global zoomInfo
    266     if { [$graph cget -invertxy] } {
    267         set zoomInfo($graph,$index,x) $y
    268         set zoomInfo($graph,$index,y) $x
    269     } else {
    270         set zoomInfo($graph,$index,x) $x
    271         set zoomInfo($graph,$index,y) $y
    272     }
    273 }
    274 
    275 proc blt::MarkPoint { graph index } {
    276     global zoomInfo
    277     set x [$graph xaxis invtransform $zoomInfo($graph,$index,x)]
    278     set y [$graph yaxis invtransform $zoomInfo($graph,$index,y)]
    279     set marker "zoomText_$index"
    280     set text [format "x=%.4g\ny=%.4g" $x $y]
    281 
    282     if [$graph marker exists $marker] {
    283         $graph marker configure $marker -coords { $x $y } -text $text
    284     } else {
    285         $graph marker create text -coords { $x $y } -name $marker \
    286             -font *lucida*-r-*-10-* \
    287             -text $text -anchor center -bg {} -justify left
    288     }
    289 }
    290 
    291 proc blt::DestroyZoomTitle { graph } {
    292     global zoomInfo
    293 
    294     if { $zoomInfo($graph,corner) == "A" } {
    295         catch { $graph marker delete "zoomTitle" }
    296     }
    297 }
    298 
    299 proc blt::PopZoom { graph } {
    300   global zoomInfo
    301 
    302   set zoomStack $zoomInfo($graph,stack)
    303   if { [llength $zoomStack] > 0 } {
    304     set cmd [lindex $zoomStack 0]
    305     set zoomInfo($graph,stack) [lrange $zoomStack 1 end]
    306     eval $cmd
    307     blt::ZoomTitleLast $graph
    308     busy hold $graph
    309   set this [::bayesGraph::getInstance $graph]
    310   upvar \#0 ${this}::data data
    311   set gr $data(gr,active)
    312   #Tolcon_Trace "Aplicando Axis Ticks PopZoom"
    313   ::bayesGraph::GrapOptApplyAxisTicks    $this ${this}::options gr,$gr
    314     update
    315     set id [after 2000 "blt::DestroyZoomTitle $graph"]
    316     set zoomInfo($graph,afterId1) $id
    317     busy release $graph
    318   } else {
    319     catch { $graph marker delete "zoomTitle" }
    320   }
    321 }
    322 
    323 # Push the old axis limits on the stack and set the new ones
    324 
    325 proc blt::PushZoom { graph } {
    326   global zoomInfo
    327   eval $graph marker delete [$graph marker names "zoom*"]
    328   if { [info exists zoomInfo($graph,afterId)] } {
    329     after cancel $zoomInfo($graph,afterId)
    330   }
    331   set x1 $zoomInfo($graph,A,x)
    332   set y1 $zoomInfo($graph,A,y)
    333   set x2 $zoomInfo($graph,B,x)
    334   set y2 $zoomInfo($graph,B,y)
    335 
    336   if { ($x1 == $x2) || ($y1 == $y2) } {
    337     # No delta, revert to start
    338     return
    339   }
    340   set cmd {}
    341   foreach margin { xaxis yaxis x2axis y2axis } {
    342     foreach axis [$graph $margin use] {
    343       set min [$graph axis cget $axis -min]
    344       set max [$graph axis cget $axis -max]
    345       set c [list $graph axis configure $axis -min $min -max $max]
    346       append cmd "$c\n"
    347     }
    348   }
    349   set zoomInfo($graph,stack) [linsert $zoomInfo($graph,stack) 0 $cmd]
    350 
    351   busy hold $graph
    352   # This update lets the busy cursor take effect.
    353   update
    354 
    355   foreach margin { xaxis x2axis } {
    356     foreach axis [$graph $margin use] {
    357       set min [$graph axis invtransform $axis $x1]
    358       set max [$graph axis invtransform $axis $x2]
    359       if { $min > $max } {
    360         set tmp $min
    361         set min $max
    362         set max $tmp
    363       }
    364       # this code is to allow zoom-out operations
    365       if { [string equal $zoomInfo($graph,mode) "zoom-out"] } {
    366         set limits [$graph axis limits $axis]
    367         set lower [lindex $limits 0]
    368         set upper [lindex $limits 1]
    369         set delta [expr ($upper - $lower)/2.0]
    370         set min [expr $min - $delta]
    371         set max [expr $max + $delta]
    372       }
    373       # end zoom-out path
    374          
    375 #      if { $min > $max } {
    376 #               $graph axis configure $axis -min $max -max $min
    377 #           } else {
    378 #               $graph axis configure $axis -min $min -max $max
    379 #           }
    380       $graph axis configure $axis -min $min -max $max
    381     }
    382   }
    383   foreach margin { yaxis y2axis } {
    384     foreach axis [$graph $margin use] {
    385       set min [$graph axis invtransform $axis $y1]
    386       set max [$graph axis invtransform $axis $y2]
    387 
    388       if { $min > $max } {
    389         set tmp $min
    390         set min $max
    391         set max $tmp
    392       }
    393 
    394       # this code is to allow zoom-out operations
    395       if { [string equal $zoomInfo($graph,mode) "zoom-out"] } {
    396         set limits [$graph axis limits $axis]
    397         set lower [lindex $limits 0]
    398         set upper [lindex $limits 1]
    399         set delta [expr ($upper - $lower)/2.0]
    400         set min [expr $min - $delta]
    401         set max [expr $max + $delta]
    402       }
    403       #end zoom-out patch
    404 
    405 #           if { $min > $max } {
    406 #               $graph axis configure $axis -min $max -max $min
    407 #           } else {
    408 #               $graph axis configure $axis -min $min -max $max
    409 #           }
    410       $graph axis configure $axis -min $min -max $max
    411         }
    412   }
    413   # This "update" forces the graph to be redrawn
    414   set this [::bayesGraph::getInstance $graph]
    415   upvar \#0 ${this}::data data
    416   set gr $data(gr,active)
    417   #Tolcon_Trace "Aplicando Axis Ticks PushZoom"
    418   ::bayesGraph::GrapOptApplyAxisTicks    $this ${this}::options gr,$gr
    419   update
    420    
    421   busy release $graph
    422 }
    423 
    424 #
    425 # This routine terminates either an existing zoom, or pops back to
    426 # the previous zoom level (if no zoom is in progress).
    427 #
    428 
    429 proc blt::ResetZoom { graph } {
    430   global zoomInfo
    431 
    432   if { ![info exists zoomInfo($graph,corner)] } {
    433     blt::InitStack $graph
    434   }
    435   eval $graph marker delete [$graph marker names "zoom*"]
    436 
    437   if { $zoomInfo($graph,corner) == "A" } {
    438     # Reset the whole axis
    439     blt::PopZoom $graph
    440   } else {
    441     global zoomMod
    442     if { [info exists zoomMod] } {
    443       set modifier $zoomMod
    444     } else {
    445       set modifier "Any-"
    446     }
    447     set zoomInfo($graph,corner) A
    448     blt::RemoveBindTag $graph select-region-$graph
    449   }
    450 }
    451 
    452 proc blt::ResetScroll { graph } {
    453   global zoomInfo
    454 
    455   eval $graph marker delete [$graph marker names "scroll*"]
    456   blt::RemoveBindTag $graph scroll-region-$graph
    457   set zoomInfo($graph,corner) A 
    458 }
    459 
    460 option add *zoomTitle.font        -*-helvetica-medium-R-*-*-18-*-*-*-*-*-*-*
    461 option add *zoomTitle.shadow      yellow4
    462 option add *zoomTitle.foreground  yellow1
    463 option add *zoomTitle.coords      "-Inf Inf"
    464 
    465 option add *scrollTitle.font      -*-helvetica-medium-R-*-*-18-*-*-*-*-*-*-*
    466 option add *scrollTitle.shadow    yellow4
    467 option add *scrollTitle.foreground  yellow1
    468 option add *scrollTitle.coords    "-Inf Inf"
    469 
    470 proc blt::ZoomTitleNext { graph } {
    471     global zoomInfo
    472     set level [expr [llength $zoomInfo($graph,stack)] + 1]
    473     if { [$graph cget -invertxy] } {
    474         set coords "-Inf -Inf"
    475     } else {
    476         set coords "-Inf Inf"
    477     }
    478     $graph marker create text -name "zoomTitle" -text "Zoom #$level" \
    479         -coords $coords -bindtags "" -anchor nw
    480 }
    481 
    482 proc blt::ScrollTitle { graph } {
    483     if { [$graph cget -invertxy] } {
    484         set coords "-Inf -Inf"
    485     } else {
    486         set coords "-Inf Inf"
    487     }
    488     $graph marker create text -name "scrollTitle" -text "scrolling ..." \
    489         -coords $coords -bindtags "" -anchor nw
    490 }
    491 
    492 proc blt::ZoomTitleLast { graph } {
    493     global zoomInfo
    494 
    495     set level [llength $zoomInfo($graph,stack)]
    496     if { $level > 0 } {
    497         $graph marker create text -name "zoomTitle" -anchor nw \
    498             -text "Zoom #$level"
    499     }
    500112}
    501113
    … …  
    517129  update
    518130
    519     Tolcon_Trace "En ZoomScale zoomInfo($graph,scale) vale  $zoomInfo($graph,scale)"
     131  Tolcon_Trace "En ZoomScale zoomInfo($graph,scale) vale  $zoomInfo($graph,scale)"
    520132
    521133  if { [string equal $zoomInfo($graph,mode) "zoom-in"] } {
    … …  
    610222        # Delete the modal binding
    611223      ResetScroll $graph
    612     }
    613 }
    614 
    615 option add *zoomOutline.dashes          4       
    616 option add *zoomTitle.anchor            nw
    617 option add *zoomOutline.lineWidth       2
    618 option add *zoomOutline.xor             yes
    619 
    620 proc blt::MarchingAnts { graph offset } {
    621     global zoomInfo
    622 
    623     incr offset
    624     if { [$graph marker exists zoomOutline] } {
    625         $graph marker configure zoomOutline -dashoffset $offset
    626         set interval $zoomInfo($graph,interval)
    627         set id [after $interval [list blt::MarchingAnts $graph $offset]]
    628         set zoomInfo($graph,afterId) $id
    629     }
    630 }
    631 
    632 proc blt::Box { graph } {
    633     global zoomInfo
    634 
    635     if { $zoomInfo($graph,A,x) > $zoomInfo($graph,B,x) } {
    636         set x1 [$graph xaxis invtransform $zoomInfo($graph,B,x)]
    637         set y1 [$graph yaxis invtransform $zoomInfo($graph,B,y)]
    638         set x2 [$graph xaxis invtransform $zoomInfo($graph,A,x)]
    639         set y2 [$graph yaxis invtransform $zoomInfo($graph,A,y)]
    640     } else {
    641         set x1 [$graph xaxis invtransform $zoomInfo($graph,A,x)]
    642         set y1 [$graph yaxis invtransform $zoomInfo($graph,A,y)]
    643         set x2 [$graph xaxis invtransform $zoomInfo($graph,B,x)]
    644         set y2 [$graph yaxis invtransform $zoomInfo($graph,B,y)]
    645     }
    646     set coords { $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x1 $y1 }
    647     if { [$graph marker exists "zoomOutline"] } {
    648         $graph marker configure "zoomOutline" -coords $coords
    649     } else {
    650         set X [lindex [$graph xaxis use] 0]
    651         set Y [lindex [$graph yaxis use] 0]
    652         $graph marker create line -coords $coords -name "zoomOutline" \
    653             -mapx $X -mapy $Y
    654         set interval $zoomInfo($graph,interval)
    655         set id [after $interval [list blt::MarchingAnts $graph 0]]
    656         set zoomInfo($graph,afterId) $id
    657224    }
    658225}
    … …  
    679246  set zoomInfo($graph,A,y) $zoomInfo($graph,B,y)
    680247}
    681 
    682 proc Blt_PostScriptDialog { graph } {
    683     set top $graph.top
    684     toplevel $top
    685 
    686     foreach var { center landscape maxpect preview decorations padx
    687         pady paperwidth paperheight width height colormode } {
    688         global $graph.$var
    689         set $graph.$var [$graph postscript cget -$var]
    690     }
    691     set row 1
    692     set col 0
    693     label $top.title -text "PostScript Options"
    694     table $top $top.title -cspan 7
    695     foreach bool { center landscape maxpect preview decorations } {
    696         set w $top.$bool-label
    697         label $w -text "-$bool" -font *courier*-r-*12*
    698         table $top $row,$col $w -anchor e -pady { 2 0 } -padx { 0 4 }
    699         set w $top.$bool-yes
    700         global $graph.$bool
    701         radiobutton $w -text "yes" -variable $graph.$bool -value 1
    702         table $top $row,$col+1 $w -anchor w
    703         set w $top.$bool-no
    704         radiobutton $w -text "no" -variable $graph.$bool -value 0
    705         table $top $row,$col+2 $w -anchor w
    706         incr row
    707     }
    708     label $top.modes -text "-colormode" -font *courier*-r-*12*
    709     table $top $row,0 $top.modes -anchor e  -pady { 2 0 } -padx { 0 4 }
    710     set col 1
    711     foreach m { color greyscale } {
    712         set w $top.$m
    713         radiobutton $w -text $m -variable $graph.colormode -value $m
    714         table $top $row,$col $w -anchor w
    715         incr col
    716     }
    717     set row 1
    718     frame $top.sep -width 2 -bd 1 -relief sunken
    719     table $top $row,3 $top.sep -fill y -rspan 6
    720     set col 4
    721     foreach value { padx pady paperwidth paperheight width height } {
    722         set w $top.$value-label
    723         label $w -text "-$value" -font *courier*-r-*12*
    724         table $top $row,$col $w -anchor e  -pady { 2 0 } -padx { 0 4 }
    725         set w $top.$value-entry
    726         global $graph.$value
    727         entry $w -textvariable $graph.$value -width 8
    728         table $top $row,$col+1 $w -cspan 2 -anchor w -padx 8
    729         incr row
    730     }
    731     table configure $top c3 -width .125i
    732     button $top.cancel -text "Cancel" -command "destroy $top"
    733     table $top $row,0 $top.cancel  -width 1i -pady 2 -cspan 3
    734     button $top.reset -text "Reset" -command "destroy $top"
    735     #table $top $row,1 $top.reset  -width 1i
    736     button $top.print -text "Print" -command "blt::ResetPostScript $graph"
    737     table $top $row,4 $top.print  -width 1i -pady 2 -cspan 2
    738 }
    739 
    740 proc blt::ResetPostScript { graph } {
    741     foreach var { center landscape maxpect preview decorations padx
    742         pady paperwidth paperheight width height colormode } {
    743         global $graph.$var
    744         set old [$graph postscript cget -$var]
    745         if { [catch {$graph postscript configure -$var [set $graph.$var]}] != 0 } {
    746             $graph postscript configure -$var $old
    747             set $graph.$var $old
    748         }
    749     }
    750     $graph postscript output "out.ps"
    751     puts stdout "wrote file \"out.ps\"."
    752     flush stdout
    753 }
Note: See TracChangeset for help on using the changeset viewer.