Tk Source Code

Artifact 7bbbc4a65ff8c93955d5d6e51e02a90f8060341a23624d3038c1d9400d6252a2:

Attachment "tkScalingBugXft.tcl" to ticket [1de3a483] added by kjnash 2023-08-09 13:08:12.

---

#! /usr/bin/env wish

# Test script for Tk bug 1de3a48312

# To allow re-run in same interpreter:
catch {font delete PointFont}
catch {font delete PixelFont}
destroy .l1 .l2 .f
if {[info exists scale]} {
    tk scaling $scale
}


proc ScaleMe {} {
    global out scale radio pix bor
    if {$radio eq "1"} {
        set new $scale
    } else {
        set new [expr {$scale * 2}]
    }
    tk scaling $new
    set out "Tk scaling: [format %.6f $new]"
    font configure PixelFont -size $pix
    font configure PointFont -size 20
    destroy .l1 .l2
    label .l1
    label .l2
    pack forget .f
    pack .l1 .l2 .f  -padx 20 -pady 10

    .l1 configure -text "Borders and Font in Pixels" -font PixelFont -bd $bor -relief raised
    .l2 configure -text "Borders and Font in Points" -font PointFont -bd 10pt -relief raised
    return
}

. configure -bg white

set scale [tk scaling]

# Set pixel dimensions so that .l1 and .l2 appear the same at x1 scaling.
set pix [expr {round(-20 * $scale)}]
set bor [expr {round(10 * $scale)}]

set fam [font actual TkDefaultFont -family]
font create PixelFont -family $fam
font create PointFont -family $fam

frame .f
label .f.out -textvariable out
radiobutton .f.sc1 -text "Scaling x1" -variable ::radio -value 1 -command ScaleMe
radiobutton .f.sc2 -text "Scaling x2" -variable ::radio -value 2 -command ScaleMe
pack .f.out .f.sc1 .f.sc2 -side left

set radio 1
ScaleMe