[http://www.kb-creative.net/images/ulam/UlamDemo.png]
----

[KWJ] '''ULAM SPIRAL DEMO ---'''

This is a Tcl/Tk script which illustrates a method for generating Ulam's Spiral, see also [Prime Number Browser] and [Primal Screens].  In the figure, we have the integers from 1 to 49 laid out in a spiral pattern as first described by Stanislau Ulam, see  [[1]] http://mathworld.wolfram.com/PrimeSpiral.html.  The blue Horizontal and Vertical lines passing through the number 1, are for reference purposes.  The two black Diagonal lines traversing the upper left and lower right quadrants pass through integers which are perfect squares.  The upper left line passes thru numbers of the form y = M*M, where M is an even integer.  The lower right line passes thru values where M is odd.

Let M be 2, and wrap (2*M - 1) cells in an inverted L pattern to the right of and around the single starting cell, creating a square pattern of four cells.  For the next iteration, let M be 3, and again, wrap (2*M - 1) cells in an L shaped pattern around the last four cells, creating a new pattern of nine cells. The third iteration for M = 4, wraps another (2*M - 1) cells about these last cells.  The terminating cell always contains the integer M*M, and falls on one of the lines of even or odd squres.  Prime numbers are printed in bold, non primes are in italics.  Every time the "Click_Here" button is depressed, M is incremented by one and a new wrapping layer is added.  See [Primal Screens] for further information about the significance of the lines of Even and Odd Squares.  For further background, see the fine page by Gerard Sookahet on the Wiki, at [Ulam spiral].

This script was developed on an iMac, running Leopard OS X, with TclTk 8.4.7 installed. It has a 19 inch screen, so I'm not sure how the graphics might appear, or the script behave on other systems, your results may vary.  Any helpful comments or modifications are greatly appreciated.

----


======
#!/bin/sh
# \
exec wish "$0" ${1+"$@"}

#=====================================================================================
#  
#                   Ulam Spiral Demo Program
#
#   METHOD---
#   On an integer lattice, place square cells centered on each lattice point.
#   Make cell side lengths equal to the distance between lattice points.  
#   Starting with a single cell at the center of the lattice, wrap it with 
#   three cells that form an inverted "L" shape starting to the right of the 
#   first cell, completing a larger Square Pattern of four cells.  Label the first
#   cell with the number 1, then assign increasing integers to each new cell.  
#   After the last cell has been labeled, wrap an "L" shaped pattern of five 
#   more cells around the the first four cells.  Continue to repeat the
#   wrapping process with inverted and regular "L" shapes.
#   
#
#   VARIANTS---
#   This scheme forms a Counter Clockwise Spiral.  Clockwise creates a 
#   different pattern.  The starting integer and location of the starting
#   integer within the first group of four cells might also be varied.
#=====================================================================================


#  Version of March 16, 2009

#    Comments:
#
#    M -- the number of cells forming the edge of a larger Square Pattern.
#    primes -- the list containing the prime numbers smaller than 121.
#    primeIndex -- The zero origin index to the list of primes.
#    runningIndex -- The current square cell number to be plotted.
#    The side of a square cell is  2 * $delta in length.
#

#   Calling Sequence
#-------------------
#   canvasSetup
#   Click_Here
#       drawSquares
#         iterate
#           square
#       drawCoords
#       odd_evenSquares

#----------------------
#  Some initialization.
#----------------------
set bkgndColor {}
set delta 30
set fgndColor black
set nucX {}
set nucY {}
set M 2
set primeFont "Courier 20 bold"
set primeIndex 0

#   The list containing prime numbers smaller than 121.
set primes {
2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 
103 107 109 113  
           }

set runningIndex 1
set squareColors { {gainsboro  black} {linen      black} {lavender   black} \
          {gray       black} {"deep sky blue"  white} {firebrick  white} \
          {aquamarine black} {green      black} {sienna     white} \
          {turquoise  black} {maroon     white} {bisque4    white} \
          {SlateBlue  white} 
   }

set textFont "Times 16 italic"


#-------------------------------------------------
#  Proc Click_Here
#  A proc which responds to the Click_Here button.
#  The next wrapping of (2*M -1) cells will 
#  be added to the existing Ulam Spiral plot.  
#  Also refreshes the Reference Lines.
#             Demo.tcl
#-------------------------------------------------
proc Click_Here { } {
   global  cX cY M M_Value nucX nucY warnTxt
  
   if {$M == 2} {
#  Initial Square created here.
      square $cX $cY
   }

   if {$M > 11} {
      $warnTxt delete 1.0 end
      $warnTxt insert insert "That's It!"
   } else {
      drawSquares
      set cX $nucX
      set cY $nucY
   }

   $M_Value delete 1.0 end
   $M_Value insert insert [expr {$M -1}]

#  Add Reference Lines.  Do this every cycle so lines overlay numbers.
   drawCoords
   odd_evenSquares
}


#------------------------------------------------------
#  Proc drawCoords.
#  Overlay blue X and Y Coordinate Axes on the Ulam plot
#  for reference purposes.
#             Demo.tcl
#------------------------------------------------------
proc drawCoords {} {
      global  cX0 cY0 window xMin xMax yMin yMax

#     Draw Coordinate Axes
      set coords {}
      set x1 $xMin
      set y1 $cY0
      set x2 $xMax
      set y2 $cY0
      lappend coords [list $x1 $y1 $x2 $y2]
      eval {$window create line} $coords \
           {-width 0 -fill blue2}
           
      set coords {}
      set x1 $cX0
      set y1 $yMin
      set x2 $cX0
      set y2 $yMax
      lappend coords [list $x1 $y1 $x2 $y2]
      eval {$window create line} $coords \
           {-width 0 -fill blue2}
}


#-------------------------------------------------------
#  Proc odd_evenSquares.
#  Draw lines through cells which are the Squares of Odd
#  and Even numbers.
#             Demo.tcl
#-------------------------------------------------------
proc odd_evenSquares {} {

#   Draw lines through the squares of the Odd and Even numbers.
    plotLine 336 276  96 36
    plotLine 336 336  636 636   
}


#---------------------------------------------------------
#  Proc plotLine.
#  Plot a line connecting the two points, x1 y1 and x2 y2.
#             Demo.tcl
#---------------------------------------------------------
proc plotLine {x1 y1 x2 y2} {
    global  window

    lappend coords [list $x1 $y1 $x2 $y2]
    eval {$window create line} $coords \
         {-width 0 -fill black} 
}


#-------------------------------------------------
#  Proc canvasSetup
#  Create the Ulam Spiral canvas with buttons etc.
#             Demo.tcl
#-------------------------------------------------
proc canvasSetup { } {
   global cX0 cY0 cX cY delta M_Value primeFont warnTxt
   global window xMin xMax yMin yMax

   set window .square
   catch {destroy $window}
   toplevel $window

   wm title $window "Ulam's Spiral Demo"
   wm geometry $window +600+150
   wm withdraw .
   focus $window

#  Determine screen width and height.
   set screenwd [winfo screenwidth .]
   set screenht [winfo screenheight .]

#  Make a canvas to contain the Ulam screen.
#   set winwd [expr {int ( 0.45*$screenwd )}]
   set winwd [expr {int ( 0.40*$screenwd )}]
   set winht $winwd

   set cX [expr {int ($winwd / 2)}]
   set cY $cX

#  Center of the very first Cell.
   set cX0 $cX
   set cY0 $cY
   set xMin [expr {$cX0 - 10 * $delta}]
   set xMax [expr {$cX0 + 10 * $delta}]
   set yMin [expr {$cX0 - 10 * $delta}]
   set yMax [expr {$cX0 + 10 * $delta}]

   set f1 [frame $window.f1 -relief sunken -borderwidth 2 -height 30]
   pack $f1 -fill x -side top


   button $f1.bp -text "Click_Here" -width 9 -bg blue -fg white -font $primeFont \
        -command Click_Here

   label $f1.lbl1 -text "M is:" -width 15  -anchor e -font $primeFont
   text $f1.txt -relief raised -bd 2 -width 2 -height 1 -font $primeFont
   set M_Value $f1.txt
   text $f1.txtw -relief raised -bd 2 -width 10 -height 1 -font $primeFont
   set warnTxt $f1.txtw
   eval pack [winfo children $f1] -side left 

   button  $f1.bq -text Quit -width 5 -bg blue -fg white -font $primeFont \
        -command exit
   pack $f1.bq -side right

   set window $window.c
   pack [canvas $window -width $winwd -height $winht -bg "alice blue"]

   raise .
}


#------------------------------------------------------
#  Proc drawSquares
#  A proc to draw a wrapping pattern of (2*$M -1) cells 
#  in an "L" or inverted "L" shape.
#             Demo.tcl
#------------------------------------------------------
proc drawSquares {} {
   global bkgndColor cX cY  fgndColor M nucX nucY 
   global runningIndex squareColors

   set nucX $cX
   set nucY $cY

   set colors [lindex $squareColors [expr {$M -2}] ]
   set fgndColor [lindex $colors 1]
   set bkgndColor [lindex $colors 0]

   iterate

   incr M
   incr runningIndex
}


#--------------------------------------------------------
#  Proc iterate.
#  Create and number the individual cells in the wrapping
#  pattern.  Draw cells in Counter-ClockWise Direction.
#             Demo.tcl
#--------------------------------------------------------
proc iterate { } {
      global   delta M nextOp nucX nucY runningIndex

      set num_Moves [expr {$M -1}]
      set twoDelta [expr {2*$delta}]
      set nextOp "right"
      if {[expr {fmod ($M,2)}] > 0.0} {

         set nextOp "left"
      }

      if {[string compare $nextOp "right"] == 0} {
         set nucX [expr {$nucX + $twoDelta}]
         square $nucX $nucY

         for {set i 1} {$i <= $num_Moves} {incr i 1} {
            set nucY [expr {$nucY - $twoDelta}]
            square $nucX $nucY
         }

         for {set i 1} {$i <= $num_Moves} {incr i 1} {
            set nucX [expr {$nucX - $twoDelta}]
            square $nucX $nucY
         }

      } else {
          set nucX [expr {$nucX - $twoDelta}]
          square $nucX $nucY

          for {set i 1} {$i <= $num_Moves} {incr i 1} {
             set nucY [expr {$nucY + $twoDelta}]
             square $nucX $nucY
          }

          for {set i 1} {$i <= $num_Moves} {incr i 1} {
             set nucX [expr {$nucX + $twoDelta}]
             square $nucX $nucY
          }
      }

      incr runningIndex -1
}


#----------------------------------------------------------------
#  Proc square
#  Draw a square cell centered at x and y.  The cell edge will be 
#  (2 * $delta) in length.  Check to see if runningIndex is a 
#  member of the primes list.  If so, print it's value in blue
#  and primeFont.  Otherwise, print values in black and textFont.
#             Demo.tcl
#----------------------------------------------------------------
proc square { x y } {
   global bkgndColor delta fgndColor primeFont primeIndex
   global primes runningIndex textFont window

   update idletasks
   after 125

   if {[lindex $primes $primeIndex] == $runningIndex} {
      set fgnd blue
      set numberFont $primeFont
      incr primeIndex
   } else {
      set fgnd $fgndColor
      set numberFont $textFont
   }

#  Calculate coordinates for square cell.
   set x1 [expr {$x - $delta}]
   set y1 [expr {$y - $delta}]
   set x2 [expr {$x + $delta}]
   set y2 [expr {$y + $delta}]

#  Create cell here with fill bkgndColor. 
   $window create rectangle $x1 $y1 $x2 $y2 -fill $bkgndColor \
         -outline lightblue1 -width 2
#  Label cell with runningIndex.
   $window create text $x $y -text $runningIndex -fill $fgnd -font $numberFont   
   incr runningIndex
}


#--------------
#   Start Demo.
#--------------
canvasSetup 
Click_Here

======


----
See also [Prime Number Browser] and [Primal Screens]
----

----
!!!!!!
%| [Category Graphics] | [Category Mathematics] | [Category Browsers] |%
!!!!!!