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 make "k :x
   
repeat 301 [checkloop (pack :xmake "x :x+make "n :n+1]
   
make "outlist arraytolist :outray
   
print "########################################################
   
yaxis
   
make "j pu make "itt setpos (list -200 -50pd
   
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 "... :xliststop
   
]
   
if (:xlist = (reverse :xlist)) [
      
setitem :n :outray :i
      
print (list (:n+(:k-1)) "... :i "... :xliststop
   
]
   
;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 :aa :z
   
make "cc arraytolist :aa
   
if :z=[make "cc butfirst :cc]
   
output :cc
end

to addloop :a :b :la
   
if :la [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 [make "c (last :cmake "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 rt 90 bk pd label (:j+:kpu fd lt 90 bk 3
   
fd 15 pu
end

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

to xaxis
   
bk fd 1
   
fd (first :outlist)*bk (first :outlist)*3
   
if (modulo :j+:k 10) = [pd bk fd pu]
   
if (modulo :j+:k 100) = [jump]
   
if (first :outlist) > 10 [spike make "itt 0]
   
pu rt 90 fd 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 fd 3
   
pu fd lt 90 fd rt 90 pd label pu
   
lt 90 bk rt 90 bk lt 90
   
repeat 20 [pd fd 15 rt 90 bk fd 3
   
pu fd lt 90 fd rt 90 pd label (list :fpu
   
lt 90 bk rt 90 bk 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 "--> "8pu bk 10
   
setlabelfont [[Arial] -10 0 0 400 0 0 0 0 3 2 1 34]
   
bk 300 pu
   
setpos (list -237 85label "iterations
   
setpos [75 -70rt 90 label (list "positive "integers)
   
seth 0
end