Tk Source Code

Check-in [76212b98]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Cleaning up the script bindings further. [table] is gone; [grid] replaces it.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-510
Files: files | file ages | folders
SHA3-256: 76212b9876abc7725acdb378db271ffaab45e17ab3180056d1562136d4f2f5c8
User & Date: dkf 2018-11-02 08:43:29
Context
2018-11-28
20:49
New files from RenĂ© Zaumseil check-in: c5371055 user: fvogel tags: tip-510
2018-11-02
08:43
Cleaning up the script bindings further. [table] is gone; [grid] replaces it. check-in: 76212b98 user: dkf tags: tip-510
2018-11-01
11:39
Some cleaning up check-in: 9bfc06dc user: dkf tags: tip-510
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to library/rbc/graph.tcl.

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
...
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
...
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
...
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
...
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
...
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
...
494
495
496
497
498
499
500

501
502

503
504
    set elem [$graph legend get current]
    $graph legend deactivate $elem
}

proc rbc::HighlightLegend { graph } {
    set elem [$graph legend get current]
    set relief [$graph element cget $elem -labelrelief]
    if { $relief == "flat" } {
	$graph element configure $elem -labelrelief raised
	$graph element activate $elem
    } else {
	$graph element configure $elem -labelrelief flat
	$graph element deactivate $elem
    }
}
................................................................................
	    -text $text -anchor center -bg {} -justify left
    }
}

proc rbc::DestroyZoomTitle { graph } {
    variable zoomInfo

    if { $zoomInfo($graph,corner) == "A" } {
	catch { $graph marker delete "zoomTitle" }
    }
}

proc rbc::PopZoom { graph } {
    namespace upvar ::rbc zoomInfo($graph,stack) zoomStack

................................................................................
    variable zoomInfo

    if { ![info exists zoomInfo($graph,corner)] } {
	rbc::InitStack $graph 
    }
    $graph marker delete {*}[$graph marker names "zoom*"]

    if { $zoomInfo($graph,corner) == "A" } {
	# Reset the whole axis
	rbc::PopZoom $graph
    } else {
	global zoomMod

	if { [info exists zoomMod] } {
	    set modifier $zoomMod
................................................................................
	rbc::RemoveBindTag $graph select-region-$graph
    }
}

option add *zoomTitle.font	  -*-helvetica-medium-R-*-*-18-*-*-*-*-*-*-* 
option add *zoomTitle.shadow	  yellow4
option add *zoomTitle.foreground  yellow1
option add *zoomTitle.coords	  "-Inf Inf"

proc rbc::ZoomTitleNext { graph } {
    variable zoomInfo

    set level [expr {[llength $zoomInfo($graph,stack)] + 1}]
    if { [$graph cget -invertxy] } {
	set coords "-Inf -Inf"
    } else {
	set coords "-Inf Inf"
    }
    $graph marker create text -name "zoomTitle" -text "Zoom #$level" \
	-coords $coords -bindtags "" -anchor nw
}

proc rbc::ZoomTitleLast { graph } {
    variable zoomInfo
................................................................................
	set modifier "Any-"
    }
    bind select-region-$graph <${modifier}Motion> { 
	rbc::GetCoords %W %x %y B
	#rbc::MarkPoint $graph B
	rbc::Box %W
    }
    if { $zoomInfo($graph,corner) == "A" } {
	if { ![$graph inside $x $y] } {
	    return
	}
	# First corner selected, start watching motion events

	#rbc::MarkPoint $graph A
	rbc::ZoomTitleNext $graph 
................................................................................
	pady paperwidth paperheight width height colormode } {
	global $graph.$var
	set $graph.$var [$graph postscript cget -$var]
    }
    set row 1
    set col 0
    label $top.title -text "PostScript Options"
    table $top $top.title -cspan 7
    foreach bool { center landscape maxpect preview decorations } {
	set w $top.$bool-label
	label $w -text "-$bool" -font *courier*-r-*12* 
	table $top $row,$col $w -anchor e -pady { 2 0 } -padx { 0 4 }
	set w $top.$bool-yes
	global $graph.$bool
	radiobutton $w -text "yes" -variable $graph.$bool -value 1
	table $top $row,$col+1 $w -anchor w
	set w $top.$bool-no
	radiobutton $w -text "no" -variable $graph.$bool -value 0
	table $top $row,$col+2 $w -anchor w
	incr row
    }
    label $top.modes -text "-colormode" -font *courier*-r-*12* 
    table $top $row,0 $top.modes -anchor e  -pady { 2 0 } -padx { 0 4 }
    set col 1
    foreach m { color greyscale } {
	set w $top.$m
	radiobutton $w -text $m -variable $graph.colormode -value $m
	table $top $row,$col $w -anchor w
	incr col
    }
    set row 1
    frame $top.sep -width 2 -bd 1 -relief sunken
    table $top $row,3 $top.sep -fill y -rspan 6
    set col 4
    foreach value { padx pady paperwidth paperheight width height } {
	set w $top.$value-label
	label $w -text "-$value" -font *courier*-r-*12* 
	table $top $row,$col $w -anchor e  -pady { 2 0 } -padx { 0 4 }
	set w $top.$value-entry
	global $graph.$value
	entry $w -textvariable $graph.$value -width 8
	table $top $row,$col+1 $w -cspan 2 -anchor w -padx 8
	incr row
    }
    table configure $top c3 -width .125i
    button $top.cancel -text "Cancel" -command "destroy $top"
    table $top $row,0 $top.cancel  -width 1i -pady 2 -cspan 3
    button $top.reset -text "Reset" -command "destroy $top"
    #table $top $row,1 $top.reset  -width 1i
    button $top.print -text "Print" -command "rbc::ResetPostScript $graph"
    table $top $row,4 $top.print  -width 1i -pady 2 -cspan 2
}

proc rbc::ResetPostScript { graph } {
    foreach var { center landscape maxpect preview decorations padx 
	pady paperwidth paperheight width height colormode } {
	global $graph.$var
	set old [$graph postscript cget -$var]
................................................................................
	if {[catch {
	    $graph postscript configure -$var [set $graph.$var]
	}]} {
	    $graph postscript configure -$var $old
	    set $graph.$var $old
	}
    }

    $graph postscript output "out.ps"
    puts stdout "wrote file \"out.ps\"."

    flush stdout
}






|







 







|







 







|







 







|






|

|







 







|







 







|



|



|


|


|
|




|




|



|
|



|


|
|
|
|
|
|
|







 







>
|
<
>


41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
...
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
...
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
...
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
...
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
...
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
...
494
495
496
497
498
499
500
501
502

503
504
505
    set elem [$graph legend get current]
    $graph legend deactivate $elem
}

proc rbc::HighlightLegend { graph } {
    set elem [$graph legend get current]
    set relief [$graph element cget $elem -labelrelief]
    if { $relief eq "flat" } {
	$graph element configure $elem -labelrelief raised
	$graph element activate $elem
    } else {
	$graph element configure $elem -labelrelief flat
	$graph element deactivate $elem
    }
}
................................................................................
	    -text $text -anchor center -bg {} -justify left
    }
}

proc rbc::DestroyZoomTitle { graph } {
    variable zoomInfo

    if { $zoomInfo($graph,corner) eq "A" } {
	catch { $graph marker delete "zoomTitle" }
    }
}

proc rbc::PopZoom { graph } {
    namespace upvar ::rbc zoomInfo($graph,stack) zoomStack

................................................................................
    variable zoomInfo

    if { ![info exists zoomInfo($graph,corner)] } {
	rbc::InitStack $graph 
    }
    $graph marker delete {*}[$graph marker names "zoom*"]

    if { $zoomInfo($graph,corner) eq "A" } {
	# Reset the whole axis
	rbc::PopZoom $graph
    } else {
	global zoomMod

	if { [info exists zoomMod] } {
	    set modifier $zoomMod
................................................................................
	rbc::RemoveBindTag $graph select-region-$graph
    }
}

option add *zoomTitle.font	  -*-helvetica-medium-R-*-*-18-*-*-*-*-*-*-* 
option add *zoomTitle.shadow	  yellow4
option add *zoomTitle.foreground  yellow1
option add *zoomTitle.coords	  [list -Inf Inf]

proc rbc::ZoomTitleNext { graph } {
    variable zoomInfo

    set level [expr {[llength $zoomInfo($graph,stack)] + 1}]
    if { [$graph cget -invertxy] } {
	set coords [list -Inf -Inf]
    } else {
	set coords [list -Inf Inf]
    }
    $graph marker create text -name "zoomTitle" -text "Zoom #$level" \
	-coords $coords -bindtags "" -anchor nw
}

proc rbc::ZoomTitleLast { graph } {
    variable zoomInfo
................................................................................
	set modifier "Any-"
    }
    bind select-region-$graph <${modifier}Motion> { 
	rbc::GetCoords %W %x %y B
	#rbc::MarkPoint $graph B
	rbc::Box %W
    }
    if { $zoomInfo($graph,corner) eq "A" } {
	if { ![$graph inside $x $y] } {
	    return
	}
	# First corner selected, start watching motion events

	#rbc::MarkPoint $graph A
	rbc::ZoomTitleNext $graph 
................................................................................
	pady paperwidth paperheight width height colormode } {
	global $graph.$var
	set $graph.$var [$graph postscript cget -$var]
    }
    set row 1
    set col 0
    label $top.title -text "PostScript Options"
    grid $top.title -columnspan 7
    foreach bool { center landscape maxpect preview decorations } {
	set w $top.$bool-label
	label $w -text "-$bool" -font *courier*-r-*12* 
	grid $w -row $row -column 0 -anchor e -pady { 2 0 } -padx { 0 4 }
	set w $top.$bool-yes
	global $graph.$bool
	radiobutton $w -text "yes" -variable $graph.$bool -value 1
	grid $w -row $row -column 1 -anchor w
	set w $top.$bool-no
	radiobutton $w -text "no" -variable $graph.$bool -value 0
	grid $w -row $row -column 2 -anchor w
	incr row
    }
    label $top.modes -text "-colormode" -font *courier*-r-*12*
    grid $top.modes -row $row -anchor e  -pady { 2 0 } -padx { 0 4 }
    set col 1
    foreach m { color greyscale } {
	set w $top.$m
	radiobutton $w -text $m -variable $graph.colormode -value $m
	grid $w -row $row -column $col -anchor w
	incr col
    }
    set row 1
    frame $top.sep -width 2 -bd 1 -relief sunken
    grid $top.sep -row 1 -column 3 -fill y -rowspan 6
    set col 4
    foreach value { padx pady paperwidth paperheight width height } {
	set w $top.$value-label
	label $w -text "-$value" -font *courier*-r-*12*
	grid $w -row $row -column 4 -anchor e -pady {2 0} -padx {0 4}
	set w $top.$value-entry
	global $graph.$value
	entry $w -textvariable $graph.$value -width 8
	grid $w - -row $row -column 5 -anchor w -padx 8
	incr row
    }
    grid columnconfigure $top 3 -minsize .125i
    button $top.cancel -text "Cancel" -command [list destroy $top]
    grid $top.cancel - - -row $row -column 0 -pady 2
    button $top.reset -text "Reset" -command [list destroy $top]
    #grid $top.reset -row $row -column 1
    button $top.print -text "Print" -command [list rbc::ResetPostScript $graph]
    grid $top.print - -row $row -column 4 -pady 2
}

proc rbc::ResetPostScript { graph } {
    foreach var { center landscape maxpect preview decorations padx 
	pady paperwidth paperheight width height colormode } {
	global $graph.$var
	set old [$graph postscript cget -$var]
................................................................................
	if {[catch {
	    $graph postscript configure -$var [set $graph.$var]
	}]} {
	    $graph postscript configure -$var $old
	    set $graph.$var $old
	}
    }
    set filename "out.ps"
    $graph postscript output $filename

    puts stdout [format "wrote file \"%s\"." $filename]
    flush stdout
}