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
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
#
# Manipulation des points
# (c) 1995-7 Alexandre Burton
# v. 1.80a (10/08/97)
#
proc updatePoints { cible } {
global data actif items path couleur
update
$path(area) delete $cible
array set dataCourant $data($cible)
foreach floatX [array names dataCourant] {
set floatY $dataCourant($floatX)
set screenY [floatToScreenY $floatY]
set screenX [floatToScreenX $floatX]
set item [$path(area) create oval [expr $screenX-2] [expr $screenY-2] \
[expr $screenX+2] [expr $screenY+2] \
-width 1 -outline $couleur(active) -fill $couleur($cible) ]
$path(area) addtag point withtag $item
$path(area) addtag $cible withtag $item
set itemsInit($item) $floatX
set dataInit($floatX) $floatY
}
set items($cible) [array get itemsInit]
}
proc kilkil {x y} {
global path
$path(area) addtag toKill withtag current
killPoint $x $y
}
proc selectKill {} {
global couleur path
$path(area) itemconfig current -fill $couleur(kill)
$path(area) addtag toKill withtag current
}
proc killPoint {x y} {
global liste items actif couleur data path
set victime [$path(area) find withtag toKill]
if {$victime > 0} {
array set itemsCourant $items($actif)
set locFloat(x) $itemsCourant($victime)
if { $locFloat(x) > 0 && $locFloat(x) < 1 } then {
array set dataCourant $data($actif)
unset itemsCourant($victime)
unset dataCourant($locFloat(x))
set items($actif) [array get itemsCourant]
set data($actif) [array get dataCourant]
$path(area) delete toKill
updateLine $actif
} else {
$path(area) itemconfig toKill -fill $couleur($actif)
$path(area) dtag toKill
}
}
}
proc allume {} {
global couleur actif path
if { [$path(area) itemcget current -fill] == $couleur($actif) } {
$path(area) dtag active
$path(area) addtag active withtag current
$path(area) itemconfig current -fill $couleur(fg) -outline black
}
}
proc allumeLigne {} {
global couleur actif path
set couleur(ligne) [$path(area) itemcget current -fill]
$path(area) itemconfig current -fill $couleur(fg)
}
proc addPoint {x y} {
global items data limite actif couleur path
set x [$path(area) canvasx $x]
set y [$path(area) canvasy $y]
if { $x <= $limite(supX) && $x >= $limite(pad) && $y <= $limite(supY) && $y >= $limite(pad) } then {
array set itemsCourant $items($actif)
array set dataCourant $data($actif)
set locFloat(x) [screenToFloatX $x]
if { [ lsearch -exact [array names dataCourant] $locFloat(x) ] == "-1" } then {
set item [$path(area) create oval [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2] \
-width 1 -outline black -fill $couleur($actif) ]
set dataX [screenToFloatX $x ]
set dataY [screenToFloatY $y ]
set itemsCourant($item) $dataX
set dataCourant($dataX) $dataY
set items($actif) [array get itemsCourant]
set data($actif) [array get dataCourant]
$path(area) addtag point withtag $item
$path(area) addtag $actif withtag $item
$path(area) addtag point.$actif withtag $item
$path(area) addtag selected withtag $item
$path(area) raise selected
unset x y itemsCourant dataCourant dataX dataY
}
}
}
proc plotDown {x y} {
global cfont plot data limite items dragging actif couleur soundOutInfo path module fenetre
update
if {[$path(area) find withtag toKill] > 0} {return}
set item [$path(area) find withtag current]
set tags [$path(area) gettags $item]
foreach t $tags {
# if [string match line.* $t ] { grabLine [string trim [file extension $t] .] $y; return}
if [string match line.* $t ] { grabLine [lindex [split $t .] 1] $y; return}
}
$path(area) dtag selected
$path(area) addtag selected withtag active
$path(area) dtag active
if [info exists dragging] {return 0}
$path(area) dtag line selected
$path(area) raise selected
if {[$path(area) find withtag selected] < 1 } {addPoint $x $y}
if {[$path(area) find withtag selected] > 0} {
array set itemsCourant $items($actif)
array set dataCourant $data($actif)
set listeCourante [lsort -real [array names dataCourant] ]
set itemSelection [$path(area) find withtag selected]
set locFloat(curX) $itemsCourant($itemSelection)
set plot(float) $locFloat(curX)
set positionCourante [lsearch -exact $listeCourante $locFloat(curX)]
set positionPrecedente [expr $positionCourante -1]
set positionSuivante [expr $positionCourante +1]
set locFloat(preX) [lindex $listeCourante $positionPrecedente]
set locFloat(postX) [lindex $listeCourante $positionSuivante]
set plot(lastX) [floatToScreenX [lindex $listeCourante $positionCourante]]
set plot(lastY) [floatToScreenY $dataCourant([lindex $listeCourante $positionCourante])]
if {$locFloat(curX) == 0} then {
set plot(preX) $plot(lastX)
set plot(preY) $plot(lastY)
set plot(postX) [floatToScreenX [lindex $listeCourante $positionSuivante]]
set plot(postY) [floatToScreenY $dataCourant($locFloat(postX))]
set plot(minX) $plot(lastX)
set plot(maxX) $plot(lastX)
set plot(fixed) 1
} else {
if {$locFloat(curX) == 1} then {
set plot(preX) [floatToScreenX [lindex $listeCourante $positionPrecedente]]
set plot(preY) [floatToScreenY $dataCourant($locFloat(preX))]
set plot(postX) $plot(lastX)
set plot(postY) $plot(lastY)
set plot(minX) $plot(lastX)
set plot(maxX) $plot(lastX)
set plot(fixed) 1
} else {
set plot(preX) [floatToScreenX [lindex $listeCourante $positionPrecedente]]
set plot(preY) [floatToScreenY $dataCourant($locFloat(preX))]
set plot(postX) [floatToScreenX [lindex $listeCourante $positionSuivante]]
set plot(postY) [floatToScreenY $dataCourant($locFloat(postX))]
set plot(minX) [expr $plot(preX) + 1]
set plot(maxX) [expr $plot(postX) - 1]
set plot(fixed) 0
}
}
if {$plot(minX) > $plot(lastX) && $plot(maxX) < $plot(lastX)} {set $plot(minX) $plot(lastX); set plot(fixed) 1}
set plot(origX) $plot(lastX)
set tempGraph [list $plot(preX) $plot(preY) $plot(lastX) $plot(lastY) $plot(postX) $plot(postY)]
eval {$path(area) create line} $tempGraph {-width 0 -tags tempLine -fill $couleur(kill) }
set rx [winfo height $path(rulerX)]
if {$soundOutInfo(duree) >0} {
$path(rulerX) create line $plot(lastX) 0 $plot(lastX) $rx -tags coorX -fill grey40
}
$path(rulerY) create line 0 [expr $plot(lastY)] 40 [expr $plot(lastY)] -tags coorY -fill grey40
if {($couleur(gridC) != "gray89")&&($couleur(gridC) != "gray90")} {
$path(area) create line $limite(pad) $plot(lastY) [expr $fenetre(maxX) -$limite(pad)] $plot(lastY) -tags [list coorLY ruleC] -fill $couleur(gridC)
$path(area) create text $plot(lastX) $plot(lastY) -anchor se -justify r -font $cfont(small) -tags [list coor ruleC] -fill $couleur(gridC)
if {$soundOutInfo(duree) >0} {
$path(area) create line $plot(lastX) $limite(pad) $plot(lastX) [expr $fenetre(maxY) -$limite(pad)] -tags [list coorLX ruleC] -fill $couleur(gridC)
}
temoin [screenToFloatX $plot(lastX)] [screenToFloatY $plot(lastY)]
}
}
}
proc plotMove {x y} {
global plot limite actif path dragging
if [info exists dragging] {lineMove $y; return}
if {[$path(area) find withtag selected] > 0 } {
set x [$path(area) canvasx $x]
set y [$path(area) canvasy $y]
if {$x < $plot(minX)} {set x $plot(minX)}
if {$x > $plot(maxX)} {set x $plot(maxX)}
if {$y < $limite(pad)} {set y $limite(pad)}
if {$y > $limite(supY)} {set y $limite(supY)}
if {$plot(fixed)} {set x $plot(lastX)}
set diffX [expr $x - $plot(lastX)]
set diffY [expr $y - $plot(lastY)]
$path(area) move selected $diffX $diffY
$path(area) move coor $diffX $diffY
$path(area) move coorY 0 $diffY
$path(area) move coorX $diffX 0
$path(rulerX) move coorX $diffX 0
$path(rulerY) move coorY 0 $diffY
$path(area) move coorLY 0 $diffY
$path(area) move coorLX $diffX 0
set plot(lastX) $x
set plot(lastY) $y
temoin [screenToFloatX $x] [screenToFloatY $y]
eval {$path(area) coords tempLine} $plot(preX) $plot(preY) $x $y $plot(postX) $plot(postY)
# $path(area) lower tempLine
}
}
proc eteint {} {
global couleur actif path
$path(area) dtag toKill
$path(area) dtag active
set couleur(current) [$path(area) itemcget current -fill]
if { $couleur(current) == $couleur(fg) || $couleur(current) == $couleur(kill) } {
$path(area) itemconfig current -fill $couleur($actif)
}
}
proc eteintLigne {} {
global couleur actif path
set couleur(current) [$path(area) itemcget current -fill]
$path(area) itemconfig current -fill $couleur(ligne)
}
|
