aUCBLogo Demos and Tests / ifs2

to IFS2   ;I_terative F_unction S_ystem
   setScreenColor 0
   allFullScreen
   (splitScreen 0.9)
   trafomode=true
   maxi2=16
   maxi=Int 2^maxi2
   palsize=256
   pal=IntArray loadPalette "ifs.pal

   dragon
;   LevyDragon
;   SierpinskiTriangle
;   fern
;   hexagon
;   tree
;   leaf
   demos=
      [   koch2
         smiley
         am2
         tm30
         feather
         oriental
         quadrat
         quadrat2
         rosette
         rosette2
         star
         star1
         star3
         star4
         t
         t6
         t8
         universe
      ]

   pr [+ - chooses demo, ESC stops]
   i=1
   io=0
   running=true
   while [running]
   [   if i != io
      [   initDemo i
         io=i
      ]
      IFSLoop
      ch=readChar
      case ch
      [   [[char 27] running=false]
         ["+ if i<count demos [i=i+1]]
         ["- if i>1           [i=i-1]]
         ["\  trafomode=not trafomode]
         ["c clearScreen]
      ]
   ]
   notFullScreen
   splitScreen
end

to initDemo nr
   IFSLoad word demos.nr ".ifs
   (print word nr ") demos.nr)
   initProbabilites
   initGraph
   runtime=Int 0
end

to initProbabilites
   pa=Array maxi2
   pai=Int (ln n)/ln 2
   for [l pai maxi2]
   [   l2=2^l
      pat=IntArray l2
      k=1
      for [i 1 n]
      [   kmax=Int p.i*l2
         if kmax >= k
         [   setItems k pat IntArray rseq i i kmax-k+1
;            for [j k kmax]
;            [
;(show j i)
;               pat.j=i
;            ]
         ]
         k=kmax+1
      ]
      pa.l=pat
;show p
;show pa.l
      pa.l=shuffle pa.l
;show pa
   ]
   maxii=Int 2^pai
   x=rseqFA 0 0 maxii
   y=rseqFA 0 0 maxii

   m=count d
   d1=FloatArray m
   d2=FloatArray m
   d3=FloatArray m
   d4=FloatArray m
   d5=FloatArray m
   d6=FloatArray m
   for [i 1 m]
   [   d1.i=(d.i).1
      d2.i=(d.i).2
      d3.i=(d.i).3
      d4.i=(d.i).4
      d5.i=(d.i).5
      d6.i=(d.i).6
   ]
end

to shuffle_Logo a
   local [n j k tmp]
   n=count a
   for [i 1 n]
   [   j=1+random n
      k=1+random n
      tmp=a.j
      a.j=a.k
      a.k=tmp
   ]
end

to IFSLoop
   until [key?]
   [   IFSiterate
      GC
   ]
end

to init
   n=count p
   p0=0
   for [i 1 n]
   [   p.i=p0+p.i
      p0=p.i
   ]
   p=p/(max p)

   initProbabilites
   initGraph
   runtime=Int 0
   IFSLoop
end

to dragon
   p={1 1}
   d=   {   { 0.5 -0.5  0.5  0.5  0  0  0.5}
         {-0.5 -0.5  0.5 -0.5  1  0  0.5}
      }
   sk=300
   x0=0
   y0=0
   init
end

to LevyDragon
   p={1 1}
   d=   {   {0.5 -0.5  0.5  0.5  0    0  }
         {0.5  0.5 -0.5  0.5  0.5  0.5}
      }
   sk=350
   x0=-170
   y0=-120
   init
end

to SierpinskiTriangle
   p={1 1 1}
   d=   {   {0.5 0 0 0.5 0    0    }
         {0.5 0 0 0.5 0.5  0    }
         {0.5 0 0 0.5 0.25 0.433}
      }
   sk=600
   x0=-300
   y0=-300*(sqrt 3)/2
   init
end

to fern
   p={10 70 70 850}
   d=   {   { 0.00  0.00  0.00  0.16  0.00  0.00}
         { 0.20 -0.26  0.23  0.22  0.00  1.60}
         {-0.15  0.28  0.26  0.24  0.00  0.44}
         { 0.85  0.04 -0.04  0.85  0.00  1.60}
      }
   sk=50
   x0=0
   y0=-250
   init
end

to hexagon
   p={200 100 100 200 1000}
   d=   {   {0.333333 0 0 0.333333 -0.333333 0}
         {0.166667 -0.288675 0.288675 0.166667 -0.0833333 0.144337}
         {0.166666 0.288675 -0.288675 0.166666 0.0833333 0.144337}
         {0.333333 0 0 0.333333 0.333333 0}
         {0.506667 -0.859357 0.859357 0.506667 0.25 -0.433012}
      }
   sk=300
   x0=-150
   y0=0
   init
end

to tree
   p={400 100 1000 1000}
   d=   {   {0 0 0 0.5 0 0}
         {0.1 0 0 0.1 0 0.2}
         {0.42 -0.42 0.42 0.42 0 0.2}
         {0.42 0.42 -0.42 0.42 0 0.2}
      }
   sk=1200
   x0=0
   y0=-300
   init
end

to leaf
   p={150 150 150 500}
   d=   {   {0.95 -0.1 0.1 0.95 0.45 0.075}
         {0.35 -0.5 0.5 0.35 0 0.45}
         {0.55 0.43 -0.43 0.55 0 0.44}
         {0.85 0.05 -0.05 0.85 0 1.6}
      }
   sk=40
   x0=0
   y0=-200
   init
end

to readNumber
   local "w
   w=readWord
   if (first w)=="
   [   w=bf w
   ]
   output w+0
end

to ifsLoad filename
   openRead filename
   setReader filename
   n=readNumber+1
   p=array n
   d=array n
   for [i 1 n]
   [   di=array 6
      for [j 1 6]
      [   di.j=readNumber
      ]
      d.i=di
      p.i=readNumber
   ]
   sk=readNumber
   x0=readNumber-400
   y0=300-readNumber
   setReader []
   close filename
   p=p/(max p)
   (pr "p= p)
   (pr "d= d)
   (pr "sk= sk)
   (pr "x0= x0)
   (pr "y0= y0)
end

to IFSLoad2 filename
   openRead filename
   setReader filename
   repeat 3 [ignore readWord]
   x=readList
   y=readList
   sk=600*(x.2-x.1)
   x0=x.1+x.2
   y0=y.1+y.2
   ignore readWord
   n=readNumber
   repeat 2   [ignore readWord]
   d=array n
   for [i 1 n]
   [   l=readList
      d.i=listToArray (list l.1 l.4 l.3 l.2 l.5 l.6)
   ]
   repeat 2   [ignore readWord]
   p=listToArray readList
   setReader []
   close filename
   init
   (pr "p= p)
   (pr "d= d)
   (pr "sk= sk)
   (pr "x0= x0)
   (pr "y0= y0)
end

to initGraph
   cs ht
   noRefresh
;   singleBuffer
   PenUp
   setXY -400 -300
   bm=Bitcopy 800 600
   bx=BitMaxX bm
   by=BitMaxY bm
   t=16
   PenDown
end

to IFSiterate
   local [p]
   p=pa.pai
   for [i 1 2]
   [   xx= d1.p*x + d2.p*y + d5.p
      yy= d3.p*x + d4.p*y + d6.p

      xi= xx*sk+x0
      yi= yy*sk+y0

      if runtime > -1
      [   ifelse trafomode
         [   setPixelXY xi yi (mod p-1 15)+1
         ][
;            setPixelXY xi yi pal.Int t
;         ]
;   ignore[
            xb=xi-400
            yb=yi-300
            for [j 1 [count x]]
            [   c=addColorsMod (BitPixel bm xb.j yb.j) pal.Int t
               BitSetPixel bm xb.j yb.j c
               setPixelXY xi.j yi.j c
            ]
         ]
      ]
      ox=x
      oy=y
      x=xx
      y=yy
      p=rotate p random maxii
      t=(mod t palsize)+1
      runtime+=1
   ]
   pa.pai=p
   ifelse pai < maxi2
   [   pai=pai+1
      maxii=maxii*2
      x=combine x ox
      y=combine y oy
   ][
      updateGraph
      dispatchMessages
      if Key? [break]
   ]
end