1# RCS: @(#) $Id: random.tcl,v 1.27 2010/03/08 16:59:31 treectrl Exp $
2
3set RandomN 500
4set RandomDepth 5
5
6#
7# Demo: random N items
8#
9proc DemoRandom {} {
10
11    set T [DemoList]
12
13    InitPics folder-* small-*
14
15    set height [font metrics [$T cget -font] -linespace]
16    if {$height < 18} {
17	set height 18
18    }
19
20    #
21    # Configure the treectrl widget
22    #
23
24    $T configure -itemheight $height -selectmode extended \
25	-showroot yes -showrootbutton yes -showbuttons yes -showlines $::ShowLines \
26	-scrollmargin 16 -xscrolldelay "500 50" -yscrolldelay "500 50"
27
28    #
29    # Create columns
30    #
31
32    $T column create -expand yes -weight 4 -text Item -itembackground {#e0e8f0 {}} \
33	-tags colItem
34    $T column create -text Parent -justify center -itembackground {gray90 {}} \
35	-uniform a -expand yes -tags colParent
36    $T column create -text Depth -justify center -itembackground {linen {}} \
37	-uniform a -expand yes -tags colDepth
38
39    $T configure -treecolumn colItem
40
41    #
42    # Create elements
43    #
44
45    $T element create elemImgFolder image -image {folder-open {open} folder-closed {}}
46    $T element create elemImgFile image -image small-file
47    $T element create elemTxtName text -wrap none \
48	-fill [list $::SystemHighlightText {selected focus}]
49    $T element create elemTxtCount text -fill blue
50    $T element create elemTxtAny text
51    $T element create elemRectSel rect -showfocus yes \
52	-fill [list $::SystemHighlight {selected focus} gray {selected !focus}]
53
54    #
55    # Create styles using the elements
56    #
57
58    set S [$T style create styFolder]
59    $T style elements $S {elemRectSel elemImgFolder elemTxtName elemTxtCount}
60    $T style layout $S elemImgFolder -padx {0 4} -expand ns
61    $T style layout $S elemTxtName -minwidth 12 -padx {0 4} -expand ns -squeeze x
62    $T style layout $S elemTxtCount -padx {0 6} -expand ns
63    $T style layout $S elemRectSel -union [list elemTxtName] -iexpand ns -ipadx 2
64
65    set S [$T style create styFile]
66    $T style elements $S {elemRectSel elemImgFile elemTxtName}
67    $T style layout $S elemImgFile -padx {0 4} -expand ns
68    $T style layout $S elemTxtName -minwidth 12 -padx {0 4} -expand ns -squeeze x
69    $T style layout $S elemRectSel -union [list elemTxtName] -iexpand ns -ipadx 2
70
71    set S [$T style create styAny]
72    $T style elements $S {elemTxtAny}
73    $T style layout $S elemTxtAny -padx 6 -expand ns
74
75    TreeCtrl::SetSensitive $T {
76	{colItem styFolder elemRectSel elemImgFolder elemTxtName}
77	{colItem styFile elemRectSel elemImgFile elemTxtName}
78    }
79    TreeCtrl::SetDragImage $T {
80	{colItem styFolder elemImgFolder elemTxtName}
81	{colItem styFile elemImgFile elemTxtName}
82    }
83
84    #
85    # Create items and assign styles
86    #
87
88    set clicks [clock clicks]
89    $T item configure root -button auto
90    set items [$T item create -count [expr {$::RandomN - 1}] -button auto]
91    set added root
92    foreach itemi $items {
93	set j [expr {int(rand() * [llength $added])}]
94	set itemj [lindex $added $j]
95	if {[$T depth $itemj] < $::RandomDepth - 1} {
96	    lappend added $itemi
97	}
98	if {rand() * 2 > 1} {
99	    $T item collapse $itemi
100	}
101	if {rand() * 2 > 1} {
102	    $T item lastchild $itemj $itemi
103	} else {
104	    $T item firstchild $itemj $itemi
105	}
106    }
107    puts "created $::RandomN-1 items in [expr [clock clicks] - $clicks] clicks"
108
109    set clicks [clock clicks]
110    lappend items [$T item id root]
111    foreach item $items {
112	set numChildren [$T item numchildren $item]
113	if {$numChildren} {
114	    $T item style set $item colItem styFolder colParent styAny colDepth styAny
115	    $T item element configure $item \
116		colItem elemTxtName -text "Item $item" + elemTxtCount -text "($numChildren)" , \
117		colParent elemTxtAny -text "[$T item parent $item]" , \
118		colDepth elemTxtAny -text "[$T depth $item]"
119	} else {
120	    $T item style set $item colItem styFile colParent styAny colDepth styAny
121	    $T item element configure $item \
122		colItem elemTxtName -text "Item $item" , \
123		colParent elemTxtAny -text "[$T item parent $item]" , \
124		colDepth elemTxtAny -text "[$T depth $item]"
125	}
126    }
127    puts "configured $::RandomN items in [expr [clock clicks] - $clicks] clicks"
128
129    bind DemoRandom <Double-ButtonPress-1> {
130	TreeCtrl::DoubleButton1 %W %x %y
131	break
132    }
133    bind DemoRandom <Control-ButtonPress-1> {
134	set TreeCtrl::Priv(selectMode) toggle
135	RandomButton1 %W %x %y
136	break
137    }
138    bind DemoRandom <Shift-ButtonPress-1> {
139	set TreeCtrl::Priv(selectMode) add
140	RandomButton1 %W %x %y
141	break
142    }
143    bind DemoRandom <ButtonPress-1> {
144	set TreeCtrl::Priv(selectMode) set
145	RandomButton1 %W %x %y
146	break
147    }
148    bind DemoRandom <Button1-Motion> {
149	RandomMotion1 %W %x %y
150	break
151    }
152    bind DemoRandom <ButtonRelease-1> {
153	RandomRelease1 %W %x %y
154	break
155    }
156
157    bindtags $T [list $T DemoRandom TreeCtrl [winfo toplevel $T] all]
158
159    return
160}
161
162proc RandomButton1 {T x y} {
163    variable TreeCtrl::Priv
164    focus $T
165    set id [$T identify $x $y]
166    set Priv(buttonMode) ""
167
168    # Click outside any item
169    if {$id eq ""} {
170	$T selection clear
171
172    # Click in header
173    } elseif {[lindex $id 0] eq "header"} {
174	TreeCtrl::ButtonPress1 $T $x $y
175
176    # Click in item
177    } else {
178	lassign $id where item arg1 arg2 arg3 arg4
179	switch $arg1 {
180	    button {
181		$T item toggle $item
182	    }
183	    line {
184		$T item toggle $arg2
185	    }
186	    column {
187		if {![TreeCtrl::IsSensitive $T $x $y]} {
188		    $T selection clear
189		    return
190		}
191
192		set Priv(drag,motion) 0
193		set Priv(drag,click,x) $x
194		set Priv(drag,click,y) $y
195		    set Priv(drag,x) [$T canvasx $x]
196		set Priv(drag,y) [$T canvasy $y]
197		set Priv(drop) ""
198
199		if {$Priv(selectMode) eq "add"} {
200		    TreeCtrl::BeginExtend $T $item
201		} elseif {$Priv(selectMode) eq "toggle"} {
202		    TreeCtrl::BeginToggle $T $item
203		} elseif {![$T selection includes $item]} {
204		    TreeCtrl::BeginSelect $T $item
205		}
206		$T activate $item
207
208		if {[$T selection includes $item]} {
209		    set Priv(buttonMode) drag
210		}
211	    }
212	}
213    }
214    return
215}
216
217proc RandomMotion1 {T x y} {
218    variable TreeCtrl::Priv
219    if {![info exists Priv(buttonMode)]} return
220    switch $Priv(buttonMode) {
221	"drag" {
222	    set Priv(autoscan,command,$T) {RandomMotion %T %x %y}
223	    TreeCtrl::AutoScanCheck $T $x $y
224	    RandomMotion $T $x $y
225	}
226	default {
227	    TreeCtrl::Motion1 $T $x $y
228	}
229    }
230    return
231}
232
233proc RandomMotion {T x y} {
234    variable TreeCtrl::Priv
235    switch $Priv(buttonMode) {
236	"drag" {
237	    if {!$Priv(drag,motion)} {
238		# Detect initial mouse movement
239		if {(abs($x - $Priv(drag,click,x)) <= 4) &&
240		    (abs($y - $Priv(drag,click,y)) <= 4)} return
241
242		set Priv(selection) [$T selection get]
243		set Priv(drop) ""
244		$T dragimage clear
245		# For each selected item, add 2nd and 3rd elements of
246		# column "item" to the dragimage
247		foreach I $Priv(selection) {
248		    foreach list $Priv(dragimage,$T) {
249			set C [lindex $list 0]
250			set S [lindex $list 1]
251			if {[$T item style set $I $C] eq $S} {
252			    eval $T dragimage add $I $C [lrange $list 2 end]
253			}
254		    }
255		}
256		set Priv(drag,motion) 1
257	    }
258
259	    # Find the item under the cursor
260	    set cursor X_cursor
261	    set drop ""
262	    set id [$T identify $x $y]
263	    if {[TreeCtrl::IsSensitive $T $x $y]} {
264		set item [lindex $id 1]
265		# If the item is not in the pre-drag selection
266		# (i.e. not being dragged) see if we can drop on it
267		if {[lsearch -exact $Priv(selection) $item] == -1} {
268		    set drop $item
269		    # We can drop if dragged item isn't an ancestor
270		    foreach item2 $Priv(selection) {
271			if {[$T item isancestor $item2 $item]} {
272			    set drop ""
273			    break
274			}
275		    }
276		    if {$drop ne ""} {
277			scan [$T item bbox $drop] "%d %d %d %d" x1 y1 x2 y2
278			if {$y < $y1 + 3} {
279			    set cursor top_side
280			    set Priv(drop,pos) prevsibling
281			} elseif {$y >= $y2 - 3} {
282			    set cursor bottom_side
283			    set Priv(drop,pos) nextsibling
284			} else {
285			    set cursor ""
286			    set Priv(drop,pos) lastchild
287			}
288		    }
289		}
290	    }
291
292	    if {[$T cget -cursor] ne $cursor} {
293		$T configure -cursor $cursor
294	    }
295
296	    # Select the item under the cursor (if any) and deselect
297	    # the previous drop-item (if any)
298	    $T selection modify $drop $Priv(drop)
299	    set Priv(drop) $drop
300
301	    # Show the dragimage in its new position
302	    set x [expr {[$T canvasx $x] - $Priv(drag,x)}]
303	    set y [expr {[$T canvasy $y] - $Priv(drag,y)}]
304	    $T dragimage offset $x $y
305	    $T dragimage configure -visible yes
306	}
307	default {
308	    TreeCtrl::Motion1 $T $x $y
309	}
310    }
311    return
312}
313
314proc RandomRelease1 {T x y} {
315    variable TreeCtrl::Priv
316if {![info exists Priv(buttonMode)]} return
317    switch $Priv(buttonMode) {
318	"drag" {
319	    TreeCtrl::AutoScanCancel $T
320	    $T dragimage configure -visible no
321	    $T selection modify {} $Priv(drop)
322	    $T configure -cursor ""
323	    if {$Priv(drop) ne ""} {
324		RandomDrop $T $Priv(drop) $Priv(selection) $Priv(drop,pos)
325	    }
326	    unset Priv(buttonMode)
327	}
328	default {
329	    TreeCtrl::Release1 $T $x $y
330	}
331    }
332    return
333}
334
335proc RandomDrop {T target source pos} {
336    set parentList {}
337    switch -- $pos {
338	lastchild { set parent $target }
339	prevsibling { set parent [$T item parent $target] }
340	nextsibling { set parent [$T item parent $target] }
341    }
342    foreach item $source {
343
344	# Ignore any item whose ancestor is also selected
345	set ignore 0
346	foreach ancestor [$T item ancestors $item] {
347	    if {[lsearch -exact $source $ancestor] != -1} {
348		set ignore 1
349		break
350	    }
351	}
352	if {$ignore} continue
353
354	# Update the old parent of this moved item later
355	if {[lsearch -exact $parentList $item] == -1} {
356	    lappend parentList [$T item parent $item]
357	}
358
359	# Add to target
360	$T item $pos $target $item
361
362	# Update text: parent
363	$T item element configure $item colParent elemTxtAny -text $parent
364
365	# Update text: depth
366	$T item element configure $item colDepth elemTxtAny -text [$T depth $item]
367
368	# Recursively update text: depth
369	foreach item [$T item descendants $item] {
370	    $T item element configure $item colDepth elemTxtAny -text [$T depth $item]
371	}
372    }
373
374    # Update items that lost some children
375    foreach item $parentList {
376	set numChildren [$T item numchildren $item]
377	if {$numChildren == 0} {
378	    $T item style map $item colItem styFile {elemTxtName elemTxtName}
379	} else {
380	    $T item element configure $item colItem elemTxtCount -text "($numChildren)"
381	}
382    }
383
384    # Update the target that gained some children
385    if {[$T item style set $parent colItem] ne "styFolder"} {
386	$T item style map $parent colItem styFolder {elemTxtName elemTxtName}
387    }
388    set numChildren [$T item numchildren $parent]
389    $T item element configure $parent colItem elemTxtCount -text "($numChildren)"
390    return
391}
392
393#
394# Demo: random N items, button images
395#
396proc DemoRandom2 {} {
397
398    set T [DemoList]
399
400    DemoRandom
401
402    InitPics mac-*
403
404    $T configure -buttonimage {mac-collapse open mac-expand {}} \
405	-showlines no
406
407    return
408}
409
410