Tcl Source Code

Artifact [8faaf0d2ef]
Login

Artifact 8faaf0d2ef8c11f8e063b6fe32656e3809bf9434:

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