Scid  4.6.5
pane.tcl
Go to the documentation of this file.
1 
2 # The following paned window code is loosely based on code from the book:
3 #
4 # Effective Tcl/Tk Programming
5 # Mark Harrison, DSC Communications Corp.
6 # Michael McLennan, Bell Labs Innovations for Lucent Technologies
7 # Addison-Wesley Professional Computing Series
8 # Copyright (c) 1996-1997 Lucent Technologies Inc. and Mark Harrison
9 #
10 # Many modifications and improvements for use in Scid have been made,
11 # including namespacing the code.
12 
13 namespace eval ::utils::pane {}
14 
15 array set ::utils::pane::_data {}
16 
17 # Create
18 #
19 # Create a paned window.
20 #
21 proc ::utils::pane::Create {win pane1 pane2 width height {ratio 0.5} {orient vert}} {
22  variable _data
23  set _data($win,1) $pane1
24  set _data($win,2) $pane2
25  set _data($win,drag) 1
26  set vertical 1
27  if {[string index $orient 0] == "h"} { set vertical 0}
28  set _data($win,vertical) $vertical
29  # Default minimum size of each frame is 10%:
30  set _data($win,min) 0.1
31  set _data($win,max) 0.9
32 
33  frame $win -width $width -height $height
34  frame $win.$pane1
35  frame $win.$pane2
36  if {$vertical} {
37  place $win.$pane1 -relx 0.5 -rely 0 -anchor n -relwidth 1.0 -relheight 0.5
38  place $win.$pane2 -relx 0.5 -rely 1 -anchor s -relwidth 1.0 -relheight 0.5
39 
40  frame $win.pane_sash -height 2 -borderwidth 2 -relief groove \
41  -cursor sb_v_double_arrow ;# -background black
42  place $win.pane_sash -relx 0.5 -rely 0.5 -relwidth 1.0 -anchor c
43 
44  frame $win.pane_grip -width 20 -height 7 -borderwidth 1 -relief solid \
45  -cursor sb_v_double_arrow -background gray
46  place $win.pane_grip -relx 0.95 -rely 0.5 -anchor c
47  } else {
48  place $win.$pane1 -relx 0 -rely 0.5 -anchor w -relwidth 0.5 -relheight 1.0
49  place $win.$pane2 -relx 1 -rely 0.5 -anchor e -relwidth 0.5 -relheight 1.0
50 
51  frame $win.pane_sash -width 1 -borderwidth 1 -relief flat \
52  -cursor sb_h_double_arrow -background black
53  place $win.pane_sash -relx 0.5 -rely 0.5 -relheight 1.0 -anchor c
54 
55  frame $win.pane_grip -height 20 -width 7 -borderwidth 1 -relief solid \
56  -cursor sb_h_double_arrow -background gray
57  place $win.pane_grip -relx 0.5 -rely 0.95 -anchor c
58  }
59 
60  #bind $win.pane_grip <Enter> "::utils::pane::Enter $win"
61  #bind $win.pane_grip <Leave> "::utils::pane::Leave $win"
62  #bind $win.pane_sash <Enter> "::utils::pane::Enter $win"
63  #bind $win.pane_sash <Leave> "::utils::pane::Leave $win"
64 
65  if {$vertical} { set c "%Y"} else { set c "%X"}
66  bind $win.pane_grip <ButtonPress-1> "::utils::pane::Grab $win"
67  bind $win.pane_grip <B1-Motion> "::utils::pane::Drag $win $c"
68  bind $win.pane_grip <ButtonRelease-1> "::utils::pane::Drop $win $c"
69  bind $win.pane_sash <ButtonPress-1> "::utils::pane::Grab $win"
70  bind $win.pane_sash <B1-Motion> "::utils::pane::Drag $win $c"
71  bind $win.pane_sash <ButtonRelease-1> "::utils::pane::Drop $win $c"
72 
73  ::utils::pane::Divide $win $ratio
74  return $win
75 }
76 
77 proc ::utils::pane::SetDrag {win bool} {
78  set ::utils::pane::_data($win,drag) $bool
79 }
80 
81 proc ::utils::pane::SetRange {win min max} {
82  set ::utils::pane::_data($win,min) $min
83  set ::utils::pane::_data($win,max) $max
84 }
85 
86 proc ::utils::pane::Enter {win} {
87  $win.pane_sash configure -background yellow
88  $win.pane_grip configure -background yellow
89 }
90 
91 proc ::utils::pane::Leave {win} {
92  $win.pane_sash configure -background black
93  $win.pane_grip configure -background black
94 }
95 
96 proc ::utils::pane::Grab {win} {
97  $win.pane_sash configure -background red
98  $win.pane_grip configure -background red
99 }
100 
101 proc ::utils::pane::Drag {win y} {
102  variable _data
103  set vertical $_data($win,vertical)
104  if {$vertical} {
105  set realY [expr {$y-[winfo rooty $win]}]
106  set Ymax [winfo height $win]
107  } else {
108  set realY [expr {$y-[winfo rootx $win]}]
109  set Ymax [winfo width $win]
110  }
111  set frac [expr {double($realY) / $Ymax}]
112  if {$frac < $_data($win,min)} {set frac $_data($win,min)}
113  if {$frac > $_data($win,max)} {set frac $_data($win,max)}
114 
115  if {$_data($win,drag)} {
116  ::utils::pane::Divide $win $frac
117  } else {
118  if {$vertical} {
119  place $win.pane_sash -rely $frac
120  place $win.pane_grip -rely $frac
121  } else {
122  place $win.pane_sash -relx $frac
123  place $win.pane_grip -relx $frac
124  }
125  }
126  return $frac
127 }
128 
129 proc ::utils::pane::Drop {win y} {
130  set frac [::utils::pane::Drag $win $y]
131  ::utils::pane::Divide $win $frac
132  $win.pane_sash configure -background black
133  $win.pane_grip configure -background gray
134 }
135 
136 proc ::utils::pane::Divide {win frac} {
137  if {$::utils::pane::_data($win,vertical)} {
138  place $win.pane_sash -rely $frac
139  place $win.pane_grip -rely $frac
140  place $win.$::utils::pane::_data($win,1) -relheight $frac
141  place $win.$::utils::pane::_data($win,2) -relheight [expr {1.0 - $frac}]
142  } else {
143  place $win.pane_sash -relx $frac
144  place $win.pane_grip -relx $frac
145  place $win.$::utils::pane::_data($win,1) -relwidth $frac
146  place $win.$::utils::pane::_data($win,2) -relwidth [expr {1.0 - $frac}]
147  }
148 }