Unnamed Fossil Project

Check-in [131f274417]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:fixes and code for useQuadColor
Timelines: family | ancestors | trunk
Files: files | file ages | folders
SHA1:131f274417fad758fc39e40a37a1541d3f234508
User & Date: arnulf 2013-09-21 20:39:14
Context
2013-09-21
20:39
fixes and code for useQuadColor Leaf check-in: 131f274417 user: arnulf tags: trunk
20:38
initial version check-in: 5c2b7dd74b user: arnulf tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to library/ntkBackgroundElement.tcl.

29
30
31
32
33
34
35




36
37
38
39
40
41
42
..
48
49
50
51
52
53
54



55










56
57
58
59
60
61
62
63
64
65

#================================ InitializeOptionValues ============================
#     
#=========================================================================

::itcl::body BackgroundElement::InitializeOptionValues {styleName recordPtr state} {
#puts stderr "BackgroundElement::InitializeOptionValues!$styleName!$recordPtr!$state!"




    InitializeOptionValuesBase $styleName $recordPtr $state
configure
}

#================================ ElementSize ============================
#     
#=========================================================================
................................................................................
#================================ ElementDraw ============================
#     
#=========================================================================

::itcl::body BackgroundElement::ElementDraw {recordPtr box state} {
#puts stderr "BackgroundElement ElementDraw $box $state"
    set background [cget -background]



    set backgroundColor [ColorValue2RGBA $background]










#puts stderr "background CLOPT![info options]![cget -background]!"
    lassign [GetElementPositions $box] pos1 pos2 pos3 pos4
#puts stderr "BACKGROUND2!$pos1!$pos2!$pos3!$pos4!"
    ::gles2::builtin::fillrectangle [list $pos1 $backgroundColor] [list $pos2 $backgroundColor] [list $pos3 $backgroundColor] [list $pos4 $backgroundColor]
    ::gles2::swapbuffers
#puts -nonewline stderr "BackgroundElement::ElementDraw >"
    set ch [::ntk::Debug::DebugInput]
}

} ; # end namespace ::ntk::classes







>
>
>
>







 







>
>
>
|
>
>
>
>
>
>
>
>
>
>
|


|






29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
..
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

#================================ InitializeOptionValues ============================
#     
#=========================================================================

::itcl::body BackgroundElement::InitializeOptionValues {styleName recordPtr state} {
#puts stderr "BackgroundElement::InitializeOptionValues!$styleName!$recordPtr!$state!"
if {![::info exists ::useQuadColor]} {
set ::useQuadColor 0
}

    InitializeOptionValuesBase $styleName $recordPtr $state
configure
}

#================================ ElementSize ============================
#     
#=========================================================================
................................................................................
#================================ ElementDraw ============================
#     
#=========================================================================

::itcl::body BackgroundElement::ElementDraw {recordPtr box state} {
#puts stderr "BackgroundElement ElementDraw $box $state"
    set background [cget -background]
if {$::useQuadColor} {
set background "@#ff0000:#00ff00:#0000ff:#555555"
}
    set backgroundColorLst [ColorValue2RGBA $background]
#puts stderr "backgroundColorLst!$backgroundColorLst!"
    if {[llength $backgroundColorLst] == 1} {
        set backgroundColorLst [lindex $backgroundColorLst 0]
        lassign $backgroundColorLst backgroundColor1 backgroundColor2 backgroundColor3 backgroundColor4
    } else {
        set backgroundColor1 $backgroundColorLst
        set backgroundColor2 $backgroundColorLst
        set backgroundColor3 $backgroundColorLst
        set backgroundColor4 $backgroundColorLst
    }
#puts stderr "background CLOPT![info options]![cget -background]!$backgroundColor1!"
    lassign [GetElementPositions $box] pos1 pos2 pos3 pos4
#puts stderr "BACKGROUND2!$pos1!$pos2!$pos3!$pos4!"
    ::gles2::builtin::fillrectangle [list $pos1 $backgroundColor1] [list $pos2 $backgroundColor2] [list $pos3 $backgroundColor3] [list $pos4 $backgroundColor4]
    ::gles2::swapbuffers
#puts -nonewline stderr "BackgroundElement::ElementDraw >"
    set ch [::ntk::Debug::DebugInput]
}

} ; # end namespace ::ntk::classes

Changes to library/ntkUtils.tcl.

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
    4 {
        # seems to be already a RGBA value nothing to do
        return $value
      }
    3 {
        # seems to be a RGB value add an alpha value
        lappend value $alphaValue
	return $value
      }
    1 {
         # seems to be a hex value (like #d9d9d9) or a color name (like black)
         if {[string range $value 0 0] eq "#"} {
             set val [string range $value 1 end]
             if {[string length $val] == 8} {
                 set r [expr {"0x[string range $val 0 1]" / 255.0}]
                 set g [expr {"0x[string range $val 2 3]" / 255.0}]
                 set b [expr {"0x[string range $val 4 5]" / 255.0}]
                 set a [expr {"0x[string range $val 6 7]" / 255.0}]
		 return [list $r $g $b $a]
	     } else {
                 if {[string length $val] == 6} {
                     set r [expr {"0x[string range $val 0 1]" / 255.0}]
                     set g [expr {"0x[string range $val 2 3]" / 255.0}]
                     set b [expr {"0x[string range $val 4 5]" / 255.0}]
                     set a [expr {255 / 255.0}]
		     return [list $r $g $b $a]
	         } else {
                     return -code error "ColorValue2RGBA bad color value: $value!"
                 }
             }
	 } else {


































             # seems to be a color name. We handle only special ones right now
             switch $value {
             black {
                 return [list 0.0 0.0 0.0 1.0]
               }
             white {
                 return [list 1.0 1.0 1.0 1.0]
               }
             default {
                 return -code error "ColorValue2RGBA color names not yet handled!!"
               }
             }

	 }
      }
    }
}

#================================ GetElementPositions ============================
#    Convert parcel coordinates to graphics context positions







|










|
|





|
|
|


|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
>







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
    4 {
        # seems to be already a RGBA value nothing to do
        return $value
      }
    3 {
        # seems to be a RGB value add an alpha value
        lappend value $alphaValue
        return $value
      }
    1 {
         # seems to be a hex value (like #d9d9d9) or a color name (like black)
         if {[string range $value 0 0] eq "#"} {
             set val [string range $value 1 end]
             if {[string length $val] == 8} {
                 set r [expr {"0x[string range $val 0 1]" / 255.0}]
                 set g [expr {"0x[string range $val 2 3]" / 255.0}]
                 set b [expr {"0x[string range $val 4 5]" / 255.0}]
                 set a [expr {"0x[string range $val 6 7]" / 255.0}]
                 return [list $r $g $b $a]
             } else {
                 if {[string length $val] == 6} {
                     set r [expr {"0x[string range $val 0 1]" / 255.0}]
                     set g [expr {"0x[string range $val 2 3]" / 255.0}]
                     set b [expr {"0x[string range $val 4 5]" / 255.0}]
                     set a [expr {255 / 255.0}]
                     return [list $r $g $b $a]
                 } else {
                    return -code error "ColorValue2RGBA bad color value: $value!"
                 }
             }
         } else {
             if {[string range $value 0 0] eq "@"} {
                 set val [string range $value 1 end]
                 set lst [split $val :]
#puts stderr "LST!$val!$lst!"
                 set result [list]
                 foreach entry $lst {
#puts stderr "entry!$entry!"
                     if {[string range $entry 0 0] eq "#"} {
                         set val [string range $entry 1 end]
#puts stderr "val!$val!"
                         if {[string length $val] == 8} {
                             set r [expr {"0x[string range $val 0 1]" / 255.0}]
                             set g [expr {"0x[string range $val 2 3]" / 255.0}]
                             set b [expr {"0x[string range $val 4 5]" / 255.0}]
                             set a [expr {"0x[string range $val 6 7]" / 255.0}]
                             lappend result [list $r $g $b $a]
	                 } else {
                             if {[string length $val] == 6} {
                                 set r [expr {"0x[string range $val 0 1]" / 255.0}]
                                 set g [expr {"0x[string range $val 2 3]" / 255.0}]
                                 set b [expr {"0x[string range $val 4 5]" / 255.0}]
                                 set a [expr {255 / 255.0}]
                                 lappend result [list $r $g $b $a]
	                     } else {
                                 return -code error "ColorValue2RGBA bad color value: $value!"
                             }
                         }
                     } else {
                         return -code error "ColorValue2RGBA bad color value: $value!"
                     }
                 }
#puts stderr "result!$result!"
                     return [list $result]
	     } else {
                 # seems to be a color name. We handle only special ones right now
                 switch $value {
                 black {
                     return [list 0.0 0.0 0.0 1.0]
                   }
                 white {
                     return [list 1.0 1.0 1.0 1.0]
                   }
                 default {
                     return -code error "ColorValue2RGBA color names not yet handled!!"
                   }
                 }
	     }
	 }
      }
    }
}

#================================ GetElementPositions ============================
#    Convert parcel coordinates to graphics context positions

Changes to library/tclIndex.

124
125
126
127
128
129
130

131
132
133
134
135
136
137
...
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
set auto_index(::ntk::treeview::TreeviewSeeCommand) [list source [file join $dir ntkTTreeview.tcl]]
set auto_index(::ntk::treeview::TreeviewSelectionCommand) [list source [file join $dir ntkTTreeview.tcl]]
set auto_index(::ntk::treeview::TreeviewSetCommand) [list source [file join $dir ntkTTreeview.tcl]]
set auto_index(::ntk::treeview::TreeviewTagCommand) [list source [file join $dir ntkTTreeview.tcl]]
set auto_index(::ntk::treeview::TreeviewXViewCommand) [list source [file join $dir ntkTTreeview.tcl]]
set auto_index(::ntk::treeview::TreeviewYViewCommand) [list source [file join $dir ntkTTreeview.tcl]]
set auto_index(::ntk::treeview::insert) [list source [file join $dir ntkTTreeview.tcl]]

set auto_index(::ntk::classes::init) [list source [file join $dir ntkInit.tcl]]
set auto_index(::ntk::classes::init::init) [list source [file join $dir ntkInit.tcl]]
set auto_index(::ntk::classes::init::RegisterElements) [list source [file join $dir ntkInit.tcl]]
set auto_index(::ntk::classes::init::RegisterWidgets) [list source [file join $dir ntkInit.tcl]]
set auto_index(::ntk::classes::init::RegisterThemes) [list source [file join $dir ntkInit.tcl]]
set auto_index(::ntk::classes::init::init) [list source [file join $dir ntkInit.tcl]]
set auto_index(::ntk::classes::init::RegisterElements) [list source [file join $dir ntkInit.tcl]]
................................................................................
set auto_index(::ntk::classes::tentryBase::EntryNeedsValidation) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::AdjustIndex) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::constructor) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::CharBox) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::PointToChar) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::EntryCharPosition) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::EntryEditable) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::CreateScrollHandle) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::EntryBBoxCommand) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::EntryDeleteCommand) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::EntryGetCommand) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::EntryICursorCommand) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::UtfAtIndex) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::NumUtfChars) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::ExpandPercents) [list source [file join $dir ntkTEntryBase.tcl]]







>







 







<







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
...
521
522
523
524
525
526
527

528
529
530
531
532
533
534
set auto_index(::ntk::treeview::TreeviewSeeCommand) [list source [file join $dir ntkTTreeview.tcl]]
set auto_index(::ntk::treeview::TreeviewSelectionCommand) [list source [file join $dir ntkTTreeview.tcl]]
set auto_index(::ntk::treeview::TreeviewSetCommand) [list source [file join $dir ntkTTreeview.tcl]]
set auto_index(::ntk::treeview::TreeviewTagCommand) [list source [file join $dir ntkTTreeview.tcl]]
set auto_index(::ntk::treeview::TreeviewXViewCommand) [list source [file join $dir ntkTTreeview.tcl]]
set auto_index(::ntk::treeview::TreeviewYViewCommand) [list source [file join $dir ntkTTreeview.tcl]]
set auto_index(::ntk::treeview::insert) [list source [file join $dir ntkTTreeview.tcl]]
set auto_index(::ntk::treeview::item) [list source [file join $dir ntkTTreeview.tcl]]
set auto_index(::ntk::classes::init) [list source [file join $dir ntkInit.tcl]]
set auto_index(::ntk::classes::init::init) [list source [file join $dir ntkInit.tcl]]
set auto_index(::ntk::classes::init::RegisterElements) [list source [file join $dir ntkInit.tcl]]
set auto_index(::ntk::classes::init::RegisterWidgets) [list source [file join $dir ntkInit.tcl]]
set auto_index(::ntk::classes::init::RegisterThemes) [list source [file join $dir ntkInit.tcl]]
set auto_index(::ntk::classes::init::init) [list source [file join $dir ntkInit.tcl]]
set auto_index(::ntk::classes::init::RegisterElements) [list source [file join $dir ntkInit.tcl]]
................................................................................
set auto_index(::ntk::classes::tentryBase::EntryNeedsValidation) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::AdjustIndex) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::constructor) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::CharBox) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::PointToChar) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::EntryCharPosition) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::EntryEditable) [list source [file join $dir ntkTEntryBase.tcl]]

set auto_index(::ntk::classes::tentryBase::EntryBBoxCommand) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::EntryDeleteCommand) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::EntryGetCommand) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::EntryICursorCommand) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::UtfAtIndex) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::NumUtfChars) [list source [file join $dir ntkTEntryBase.tcl]]
set auto_index(::ntk::classes::tentryBase::ExpandPercents) [list source [file join $dir ntkTEntryBase.tcl]]