MODULE Fractal;

(* Procedures to create fractal shapes. *)

IMPORT PS, Math, R2, Circle;

CONST DefaultDepth = 3;

(* This module maintains a current depth, which 
   limits the maximum recursion depth of the 
   procedures in this module. *)

PRIVATE VAR level := DefaultDepth;

/* Recursive depth used by procedures in this 
   module. */

PROC SetDepth(d) IS level := d END;

UI SetTool(SetDepth);

(* Set the current depth to "d". *)

UI Param(SetDepth, DefaultDepth);

UI Param(SetDepth, 1);

UI Param(SetDepth, 2);

UI Param(SetDepth, 3);

UI Param(SetDepth, 4);

UI Param(SetDepth, 5);

UI Param(SetDepth, 6);

UI Param(SetDepth, 7);

UI Param(SetDepth, 8);

UI Param(SetDepth, 9);

UI Param(SetDepth, 10);

UI Param(SetDepth, 11);

UI Param(SetDepth, 12);

PRIVATE PROC Koch(a, b, level) IS 
  IF 
    level = 0 -> PS.LineTo(b) 
  | VAR 
      c = (0.343, 0) REL (a, b), 
      d = (0.657, 0) REL (a, b), 
      e = (0.5, 0.305) REL (a, b) 
    IN 
      Koch(a, c, level - 1); 
      Koch(c, e, level - 1); 
      Koch(e, d, level - 1); 
      Koch(d, b, level - 1) 
    END 
  FI 
END;

/* Draw a Koch curve _/\_ from "a" to "b" with 
   recursive depth "level". When "level = 0", 
   this procedure draws a line segment from "a" 
   to "b". Requires that "a" is the current point 
   of the current path. */

PROC Snowflake(a, b) IS 
  IF 
    VAR c ~ (0.5, -1) REL (a, b) IN 
      (a, b) CONG (a, c) AND (a, b) CONG (b, c) -> 
        PS.MoveTo(a); 
        Koch(a, b, level); 
        Koch(b, c, level); 
        Koch(c, a, level) 
    END 
  FI 
END;

UI PointTool(Snowflake);

(* Draw a Koch snowflake with recursive depth 
   "level" as an equilateral triangle whose 
   orientation is determined as the clockwise 
   ordering of the vertices, where "a" and "b" 
   are the first two vertices in the order. *)

PRIVATE PROC Square2(p, q, level) IS 
  IF 
    level = 0 -> PS.LineTo(q) 
  | VAR 
      a = (0.25, 0) REL (p, q), 
      b = (0.25, 0.25) REL (p, q), 
      c = (0.5, 0.25) REL (p, q), 
      d = (0.5, -0.25) REL (p, q), 
      e = (0.75, -0.25) REL (p, q), 
      f = (0.75, 0) REL (p, q) 
    IN 
      Square2(p, a, level - 1); 
      Square2(a, b, level - 1); 
      Square2(b, c, level - 1); 
      Square2(c, d, level - 1); 
      Square2(d, e, level - 1); 
      Square2(e, f, level - 1); 
      Square2(f, q, level - 1) 
    END 
  FI 
END;

/* Draw a square sine-wave like from from "p" to 
   "q" with recursive depth "level". When "level 
   = 0", this procedure draws a line segment from 
   "p" to "q". Requires that "p" is the current 
   point of the current path. */

PROC Square(a, b) IS 
  IF 
    VAR 
      c = (1, -1) REL (a, b), 
      d = (0, -1) REL (a, b) 
    IN 
      PS.MoveTo(a); 
      Square2(a, b, level); 
      Square2(b, c, level); 
      Square2(c, d, level); 
      Square2(d, a, level) 
    END 
  FI 
END;

UI PointTool(Square);

(* Draw a square-based fractal with recursive 
   depth "level" as a square on "a" and "b" whose 
   orientation is determined by "a" immediately 
   proceeding "b" in the clockwise ordering of 
   the vertices. *)

PRIVATE CONST 
  Left = 1, Right = -1, StrokeGrain = 8;

PRIVATE PROC draw:Dragon2(curve, level) IS 
  IF 
    level > 1 -> draw:Dragon2(Left, level - 1) 
  | SKIP 
  FI; 
  VAR center, curr IN 
    curr := PS.CurrentPoint(); 
    center := 
      (0, curve) REL (curr, R2.Plus(curr, draw)); 
    IF 
      curve = Left -> 
        Circle.DrawQuarterCC(center); 
        draw := (-CDR(draw), CAR(draw)) 
    | curve = Right -> 
        Circle.DrawQuarter(center); 
        draw := (CDR(draw), -CAR(draw)) 
    FI; 
    IF 
      level > 1 -> draw:Dragon2(Right, level - 1) 
    | SKIP 
    FI 
  END; 
  IF 
    level = StrokeGrain -> 
      VAR curr = PS.CurrentPoint() IN 
        PS.Stroke(); PS.MoveTo(curr) 
      END | SKIP 
  FI 
END;

PROC Dragon(p, q) IS 
  PS.MoveTo(p); 
  VAR drawDir IN 
    drawDir := R2.Minus(q, p); 
    drawDir := 
      R2.Times(1 / Math.Pow(level, 1.5), drawDir); 
    drawDir:Dragon2(Left, level); 
    IF 
      level < StrokeGrain -> PS.Stroke() | SKIP 
    FI 
  END 
END;

UI PointTool(Dragon);

PRIVATE VAR history := NIL;

PROC Save() IS history := (level, history) END;

PROC Restore() IS 
  level := CAR(history); history := CDR(history) 
END;

UI PointTool(Save);

UI PointTool(Restore);

(* Save/Restore the current recursive depth. *)

PROC Cmd0() IS 
  IF 
    VAR 
      a ~ (-82.36527, 169.90158), b ~ (70.05782, 169.90158), 
      c ~ (-17.98782, -174.39633), d ~ (-159.05019, -174.39633) 
    IN 
      a HOR b AND c HOR d -> 
        SetDepth(3); 
        Snowflake(a, b); 
        PS.Stroke(); 
        SetDepth(6); 
        Dragon(c, d) 
    END 
  FI 
END;