1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
#!/usr/bin/wish -f
canvas .net -width 1000 -height 800 -background white -relief sunken
pack .net -side bottom
# init variables
set classes 0; set oldx 0; set oldy 0;
# can be change to modify classes aperance (at your own risks)
set attrH 15; set attrX 5; set captionH 30; set charSize 10
# Primitive to draw a class : it automatically fits the members (could be wrong for some names)
proc makeClass {x y caption pubAttrs protAttrs privAttrs} {
global classes attrH attrX captionH charSize
set classes [expr "$classes+1"]
set ox [expr "$x+$attrX"]; set oy [expr "$y+$captionH"]
set maxl [string length $caption]
for {set i 0} {$i < [llength $pubAttrs] } {incr i} {
set oy [expr "$oy+$attrH"];
.net create text $ox $oy -tag pubattr$classes$i -text [lindex $pubAttrs $i] -anchor w \
-font -*-courier-medium-r-*-*-12-*
if {$maxl < [string length [lindex $pubAttrs $i]]} {
set maxl [string length [lindex $pubAttrs $i]]
}
}
set oy1 [expr "$oy+$attrH"];
set oy [expr "$oy+$attrH"];
for {set i 0} {$i < [llength $protAttrs] } {incr i} {
set oy [expr "$oy+$attrH"];
.net create text $ox $oy -tag protattr$classes$i -text [lindex $protAttrs $i] -anchor w \
-font -*-courier-medium-r-*-*-12-*
if {$maxl < [string length [lindex $protAttrs $i]]} {
set maxl [string length [lindex $protAttrs $i]]
}
}
set oy2 [expr "$oy+$attrH"];
set oy [expr "$oy+$attrH"];
for {set i 0} {$i < [llength $privAttrs] } {incr i} {
set oy [expr "$oy+$attrH"];
.net create text $ox $oy -tag privattr$classes$i -text [lindex $privAttrs $i] -anchor w \
-font -*-courier-medium-r-*-*-12-*
if {$maxl < [string length [lindex $privAttrs $i]]} {
set maxl [string length [lindex $privAttrs $i]]
}
}
set oy [expr "$oy+$attrH"];
set x2 [expr "$x+$maxl*$charSize+10"];
.net create text [expr "$x+($x2-$x)/2"] [expr "$y+($captionH)/2"] -tag caption$classes \
-text $caption -font -*-helvetica-bold-r-*-*-14-*
.net create rectangle $x $y $x2 $oy -tag rect$classes
.net create line $x [expr "$y+$captionH"] $x2 [expr "$y+$captionH"] -tag captionLine$classes
.net create line $x $oy1 $x2 $oy1 -tag pubprotLine$classes
.net create line $x $oy2 $x2 $oy2 -tag protprivLine$classes
# these are the possible actions a user can perform on the classes
.net bind rect$classes <Enter> ".net itemconfigure rect$classes -width 5"
.net bind rect$classes <Leave> ".net itemconfigure rect$classes -width 1"
.net bind rect$classes <ButtonPress-1> "beginmove %x %y"
.net bind rect$classes <B1-Motion> "moveClass $classes [llength $pubAttrs] [llength $protAttrs] \
[llength $privAttrs] %x %y"
}
# this primitive gives the begining,intermediate and ending points the link should follow to be
# drawn between two classes.
proc getRelationPoints {classId1 classId2} {
set bbox1 [.net bbox rect$classId1]; set bbox2 [.net bbox rect$classId2]
set mx1 [expr "([lindex $bbox1 0]+[lindex $bbox1 2])/2"]
set mx2 [expr "([lindex $bbox2 0]+[lindex $bbox2 2])/2"]
set my1 [expr "([lindex $bbox1 1]+[lindex $bbox1 3])/2"]
set my2 [expr "([lindex $bbox2 1]+[lindex $bbox2 3])/2"]
if {[lindex $bbox2 0] > [lindex $bbox1 2]} {
set xorig [lindex $bbox1 2]; set yorig $my1
if {$my1 <= [lindex $bbox2 3] && $my1 >= [lindex $bbox2 1]} {
set xdest [lindex $bbox2 0]; set ydest $my1; set xint [expr "($mx2+$mx1)/2"]; set yint $my1
} else {
if {$my1 < [lindex $bbox2 3]} {
set ydest [lindex $bbox2 1]; set xdest $mx2; set yint $my1; set xint $mx2
} else {
set ydest [lindex $bbox2 3]; set xdest $mx2; set yint $my1; set xint $mx2
}
}
return "$xorig $yorig $xint $yint $xdest $ydest"
}
if {[lindex $bbox1 0] > [lindex $bbox2 2]} {
set xorig [lindex $bbox1 0]; set yorig $my1
if {$my1 <= [lindex $bbox2 3] && $my1 >= [lindex $bbox2 1]} {
set xdest [lindex $bbox2 2]; set ydest $my1; set xint [expr "($mx1+$mx2)/2"]; set yint $my1
} else {
if {$my1 < [lindex $bbox2 3]} {
set ydest [lindex $bbox2 1]; set xdest $mx2; set yint $my1; set xint $mx2
} else {
set ydest [lindex $bbox2 3]; set xdest $mx2; set yint $my1; set xint $mx2
}
}
return "$xorig $yorig $xint $yint $xdest $ydest"
}
if {$my1 > $my2} {
set xorig $mx1; set yorig [lindex $bbox1 1]
set xint1 $mx1; set yint1 [expr "([lindex $bbox2 3]+[lindex $bbox1 1])/2"]
set xint2 $mx2; set yint2 $yint1
set xdest $mx2; set ydest [lindex $bbox2 3]
} else {
set xorig $mx1; set yorig [lindex $bbox1 3]
set xint1 $mx1; set yint1 [expr "([lindex $bbox2 1]+[lindex $bbox1 3])/2"]
set xint2 $mx2; set yint2 $yint1
set xdest $mx2; set ydest [lindex $bbox2 1]
}
return "$xorig $yorig $xint1 $yint1 $xint2 $yint2 $xdest $ydest"
}
# makes a relation using the "getRelationPoints" primitive
proc makeRelation {classId1 classId2} {
eval {.net create line} [getRelationPoints $classId1 $classId2] \
{-tag rel$classId1$classId2}
.net addtag rel$classId2$classId1 withtag rel$classId1$classId2
}
# register the old position of the mouse
proc beginmove {x y} {
global oldx oldy
set oldx $x; set oldy $y
}
# move the class from (x-oldx, y-oldy)
proc moveClass {classId nPubAttrs nProtAttrs nPrivAttrs x y} {
global oldx oldy classes
.net move rect$classId [expr "$x - $oldx"] [expr "$y - $oldy"]
.net move caption$classId [expr "$x - $oldx"] [expr "$y - $oldy"]
.net move captionLine$classId [expr "$x - $oldx"] [expr "$y - $oldy"]
for {set i 0} {$i < $nPubAttrs} {incr i} {
.net move pubattr$classId$i [expr "$x - $oldx"] [expr "$y - $oldy"]
}
for {set i 0} {$i < $nProtAttrs} {incr i} {
.net move protattr$classId$i [expr "$x - $oldx"] [expr "$y - $oldy"]
}
for {set i 0} {$i < $nPrivAttrs} {incr i} {
.net move privattr$classId$i [expr "$x - $oldx"] [expr "$y - $oldy"]
}
.net move pubprotLine$classId [expr "$x - $oldx"] [expr "$y - $oldy"]
.net move protprivLine$classId [expr "$x - $oldx"] [expr "$y - $oldy"]
for {set i 1} {$i <= $classes} {incr i} {
eval {.net coords rel$classId$i} [getRelationPoints $classId $i]
}
set oldx $x; set oldy $y
}
# the graph compiler will append the code to draw the classes after this line...
|
