MODULE Anim;

(* A module for drawing animations. *)

IMPORT Time, PS;

(* PERMANENT OBJECTS *)

PRIVATE VAR permList := NIL;

(* This module maintains a list of permanent 
   objects, each represented by a 
   zero-argument closure. The list is 
   initially empty. *)

PROC ClearPerm() IS permList := NIL END;

(* Make the list of permanent objects empty. 
*)

PROC AddPerm(cl) IS 
  permList := (cl, permList) 
END;

(* Add the zero-argument closure "cl" to the 
   list of permanent objects. *)

PRIVATE PROC DrawPerm2(l) IS 
  IF 
    l # NIL -> 
      DrawPerm2(CDR(l)); APPLY(CAR(l)) | SKIP 
  FI 
END;

PROC DrawPerm() IS DrawPerm2(permList) END;

(* Draw the permanent objects by invoking 
   their closures in the order they were 
   added. *)

(* ANIMATION OBJECTS *)

(* An {\it animation} is a pair "(cl, dur)", 
   where "cl" is a closure for drawing each 
   frame of an animation, and "dur" is the 
   animation's duration. The "Play" procedure 
   below applies "cl" with a single time 
   argument in the interval "[0,dur]". *)

PRIVATE PROC SeqFrame(a1, a2, t) IS 
  IF 
    t <= CDR(a1) -> APPLY(CAR(a1), t) 
  | APPLY(CAR(a2), t - CDR(a1)) 
  FI 
END;

PROC an := Seq(a1, a2) IS 
  an := 
    (CLOSE(SeqFrame, a1, a2), 
     CDR(a1) + CDR(a2)) 
END;

(* "an" is the animation that runs "a1" 
   followed by "a2"; its duration is the sum 
   of the durations of "a1" and "a2". *)

PRIVATE PROC CoFrame(a1, a2, t) IS 
  IF 
    t <= CDR(a1) -> APPLY(CAR(a1), t) | SKIP 
  FI; 
  IF 
    t <= CDR(a2) -> APPLY(CAR(a2), t) | SKIP 
  FI 
END;

PROC an := Co(a1, a2) IS 
  an := 
    (CLOSE(CoFrame, a1, a2), 
     MAX(CDR(a1), CDR(a2))) 
END;

(* "an" is the animation that runs "a1" and 
   "a2" in parallel; its duration is the 
   maximum of the durations of "a1" and "a2". 
   Each animation is run for its natural 
   duration, so if one animation's duration 
   is shorter than the other, it will finish 
   sooner. No frames are displayed for the 
   shorter animation once it completes. *)

PRIVATE PROC ScaleFrame(an, dur, t) IS 
  APPLY(CAR(an), CDR(an) * (t / dur)) 
END;

PROC an := Scale(a, dur) IS 
  an := (CLOSE(ScaleFrame, a, dur), dur) 
END;

(* "an" is the animation "a" scaled in time 
   to take a total of "dur" seconds, 
   regardless of "a"'s duration. *)

PRIVATE PROC ExtendFrame(an, t) IS 
  APPLY(CAR(an), MIN(t, CDR(an))) 
END;

PROC an := Extend(a, dur) IS 
  an := (CLOSE(ExtendFrame, a), dur) 
END;

(* "an" is the animation "a" with a total 
   duration of "dur". If "dur" is less than 
   "Dur(a)", then "a"'s animation is 
   truncated. If "dur" is greater than 
   "Dur(a)" then "a" is extended by playing 
   its last frame an extra "dur - Dur(a)" 
   seconds. *)

PRIVATE PROC RepeatFrame(an, dur, t) IS 
  VAR t0 IN 
    t0 := t MOD CDR(an); 
    IF 
      t0 = 0 AND t # 0 -> t0 := CDR(an) | SKIP 
    FI; 
    APPLY(CAR(an), t0) 
  END 
END;

PROC an := Repeat(a, n) IS 
  IF 
    VAR dur = n * CDR(a) IN 
      an := (CLOSE(RepeatFrame, a, dur), dur) 
    END 
  FI 
END;

(* "an" is the animation "a" repeated "n" 
   times; its duration is "n * Dur(a)". *)

PRIVATE PROC ReverseFrame(an, t) IS 
  APPLY(CAR(an), CDR(an) - t) 
END;

PROC an := Reverse(a) IS 
  an := (CLOSE(ReverseFrame, a), CDR(a)) 
END;

(* "an" is the animation "a" in reverse; its 
   duration is the same as "a"'s duration. *)

PRIVATE PROC WarpTimeFrame(an, warp, t) IS 
  APPLY(CAR(an), APPLY(warp, t)) 
END;

PROC an := WarpTime(a, warp) IS 
  an := 
    (CLOSE(WarpTimeFrame, a, warp), CDR(a)) 
END;

(* "an" is the animation whose duration is 
   "Dur(a)" and whose frame at time "t" is 
   produced by running "APPLY(CAR(a), 
   APPLY(warp, t))". *)

PRIVATE PROC NormalizeFrame(an, t) IS 
  APPLY(CAR(an), t / CDR(an)) 
END;

PROC an := Normalize(a) IS 
  an := (CLOSE(NormalizeFrame, a), CDR(a)) 
END;

(* "an" is the animation with duration 
   "Dur(a)" whose frame for time "t" is 
   produced by running "APPLY(CAR(a), 
   t/Dur(a))". Hence, "a"'s closure will be 
   invoked with values of "t" in the interval 
   [0, 1]. *)

PRIVATE PROC SkipFrame(t) IS SKIP END;

PROC an := Skip(dur) IS 
  an := (SkipFrame, dur) 
END;

(* "an" is the animation that does nothing 
   for "dur" seconds. *)

(* DRAWING ANIMATIONS *)

CONST DefaultTFactor = 1;

(* This module maintains a current time 
   factor, which is the ratio between 
   animation time and real time used by the 
   procedure "Play" below. Time factors less 
   than 1.0 cause the animation to run faster 
   than real time. *)

PRIVATE VAR tFactor := DefaultTFactor;

PROC SetTFactor(k) IS tFactor := k END;

UI SetTool(SetTFactor);

(* Set the current time factor to "k". *)

UI Param(SetTFactor, DefaultTFactor);

UI Param(SetTFactor, 0.25);

UI Param(SetTFactor, 0.5);

UI Param(SetTFactor, 1);

UI Param(SetTFactor, 2);

UI Param(SetTFactor, 5);

PROC Play(an) IS 
  IF 
    VAR t = 0, cl, dur, start, k IN 
      start := Time.Now(); 
      cl := CAR(an); 
      dur := CDR(an); 
      k := 1 / MAX(tFactor, 0.0001); 
      DrawPerm(); 
      DO 
        t < dur -> 
          APPLY(cl, t); 
          t := k * (Time.Now() - start); 
          PS.ShowPage(); 
          PS.RestorePage(); 
          DrawPerm() 
      OD; 
      APPLY(cl, dur) 
    END 
  FI 
END;

(* Draw the animation "an", i.e., invoke the 
   animation's closure with values of "t" 
   starting at 0 and ending at the 
   animation's duration. Before each frame, 
   "DrawPerm" is called to draw the permanent 
   objects. Between frames, "PS.ShowPage" and 
   "PS.RestorePage" are called to start a new 
   frame. The animation's duration is scaled 
   against real time according to the current 
   time factor. *)

(* MISC *)

PRIVATE VAR history := NIL;

PROC Save() IS 
  history := ((permList, tFactor), history) 
END;

PROC Restore() IS 
  VAR new IN 
    new := CAR(history); 
    permList := CAR(new); 
    tFactor := CDR(new) 
  END; 
  history := CDR(history) 
END;

UI PointTool(Save);

UI PointTool(Restore);

(* Save/Restore the animation state, namely, 
   the list of permanent objects. *)