RosettaCodeData/Task/Forest-fire/Sather/forest-fire.sa

class FORESTFIRE is
  private attr fields:ARRAY{ARRAY{INT}};
  private attr swapu:INT;
  private attr rnd:RND;
  private attr verbose:BOOL;
  private attr generation:INT;
  readonly attr width, height:INT;
  const empty:INT := 0;
  const tree:INT := 1;
  const burning:INT := 2;

  attr prob_tree, prob_p, prob_f :FLT;

  create(w, h:INT, v:BOOL):SAME is
    res:FORESTFIRE := new;
    res.fields := #(2);
    res.fields[0] := #(w*h);
    res.fields[1] := #(w*h);
    res.width := w; res.height := h;
    res.swapu := 0;
    res.prob_tree := 0.55;
    res.prob_p := 0.001;
    res.prob_f := 0.00001;
    res.rnd := #RND;
    res.verbose := v;
    res.generation := 0;
    res.initfield;
    return res;
  end;

  -- to give variability
  seed(i:INT) is
    rnd.seed(i);
  end;

  create(w, h:INT):SAME is
    res ::= create(w, h, false);
    return res;
  end;

  initfield is
    n ::= 0;
    swapu := 0;
    if verbose and generation > 0 then
      #ERR + "Previous generation " + generation + "\n";
    end;
    generation := 0;
    loop i ::= 0.upto!(width-1);
      loop j ::= 0.upto!(height-1);
        if rnd.uniform > prob_tree.fltd then
          cset(i, j, empty);
        else
	  n := n + 1;
          cset(i, j, tree);
        end;
      end;
    end;
    if verbose then
      #ERR + #FMT("Field size is %dx%d (%d)", width, height, size) + "\n";
      #ERR + "There are " + n + " trees (" + (100.0*n.flt/size.flt) + "%)\n";
      #ERR + "prob_tree = " + prob_tree + "\n";
      #ERR + "prob_f = " + prob_f + "\n";
      #ERR + "prob_p = " + prob_p + "\n";
      #ERR + "ratio = " + prob_p/prob_f + "\n";
    end;
  end;

  field:ARRAY{INT} is
    return fields[swapu];
  end;

  ofield:ARRAY{INT} is
    return fields[swapu.bxor(1)];
  end;

  size:INT is
    return width*height;
  end;

  set(i, j, t:INT)
    pre bcheck(i, j)
  is
    ofield[j*width + i] := t;
  end;

  cset(i, j, t:INT)
    pre bcheck(i, j)
  is
    field[j*width + i] := t;
  end;

  private bcheck(i, j:INT):BOOL is
    if i.is_between(0, width-1) and j.is_between(0, height-1) then
      return true; -- is inside
    else
      return false; -- is outside
    end;
  end;

  get(i, j:INT):INT is
    if ~bcheck(i, j) then
      return empty;
    end;
    return field[j*width + i];
  end;

  oget(i, j:INT):INT is
    if ~bcheck(i, j) then
      return empty;
    end;
    return ofield[j*width + i];
  end;

  burning_neighbor(i, j:INT):BOOL is
    loop x ::= (-1).upto!(1);
      loop y ::= (-1).upto!(1);
        if x /= y then
          if get(i+x, j+y) = burning then return true; end;
        end;
      end;
    end;
    return false;
  end;

  evolve is
    bp ::= 0;
    loop i ::= 0.upto!(width-1);
      loop j ::= 0.upto!(height-1);
	case get(i, j)
        when burning then set(i, j, empty); bp := bp + 1;
        when empty then
          if rnd.uniform > prob_p.fltd then
            set(i, j, empty);
          else
            set(i, j, tree);
          end;
        when tree then
          if burning_neighbor(i, j) then
            set(i, j, burning);
          else
            if rnd.uniform > prob_f.fltd then
              set(i, j, tree);
            else
              set(i, j, burning);
            end;
          end;
        else
          #ERR + "corrupted field\n";
        end;
      end;
    end;
    generation := generation + 1;
    if verbose then
      if bp > 0 then
        #ERR + #FMT("Burning at gen %d: %d\n", generation-1, bp);
      end;
    end;
    swapu := swapu.bxor(1);
  end;

  str:STR is
    s ::= "";
    loop j ::= 0.upto!(height -1);
      loop i ::= 0.upto!(width -1);
        case get(i, j)
          when empty then s := s + ".";
          when tree then s := s + "Y";
          when burning then s := s + "*";
        end;
      end;
      s := s + "\n";
    end;
    s := s + "\n";
    return s;
  end;

end;

class MAIN is

  main is
    forestfire ::= #FORESTFIRE(74, 40);
    -- #FORESTFIRE(74, 40, true) to have some extra info
    -- (redirecting stderr to a file is a good idea!)

    #OUT + forestfire.str;
    -- evolve 1000 times
    loop i ::= 1000.times!;
      forestfire.evolve;
      -- ANSI clear screen sequence
      #OUT + 0x1b.char + "[H" + 0x1b.char + "[2J";
      #OUT + forestfire.str;
    end;
  end;

end;