home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / spectcl-.000 / spectcl- / usr / local / SpecTcl-0.1a / grid.tk < prev    next >
Encoding:
Text File  |  1995-11-06  |  6.5 KB  |  225 lines
  1. # SpecTcl, by S. A. Uhler
  2. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  3. #
  4. # See the file "license.txt" for information on usage and redistribution
  5. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  6. #
  7. # do grid related stuff (take 2)
  8. # all of the information is derived from querying the table layout
  9. # Grid lines are placed in "odd" rows and columns
  10.  
  11. # create the grid - for starting
  12. #  master:            master of the table
  13. #  max rows/cols:    how many grid lines to create
  14. #  size:            The thickness of each grid line
  15. #  spacing:            The grid spacing
  16. #  color:            The color of each grid line
  17.  
  18. proc grid_create {master maxrows maxcols size color {relief raised}} {
  19.     global P
  20.     # undo_log create_grid $master $maxrows $maxcols
  21.     dputs $master $maxrows,$maxcols
  22.     # should use existing grid lines instead
  23.     catch {frame $master.@0 -bg $color -bd 1 -relief $relief}
  24.     blt_table $master $master.@0 1,1 -fill both
  25.     for {set row 1} {$row <= $maxrows} {incr row 2} {
  26.         grid_line $master row $color $size $relief $row
  27.     }
  28.     for {set col 1} {$col <= $maxcols} {incr col 2} {
  29.         grid_line $master column $color $size $relief $col
  30.     }
  31.     grid_update $master
  32.     resize_init $master [expr $maxrows/2-1] [expr $maxcols/2-1] $P(grid_spacing)
  33.     grid_spacing $master
  34.     blt_table row $master configure 0 -height 0 -resize none
  35.     blt_table column $master configure 0 -width 0 -resize none
  36. }
  37.  
  38. # create a grid row or column separator frame
  39. #  master:  master of the table
  40. #  what:    "row" or "column"
  41. #  color:   grid line color
  42. #  thick:   Grid line thickness
  43. #  index:   row or column number (must be odd). Defaults to end.
  44.  
  45. proc grid_line {master what color thick {relief raised} {index ""}} {
  46.     dputs "$master $what"
  47.     if {$index == ""} {        ;# find the next grid line
  48.         set index 1
  49.         set slaves [blt_table slaves $master $master.${what}@*]
  50.         regexp {[^@]+@(.*)} [lindex $slaves 0] dummy index
  51.         incr index 2
  52.     } elseif {[winfo exists $master.${what}@$index]} {
  53.         dputs skipping $index: already exists
  54.         return $index
  55.     }
  56.     array set cursor {row sb_v_double_arrow column sb_h_double_arrow}
  57.     array set option {row height column width}
  58.     array set slot {row 0 column 1}
  59.     set win $master.${what}@$index
  60.     set place [join [lreplace {2 2} $slot($what) $slot($what) $index] ,]
  61.  
  62.     frame $win -bg $color -cursor $cursor($what) -bd 1 -relief $relief
  63.     if {$what == "row"} {
  64.         raise $win $master.row@1
  65.     } else {
  66.         lower $win $master.row@1
  67.     }
  68.     blt_table $master $win $place -fill both
  69.     blt_table $what $master configure $index -$option($what) $thick
  70.     bindtags $win "First grid $what [winfo toplevel $win] all"
  71.     # too late - we've lost the row/column number
  72.     # resize_insert $master $what $index
  73.     return $index
  74. }
  75.  
  76. # remove the last grid line - but not the first
  77.  
  78. proc grid_remove {master what} {
  79.     set slaves [blt_table slaves $master $master.${what}@*]
  80.     if {[llength $slaves] > 2} {
  81.         set slave [lindex $slaves 0]
  82.         # puts "removing grid $what <$slave>"
  83.         catch {destroy $slave}
  84.         return 1
  85.     } else {
  86.         return 0
  87.     }
  88. }
  89.  
  90. # return current grid size
  91.  
  92. proc grid_size {master {rows dummy} {cols dummy}} {
  93.     upvar $rows maxrows $cols maxcols
  94.     set maxrows [expr [llength [blt_table slaves $master $master.row@*]] * 2]
  95.     set maxcols [expr [llength [blt_table slaves $master $master.column@*]] * 2]
  96.     return $maxrows,$maxcols
  97. }
  98.  
  99. # destroy a grid entirely
  100.  
  101. proc grid_destroy {master} {
  102.     set slaves [blt_table slaves $master $master.*@*]
  103.     foreach i $slaves {
  104.         destroy $i
  105.     }
  106. }
  107.  
  108. # see if we need to add a new grid row or column
  109. #  what:    row or column
  110. #  return:  # of grid lines we need to add
  111.  
  112. proc grid_check {master what} {
  113.     set slots [blt_table $what $master dimension]
  114.     set grids [llength [blt_table slaves $master $master.${what}@*]]
  115.     # puts "grid_check (1+$slots)/2 - $grids"
  116.     return [expr (1+$slots)/2 - $grids]  ;# CHECK
  117. }
  118.  
  119. # update the row/col grid lengths after adding new grid lines to the table
  120. # look at the actual grid lines, as the table dimension isn't always reliable
  121. #   master: The master of the table
  122.  
  123. proc grid_update {master} {
  124.     array set other {row column column row}
  125.     set span 1
  126.     foreach what {row column} {
  127.         set slaves [blt_table slaves $master $master.$other($what)@*]
  128.         regexp {[^@]+@(.*)} [lindex $slaves 0] dummy span
  129.         incr span -1
  130.         dputs $what $slaves span=$span
  131.         foreach i [blt_table slaves $master $master.${what}@*] {
  132.             blt_table configure $i -$other($what)span $span
  133.         }
  134.     }
  135. }
  136.  
  137. # set the grid spacing to match the configuration info
  138. #   master:  Which table
  139.  
  140. proc grid_spacing {master} {
  141.     upvar #0 [winfo name $master] data
  142.  
  143.     dputs "$master $data(min_column) $data(min_row)"
  144.     set column 0
  145.     foreach width $data(min_column) {
  146.         blt_table column $master configure [incr column 2] -width "$width Inf"
  147.     }
  148.     set row 0
  149.     foreach height $data(min_row) {
  150.         blt_table row $master configure [incr row 2] -height "$height Inf"
  151.     }
  152. }
  153.  
  154. # turn a grid on/off - specify its size
  155.  
  156. proc grid_resize {win {size 3}} {
  157.     if {$size == "on"} {set size 3}
  158.     if {$size == "off"} {set size 0}
  159.     set rows [blt_table row $win dimension]
  160.     set cols [blt_table column $win dimension]
  161.     for {set row 1} {$row < $rows} {incr row 2} {
  162.         append row_list " $row"
  163.     }
  164.     for {set col 1} {$col < $cols} {incr col 2} {
  165.         append col_list " $col"
  166.     }
  167.     blt_table column $win configure $col_list -width $size
  168.     blt_table row $win configure $row_list -height $size
  169. }
  170.  
  171. # insert a row or column into a grid - invoked from a grid-window binding
  172. # Then update the grid as needed
  173.  
  174. proc grid_insert {win} {
  175.     set what [split [winfo name $win] @]
  176.     set master [winfo parent $win]
  177.     set index [lindex $what 1]
  178.     set what [lindex $what 0]
  179.     dputs $what $master $index
  180.     table_insert $master $what [incr index]
  181.     # undo_mark
  182.     grid_process $master $what 1
  183.     update_table $master "insert $what $index"
  184. }
  185.  
  186. # check the grid to see if it needs to be bigger
  187.  
  188. proc grid_process {master what {always 0}} {
  189.     global P Current
  190.     if {$always || [grid_check $master $what]} {
  191.         if {$what == "row"} {
  192.             set color [$master.column@1 cget -bg]
  193.         } else {
  194.             set color [$master.row@1 cget -bg]
  195.         }
  196.         set relief [$master.row@1 cget -relief]
  197.         set index [grid_line $master $what $color $P(grid_size) $relief]
  198.         grid_update $master 
  199.         grid_spacing $master
  200.         table_setup $master
  201.         # need to have the new shape by here (we don't)
  202.         arrow_create .can_$what $what $master
  203.  
  204.         # this is overkill!
  205.         arrow_activate .can $Current(frame)        ;# temporary?
  206.  
  207.         # undo_log create_slot $master $what $index
  208.         return 1
  209.     } 
  210.     return 0
  211. }
  212.  
  213. # change the color of a grid (to make it invisible?)
  214.  
  215. proc grid_color {master color} {
  216.     if {[$master.row@1 cget -bg] == $color} {
  217.         return 0
  218.     }
  219.     set list [info commands $master.*@*]
  220.     foreach line $list {
  221.         $line configure -bg $color
  222.     }    
  223.     return 1
  224. }    
  225.