/* odometer.tc - lrb
/* requirements: rightmost 4 palindromic then rightmost 5 palindromic then
/* middle 4 palindromic then all 6 palindromic
/* last updated: 5/18/2008

/* odometer is the main function

odometer [

int i0,i1,i2,i3,i4,i5 /* individual positions
int s /* records "stage" (0, 1, 2 or 3)
char od(6),ods /* odometer itself and save area
char lf(1);lf(0)=10;char key,esc;esc=27
char s0(2),s1(2),s2(2),s3(2)
s0(0)=s1(0)=s2(0)=s3(0)=' ';s0(1)='0';s1(1)='1';s2(1)='2';s3(1)='3'
int rw,unit,size;rw=2;unit=1;size=1000 /* rw=2 means file is an output file

fopen(rw,"odometer.out",size,unit) /* size is required but not used
cls;chide /* clear screen, hide cursor
posc(4,29);ps("odometer.tc - 5/16/2008")

for (i0=0;i0<10;++i0) [
  od(0)='0'+i0
  for (i1=0;i1<10;++i1) [
    od(1)='0'+i1
    for (i2=0;i2<10;++i2) [
      od(2)='0'+i2
      for (i3=0;i3<10;++i3) [
        od(3)='0'+i3
        for (i4=0;i4<10;++i4) [
          od(4)='0'+i4
          for (i5=0;i5<10;++i5) [
            od(5)='0'+i5
            if (s==0) if (palindrome(od+2)) [ /* rightmost 4
              posc(10,37);ps(od);s=1
              fwrite(od,od+5,1);fwrite(s0,s0+1,1);fwrite(lf,lf,1)]
              else []
            else if (s==1) if (palindrome(od+1)) [ /* rightmost 5
              posc(11,37);ps(od);s=2
              fwrite(od,od+5,1);fwrite(s1,s1+1,1);fwrite(lf,lf,1)]
              else s=0
            else if (s==2) [
              ods=od(5);od(5)=0
              /* save it, make next check involve only middle 4
              if (palindrome(od+1)) [ /* middle 4
                od(5)=ods;posc(12,37);ps(od);s=3
                fwrite(od,od+5,1);fwrite(s2,s2+1,1);fwrite(lf,lf,1)]
                else s=0
              ]
            else if (s==3) if (palindrome(od)) [ /* all 6
              posc(13,37);ps od
              fwrite(od,od+5,1);fwrite(s3,s3+1,1);fwrite(lf,lf,1)
              pl("");cnormal;beep(880,2);beep(0,2);beep(880,8)
              pl "Strike Any Key ... Hit Esc to stop ";key=getchar
              if (key==esc) [fclose(1);exit]
              posc(15,1);ps("                                   ")
              chide;s=0
              ]
              else s=0
]]]]]]

posc(15,1);cnormal /* normal cursor
fclose(1)

] /* end odometer

/* palindrome returns 1 if string is palindromic, 0 if not
/* it works by comparing first and last character,
/* then 2nd and next to last, etc.

palindrome char s(0) [

int i,g
g=strlen(s)
for (i=0;i<=g/2-1;++i) if (s(i)!=s(g-1-i)) return 0
return 1

]