# fracdraw.tcl
# Author: Gerard Sookahet
# Date: 18 Apr 2015
# Description: Fraction visualization
# Reference: A Postmodern View of Fractions and the Reciprocals of Fermat Primes
# Mathematics Magazine, Vol. 73(2000), pp. 83-97
package require Tk
bind all <Escape> {exit}
option add *Button.relief flat
option add *Button.foreground white
option add *Button.background blue
option add *Button.width 6
option add *Label.foreground white
option add *Label.background black
option add *Entry.background lightblue
option add *Entry.relief flat
proc FracDraw {{n 1} {d 13} {b 10} H} {
.c delete all
set r1 $n
set d_1 [expr {$d-1}]
for {set i 1} {$i <= $d_1} {incr i} {
set r2 [expr {(1.0*$r1*$b/$d - $r1*$b/$d)*$d}]
set r2r [expr {$r2 - int($r2)}]
if {$r2r >= .5} {set r2 [expr {int($r2)+1}]}
if {$r2r < .5} {set r2 [expr {int($r2)}]}
set s [expr {$H/($d-1)}]
set x1 [expr {$r1*$s}]
set x2 [expr {$r2*$s}]
set y1 [expr {$H-$x1}]
set y2 [expr {$H-$x2}]
.c create line $x1 $y1 $x1 $y2 -width 2 -fill green
.c create line $x1 $y2 $x2 $y2 -width 2 -fill green
if {$r2 == $n} break
set r1 $r2
}
}
wm geometry . +100+1
set H 400
set num 1
set den 37
set base 35
pack [canvas .c -width $H -height $H -bg black]
set f1 [frame .f1 -relief flat -bg black]
pack $f1 -fill x
label $f1.l1 -text numerator
entry $f1.e1 -width 4 -textvariable num
label $f1.l2 -text denominator
entry $f1.e2 -width 4 -textvariable den
label $f1.l3 -text base
entry $f1.e3 -width 4 -textvariable base
button $f1.br -text Run -command {FracDraw $num $den $base $H}
button $f1.bq -text Quit -command exit
pack {*}[winfo children $f1] -side left -padx 2AMG: Here's a version that uses spinboxes instead of entrys, automatically updates the screen, and has simpler rounding. There are a few other minor tweaks. I also added an arc visualization mode, and arcs and lines can be separately enabled or disabled. The arc mode seems to show interesting patterns with the perimeter of the "envelope" of the arcs, and these patterns are much harder to see with the lines alone.
# fracdraw.tcl
# Author: Gerard Sookahet
# Date: 18 Apr 2015
# Description: Fraction visualization
# Reference: A Postmodern View of Fractions and the Reciprocals of Fermat Primes
# Mathematics Magazine, Vol. 73(2000), pp. 83-97
package require Tk
bind all <Escape> {exit}
option add *Button.relief flat
option add *Button.foreground white
option add *Button.background blue
option add *Button.width 6
option add *Label.foreground white
option add *Label.background black
option add *Spinbox.background lightblue
option add *Spinbox.relief flat
option add *Checkbutton.foreground white
option add *Checkbutton.selectColor blue
option add *Checkbutton.background black
option add *Checkbutton.indicatorOn 0
proc FracDraw {n d b H arc line} {
.c delete all
set r1 $n
set d_1 [expr {$d-1}]
for {set i 1} {$i <= $d_1} {incr i} {
set r2 [expr {int(($r1*$b/double($d) - $r1*$b/$d)*$d + 0.5)}]
set s [expr {$H/($d-1)}]
set x1 [expr {$r1*$s}]
set x2 [expr {$r2*$s}]
set y1 [expr {$H-$x1}]
set y2 [expr {$H-$x2}]
if {$line} {
.c create line $x1 $y1 $x1 $y2 -width 2 -fill green
.c create line $x1 $y2 $x2 $y2 -width 2 -fill green
}
if {$arc} {
set xc [expr {($x1 + $x2) / 2}]
set yc [expr {($y1 + $y2) / 2}]
.c create arc\
[expr {($x1 - $xc) * sqrt(2) + $xc}]\
[expr {($y1 - $yc) * sqrt(2) + $yc}]\
[expr {($x2 - $xc) * sqrt(2) + $xc}]\
[expr {($y2 - $yc) * sqrt(2) + $yc}]\
-start [expr {$r1 < $r2 ? 45 : -135}]\
-outline blue -extent 180 -style arc -tag arc
}
if {$r2 == $n} break
set r1 $r2
}
.c raise arc
}
wm geometry . +100+1
wm resizable . 0 0
wm title . "Fraction Visualization"
set H 400
pack [canvas .c -width $H -height $H -bg black]
set f1 [frame .f1 -relief flat -bg black]
pack $f1 -fill x
foreach {var val} {numerator 1 denominator 37 base 35} {
set $var $val
label $f1.$var-l -text $var
spinbox $f1.$var-s -textvariable $var -from 1 -to 99 -width 4\
-command {FracDraw $numerator $denominator $base $H $arc $line}
}
foreach {var val} {arc 1 line 1} {
set $var $val
checkbutton $f1.$var-c -text $var -variable $var\
-command {FracDraw $numerator $denominator $base $H $arc $line}
}
FracDraw $numerator $denominator $base $H $arc $line
button $f1.quit-b -text Quit -command exit
pack {*}[winfo children $f1] -side left -padx 2Screenshot of the above: