cls
sync on
 
rem Set up Fractal Variables
iterations=10
axiom$="8" : rem (X)
rules=1
 
movelen#=20
angchange#=15
 
rem Set upper limit of Code Lenth
arraynums=65536
 
rem Initialise arrays
dim set(arraynums)   : rem Final code
dim set1(arraynums)  : rem Code creation array 1
dim set2(arraynums)  : rem Code creation array 1
 
rem Array for rules, this time there's only 1
dim rule$(rules,1)
rem equivalent:
rem        (X)                 (F[+X][F-X])
rule$(1,0)="8"    : rule$(1,1)="1638761487"
 
rem Array to convert numbers of symbols
dim char$(9)
char$(1)="F"
char$(2)="f"
char$(3)="+"
char$(4)="-"
char$(5)="|"
char$(6)="["
char$(7)="]"
char$(8)="X"
char$(9)="Y"
 
gosub GenerateSet
gosub DrawFractal
 
rem Loop until any key is pressed
repeat : sync : until scancode()<>0 or mouseclick()<>0
 
end
 
GenerateSet:
 
   rem Set the first array to the original axiom
   for i=1 to len(axiom$)
      set1(i)=val(mid$(axiom$,i))
   next i
 
   rem Set the code lenths for each array
   set1size=len(axiom$)
   set2size=0
 
   rem Start on code generation array 1 (actually, this is array 2 but I'm going to switch it in a moment)
   setno=1
 
   rem Begin the FOR loop
   for i=1 to iterations
 
      rem Switch the array that we're using
      setno=1-setno
 
      rem If we're on the >first< array
      if setno=0
 
         rem Clear the >second< array (actually, it's not cleared, but becuase 'set2size' is 0 the data will be overwritten)
         set2size=0
         rem Go though the >first< array
         for j=1 to set1size
            rem Search though the rules to see if the current character should be changed
            rulefound=0
            for k=1 to rules
               rem If it matches a rule...
               if rule$(k,0)=str$(set1(j))
                  rem ...then copy the rule into array >2<
                  for l=1 to len(rule$(k,1))
                     set2size=set2size+1
                     set2(set2size)=val(mid$(rule$(k,1),l))
                  next l
                  rulefound=1
               endif
            next k
            rem If no rule matches...
            if rulefound=0
               rem ...then simply copy the symbol in array >1< to array >2<
               set2size=set2size+1
               set2(set2size)=set1(j)
            endif
         next j
 
      rem If we're on the >second< array
      else
 
         rem Clear the >first< array (actually, it's not cleared, but becuase 'set1size' is 0 the data will be overwritten)
         set1size=0
         rem Go though the >second< array
         for j=1 to set2size
            rulefound=0
            rem Search though the rules to see if the current character should be changed
            for k=1 to rules
               rem If it matches a rule...
               if rule$(k,0)=str$(set2(j))
                  rem ...then copy the rule into array >1<
                  for l=1 to len(rule$(k,1))
                     set1size=set1size+1
                     set1(set1size)=val(mid$(rule$(k,1),l))
                  next l
                  rulefound=1
               endif
            next k
            rem If no rule matches...
            if rulefound=0
               rem ...then simply copy the symbol in array >2< to array >1<
               set1size=set1size+1
               set1(set1size)=set2(j)
            endif
         next j
 
      endif
 
   next i
 
   rem Copy the current code from the current array into the final array
   if setno=0
      for i=1 to set2size
         set(i)=set2(i)
      next i
      setsize=set2size
   else
      for i=1 to set1size
         set(i)=set1(i)
      next i
      setsize=set1size
   endif
 
   rem Delete the unnecessary arrays
   undim set1(arraynums)
   undim set2(arraynums)
 
return
 
DrawFractal:
 
   rem Display the first few hundred symbols for decoration
   ink rgb(150,150,150),0
   forto=setsize
   if forto>4800 then forto=4800
   for i=1 to forto
      print char$(set(i)); : rem Accessing the 'char$()' array
   next i
 
   rem Set up initial state
   x#=320
   y#=470
   angle#=270
 
   rem Setup stack
   dim stackx#(1000)
   dim stacky#(1000)
   dim stackang#(1000)
   stackon=0
 
   ink rgb(255,255,0),0
 
   rem Cycle through the code
   for i=1 to setsize
 
      rem Move forward, drawing a line ("F","X" or "Y")
      if set(i)=1  or set(i)=8 or set(i)=9
         rem Draw the line
         line x#,y#,x#+cos(angle#)*movelen#,y#+sin(angle#)*movelen#
         rem Change the coordinates
         x#=x#+cos(angle#)*movelen#
         y#=y#+sin(angle#)*movelen#
      endif
 
      rem Move forward, without drawing ("f")
      if set(i)=2
         x#=x#+cos(angle#)*movelen#
         y#=y#+sin(angle#)*movelen#
      endif
 
      rem Turn left ("+")
      if set(i)=3
         angle#=wrapvalue(angle#-angchange#)
      endif
 
      rem Turn right ("-")
      if set(i)=4
         angle#=wrapvalue(angle#+angchange#)
      endif
 
      rem Rotate 180
      if set(i)=5
         angle#=wrapvalue(angle#+180)
      endif
 
      rem Store state to stack
      if set(i)=6
         stackon=stackon+1          : rem Increase stack size
         stackx#(stackon)=x#        : rem Save x
         stacky#(stackon)=y#        : rem Save y
         stackang#(stackon)=angle#  : rem Save angle
      endif
 
      rem Pop the state from the stack and set the drawer to it
      if set(i)=7
         x#=stackx#(stackon)        : rem Return to the x stacked at the top of the stack
         y#=stacky#(stackon)        : rem Return to the y stacked at the top of the stack
         angle#=stackang#(stackon)  : rem Return to the angle stacked at the top of the stack
         stackon=stackon-1          : rem Delete the top stackv (actually just decreasing the stack size, but it will eventually be overwritten)
      endif
 
   next i
 
return