aUCBLogo Demos and Tests / palindromic_numbers_robbie

setLogoLanguage "ucblogo

to palindromic_numbers_robbie
;traceall
;trace primitives
   doit 19
end

to doit :x
   print "########################################################
   cs pu ht home
   setlabelfont [[Arial] -10 0 0 400 0 0 0 0 3 2 1 34]
   make "outray (array 301)
   make "n 1 make "k :x
   repeat 301 [checkloop (pack :x) 0 make "x :x+1 make "n :n+1]
   make "outlist arraytolist :outray
   print "########################################################
   yaxis
   make "j 0 pu make "itt 0 setpos (list -200 -50) pd
   repeat 301 [xaxis make "j :j+1]
   print (list "doit :k+300)
   gifsave (word "doit :k ".gif)
end

to checkloop :xlist :I
   if :i > 99 [
      setitem :n :outray 100
      print (list (:n+(:k-1)) "... :i "... :xlist) stop
   ]
   if (:xlist = (reverse :xlist)) [
      setitem :n :outray :i
      print (list (:n+(:k-1)) "... :i "... :xlist) stop
   ]
   ;ignore (reverse :xlist)
   checkloop (addm :xlist (reverse :xlist)) :i+1
end

to addm :a :b
   make "la (count :a)+1
   make "aa (array :la 1)
   make "z 0
   addloop :a :b :la
   setitem 1 :aa :z
   make "cc arraytolist :aa
   if :z=0 [make "cc butfirst :cc]
   output :cc
end

to addloop :a :b :la
   if :la = 1 [stop]
;(show :a (last :a) :b (last :b) :z)
;(print typeof (last :a) typeof (last :b) typeof :z)
   make "c (last :a)+(last :b)+:z
   make "z 0
   if :c > 9 [make "c (last :c) make "z 1]
   setitem :la :aa :c
   addloop (butlast :a) (butlast :b) (:la-1)
end

to pack :x
   make "xlist :x
   output :xlist
end

to jump
   pd bk 15
   pu fd 3 rt 90 bk 7 pd label (:j+:k) pu fd 7 lt 90 bk 3
   fd 15 pu
end

to spike
   pu fd ((first :outlist)*3)+1 rt 90 bk 7 lt 90
   if (:itt > 2) [pd label (:j+:k)]
   pu bk ((first :outlist)*3)+1 rt 90 fd 7 lt 90
   make "itt 0
end

to xaxis
   bk 1 fd 1
   fd (first :outlist)*3 bk (first :outlist)*3
   if (modulo :j+:k 10) = 0 [pd bk 5 fd 5 pu]
   if (modulo :j+:k 100) = 0 [jump]
   if (first :outlist) > 10 [spike make "itt 0]
   pu rt 90 fd 2 lt 90 pd
   make "outlist butfirst :outlist
   make "itt :itt+1
end

to yaxis
   make "f 5
   pu setpos (list -220 -50)
   pd rt 90 bk 3 fd 3
   pu fd 2 lt 90 fd 6 rt 90 pd label 0 pu
   lt 90 bk 6 rt 90 bk 2 lt 90
   repeat 20 [pd fd 15 rt 90 bk 3 fd 3
   pu fd 2 lt 90 fd 6 rt 90 pd label (list :f) pu
   lt 90 bk 6 rt 90 bk 2 lt 90 make "f :f+5]
   pd fd 10
   setlabelfont [[Arial] -10 0 0 400 255 0 0 0 3 2 1 34]
   label (list "--> "8) pu bk 10
   setlabelfont [[Arial] -10 0 0 400 0 0 0 0 3 2 1 34]
   bk 300 pu
   setpos (list -237 85) label "iterations
   setpos [75 -70] rt 90 label (list "positive "integers)
   seth 0
end