Updated 2015-06-15 17:34:29 by HJG

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