OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [library/] [clrpick.tcl] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# clrpick.tcl --
2
#
3
#       Color selection dialog for platforms that do not support a
4
#       standard color selection dialog.
5
#
6
# SCCS: @(#) clrpick.tcl 1.3 96/09/05 09:59:24
7
#
8
# Copyright (c) 1996 Sun Microsystems, Inc.
9
#
10
# See the file "license.terms" for information on usage and redistribution
11
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12
#
13
# ToDo:
14
#
15
#       (1): Find out how many free colors are left in the colormap and
16
#            don't allocate too many colors.
17
#       (2): Implement HSV color selection. 
18
#
19
 
20
# tkColorDialog --
21
#
22
#       Create a color dialog and let the user choose a color. This function
23
#       should not be called directly. It is called by the tk_chooseColor
24
#       function when a native color selector widget does not exist
25
#
26
proc tkColorDialog {args} {
27
    global tkPriv
28
    set w .__tk__color
29
    upvar #0 $w data
30
 
31
    # The lines variables track the start and end indices of the line
32
    # elements in the colorbar canvases.
33
    set data(lines,red,start)   0
34
    set data(lines,red,last)   -1
35
    set data(lines,green,start) 0
36
    set data(lines,green,last) -1
37
    set data(lines,blue,start)  0
38
    set data(lines,blue,last)  -1
39
 
40
    # This is the actual number of lines that are drawn in each color strip.
41
    # Note that the bars may be of any width.
42
    # However, NUM_COLORBARS must be a number that evenly divides 256.
43
    # Such as 256, 128, 64, etc.
44
    set data(NUM_COLORBARS) 8
45
 
46
    # BARS_WIDTH is the number of pixels wide the color bar portion of the
47
    # canvas is. This number must be a multiple of NUM_COLORBARS
48
    set data(BARS_WIDTH) 128
49
 
50
    # PLGN_WIDTH is the number of pixels wide of the triangular selection
51
    # polygon. This also results in the definition of the padding on the 
52
    # left and right sides which is half of PLGN_WIDTH. Make this number even.
53
    set data(PLGN_HEIGHT) 10
54
 
55
    # PLGN_HEIGHT is the height of the selection polygon and the height of the 
56
    # selection rectangle at the bottom of the color bar. No restrictions.
57
    set data(PLGN_WIDTH) 10
58
 
59
    tkColorDialog_Config $w $args
60
    tkColorDialog_InitValues $w
61
 
62
    if {![winfo exists $w]} {
63
        toplevel $w -class tkColorDialog
64
        tkColorDialog_BuildDialog $w
65
    }
66
    wm transient $w $data(-parent)
67
 
68
 
69
    # 5. Withdraw the window, then update all the geometry information
70
    # so we know how big it wants to be, then center the window in the
71
    # display and de-iconify it.
72
 
73
    wm withdraw $w
74
    update idletasks
75
    set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
76
            - [winfo vrootx [winfo parent $w]]}]
77
    set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
78
            - [winfo vrooty [winfo parent $w]]}]
79
    wm geom $w +$x+$y
80
    wm deiconify $w
81
    wm title $w $data(-title)
82
 
83
    # 6. Set a grab and claim the focus too.
84
 
85
    set oldFocus [focus]
86
    set oldGrab [grab current $w]
87
    if {$oldGrab != ""} {
88
        set grabStatus [grab status $oldGrab]
89
    }
90
    grab $w
91
    focus $data(okBtn)
92
 
93
    # 7. Wait for the user to respond, then restore the focus and
94
    # return the index of the selected button.  Restore the focus
95
    # before deleting the window, since otherwise the window manager
96
    # may take the focus away so we can't redirect it.  Finally,
97
    # restore any grab that was in effect.
98
 
99
    tkwait variable tkPriv(selectColor)
100
    catch {focus $oldFocus}
101
    grab release $w
102
    destroy $w
103
    unset data
104
    if {$oldGrab != ""} {
105
        if {$grabStatus == "global"} {
106
            grab -global $oldGrab
107
        } else {
108
            grab $oldGrab
109
        }
110
    }
111
    return $tkPriv(selectColor)
112
}
113
 
114
# tkColorDialog_InitValues --
115
#
116
#       Get called during initialization or when user resets NUM_COLORBARS
117
#
118
proc tkColorDialog_InitValues {w} {
119
    upvar #0 $w data
120
 
121
    # IntensityIncr is the difference in color intensity between a colorbar
122
    # and its neighbors.
123
    set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}]
124
 
125
    # ColorbarWidth is the width of each colorbar
126
    set data(colorbarWidth) \
127
            [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}]
128
 
129
    # Indent is the width of the space at the left and right side of the
130
    # colorbar. It is always half the selector polygon width, because the
131
    # polygon extends into the space.
132
    set data(indent) [expr {$data(PLGN_WIDTH) / 2}]
133
 
134
    set data(colorPad) 2
135
    set data(selPad)   [expr {$data(PLGN_WIDTH) / 2}]
136
 
137
    #
138
    # minX is the x coordinate of the first colorbar
139
    #
140
    set data(minX) $data(indent)
141
 
142
    #
143
    # maxX is the x coordinate of the last colorbar
144
    #
145
    set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}]
146
 
147
    #
148
    # canvasWidth is the width of the entire canvas, including the indents
149
    #
150
    set data(canvasWidth) [expr {$data(BARS_WIDTH) + \
151
            $data(PLGN_WIDTH)}]
152
 
153
    # Set the initial color, specified by -initialcolor, or the
154
    # color chosen by the user the last time.
155
    set data(selection) $data(-initialcolor)
156
    set data(finalColor)  $data(-initialcolor)
157
    set rgb [winfo rgb . $data(selection)]
158
 
159
    set data(red,intensity)   [expr {[lindex $rgb 0]/0x100}]
160
    set data(green,intensity) [expr {[lindex $rgb 1]/0x100}]
161
    set data(blue,intensity)  [expr {[lindex $rgb 2]/0x100}]
162
}
163
 
164
# tkColorDialog_Config  --
165
#
166
#       Parses the command line arguments to tk_chooseColor
167
#
168
proc tkColorDialog_Config {w argList} {
169
    global tkPriv
170
    upvar #0 $w data
171
 
172
    # 1: the configuration specs
173
    #
174
    set specs {
175
        {-initialcolor "" "" ""}
176
        {-parent "" "" "."}
177
        {-title "" "" "Color"}
178
    }
179
 
180
    # 2: parse the arguments
181
    #
182
    tclParseConfigSpec $w $specs "" $argList
183
 
184
    if {![string compare $data(-title) ""]} {
185
        set data(-title) " "
186
    }
187
    if {![string compare $data(-initialcolor) ""]} {
188
        if {[info exists tkPriv(selectColor)] && \
189
                [string compare $tkPriv(selectColor) ""]} {
190
            set data(-initialcolor) $tkPriv(selectColor)
191
        } else {
192
            set data(-initialcolor) [. cget -background]
193
        }
194
    } else {
195
        if {[catch {winfo rgb . $data(-initialcolor)} err]} {
196
            error $err
197
        }
198
    }
199
 
200
    if {![winfo exists $data(-parent)]} {
201
        error "bad window path name \"$data(-parent)\""
202
    }
203
}
204
 
205
# tkColorDialog_BuildDialog --
206
#
207
#       Build the dialog.
208
#
209
proc tkColorDialog_BuildDialog {w} {
210
    upvar #0 $w data
211
 
212
    # TopFrame contains the color strips and the color selection
213
    #
214
    set topFrame [frame $w.top -relief raised -bd 1]
215
 
216
    # StripsFrame contains the colorstrips and the individual RGB entries
217
    set stripsFrame [frame $topFrame.colorStrip]
218
 
219
    foreach c { Red Green Blue } {
220
        set color [string tolower $c]
221
 
222
        # each f frame contains an [R|G|B] entry and the equiv. color strip.
223
        set f [frame $stripsFrame.$color]
224
 
225
        # The box frame contains the label and entry widget for an [R|G|B]
226
        set box [frame $f.box]
227
 
228
        label $box.label -text $c: -width 6 -under 0 -anchor ne
229
        entry $box.entry -textvariable [format %s $w]($color,intensity) \
230
            -width 4
231
        pack $box.label -side left -fill y -padx 2 -pady 3
232
        pack $box.entry -side left -anchor n -pady 0
233
        pack $box -side left -fill both
234
 
235
        set height [expr \
236
            {[winfo reqheight $box.entry] - \
237
            2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}]
238
 
239
        canvas $f.color -height $height\
240
            -width $data(BARS_WIDTH) -relief sunken -bd 2
241
        canvas $f.sel -height $data(PLGN_HEIGHT) \
242
            -width $data(canvasWidth) -highlightthickness 0
243
        pack $f.color -expand yes -fill both
244
        pack $f.sel -expand yes -fill both
245
 
246
        pack $f -side top -fill x -padx 0 -pady 2
247
 
248
        set data($color,entry) $box.entry
249
        set data($color,col) $f.color
250
        set data($color,sel) $f.sel
251
 
252
        bind $data($color,col) <Configure> \
253
            "tkColorDialog_DrawColorScale $w $color 1"
254
        bind $data($color,col) <Enter> \
255
            "tkColorDialog_EnterColorBar $w $color"
256
        bind $data($color,col) <Leave> \
257
            "tkColorDialog_LeaveColorBar $w $color"
258
 
259
        bind $data($color,sel) <Enter> \
260
            "tkColorDialog_EnterColorBar $w $color"
261
        bind $data($color,sel) <Leave> \
262
            "tkColorDialog_LeaveColorBar $w $color"
263
 
264
        bind $box.entry <Return> "tkColorDialog_HandleRGBEntry $w"
265
    }
266
 
267
    pack $stripsFrame -side left -fill both -padx 4 -pady 10
268
 
269
    # The selFrame contains a frame that demonstrates the currently
270
    # selected color
271
    #
272
    set selFrame [frame $topFrame.sel]
273
    set lab [label $selFrame.lab -text "Selection:" -under 0 -anchor sw]
274
    set ent [entry $selFrame.ent -textvariable [format %s $w](selection) \
275
        -width 16]
276
    set f1  [frame $selFrame.f1 -relief sunken -bd 2]
277
    set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70]
278
 
279
    pack $lab $ent -side top -fill x -padx 4 -pady 2
280
    pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
281
    pack $data(finalCanvas) -expand yes -fill both
282
 
283
    bind $ent <Return> "tkColorDialog_HandleSelEntry $w"
284
 
285
    pack $selFrame -side left -fill none -anchor nw
286
    pack $topFrame -side top -expand yes -fill both -anchor nw
287
 
288
    # the botFrame frame contains the buttons
289
    #
290
    set botFrame [frame $w.bot -relief raised -bd 1]
291
    button $botFrame.ok     -text OK            -width 8 -under 0 \
292
        -command "tkColorDialog_OkCmd $w"
293
    button $botFrame.cancel -text Cancel        -width 8 -under 0 \
294
        -command "tkColorDialog_CancelCmd $w"
295
 
296
    set data(okBtn)      $botFrame.ok
297
    set data(cancelBtn)  $botFrame.cancel
298
 
299
    pack $botFrame.ok $botFrame.cancel \
300
        -padx 10 -pady 10 -expand yes -side left
301
    pack $botFrame -side bottom -fill x
302
 
303
 
304
    # Accelerator bindings
305
 
306
    bind $w <Alt-r> "focus $data(red,entry)"
307
    bind $w <Alt-g> "focus $data(green,entry)"
308
    bind $w <Alt-b> "focus $data(blue,entry)"
309
    bind $w <Alt-s> "focus $ent"
310
    bind $w <KeyPress-Escape> "tkButtonInvoke $data(cancelBtn)"
311
    bind $w <Alt-c> "tkButtonInvoke $data(cancelBtn)"
312
    bind $w <Alt-o> "tkButtonInvoke $data(okBtn)"
313
 
314
    wm protocol $w WM_DELETE_WINDOW "tkColorDialog_CancelCmd $w"
315
}
316
 
317
# tkColorDialog_SetRGBValue --
318
#
319
#       Sets the current selection of the dialog box
320
#
321
proc tkColorDialog_SetRGBValue {w color} {
322
    upvar #0 $w data 
323
 
324
    set data(red,intensity)   [lindex $color 0]
325
    set data(green,intensity) [lindex $color 1]
326
    set data(blue,intensity)  [lindex $color 2]
327
 
328
    tkColorDialog_RedrawColorBars $w all
329
 
330
    # Now compute the new x value of each colorbars pointer polygon
331
    foreach color { red green blue } {
332
        set x [tkColorDialog_RgbToX $w $data($color,intensity)]
333
        tkColorDialog_MoveSelector $w $data($color,sel) $color $x 0
334
    }
335
}
336
 
337
# tkColorDialog_XToRgb --
338
#
339
#       Converts a screen coordinate to intensity
340
#
341
proc tkColorDialog_XToRgb {w x} {
342
    upvar #0 $w data
343
 
344
    return [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}]
345
}
346
 
347
# tkColorDialog_RgbToX
348
#
349
#       Converts an intensity to screen coordinate.
350
#
351
proc tkColorDialog_RgbToX {w color} {
352
    upvar #0 $w data
353
 
354
    return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]
355
}
356
 
357
 
358
# tkColorDialog_DrawColorScale --
359
# 
360
#       Draw color scale is called whenever the size of one of the color
361
#       scale canvases is changed.
362
#
363
proc tkColorDialog_DrawColorScale {w c {create 0}} {
364
    global lines
365
    upvar #0 $w data
366
 
367
    # col: color bar canvas
368
    # sel: selector canvas
369
    set col $data($c,col)
370
    set sel $data($c,sel)
371
 
372
    # First handle the case that we are creating everything for the first time.
373
    if {$create} {
374
        # First remove all the lines that already exist.
375
        if { $data(lines,$c,last) > $data(lines,$c,start)} {
376
            for {set i $data(lines,$c,start)} \
377
                {$i <= $data(lines,$c,last)} { incr i} {
378
                $sel delete $i
379
            }
380
        }
381
        # Delete the selector if it exists
382
        if {[info exists data($c,index)]} {
383
            $sel delete $data($c,index)
384
        }
385
 
386
        # Draw the selection polygons
387
        tkColorDialog_CreateSelector $w $sel $c
388
        $sel bind $data($c,index) <ButtonPress-1> \
389
            "tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1"
390
        $sel bind $data($c,index) <B1-Motion> \
391
            "tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
392
        $sel bind $data($c,index) <ButtonRelease-1> \
393
            "tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)"
394
 
395
        set height [winfo height $col]
396
        # Create an invisible region under the colorstrip to catch mouse clicks
397
        # that aren't on the selector.
398
        set data($c,clickRegion) [$sel create rectangle 0 0 \
399
            $data(canvasWidth) $height -fill {} -outline {}]
400
 
401
        bind $col <ButtonPress-1> \
402
            "tkColorDialog_StartMove $w $sel $c %x $data(colorPad)"
403
        bind $col <B1-Motion> \
404
            "tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)"
405
        bind $col <ButtonRelease-1> \
406
            "tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)"
407
 
408
        $sel bind $data($c,clickRegion) <ButtonPress-1> \
409
            "tkColorDialog_StartMove $w $sel $c %x $data(selPad)"
410
        $sel bind $data($c,clickRegion) <B1-Motion> \
411
            "tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
412
        $sel bind $data($c,clickRegion) <ButtonRelease-1> \
413
            "tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)"
414
    } else {
415
        # l is the canvas index of the first colorbar.
416
        set l $data(lines,$c,start)
417
    }
418
 
419
    # Draw the color bars.
420
    set highlightW [expr \
421
            {[$col cget -highlightthickness] + [$col cget -bd]}]
422
    for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
423
        set intensity [expr {$i * $data(intensityIncr)}]
424
        set startx [expr {$i * $data(colorbarWidth) + $highlightW}]
425
        if { $c == "red" } {
426
            set color [format "#%02x%02x%02x" \
427
                           $intensity \
428
                           $data(green,intensity) \
429
                           $data(blue,intensity)]
430
        } elseif { $c == "green" } {
431
            set color [format "#%02x%02x%02x" \
432
                           $data(red,intensity) \
433
                           $intensity \
434
                           $data(blue,intensity)]
435
        } else {
436
            set color [format "#%02x%02x%02x" \
437
                           $data(red,intensity) \
438
                           $data(green,intensity) \
439
                           $intensity]
440
        }
441
 
442
        if {$create} {
443
            set index [$col create rect $startx $highlightW \
444
                    [expr {$startx +$data(colorbarWidth)}] \
445
                    [expr {[winfo height $col] + $highlightW}]\
446
                -fill $color -outline $color]
447
        } else {
448
            $col itemconf $l -fill $color -outline $color
449
            incr l
450
        }
451
    }
452
    $sel raise $data($c,index)
453
 
454
    if {$create} {
455
        set data(lines,$c,last) $index
456
        set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]
457
    }
458
 
459
    tkColorDialog_RedrawFinalColor $w
460
}
461
 
462
# tkColorDialog_CreateSelector --
463
#
464
#       Creates and draws the selector polygon at the position
465
#       $data($c,intensity).
466
#
467
proc tkColorDialog_CreateSelector {w sel c } {
468
    upvar #0 $w data
469
    set data($c,index) [$sel create polygon \
470
 
471
        $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \
472
        $data(indent) 0]
473
    set data($c,x) [tkColorDialog_RgbToX $w $data($c,intensity)]
474
    $sel move $data($c,index) $data($c,x) 0
475
}
476
 
477
# tkColorDialog_RedrawFinalColor
478
#
479
#       Combines the intensities of the three colors into the final color
480
#
481
proc tkColorDialog_RedrawFinalColor {w} {
482
    upvar #0 $w data
483
 
484
    set color [format "#%02x%02x%02x" $data(red,intensity) \
485
        $data(green,intensity) $data(blue,intensity)]
486
 
487
    $data(finalCanvas) conf -bg $color
488
    set data(finalColor) $color
489
    set data(selection) $color
490
    set data(finalRGB) [list \
491
        $data(red,intensity) \
492
        $data(green,intensity) \
493
        $data(blue,intensity)]
494
}
495
 
496
# tkColorDialog_RedrawColorBars --
497
#
498
# Only redraws the colors on the color strips that were not manipulated.
499
# Params: color of colorstrip that changed. If color is not [red|green|blue]
500
#         Then all colorstrips will be updated
501
#
502
proc tkColorDialog_RedrawColorBars {w colorChanged} {
503
    upvar #0 $w data
504
 
505
    switch $colorChanged {
506
        red {
507
            tkColorDialog_DrawColorScale $w green
508
            tkColorDialog_DrawColorScale $w blue
509
        }
510
        green {
511
            tkColorDialog_DrawColorScale $w red
512
            tkColorDialog_DrawColorScale $w blue
513
        }
514
        blue {
515
            tkColorDialog_DrawColorScale $w red
516
            tkColorDialog_DrawColorScale $w green
517
        }
518
        default {
519
            tkColorDialog_DrawColorScale $w red
520
            tkColorDialog_DrawColorScale $w green
521
            tkColorDialog_DrawColorScale $w blue
522
        }
523
    }
524
    tkColorDialog_RedrawFinalColor $w
525
}
526
 
527
#----------------------------------------------------------------------
528
#                       Event handlers
529
#----------------------------------------------------------------------
530
 
531
# tkColorDialog_StartMove --
532
#
533
#       Handles a mousedown button event over the selector polygon.
534
#       Adds the bindings for moving the mouse while the button is
535
#       pressed.  Sets the binding for the button-release event.
536
# 
537
# Params: sel is the selector canvas window, color is the color of the strip.
538
#
539
proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} {
540
    upvar #0 $w data
541
 
542
    if {!$dontMove} {
543
        tkColorDialog_MoveSelector $w $sel $color $x $delta
544
    }
545
}
546
 
547
# tkColorDialog_MoveSelector --
548
# 
549
# Moves the polygon selector so that its middle point has the same
550
# x value as the specified x. If x is outside the bounds [0,255],
551
# the selector is set to the closest endpoint.
552
#
553
# Params: sel is the selector canvas, c is [red|green|blue]
554
#         x is a x-coordinate.
555
#
556
proc tkColorDialog_MoveSelector {w sel color x delta} {
557
    upvar #0 $w data
558
 
559
    incr x -$delta
560
 
561
    if { $x < 0 } {
562
        set x 0
563
    } elseif { $x >= $data(BARS_WIDTH)} {
564
        set x [expr {$data(BARS_WIDTH) - 1}]
565
    }
566
    set diff [expr {$x - $data($color,x)}]
567
    $sel move $data($color,index) $diff 0
568
    set data($color,x) [expr {$data($color,x) + $diff}]
569
 
570
    # Return the x value that it was actually set at
571
    return $x
572
}
573
 
574
# tkColorDialog_ReleaseMouse
575
#
576
# Removes mouse tracking bindings, updates the colorbars.
577
#
578
# Params: sel is the selector canvas, color is the color of the strip,
579
#         x is the x-coord of the mouse.
580
#
581
proc tkColorDialog_ReleaseMouse {w sel color x delta} {
582
    upvar #0 $w data 
583
 
584
    set x [tkColorDialog_MoveSelector $w $sel $color $x $delta]
585
 
586
    # Determine exactly what color we are looking at.
587
    set data($color,intensity) [tkColorDialog_XToRgb $w $x]
588
 
589
    tkColorDialog_RedrawColorBars $w $color
590
}
591
 
592
# tkColorDialog_ResizeColorbars --
593
#
594
#       Completely redraws the colorbars, including resizing the
595
#       colorstrips
596
#
597
proc tkColorDialog_ResizeColorBars {w} {
598
    upvar #0 $w data
599
 
600
    if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) ||
601
         (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} {
602
        set data(BARS_WIDTH) $data(NUM_COLORBARS)
603
    }
604
    tkColorDialog_InitValues $w
605
    foreach color { red green blue } {
606
        $data($color,col) conf -width $data(canvasWidth)
607
        tkColorDialog_DrawColorScale $w $color 1
608
    }
609
}
610
 
611
# tkColorDialog_HandleSelEntry --
612
#
613
#       Handles the return keypress event in the "Selection:" entry
614
#
615
proc tkColorDialog_HandleSelEntry {w} {
616
    upvar #0 $w data
617
 
618
    set text [string trim $data(selection)]
619
    # Check to make sure that the color is valid
620
    if {[catch {set color [winfo rgb . $text]} ]} {
621
        set data(selection) $data(finalColor)
622
        return
623
    }
624
 
625
    set R [expr {[lindex $color 0]/0x100}]
626
    set G [expr {[lindex $color 1]/0x100}]
627
    set B [expr {[lindex $color 2]/0x100}]
628
 
629
    tkColorDialog_SetRGBValue $w "$R $G $B"
630
    set data(selection) $text
631
}
632
 
633
# tkColorDialog_HandleRGBEntry --
634
#
635
#       Handles the return keypress event in the R, G or B entry
636
#
637
proc tkColorDialog_HandleRGBEntry {w} {
638
    upvar #0 $w data
639
 
640
    foreach c {red green blue} {
641
        if {[catch {
642
            set data($c,intensity) [expr {int($data($c,intensity))}]
643
        }]} {
644
            set data($c,intensity) 0
645
        }
646
 
647
        if {$data($c,intensity) < 0} {
648
            set data($c,intensity) 0
649
        }
650
        if {$data($c,intensity) > 255} {
651
            set data($c,intensity) 255
652
        }
653
    }
654
 
655
    tkColorDialog_SetRGBValue $w "$data(red,intensity) $data(green,intensity) \
656
        $data(blue,intensity)"
657
}
658
 
659
# mouse cursor enters a color bar
660
#
661
proc tkColorDialog_EnterColorBar {w color} {
662
    upvar #0 $w data
663
 
664
    $data($color,sel) itemconfig $data($color,index) -fill red
665
}
666
 
667
# mouse leaves enters a color bar
668
#
669
proc tkColorDialog_LeaveColorBar {w color} {
670
    upvar #0 $w data
671
 
672
    $data($color,sel) itemconfig $data($color,index) -fill black
673
}
674
 
675
# user hits OK button
676
#
677
proc tkColorDialog_OkCmd {w} {
678
    global tkPriv
679
    upvar #0 $w data
680
 
681
    set tkPriv(selectColor) $data(finalColor)
682
}
683
 
684
# user hits Cancel button
685
#
686
proc tkColorDialog_CancelCmd {w} {
687
    global tkPriv
688
 
689
    set tkPriv(selectColor) ""
690
}
691
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.