Ulam spiral and relatives

[tsh73]

"relatives"?
Yes, there is also Klauber triangle and Sacks spiral.
Obviously I spent too much time on them
You can view them in numbers form, with nice 2pixel dots and even with tiny 1px dots
(just explore program menu)

 






'tsh73, Oct 2019
'Klauber triangle
'Sacks spiral
'Ulam spiral
'https://en.wikipedia.org/wiki/Ulam_spiral
'http://numberspiral.com/

'nomainwin

'---------------------------------------
Half=300
desiredWidth = 2*Half
desiredHeight = 2*Half
h=1    'so we have maximum amount of points
   'so then we change it works even for 1px
N=(2*Half/h)^2

gosub [ajustWindow]
'now, center window
   UpperLeftX = (DisplayWidth - WindowWidth)/2
   UpperLeftY = (DisplayHeight - WindowHeight)/2

   'now, open your window with desired size
       'with menu if you wish
   MENU #gr, "File", "Ulam spiral",[ulam1],"Klauber triangle",[klauber1],"Sacks spiral",[sacks1],|,"Exit", [quit]
   MENU #gr, "Options", "Step size",[stepSize]

   open "Ulam spiral etc" for graphics_nsb_nf as #gr

   #gr, "trapclose [quit]"
   #gr, "down"
   #gr, "home; posxy cx cy"
'-------------------------------------
   #gr, "place "; cx-60;" "; cy-30
   #gr, "\Finding primes..."

   dim a(N)
   nn=int(sqr(N))
   t0=time$("ms")
   for i=2 to nn
       if a(i)<>0 then [skipNonPrime]
       for j=2*i to N step i
           'a(j)=1
           a(j)=a(j)+1
       next
   [skipNonPrime]
   #gr, "place "; cx-20;" "; cy-30
       #gr, "\"
       #gr, "\";using("###", int(i/nn*100));"%"
   next
   #gr, "place "; cx-60;" "; cy-30
   #gr, "\\\Counting primes..."

   s=0
   for i=2 to N
       'print i, a(i)
       s=s+(a(i)=0)
       if a(i)>maxVal then maxVal=a(i)
   next
   print "nPrimes ";s       ; " per ";N
   t1=time$("ms")
   print "Time taken ";t1-t0; " per ";N
   print "maxVal ";maxVal

   #gr, "place "; cx-60;" "; cy-30
   #gr, "\\\\found ";s

   '-------------------------------------

   h=3    'valid are 1, 2, 3, and 20
   'thing that will be drawn after start
   goto [ulam1]
   'goto [klauber1]
   'goto [sacks1]

wait

'-----------------------
[ulam1]
   #gr "cls"
   x=cx:y=cy
   if h >1 then
       #gr "size 2"
   else
       #gr "size 1"
   end if
   #gr "set ";x;" ";y
   j=1
   if h >=20 then #gr "\";j
   'h=3
   'h=2
   'h=1
   dim dx(3), dy(3)    'from 0
   for i=0 to 3
       'rectangular
       dx(i)=val(word$("1  0 -1 0",i+1))
       dy(i)=val(word$("0 -1  0 1",i+1))
       'hexagonal
       ' dx(i)=val(word$("1.73  1.73 -1.73 -1.73",i+1))
       ' dy(i)=val(word$("1 -1 -1  1",i+1))
   next
       '#gr "size 2"
   m=0
   while 1
       for d= 0 to 3
           SCAN
           if d mod 2 =0 then m=m+1
           for i = 1 to m
               x=x+dx(d)*h
               y=y+dy(d)*h
               'if x<0 or x > 2*cx or y<0 or y>2*cy then exit while
               j=j+1
               over=j>N
               if over then exit for
               if a(j)=0 then
                   '#gr "color black"
                   #gr "set ";x;" ";y
               ' else
                   ' #gr "color "; rainbow$(5/6*a(j)/maxVal)
                   ' #gr "set ";x;" ";y
                   if h >=20 then #gr "\ ";j;" ": call pause 10
               end if
           next
           if over then exit for
       next
       if x<0 or x > 2*cx or y<0 or y>2*cy then exit while
       if over then exit while
   wend
   #gr "flush"
   'notice "Pts used ";j
   print "Pts used ";j

   wait

[klauber1]
   #gr "cls"
   'h=20
   'h=2
   row=1
   x=cx-h*row:y=20+h*row
   if h >1 then
       #gr "size 2"
   else
       #gr "size 1"
   end if
   #gr "set ";x;" ";y
   j=1
   if h >=20 then #gr "\";j

   while 1
       row=row+1
       y=20+h*row
       x=cx-h*row
       for i = 1 to 2*row-1
           j=j+1
           if a(j)=0 then
               #gr "set ";x;" ";y
               if h >=20 then #gr "\ ";j;" ": call pause 10
           end if
           x=x+h
       next
       if x<0 or x > 2*cx or y<0 or y>2*cy then exit while
   wend
   #gr "flush"
   print "Pts used ";j

   wait

[sacks1]
   #gr "cls"
   x=cx:y=cy
   if h >1 then
       #gr "size 2"
   else
       #gr "size 1"
   end if
   #gr "set ";x;" ";y
   j=1
   if h >=20 then #gr "\";j
   pi=acs(-1)
   while 1
       j=j+1
       over=j>N
       if over then exit while
       r=h*sqr(j)
       phi=2*pi*sqr(j)
       x=cx+r*cos(phi)
       y=cy-r*sin(phi)
       'print j, r, phi,phi/2/pi*180,x,y
       if a(j)=0 then
           #gr "set ";x;" ";y
           if h >=20 then #gr "\ ";j;" ": call pause 10
       end if
       if x<0 or x > 2*cx or y<0 or y>2*cy then exit while
   wend
   #gr "flush"
   'notice "Pts used ";j
   print "Pts used ";j



   wait

[quit]
   timer 0
   close #gr
   end


'-------------------------------------------------
[ajustWindow]
   UpperLeftX = 20
   UpperLeftY = 20
   WindowWidth = 200   '100 seems to be too much - works different
   WindowHeight = 100
   MENU #gr, "dummy"
   open "Ajusting..." for graphics_nsb_nf as #gr
'   graphics
'   graphics_nsb
'   graphics_nsb_nf

   #gr, "home ; down ; posxy x y"
   'x, y give us width, height
   width = 2*x : height = 2*y
   close #gr

   slackX = 200-width
   slackY = 100-height

   WindowWidth = desiredWidth + slackX
   WindowHeight = desiredHeight + slackY

return

sub pause mil
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

'---------------------------------------------
' 0..1 into red-green-blue-red continuous colors
function rainbow$(x)
   hi = int((x*6) mod 6)+ 5*(x<0)  'fixed to 0..5
   f = (x*6) mod 1 + (x<0)         'frac, 0..1
   q = (1-f)
   select case hi
   case 0
       r = 1: g = f: b = 0
   case 1
       r = q: g = 1: b = 0
   case 2
       r = 0: g = 1: b = f
   case 3
       r = 0: g = q: b = 1
   case 4
       r = f: g = 0: b = 1
   case 5
       r = 1: g = 0: b = q
   end select
   R = int(r*255)
   G = int(g*255)
   B = int(b*255)
   rainbow$= R;" ";G;" ";B
end function

'---------------------------------
[stepSize]

   WindowWidth = 376
   WindowHeight = 230

   button #opt.default, "OK", [btnOK], UL, 22, 151, 122, 25
   button #opt.btEsc, "Cancel", [btEsc], UL, 230, 151, 122, 25
   radiobutton #opt.radiobutton3, "1 px", [radiobutton3Set], [radiobutton3Reset], 22, 11, 48, 20
   radiobutton #opt.radiobutton4, "2px", [radiobutton4Set], [radiobutton4Reset], 22, 46, 40, 20
   radiobutton #opt.radiobutton5, "3px (2 px dot, 1 px gap)", [radiobutton5Set], [radiobutton5Reset], 22, 81, 208, 20
   radiobutton #opt.radiobutton6, "20 px (show numbers)", [radiobutton6Set], [radiobutton6Reset], 22, 116, 176, 20
   open "Step size" for dialog_nf_modal as #opt
   print #opt, "trapclose [quit.opt]"

   print #opt, "font ms_sans_serif 10"
   'set initial
   select case h
   case 1
       #opt.radiobutton3 "set"
   case 2
       #opt.radiobutton4 "set"
   case 3
       #opt.radiobutton5 "set"
   case 20
       #opt.radiobutton6 "set"
   end select

   wait

[quit.opt]
   Close #opt
   wait


[btnOK]    'read selection
   #opt.radiobutton3 "value? res$"
   if res$="set" then h=1
   #opt.radiobutton4 "value? res$"
   if res$="set" then h=2
   #opt.radiobutton5 "value? res$"
   if res$="set" then h=3
   #opt.radiobutton6 "value? res$"
   if res$="set" then h=20
   Close #opt
   wait


[btEsc]
   Close #opt
   wait


[radiobutton3Set]    'Perform action for the radiobutton named 'radiobutton3'
   'Insert your own code here
   wait


[radiobutton3Reset]    'Perform reset for the radiobutton named 'radiobutton3'
   'Insert your own code here
   wait


[radiobutton4Set]    'Perform action for the radiobutton named 'radiobutton4'
   'Insert your own code here
   wait


[radiobutton4Reset]    'Perform reset for the radiobutton named 'radiobutton4'
   'Insert your own code here
   wait


[radiobutton5Set]    'Perform action for the radiobutton named 'radiobutton5'
   'Insert your own code here
   wait


[radiobutton5Reset]    'Perform reset for the radiobutton named 'radiobutton5'
   'Insert your own code here
   wait


[radiobutton6Set]    'Perform action for the radiobutton named 'radiobutton6'
   'Insert your own code here
   wait


[radiobutton6Reset]    'Perform reset for the radiobutton named 'radiobutton6'
   'Insert your own code here
   wait



[B+]

Cool! I've not seen Triangle or Plowed Land versions before, City Map I've seen often.

The twins really show up well with Triangle version.

[tenochtitlanuk]

Lovely.

Remember first meeting Ulam spiral decades ago- possibly a Martin Gardner column in Scientific American- and programmed it several times through different computer generations and languages. Version on my website was 2010 I notice. Might do a version colour coding primes, or even numbers, or powers of 7 or w..h.y. ( what have you)

[tsh73]

and programmed it several times through different computer generations and languages.

LOL
For me it was Sierpiński triangle - virtually any programming platform I tried got it
EDIT "Chaos game" version