# spiral.tcl 
 # Author:      Gerard Sookahet
 # Date:        03 May 2004 
 # Description: Ulam spiral and divisor spiral on a square grid
 
 package require Tk
 
 proc SpiralMain { N } {
  set w .sp
  catch {destroy $w}
  toplevel $w
  wm withdraw .
  wm title $w "Spiral number"
  wm geometry $w +100+10
 
  set dim [expr {int(sqrt($N) + 10)}]
  set mid [expr {$dim/2}]
  pack [canvas $w.c -width $dim -height $dim -bg white]
 
  set f1 [frame $w.f1 -relief sunken -borderwidth 2]
  pack $f1 -fill x
  button $f1.bu -text Ulam -width 6 -bg blue -fg white \
        -command "PlotUlam $w $N $mid" 
  button $f1.bd -text Divisor -width 6 -bg blue -fg white \
        -command "PlotDivisor $w $N $mid" 
  button $f1.bq -text Quit -width 5 -bg blue -fg white -command exit
  eval pack [winfo children $f1] -side left
 }
 
 proc PlotUlam { w N mid } {
  $w.c delete all
  set pix [image create photo]
  $w.c create image 0 0 -anchor nw -image $pix
  set cmap #030303
  set i $mid
  set j $mid
 # Spiral initialization by hand for 1 2 3 4 5 6 7
  $pix put $cmap -to $i $j
  incr i
  $pix put $cmap -to $i $j
  incr j -1
  $pix put $cmap -to $i $j
  incr i -1
  $pix put $cmap -to $i $j
  incr i -1
  $pix put $cmap -to $i $j
  incr j
  $pix put $cmap -to $i $j
  incr j
  $pix put $cmap -to $i $j
 
  set n 7
  set m 3
  set M [expr {int(sqrt($N))}]
 
  while {$m < $M} {
       for {set k 1} {$k <= $m} {incr k} {
          incr n
          incr i
           if [IsPrime $n] {$pix put $cmap -to $i $j}
       } 
       for {set k 1} {$k <= $m} {incr k} {
          incr n
          incr j -1
           if [IsPrime $n] {$pix put $cmap -to $i $j}
       } 
       set mm [expr {$m + 1}]
       for {set k 1} {$k <= $mm} {incr k} {
          incr n
          incr i -1
           if [IsPrime $n] {$pix put $cmap -to $i $j}
       } 
       for {set k 1} {$k <= $mm} {incr k} {
          incr n
          incr j
           if [IsPrime $n] {$pix put $cmap -to $i $j}
       } 
       update idletasks
       incr m 2
  } 
 }
 
 proc PlotDivisor { w N mid } {
  $w.c delete all
  set pix [image create photo]
  $w.c create image 0 0 -anchor nw -image $pix
  set cmap #030303
  set i $mid
  set j $mid
 # Spiral initialization by hand for 1 2 3 4 5 6 7
  $pix put $cmap -to $i $j
  incr i
  $pix put $cmap -to $i $j
  incr j -1
  $pix put $cmap -to $i $j
  incr i -1
  $pix put [colormap 1] -to $i $j
  incr i -1
  $pix put $cmap -to $i $j
  incr j
  $pix put [colormap 2] -to $i $j
  incr j
  $pix put $cmap -to $i $j
 
  set n 7
  set m 3
  set M [expr {int(sqrt($N))}]
 
  while {$m < $M} {
       for {set k 1} {$k <= $m} {incr k} {
          incr n
          incr i
           $pix put [colormap [NbDivisor $n]] -to $i $j
       } 
       for {set k 1} {$k <= $m} {incr k} {
          incr n
          incr j -1
           $pix put [colormap [NbDivisor $n]] -to $i $j
       } 
       set mm [expr {$m + 1}]
       for {set k 1} {$k <= $mm} {incr k} {
          incr n
          incr i -1
           $pix put [colormap [NbDivisor $n]] -to $i $j
       } 
       for {set k 1} {$k <= $mm} {incr k} {
          incr n
          incr j
           $pix put [colormap [NbDivisor $n]] -to $i $j
       } 
       update idletasks
       incr m 2
  } 
 }
 # Primality testing
 proc IsPrime { n } {
  set max [expr {int(sqrt($n))}]
  set d 2
  while {$d <= $max} {
       if {$n%$d == 0} {return 0}
       incr d
  }
  return 1
 }
 # Return the number of divisors of an integer
 proc NbDivisor { n } {
  set max [expr {int(sqrt($n))}]
  set nd 0
  for {set i 2} {$i <= $max} {incr i} {
     if {$n%$i == 0} {incr nd}
  }
  return $nd
 }
 # Arbitrary color table
 proc colormap { n } {
  set lcolor {#030303 #CD0000 #CD4F39 #EE4000 #EE6A50 #FF7F00 #EE9A00 \
              #FF8C69 #FFC125 #EEEE00 #EED5B7 #D2691E #BDB76B #00FFFF \
              #7FFFD4 #FFEFD5 #AB82FF #E066FF
  }
  return [lindex $lcolor $n]
 }
 # The maximum integer. The canvas is sized from its square root 
 SpiralMain 70000