-
Notifications
You must be signed in to change notification settings - Fork 1
/
dark-canvas-plugin.tcl
170 lines (141 loc) · 5.17 KB
/
dark-canvas-plugin.tcl
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
namespace eval dark_canvas_theme {
variable color_bg #202020
variable color_fg #c8c8c8
variable color_hl_bg #400000
variable color_hl_fg #c8c8c8
variable color_insert white
variable color_sel #7760ff
variable color_debug #00ff00
variable color_log_fatal_fg #ffe0e8
variable color_log_fatal_bg #d00
variable color_log_err #d00
variable color_log_normal $color_fg
variable color_log_normal_sel_fg black
variable color_log_debug #888888
variable color_log_verbose #686868
variable color_log_sel_bg $color_fg
variable theme_name [option get . * TkTheme]
proc is_black {color} {
if {[lsearch {black #000 #000000} $color] >= 0} {
return 1
} else {
return 0
}
}
proc is_blue {color} {
if {[lsearch {blue #00f #0000ff} $color] >= 0} {
return 1
} else {
return 0
}
}
proc is_offwhite {color} {
if {$color eq "#fcfcfc"} {
return 1
} else {
return 0
}
}
proc color_canvas_item {canv item_type tags} {
variable color_bg
variable color_fg
set tag [lindex $tags 0]
catch {
$canv itemconfigure $tag -outline $color_fg
}
if {[regexp {X[12]$} $tag]} {
$canv itemconfigure $tag -fill $color_bg
} elseif {[lsearch {line text} $item_type] >= 0} {
$canv itemconfigure $tag -fill $color_fg
} elseif {[lsearch $tags "x"] >= 0} {
} elseif {
[lsearch $tags "inlet"] >= 0 || [lsearch $tags "outlet"] >= 0
} {
$canv itemconfigure $tag -fill $color_fg
} elseif {[lsearch $tags "array"] >= 0} {
$canv itemconfigure $tag -fill $color_fg
} elseif {[regexp {BASE\d*$} $tag]} {
$canv itemconfigure $tag -fill $color_bg
} elseif {[regexp {BUT$} $tag] && $item_type eq "oval"} {
$canv itemconfigure $tag -fill $color_bg
} elseif {[regexp {BUT0$} $tag] && $item_type eq "rectangle"} {
$canv itemconfigure $tag -fill $color_fg -outline $color_fg
} elseif {[regexp {BUT\d+$} $tag] && $item_type eq "rectangle"} {
$canv itemconfigure $tag -fill $color_bg -outline $color_bg
}
}
proc canvas_trace {cmd code result op} {
variable color_bg
variable color_fg
variable color_sel
if {$code != 0} {
return
}
set canv [lindex $cmd 0]
set canv_cmd [lindex $cmd 1]
if {$canv_cmd eq "create"} {
set tags_idx [lsearch $cmd -tags]
if {$tags_idx >= 0} {
incr tags_idx
set tags [lindex $cmd $tags_idx]
set tag [lindex $tags 0]
set item_type [lindex $cmd 2]
color_canvas_item $canv $item_type $tags
}
} elseif {$canv_cmd eq "itemconfigure"} {
set tag [lindex $cmd 2]
set fill_clr [$canv itemcget $tag -fill]
set outline_clr ""
catch {
set outline_clr [$canv itemcget $tag -outline]
}
if {[is_black $fill_clr]} {
$canv itemconfigure $tag -fill $color_fg
} elseif {[is_blue $fill_clr]} {
$canv itemconfigure $tag -fill $color_sel
} elseif {[is_offwhite $fill_clr]} {
$canv itemconfigure $tag -fill $color_bg
}
if {[is_black $outline_clr]} {
$canv itemconfigure $tag -outline $color_fg
} elseif {[is_blue $outline_clr]} {
$canv itemconfigure $tag -outline $color_sel
} elseif {[is_offwhite $outline_clr]} {
$canv itemconfigure $tag -outline $color_bg
}
}
}
proc canvas_created {cmd code result op} {
variable color_bg
variable color_hl_fg
variable color_hl_bg
variable color_insert
if {$code != 0} {
return
}
set container [lindex $cmd 1]
set canv [tkcanvas_name $container]
$canv configure -background $color_bg
$canv configure -selectforeground $color_hl_fg
$canv configure -selectbackground $color_hl_bg
$canv configure -insertbackground $color_insert
trace add execution $canv leave [namespace code canvas_trace]
}
trace add execution ::pdtk_canvas_new leave [namespace code canvas_created]
::.pdwindow.text configure -background $color_bg
::.pdwindow.text configure -selectbackground $color_log_sel_bg
::.pdwindow.text.internal tag configure log0\
-foreground $color_log_fatal_fg\
-background $color_log_fatal_bg
::.pdwindow.text.internal tag configure log1\
-foreground $color_log_err
::.pdwindow.text.internal tag configure log2\
-foreground $color_log_normal\
-selectforeground $color_log_normal_sel_fg
::.pdwindow.text.internal tag configure log3\
-foreground $color_log_debug
for {set i 4} {$i <= 24} {incr i} {
::.pdwindow.text.internal tag configure log$i\
-foreground $color_log_verbose
}
}