Posted to tcl by emiliano at Thu Feb 05 03:03:20 GMT 2009view raw

  1. package require Tk 8.5
  2. catch {package require Img}
  3. package require img::jpeg
  4. #package require tktray
  5. package require http
  6.  
  7. ttk::setTheme clam
  8.  
  9. proc getMap {} {
  10. global config
  11. set fd [open $config(tmpfile) w]
  12. fconfigure $fd -encoding binary -translation binary
  13. set tok [http::geturl $config(url) -channel $fd -binary 1]
  14. http::cleanup $tok
  15. close $fd
  16. }
  17.  
  18. proc setImage {} {
  19. global config
  20. $config(image) configure -file $config(tmpfile)
  21. #after idle [list .c configure -scrollregion [.c bbox all]]
  22. file delete $config(tmpfile)
  23. }
  24.  
  25. proc mainLoop { s } {
  26. after [expr { 1000 * $s }] [info level 0]
  27. getMap
  28. setImage
  29. wm state . normal
  30. }
  31.  
  32.  
  33. set config(image) [image create photo]
  34. set config(url) \
  35. http://www.smn.gov.ar/pronos/satelite/CONAE/Latest/smn_local_goes10_imager_LATEST_ctt.jpg
  36. set config(tmpfile) /tmp/[string trim [expr {[clock clicks] % [pid] }]].jpg
  37.  
  38. wm state . withdrawn
  39. canvas .c -xscrollcommand {.sx set} -yscrollcommand {.sy set} \
  40. -scrollregion { -50 0 1014 768 }
  41. ttk::scrollbar .sx -command {.c xview} -orient horizontal
  42. ttk::scrollbar .sy -command {.c yview} -orient vertical
  43. grid .c .sy -sticky news
  44. grid .sx -sticky news
  45. grid columnconfigure . 0 -weight 1
  46. grid rowconfigure . 0 -weight 1
  47. .c create image {0 0} -anchor nw -image $config(image)
  48.  
  49.  
  50. mainLoop 1800
  51. bind all <p> {puts [winfo width .c]}
  52.  
  53. =============================================================================
  54. The image showed is 964 pixels width x 768 pixels height.
  55.  
  56. When the image fit in the canvas width, the vertical scrolling becomes
  57. notoriously sluggish, in my case when the canvas width is 966 (I guess
  58. this value is width of the canvas area + 2 * canvas borderwidth).
  59.  
  60. When the image doesn't fit in the canvas width, the vertical scrolling
  61. is normal (smooth).
  62.  
  63. The difference is notorious when dragging the vertical scrollbar thumb

Comments

Posted by emiliano at Thu Feb 05 21:00:38 GMT 2009 [text] [code]

this new code is smaller and shows the same behaviour package require Tk 8.5 package require Tcl 8.5 canvas .c -xscrollcommand {.sx set} -yscrollcommand {.sy set}\ -bg white -borderwidth 0 -highlightthickness 0 ttk::scrollbar .sx -command {.c xview} -orient horizontal ttk::scrollbar .sy -command {.c yview} -orient vertical grid .c .sy -sticky news grid .sx -sticky news grid columnconfigure . 0 -weight 1 grid rowconfigure . 0 -weight 1 set w [expr {int([winfo screenwidth .]*0.85)}] set h [expr {int([winfo screenheight .]*0.85)}] set img [image create photo -width $w -height $h] $img put black -to 0 0 $w $h .c create image {0 0} -image $img -anchor nw .c configure -scrollregion [.c bbox all]