program graftal;
{$i diablo.lib}
{ Program by Ken Birdwell and Steve Estvanik }
{ modified by T Meekins }
type
  bytearray = array[0..10000] of byte;
  codearray = array[0..7,0..20] of byte;
  realarray = array[0..10] of real;
var
     code    : codearray;
     graftal : bytearray;
     ang     : realarray;
     leaf    : boolean;
     graftal_len, gen, num_gen, num_ang, i, j : integer;
procedure getcode(var num_var : integer;
                  var code : codearray;
                  var ang : realarray;
                  var num_ang : integer );
  var key : string[20];
     d, g : integer;
     ch : char;
  begin
    write('Enter number of generations: ');
    readln(num_gen);
    for d := 0 to 7 do
       begin
       write('Enter key for ',d :1, ': ');
       readln(key);
       code[d,0] := length(key);
       for g := 1 to code[d,0] do
          case key[g] of
            '0' : code[d,g] := 0;
            '1' : code[d,g] := 1;
            '[' : code[d,g] := 128;
            ']' : code[d,g] := 64;
          end;
      end;
      write('Enter number of angles: ');
      readln(num_ang);
      for g:= 1 to num_ang do
        begin
        write('enter angle (deg) ',g : 2, ': ');
        readln(i);
        ang[g-1] := i*3.1415/180;
        end;
      write('Do you want leaves?');
      readln(ch);
      case ch of
        'y','Y' : leaf := true;
        'n','N' : leaf := false;
      end;
 end;
function findnext(p : integer;
                   var orig : bytearray;
                   var orig_len : integer ) : integer ;
var
    found : boolean;
    depth : integer;
    begin
       depth := 0;
       found := FALSE;
       while (p < orig_len) and not found do
          begin
          p := p + 1;
          if (depth = 0) and (orig[p] < 2 ) then
             begin
             findnext := orig[p];
             found := TRUE;
             end
          else if (depth = 0 and orig[p] and 64) then
             begin
             findnext := 1;
             found := TRUE;
             end
          else if (orig[p] and 128) <> 0 then
             depth := depth +1
          else if (orig[p] and 64) <> 0 then
             depth := depth-1;
          end;
        if (not found) then
          findnext := 1;
    end;
procedure add_new(b2, b1, b0 : integer;
                  var dest : bytearray;
                  var code : codearray;
                  var dest_len : integer;
                  num_ang : integer );
    var d, i : integer;
    begin
        d := b2 * 4 + b1 * 2 + b0;
        for i := 1 to code[d, 0] do
           begin
           dest_len := dest_len + 1;
           case code[d,i] of
              0..63 : dest[dest_len] := code[d,i];
              64    : dest[dest_len] := 64;
              128   : dest[dest_len] := 128 + random(num_ang);
              end;
         end;
     end;
procedure generation (var orig : bytearray;
                      var orig_len : integer;
                      var code : codearray );
   var depth, dest_len,g,a : integer ;
       b0,b1,b2            : byte ;
       stack               : array [0..200] of integer;
       dest                : bytearray;
   begin
      depth := 0;
      dest_len := 0;
      b2 := 1;
      b1 := 1;
      for g := 1 to orig_len do
         begin
         if (orig[g] < 2) then
           begin
           b2 := b1;
           b1 := orig[g];
           b0 := findnext(g, orig, orig_len);
           add_new(b2, b1, b0, dest, code, dest_len, num_ang) ;
           end
         else if (orig[g] and 128) <> 0 then
           begin
           dest_len := dest_len + 1;
           dest[dest_len] := orig[g];
           depth := depth + 1;
           stack[depth] := b1;
           end
         else if (orig[g] and 64) <>0 then
           begin
           dest_len := dest_len + 1;
           dest[dest_len] := orig[g];
           b1 := stack[depth];
           depth := depth - 1;
           end;
         end;
      for a := 1 to dest_len do
         orig[a] := dest[a];
      orig_len := dest_len;
   end;
procedure print_generation(var graftal : bytearray;
                           var graftal_len : integer);
    var p : integer;
    begin
        gotoxy(1,1);
        writeln;
        for p := 1 to graftal_len do
            begin
            if (graftal[p] < 2)          then write(graftal[p]:1);
            if (graftal[p] and 128) <> 0 then write('[');
            if (graftal[p] and 64)  <> 0 then write(']');
            end;
        writeln;
    end;
procedure draw_generation (var graftal : bytearray;
                           var graftal_len : integer;
                           var ang : realarray;
                           var gen : integer);
    var a_ra, a_xp, a_yp       : array[0..50] of real;
        ra, dx, dy, xp, yp, ll : real;
        g, depth               : integer;
    begin
        xp := 250;
        yp := 500;
        ll := 5;
        dx := 0;
        dy := -ll;
        gotoxy(1,1);
        write('Gen ',gen);
        for g := 1 to graftal_len do
      begin
      if (graftal[g] < 2) then
         begin
         { drop shadow }
         { draw (round(xp)-1, round(yp)-1,
                 round(xp+dx)-1,round(yp+dy)-1);}
         draw (round(xp), round(yp),
               round(xp+dx), round(yp+dy));
         xp := xp + dx;
         yp := yp + dy;
         end;
      { start of branch}
      if (graftal[g] and 128) <> 0 then
        begin
        depth := depth + 1;
        a_ra[depth] := ra;
        a_xp[depth] := xp;
        a_yp[depth] := yp;
        ra := ra + ang[graftal[g] and $7f];
        dx := sin(ra)*ll;
        dy := -cos(ra)*ll;
        end;
     { end of branch}
     if (graftal[g] and 64) <> 0 then
        begin
        if leaf then circle (round(xp),round(yp),3);
        ra := a_ra[depth];
        xp := a_xp[depth];
        yp := a_yp[depth];
        depth := depth - 1;
        dx := sin(ra)*ll;
        dy := -cos(ra)*ll;
        end;
     end;
  end;
begin
    clrscr;
    getcode(num_gen, code, ang, num_ang);
    init_diablo;
    clrscr;
    graftal_len := 1;
    graftal[graftal_len] := 1;
    for gen := 1 to num_gen do
        begin
        generation(graftal, graftal_len, code);
        draw_generation(graftal, graftal_len, ang, gen);
        print_generation(graftal, graftal_len);
        end;
   gotoxy(1,1);
   write('Done...');
   readln(i);
   reset_diablo
end.