1#!/bin/sh
2# the next line restarts using the interpreter \
3exec wish "$0" "$@"
4
5package require Tk
6
7# copyright (C) 1995-2004 Jean-Luc Fontaine (mailto:jfontain@free.fr)
8
9
10package require stooop 4.1
11namespace import stooop::*
12package require switched 2.2
13package require tkpiechart 6.3
14
15
16pack [label .m -relief sunken -text\
17    "you may move a pie by holding down mouse button 1 over any part of it"\
18] -fill x
19
20set canvas [canvas .c -highlightthickness 0]
21pack $canvas -fill both -expand 1
22
23set pie1 [new pie\
24    $canvas 0 0 -height 100 -thickness 20 -background gray\
25    -labeler [new pieBoxLabeler $canvas -justify center -offset 10]\
26    -title "this is pie #1" -titlefont fixed -titleoffset 6 -selectable 1\
27]
28# create a few slices
29set slice11 [pie::newSlice $pie1]
30set slice12 [pie::newSlice $pie1]
31set slice13 [pie::newSlice $pie1]
32set slice14 [pie::newSlice $pie1 {some text}]
33
34set pie2 [new pie\
35    $canvas 0 0 -height 100 -thickness 10 -background white\
36    -labeler [\
37        new piePeripheralLabeler $canvas\
38            -font {-weight bold -family Helvetica -size -20}\
39            -smallfont {-family Helvetica -size -8} -bulletwidth 1c\
40    ]\
41    -title "this is pie #2" -titleoffset 10\
42]
43set slice21 [pie::newSlice $pie2]
44set slice22 [pie::newSlice $pie2]
45
46# move pies through their tags
47$canvas move pie($pie1) 10 40
48$canvas move pie($pie2) 240 40
49
50# move pie when holding mouse button 1 in pie/labels area
51for {set index 1} {$index <= 2} {incr index} {
52    $canvas bind pie([set pie$index]) <ButtonPress-1> "
53        set xLast($index) %x
54        set yLast($index) %y
55    "
56    $canvas bind pie([set pie$index]) <Button1-Motion> "
57        $canvas move pie([set pie$index])\
58            \[expr %x - \$xLast($index)\] \[expr %y - \$yLast($index)\]
59        set xLast($index) %x
60        set yLast($index) %y
61    "
62}
63
64# add a couple of buttons
65button .d -text {Delete Pies} -command "
66    # delete pies thus freeing pie data and destroying pie widgets
67    delete $pie1 $pie2
68    .d configure -state disabled
69    set delete 1
70"
71button .q -text Exit -command exit
72pack .d .q -side left -fill x -expand 1
73
74# now start some animation
75
76set delete 0
77set u 1
78
79proc refresh {} {
80    if {$::delete} return
81    # size the slices in a semi randow way (slice size in per cent of whole pie)
82    set ::u [expr (3 * $::u) % 31]
83    pie::sizeSlice $::pie1 $::slice11 [expr $::u / 100.0]
84    set ::u [expr (5 * $::u) % 31]
85    pie::sizeSlice $::pie1 $::slice12 [expr $::u / 100.0]
86    set ::u [expr (7 * $::u) % 31]
87    # display lebel value in percent for this slice
88    pie::sizeSlice $::pie1 $::slice13 [expr $::u / 100.0] "$::u %"
89    pie::sizeSlice $::pie2 $::slice21 [expr $::u / 100.0] $::u
90    set ::u [expr (11 * $::u) % 31]
91    pie::sizeSlice $::pie1 $::slice14 [expr $::u / 100.0]
92    pie::sizeSlice $::pie2 $::slice22 [expr $::u / 100.0] $::u
93    update
94    after 3000 refresh
95}
96
97proc resize {width height} {
98    set width [expr {$width / 2.0}]
99    set height [expr {$height / 2.0}]
100    switched::configure $::pie1 -width $width -height $height
101    switched::configure $::pie2 -width $width -height $height
102    $::canvas configure -scrollregion [$::canvas bbox all]
103}
104
105$canvas configure -width 400 -height 300
106bind $canvas <Configure> "resize %w %h"
107refresh
108