#!/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