George Peter Staplin April 1, 2006 - The code that follows performs 2D rotations by using scaling and a precomputed table. The table is generated using sin() and cos(), but it could easily be generated once, and the need for floating point completely eliminated.
Miguel Sofer responded to my question about how to do this, and quite graciously volunteered to write the majority of this code. I wrote the graphical part.
#
# This is a joint project --
# by Miguel Sofer (primarily) and George Peter Staplin
#
package require Tk
#
# This is used by the test procedure to compare the irot result with drot.
#
proc drot {x y a} {
set a [expr {($a*acos(0))/90}];# convert to radians
set c [expr {cos($a)}]
set s [expr {sin($a)}]
list [expr {int(round($x*$c-$y*$s))}] [expr {int(round($x*$s+$y*$c))}]
}
# create the table
set Cos {}; set Sin {}
set M [expr {pow(2,30)}]
set Coeff [expr {acos(0)/90}]
for {set a 0} {$a <= 45} {incr a} {
set A [expr {$Coeff*$a}]
lappend Cos [expr {int($M*cos($A))}]
lappend Sin [expr {int($M*sin($A))}]
}
set M [expr {int($M)}]
proc ifun a {
global Cos Sin
set a [expr {$a%360}]
# sign of sin and sign of cos
set ss 1; set sc 1
# Insure -180<$a<=180
if {$a > 180} {
set a [expr {$a-360}]
}
# Consider negative angles; after this 0<=$a<=180
if {$a < 0} {
set ss [expr {-$ss}]
set a [expr {-$a}]
}
# Convert to first quadrant
if {$a > 90} {
set sc [expr {-$sc}]
set a [expr {180-$a}]
}
# Lookup only the first 45 degrees
if {$a <= 45} {
set cos [expr {$sc*[lindex $Cos $a]}]
set sin [expr {$ss*[lindex $Sin $a]}]
} else {
set a [expr {90-$a}]
set cos [expr {$sc*[lindex $Sin $a]}]
set sin [expr {$ss*[lindex $Cos $a]}]
}
list $cos $sin
}
proc irot {x y a} {
global M
foreach {c s} [ifun $a] break
set c [expr {wide($c)}]
set s [expr {wide($s)}]
set xx [expr {int(($x*$c-$y*$s)/$M)}]
set yy [expr {int(($x*$s+$y*$c)/$M)}]
list $xx $yy
}
proc test {x y a} {
list [irot $x $y $a] [drot $x $y $a]
}
proc point {win x y} {
$win create rectangle $x $y [expr {$x + 4}] [expr {$y + 4}] -fill white
$win create text [expr {$x + 5}] [expr {$y - 5}] -text "$x,$y" -fill white
}
proc draw.circle {win radius centerx centery} {
set lastx [expr {$centerx + $radius}]
set lasty [expr {$centery + $radius}]
for {set d 1} {$d < 360} {incr d} {
set rot [irot $radius $radius $d]
set x [lindex $rot 0] ; set y [lindex $rot 1]
set x [expr {$x + $centerx}] ; set y [expr {$y + $centery}]
$win create line $lastx $lasty $x $y -fill white
set lastx $x ; set lasty $y
}
point $win $centerx $centery
}
proc main {} {
wm title . "Miguel and George's Excellent Adventure!"
pack [canvas .c -bg black] -fill both -expand 1
draw.circle .c 50 100 100
draw.circle .c 25 200 200
draw.circle .c 50 300 100
}
main