blob: f85f55392cbe07d392c77b11c670e2c34c6db5f9 (
plain)
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
|
package provide dzinc 0.1
package require Tkzinc
class_new Zinc {Thing}
def Zinc init {} {
set @group [eval old_$self add group 1]
}
def Zinc unknown {args} {
upvar 1 selector selector
old_$self $selector {expand}$args
}
rename canvas old_canvas
proc option_replace {argz} {
#set new_args {}
foreach {option val} $argz {
switch -- $option {
-bg {set option -backcolor}
-background {set option -backcolor}
-bd {set option -borderwidth}
}
lappend new_args $option $val
}
puts "new_args:::: $new_args"
return $new_args
}
#.bgerrorDialog.bitmap create oval 0 0 31 31 -fill red -outline black
#.x80e1c00.c -width 446 -height 296 -background white
proc canvas {name args} {
set result [eval [concat [list zinc $name] [option_replace $args] -highlightthickness 1]]
Zinc new_as $name
return $result
}
def Zinc remove {orig mess} {
set idx [lsearch $mess $orig]
if {$idx < 0} {return $mess}
set mess [lreplace $mess $idx $idx+1]
return $mess
}
def Zinc replace {orig new mess} {
set idx [lsearch $mess $orig]
if {$idx < 0} {return $mess}
set mess [lreplace $mess $idx $idx $new]
return $mess
}
def Zinc replace2 {orig new mess} {
set idx [lsearch $mess $orig]
if {$idx < 0} {return $mess}
set mess [lreplace $mess $idx $idx+1]
foreach item [lreverse $new] {set mess [linsert $mess $idx $item]}
return $mess
}
def Zinc insert {orig new mess} {
set idx [lsearch $mess $orig]
if {$idx < 0} {return $mess}
#set mess [lreplace $mess $idx $idx+1]
foreach item [lreverse $new] {set mess [linsert $mess $idx $item]}
return $mess
}
def Zinc canvasx {val} {
return $val
}
def Zinc canvasy {val} {
return $val
}
def Zinc substitude {args} {
set args [$self replace -width -linewidth $args]
set args [$self replace -fill -linecolor $args]
set args [$self replace2 -dash [list -linestyle dotted] $args]
set args [$self replace -outline -linecolor $args]
set args [$self remove -dashoffset $args]
return $args
}
def Zinc create {args} {
set i 0
foreach item $args {
if {[regexp {^-} $item]} {break}
incr i
}
switch [lindex $args 0] {
line {
set type curve
set args [$self replace -width -linewidth $args]
set args [$self replace -fill -linecolor $args]
set args [$self replace2 -dash [list -linestyle dotted] $args]
set args [$self remove -dashoffset $args]
}
oval {
set type arc
set args [$self replace -fill -fillcolor $args]
set args [$self replace -outline -linecolor $args]
}
window {
set type window
}
rectangle {
set type rectangle
set args [$self replace -fill -fillcolor $args]
set args [$self replace -outline -linecolor $args]
set args [$self replace -width -linewidth $args]
set args [$self replace2 -dash [list -linestyle dotted] $args]
}
text {
set type text
set args [$self replace -fill -color $args]
}
default {
puts "UNKNOWN ITEM.. [lindex $args 0]"
}
}
if {$i == 2} {
set mess [concat $type $@group [lrange $args 1 end]]
} else {
set mess [concat $type $@group [list [lrange $args 1 $i-1]] [lrange $args $i end]]
}
if {$type == "window" || $type == "text"} {set mess [linsert $mess 2 -position]}
#puts "mess >> $mess"
eval [concat [list old_$self add] $mess]
}
def Zinc itemconfigure {args} {
set mess [$self substitude $args]
eval [concat [list old_$self itemconfig] $mess]
}
def Zinc coords {args} {
eval [concat [list old_$self coords] [lindex $args 0] [list [lrange $args 1 end]]]
}
def Zinc configure {args} {
eval [concat [list old_$self configure] [option_replace $args]]
}
def Zinc delete {args} {
eval [concat [list old_$self remove] $args]
}
def Zinc gettags {args} {
set result {} ;# bogus
catch {set result [eval [concat [list old_$self gettags] $args]]}
return $result
}
def Zinc lower {tag args} {
}
|
