Tk Source Code

Artifact 178befedd1b2445287adfc0876e6a8dbfd2b937601eab41fd3eb32c5b903e9c9:

Attachment "tkScalingBugXft2.tcl" to ticket [1de3a483] added by nemethi 2026-08-24 14:39:15.

---

#! /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 radio scale out pix bor defSize
    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 -text "Borders and Font in Pixels" -font PixelFont -bd $bor -relief raised
    label .l2 -text "Borders and Font in Points" -font PointFont -bd 10p -relief raised
    pack forget .f
    pack .l1 .l2 .f -padx 20 -pady 10

    # Refresh the widgets that use TkDefaultFont.
    font configure TkDefaultFont -size $defSize
}

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 defSize [font actual TkDefaultFont -size]
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