home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / pagesmgr.tcl < prev    next >
Text File  |  2000-11-02  |  9KB  |  300 lines
  1. # ------------------------------------------------------------------------------
  2. #  pagesmgr.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: pagesmgr.tcl,v 1.1.1.1 1996/02/22 06:05:56 daniel Exp $
  5. # ------------------------------------------------------------------------------
  6. #  Index of commands:
  7. #     - PagesManager::create
  8. #     - PagesManager::configure
  9. #     - PagesManager::cget
  10. #     - PagesManager::compute_size
  11. #     - PagesManager::add
  12. #     - PagesManager::delete
  13. #     - PagesManager::raise
  14. #     - PagesManager::page
  15. #     - PagesManager::pages
  16. #     - PagesManager::getframe
  17. #     - PagesManager::_test_page
  18. #     - PagesManager::_select
  19. #     - PagesManager::_redraw
  20. #     - PagesManager::_draw_area
  21. #     - PagesManager::_resize
  22. #     - PagesManager::_realize
  23. # ------------------------------------------------------------------------------
  24.  
  25. namespace eval PagesManager {
  26.     Widget::declare PagesManager {
  27.         {-background TkResource "" 0 frame}
  28.         {-width      Int        0  0 {=0 ""}}
  29.         {-height     Int        0  0 {=0 ""}}
  30.     }
  31.  
  32.     Widget::addmap PagesManager "" :cmd {-width {} -height {}}
  33.  
  34.     proc ::PagesManager { path args } { return [eval PagesManager::create $path $args] }
  35.     proc use {} {}
  36. }
  37.  
  38.  
  39. # ------------------------------------------------------------------------------
  40. #  Command PagesManager::create
  41. # ------------------------------------------------------------------------------
  42. proc PagesManager::create { path args } {
  43.     variable $path
  44.     upvar 0  $path data
  45.  
  46.     Widget::init PagesManager $path $args
  47.  
  48.     set data(select)   ""
  49.     set data(pages)    {}
  50.     set data(cpt)      0
  51.     set data(realized) 0
  52.  
  53.     # --- creation du canvas -----------------------------------------------------------------
  54.     set w [Widget::cget $path -width]
  55.     set h [Widget::cget $path -height]
  56.     canvas $path -relief flat -bd 0 -highlightthickness 0 -width $w -height $h
  57.  
  58.     bind $path <Configure> "PagesManager::_realize $path"
  59.     bind $path <Destroy>   "PagesManager::_destroy $path"
  60.  
  61.     rename $path ::$path:cmd
  62.     proc ::$path { cmd args } "return \[eval PagesManager::\$cmd $path \$args\]"
  63.  
  64.     return $path
  65. }
  66.  
  67.  
  68. # ------------------------------------------------------------------------------
  69. #  Command PagesManager::configure
  70. # ------------------------------------------------------------------------------
  71. proc PagesManager::configure { path args } {
  72.     return [Widget::configure $path $args]
  73. }
  74.  
  75.  
  76. # ------------------------------------------------------------------------------
  77. #  Command PagesManager::cget
  78. # ------------------------------------------------------------------------------
  79. proc PagesManager::cget { path option } {
  80.     return [Widget::cget $path $option]
  81. }
  82.  
  83.  
  84. # ------------------------------------------------------------------------------
  85. #  Command PagesManager::compute_size
  86. # ------------------------------------------------------------------------------
  87. proc PagesManager::compute_size { path } {
  88.     variable $path
  89.     upvar 0  $path data
  90.  
  91.     set wmax 0
  92.     set hmax 0
  93.     update idletasks
  94.     foreach page $data(pages) {
  95.         set w    [winfo reqwidth  $path.f$page]
  96.         set h    [winfo reqheight $path.f$page]
  97.         set wmax [expr {$w>$wmax ? $w : $wmax}]
  98.         set hmax [expr {$h>$hmax ? $h : $hmax}]
  99.     }
  100.     configure $path -width $wmax -height $hmax
  101. }
  102.  
  103.  
  104. # ------------------------------------------------------------------------------
  105. #  Command PagesManager::add
  106. # ------------------------------------------------------------------------------
  107. proc PagesManager::add { path page } {
  108.     variable $path
  109.     upvar 0  $path data
  110.  
  111.     if { [lsearch $data(pages) $page] != -1 } {
  112.         return -code error "page \"$page\" already exists"
  113.     }
  114.  
  115.     lappend data(pages) $page
  116.  
  117.     frame $path.f$page -relief flat -background [Widget::cget $path -background] -borderwidth 0
  118.  
  119.     return $path.f$page
  120. }
  121.  
  122.  
  123. # ------------------------------------------------------------------------------
  124. #  Command PagesManager::delete
  125. # ------------------------------------------------------------------------------
  126. proc PagesManager::delete { path page } {
  127.     variable $path
  128.     upvar 0  $path data
  129.  
  130.     set pos [_test_page $path $page]
  131.     set data(pages) [lreplace $data(pages) $pos $pos]
  132.     if { $data(select) == $page } {
  133.         set data(select) ""
  134.     }
  135.     destroy $path.f$page
  136.     _redraw $path
  137. }
  138.  
  139.  
  140. # ------------------------------------------------------------------------------
  141. #  Command PagesManager::raise
  142. # ------------------------------------------------------------------------------
  143. proc PagesManager::raise { path {page ""} } {
  144.     variable $path
  145.     upvar 0  $path data
  146.  
  147.     if { $page != "" } {
  148.         _test_page $path $page
  149.         _select $path $page
  150.     }
  151.     return $data(select)
  152. }
  153.  
  154.  
  155. # ------------------------------------------------------------------------------
  156. #  Command PagesManager::page
  157. # ------------------------------------------------------------------------------
  158. proc PagesManager::page { path first {last ""} } {
  159.     variable $path
  160.     upvar 0  $path data
  161.  
  162.     if { $last == "" } {
  163.         return [lindex $data(pages) $first]
  164.     } else {
  165.         return [lrange $data(pages) $first $last]
  166.     }
  167. }
  168.  
  169.  
  170. # ------------------------------------------------------------------------------
  171. #  Command PagesManager::pages
  172. # ------------------------------------------------------------------------------
  173. proc PagesManager::pages { path } {
  174.     variable $path
  175.     upvar 0  $path data
  176.  
  177.     return $data(pages)
  178. }
  179.  
  180.  
  181. # ------------------------------------------------------------------------------
  182. #  Command PagesManager::_destroy
  183. # ------------------------------------------------------------------------------
  184. proc PagesManager::_destroy { path } {
  185.     variable $path
  186.     upvar 0  $path data
  187.  
  188.     Widget::destroy $path
  189.     unset data
  190.     rename $path {}
  191. }
  192.  
  193.  
  194. # ------------------------------------------------------------------------------
  195. #  Command PagesManager::getframe
  196. # ------------------------------------------------------------------------------
  197. proc PagesManager::getframe { path page } {
  198.     return $path.f$page
  199. }
  200.  
  201.  
  202. # ------------------------------------------------------------------------------
  203. #  Command PagesManager::_test_page
  204. # ------------------------------------------------------------------------------
  205. proc PagesManager::_test_page { path page } {
  206.     variable $path
  207.     upvar 0  $path data
  208.  
  209.     if { [set pos [lsearch $data(pages) $page]] == -1 } {
  210.         return -code error "page \"$page\" does not exists"
  211.     }
  212.     return $pos
  213. }
  214.  
  215.  
  216. # ------------------------------------------------------------------------------
  217. #  Command PagesManager::_select
  218. # ------------------------------------------------------------------------------
  219. proc PagesManager::_select { path page } {
  220.     variable $path
  221.     upvar 0  $path data
  222.  
  223.     set oldsel $data(select)
  224.     if { $page != $oldsel } {
  225.         set data(select) $page
  226.         _draw_area $path
  227.     }
  228. }
  229.  
  230.  
  231. # ------------------------------------------------------------------------------
  232. #  Command PagesManager::_redraw
  233. # ------------------------------------------------------------------------------
  234. proc PagesManager::_redraw { path } {
  235.     variable $path
  236.     upvar 0  $path data
  237.  
  238.     if { !$data(realized) } {
  239.         return
  240.     }
  241.     _draw_area $path
  242. }
  243.  
  244.  
  245. # ------------------------------------------------------------------------------
  246. #  Command PagesManager::_draw_area
  247. # ------------------------------------------------------------------------------
  248. proc PagesManager::_draw_area { path } {
  249.     variable $path
  250.     upvar 0  $path data
  251.  
  252.     set w   [expr {[winfo width  $path]-1}]
  253.     set h   [expr {[winfo height $path]-1}]
  254.     set sel $data(select)
  255.     if { $sel != "" } {
  256.         if { [llength [$path:cmd find withtag "window"]] } {
  257.             $path:cmd coords "window" 0 0
  258.             $path:cmd itemconfigure "window"    \
  259.                 -width  $w        \
  260.                 -height $h    \
  261.                 -window $path.f$sel
  262.         } else {
  263.             $path:cmd create window 0 0 \
  264.                 -width  $w          \
  265.                 -height $h       \
  266.                 -anchor nw                      \
  267.                 -tags   "window"                \
  268.                 -window $path.f$sel
  269.         }
  270.     } else {
  271.         $path:cmd delete "window"
  272.     }
  273. }
  274.  
  275.  
  276. # ------------------------------------------------------------------------------
  277. #  Command PagesManager::_resize
  278. # ------------------------------------------------------------------------------
  279. proc PagesManager::_resize { path } {
  280.     _draw_area   $path
  281. }
  282.  
  283.  
  284. # ------------------------------------------------------------------------------
  285. #  Command PagesManager::_realize
  286. # ------------------------------------------------------------------------------
  287. proc PagesManager::_realize { path } {
  288.     variable $path
  289.     upvar 0  $path data
  290.  
  291.     if { [set width  [Widget::cget $path -width]]  == 0 ||
  292.          [set height [Widget::cget $path -height]] == 0 } {
  293.         compute_size $path
  294.     }
  295.  
  296.     set data(realized) 1
  297.     _draw_area $path
  298.     bind $path <Configure> "PagesManager::_resize $path"
  299. }
  300.