Attachment "canvastest.tcl" to
ticket [634636ffff]
added by
nobody
2002-11-07 03:13:53.
# This code attempts to demonstrate two Tk bugs or misfeatures:
# 1) Lines drawn on MacOS Classic or with aqua Tk*
# are offset relative to those drawn on unix (including
# MacOS X when Tk is built for unix and so uses an X server).
# The special platform-specific code shown below
# compensates for it, and so should suggest what needs to be done
# to fix this problem. I sincerely hope the authors of Tk agree that
# this is a bug, rather than a quirk users should work around.
# 2) $tcl_platform(platform) shows up as "unix" under aqua Tk*
# Note that this makes it fixing (1) very difficult, as there's
# no obvious way to tell the difference between tcl built
# for aqua and tcl built for an X server. (I am assuming that
# $tcl_platform(os) is "Darwin" in boh cases, but I've not
# verified that.)
# *By "aqua Tk" I mean Tk 8.4.0 or later built for MacOS X
# using the macosx directory, hence built to use native "aqua"
# windowing. (The other option on MacOS X is to build using
# the unix directories, in which case Tk relies on an X server).
set platform $tcl_platform(platform)
# note: on MacOS X uncomment the following line to make
# the output look good; this patch is not needed for MacOS 9:
# set platform macintosh
puts stdout "the platform is $platform"
# Draw a centered circle on the specified canvas.
#
# Inputs:
# cnv: canvas on which to draw
# xpos: x position
# ypos: y position
# rad: outer radius of circle
# width: thickness of line (inward from radius)
proc ctrCircle {cnv xpos ypos rad {width 1}} {
global platform
if {$platform == "macintosh"} {
$cnv create oval \
[expr $xpos - $rad] \
[expr $ypos - $rad] \
[expr $xpos + $rad + 1] \
[expr $ypos + $rad + 1] \
-width $width
} else {
$cnv create oval \
[expr $xpos - $rad] \
[expr $ypos - $rad] \
[expr $xpos + $rad] \
[expr $ypos + $rad] \
-width $width
}
}
# Draw a centered + on the specified canvas.
#
# Inputs:
# cnv: canvas on which to draw
# xpos: x position
# ypos: y position
# rad: radius of symbol
# holeRad: radius of hole in center of symbol (0 for none)
# width: thickness of line
proc ctrPlus {cnv xpos ypos rad {holeRad 0} {width 1}} {
global platform
if {$platform == "macintosh"} {
set offset [expr $width / 2]
set xpos [expr $xpos - $offset]
set ypos [expr $ypos - $offset]
set dxy [expr $rad - $offset]
} else {
set dxy $rad
}
set holedxy $holeRad
$cnv create line \
$xpos [expr $ypos + $holedxy] \
$xpos [expr $ypos + $dxy] \
-width $width
$cnv create line \
$xpos [expr $ypos - $holedxy] \
$xpos [expr $ypos - $dxy] \
-width $width
$cnv create line \
[expr $xpos - $holedxy] $ypos \
[expr $xpos - $dxy] $ypos \
-width $width
$cnv create line \
[expr $xpos + $holedxy] $ypos \
[expr $xpos + $dxy] $ypos \
-width $width
}
# Draw a centered X on the specified canvas.
#
# Inputs:
# cnv: canvas on which to draw
# xpos: x position
# ypos: y position
# rad: radius of symbol
# holeRad: radius of hole in center of symbol (0 for none)
# width: thickness of line
proc ctrX {cnv xpos ypos rad {holeRad 0} {width 1}} {
global platform
if {$platform == "macintosh"} {
set offset [expr $width / 2]
set xpos [expr $xpos - $offset]
set ypos [expr $ypos - $offset]
set dxy [expr ($rad / sqrt(2)) - $offset]
set holedxy [expr ($holeRad / sqrt(2)) + $offset]
} else {
set dxy [expr $rad / sqrt(2)]
set holedxy [expr $holeRad / sqrt(2)]
}
$cnv create line \
[expr $xpos + $holedxy] [expr $ypos + $holedxy] \
[expr $xpos + $dxy] [expr $ypos + $dxy] \
-width $width
$cnv create line \
[expr $xpos + $holedxy] [expr $ypos - $holedxy] \
[expr $xpos + $dxy] [expr $ypos - $dxy] \
-width $width
$cnv create line \
[expr $xpos - $holedxy] [expr $ypos + $holedxy] \
[expr $xpos - $dxy] [expr $ypos + $dxy] \
-width $width
$cnv create line \
[expr $xpos - $holedxy] [expr $ypos - $holedxy] \
[expr $xpos - $dxy] [expr $ypos - $dxy] \
-width $width
}
canvas .c -width 201 -height 201
pack .c
ctrPlus .c 80 80 10 5
ctrPlus .c 100 80 10 5 5
ctrX .c 80 100 10 5
ctrX .c 100 100 10 5 5
ctrCircle .c 80 120 10 1
ctrCircle .c 100 120 10 5
ctrCircle .c 120 80 10
ctrPlus .c 120 80 10 5
ctrX .c 120 80 10 5
ctrCircle .c 120 100 10 5
ctrPlus .c 120 100 10 5 5
ctrX .c 120 100 10 5 5