MODULE PointProp EXPORTS PointProp, PointPropPrivate, PointPropProxy;

IMPORT Anim3D, AnimHandle, AnimHandlePrivate, AnimRequestQueue,
       AnimRequestQueuePrivate, AnimServer, GraphicsBase,
       GraphicsBasePrivate, Point3, Prop, PropPrivate;

REVEAL
  Name = PrivateName BRANDED OBJECT
    default : Base;
  OVERRIDES
    init      := InitName;
    bind      := BindName;
    makeProxy := MakeProxyName;
    push      := PushName;
    pop       := PopName;
    newStack  := NewStack;
    getState  := GetState;
  END;

PROCEDURE InitName (self : Name; default : Base) : Name =
  BEGIN
    EVAL Prop.Name.init (self);
    self.default := default;
    IF NamePM # NIL THEN
      NamePM (self);
    END;
    RETURN self;
  END InitName;

PROCEDURE BindName (self : Name; val : Val) : Prop.T =
  BEGIN
    RETURN NEW (Prop.T).init (self, val);
  END BindName;

PROCEDURE MakeProxyName (self : Name) =
  BEGIN
    IF self.proxy = NIL AND NamePM # NIL THEN
      NamePM (self);
    END;
  END MakeProxyName;

PROCEDURE PushName (self : Name; state : GraphicsBase.T; pv : Prop.Val) =
  BEGIN
    WITH stack = NARROW (state.stacks[self.id], Stack),
         val   = NARROW (pv, Val).val DO
      stack.push (val);
    END;
  END PushName;

PROCEDURE PopName (self : Name; state : GraphicsBase.T) =
  BEGIN
    EVAL NARROW (state.stacks[self.id], Stack).pop ();
  END PopName;

PROCEDURE NewStack (self : Name) : PropPrivate.Stack =
  BEGIN
    RETURN NEW (Stack).init (self.default);
  END NewStack;

PROCEDURE GetState (self : Name; state : GraphicsBase.T) : Base =
  BEGIN
    RETURN NARROW (state.stacks[self.id], Stack).top;
  END GetState;

REVEAL
  Val = PrivateVal BRANDED OBJECT
  OVERRIDES
    init     := InitVal;
    get      := GetVal;
    value    := ValueVal;
    adjust   := AdjustVal;
  END;

PROCEDURE InitVal (self : Val; beh : Beh) : Val =
  BEGIN
    self.beh  := beh;
    self.time := Anim3D.Now () - 10.0d0;

    IF ValPM # NIL THEN
      ValPM (self);
    END;
    RETURN self;
  END InitVal;

PROCEDURE GetVal (self : Val) : Base RAISES {Prop.BadMethod} =
  BEGIN
    RETURN self.beh.value (Anim3D.Now ());
  END GetVal;

PROCEDURE ValueVal (self : Val; time : LONGREAL) : Base
    RAISES {Prop.BadMethod} =
  BEGIN
    IF time = self.time THEN
      RETURN self.val;
    ELSE
      RETURN self.beh.value (time);
    END;
  END ValueVal;

PROCEDURE AdjustVal (self : Val; time : LONGREAL) : BOOLEAN
    RAISES {Prop.BadMethod} =
  BEGIN
    IF time # self.time THEN
      WITH val = self.beh.value (time) DO
        self.damaged := val # self.val;
        self.time    := time;
        self.val     := val;
      END;
    END;
    RETURN self.damaged;
  END AdjustVal;

REVEAL
  Beh = PrivateBeh BRANDED OBJECT
  OVERRIDES
    init := InitBeh;
  END;

PROCEDURE InitBeh (self : Beh) : Beh =
  BEGIN
    RETURN self;
  END InitBeh;

REVEAL
  ConstBeh = PublicConstBeh BRANDED OBJECT
    p : Base;
  OVERRIDES
    init   := InitConstBeh;
    set    := SetConstBeh;
    value  := ValueConstBeh;
  END;

PROCEDURE InitConstBeh (self : ConstBeh; p : Base) : ConstBeh =
  BEGIN
    EVAL Beh.init (self);
    self.p := p;
    IF ConstBehPM # NIL THEN
      ConstBehPM (self);
    END;
    RETURN self;
  END InitConstBeh;

PROCEDURE SetConstBeh (self : ConstBeh; p : Base) =
  BEGIN
    self.p := p;
  END SetConstBeh;

PROCEDURE ValueConstBeh (             self : ConstBeh;
                         <* UNUSED *> time : LONGREAL) : Base =
  BEGIN
    RETURN self.p;
  END ValueConstBeh;

PROCEDURE NewConst (p : Base) : Val =
  BEGIN
    RETURN NEW (Val).init (NEW (ConstBeh).init (p));
  END NewConst;

REVEAL
  AsyncBeh = PublicAsyncBeh BRANDED OBJECT
  OVERRIDES
    init    := InitAsyncBeh;
    value   := ValueAsyncBeh;
    compute := ComputeAsyncBeh;
  END;

PROCEDURE InitAsyncBeh (self : AsyncBeh) : AsyncBeh =
  BEGIN
    EVAL Beh.init (self);
    IF AsyncBehPM # NIL THEN
      AsyncBehPM (self);
    END;
    RETURN self;
  END InitAsyncBeh;

PROCEDURE ValueAsyncBeh (self : AsyncBeh; time : LONGREAL) : Base
    RAISES {Prop.BadMethod} =
  BEGIN
    RETURN self.compute (time);
  END ValueAsyncBeh;

PROCEDURE ComputeAsyncBeh (self : AsyncBeh; time : LONGREAL) : Base
    RAISES {Prop.BadMethod} =
  BEGIN
    IF self.proxy # NIL THEN
      RETURN NARROW (self.proxy, AsyncBehProxy).compute (time);
    ELSE
      RAISE Prop.BadMethod("PointProp.AsyncBeh.compute method is undefined");
    END;
  END ComputeAsyncBeh;

PROCEDURE NewAsync (b : AsyncBeh) : Val =
  BEGIN
    RETURN NEW (Val).init (b);
  END NewAsync;

REVEAL
  DepBeh = PublicDepBeh BRANDED OBJECT
    hot : BOOLEAN;
  OVERRIDES
    init    := InitDepBeh;
    value   := ValueDepBeh;
    compute := ComputeDepBeh;
  END;

PROCEDURE InitDepBeh (self : DepBeh) : DepBeh =
  BEGIN
    EVAL Beh.init (self);
    self.hot := FALSE;
    IF DepBehPM # NIL THEN
      DepBehPM (self);
    END;
    RETURN self;
  END InitDepBeh;

PROCEDURE ValueDepBeh (self : DepBeh; time : LONGREAL) : Base
    RAISES {Prop.BadMethod} =
  BEGIN
    (* "hot" is set to true while the value of the behavior is computed.
       So, if "hot" is currently true, we have cyclic dependencies.
       If unchecked, this would lead to an infinite recursion.
       We raise an exception instead. *)
    IF self.hot THEN
      RAISE Prop.BadMethod("PointProp.DepBeh occurs in a dependency cycle");
    END;

    TRY
      self.hot := TRUE;
      RETURN self.compute (time);
    FINALLY
      self.hot := FALSE;
    END;
  END ValueDepBeh;

PROCEDURE ComputeDepBeh (self : DepBeh; time : LONGREAL) : Base
    RAISES {Prop.BadMethod} =
  BEGIN
    IF self.proxy # NIL THEN
      RETURN NARROW (self.proxy, DepBehProxy).compute (time);
    ELSE
      RAISE Prop.BadMethod("PointProp.DepBeh.compute method is undefined");
    END;
  END ComputeDepBeh;

PROCEDURE NewDep (b : DepBeh) : Val =
  BEGIN
    RETURN NEW (Val).init (b);
  END NewDep;

REVEAL
  SyncBeh = PublicSyncBeh BRANDED OBJECT
    queue : MyAnimRequestQueue;
  OVERRIDES
    init        := InitSyncBeh;
    value       := ValueSyncBeh;
    addRequest  := AddRequest;
    linMoveTo   := LinMoveTo;
    linMoveBy   := LinMoveBy;
  END;

PROCEDURE InitSyncBeh (self : SyncBeh;
                       ah   : AnimHandle.T;
                       p    : Base) : SyncBeh =
  BEGIN
    EVAL Beh.init (self);
    self.queue := NEW (MyAnimRequestQueue).init (ah, p);

    IF SyncBehPM # NIL THEN
      SyncBehPM (self);
    END;
    RETURN self;
  END InitSyncBeh;

PROCEDURE ValueSyncBeh (self : SyncBeh; time : LONGREAL) : Base
    RAISES {Prop.BadMethod} =
  BEGIN
    RETURN self.queue.value (time);
  END ValueSyncBeh;

PROCEDURE AddRequest (self : SyncBeh; r : Request) RAISES {Prop.BadInterval} =
  BEGIN
    self.queue.insert (r);
  END AddRequest;

PROCEDURE LinMoveTo (self : SyncBeh; p : Base; start : REAL; dur : REAL)
    RAISES {Prop.BadInterval} =
  BEGIN
    self.queue.insert (NEW (LinMoveToReq).init (start, dur, p));
  END LinMoveTo;

PROCEDURE LinMoveBy (self : SyncBeh; p : Base; start : REAL; dur : REAL)
    RAISES {Prop.BadInterval} =
  BEGIN
    self.queue.insert (NEW (LinMoveByReq).init (start, dur, p));
  END LinMoveBy;

PROCEDURE NewSync (ah : AnimHandle.T; p : Base) : Val =
  BEGIN
    RETURN NEW (Val).init (NEW (SyncBeh).init (ah, p));
  END NewSync;

PROCEDURE BecomeSync (ah : AnimHandle.T; pv : Val) : SyncBeh
    RAISES {Prop.BadMethod} =
  BEGIN
    WITH beh = NEW (SyncBeh).init (ah, pv.get()) DO
      pv.beh := beh;
      RETURN beh;
    END;
  END BecomeSync;

REVEAL
  Request = PublicRequest BRANDED OBJECT
  OVERRIDES
    init  := InitRequest;
    value := ValueRequest;
  END;

PROCEDURE InitRequest (self : Request; start, dur : REAL) : Request =
  BEGIN
    EVAL Prop.Request.init (self, start, dur);
    IF RequestPM # NIL THEN
      RequestPM (self);
    END;
    RETURN self;
  END InitRequest;

PROCEDURE ValueRequest (self     : Request;
                        startval : Base;
                        reltime  : REAL) : Base RAISES {Prop.BadMethod} =
  BEGIN
    IF self.proxy # NIL THEN
      RETURN NARROW (self.proxy, RequestProxy).value (startval, reltime);
    ELSE
      RAISE Prop.BadMethod("PointProp.Request.value method is undefined");
    END;
  END ValueRequest;

TYPE
  LinMoveToReq = Request BRANDED OBJECT
    p : Base;
  METHODS
    init (start, dur : REAL; val : Base) : LinMoveToReq := LinMoveToInit;
  OVERRIDES
    value := LinMoveToValue;
  END;

PROCEDURE LinMoveToInit (self       : LinMoveToReq;
                         start, dur : REAL;
                         val        : Base) : LinMoveToReq =
  BEGIN
    EVAL Request.init (self, start, dur);
    self.p := val;
    RETURN self;
  END LinMoveToInit;

PROCEDURE LinMoveToValue (self       : LinMoveToReq;
                          startpoint : Base;
                          reltime    : REAL) : Base =
  VAR
    fraction : REAL;
  BEGIN
    IF self.dur # 0.0 THEN
      fraction := (reltime - self.start) / self.dur;
    ELSE
      fraction := 1.0;
    END;
    RETURN Point3.Plus (startpoint,
                        Point3.TimesScalar (Point3.Minus (self.p, startpoint),
                                            fraction));
  END LinMoveToValue;

TYPE
  LinMoveByReq = Request BRANDED OBJECT
    p : Base;
  METHODS
    init (start, dur : REAL; val : Base) : LinMoveByReq := LinMoveByInit;
  OVERRIDES
    value := LinMoveByValue;
  END;

PROCEDURE LinMoveByInit (self       : LinMoveByReq;
                         start, dur : REAL;
                         val        : Base) : LinMoveByReq =
  BEGIN
    EVAL Request.init (self, start, dur);
    self.p := val;
    RETURN self;
  END LinMoveByInit;

PROCEDURE LinMoveByValue (self       : LinMoveByReq;
                          startpoint : Base;
                          reltime    : REAL) : Base =
  VAR
    fraction : REAL;
  BEGIN
    IF self.dur # 0.0 THEN
      fraction := (reltime - self.start) / self.dur;
    ELSE
      fraction := 1.0;
    END;
    RETURN Point3.Plus (startpoint, Point3.TimesScalar (self.p, fraction));
  END LinMoveByValue;

TYPE
  MyAnimRequestQueue = AnimRequestQueue.T BRANDED OBJECT
    p : Base;  (* The initial value of the pv *)
  METHODS
    init (ah : AnimHandle.T; p : Base) : MyAnimRequestQueue
      := MyAnimRequestQueue_Init;
    value (time : LONGREAL) : Base RAISES {Prop.BadMethod}
      := MyAnimRequestQueue_Value;
  OVERRIDES
    flush := MyAnimRequestQueue_Flush;
  END;

PROCEDURE MyAnimRequestQueue_Init (self : MyAnimRequestQueue;
                                   ah   : AnimHandle.T;
                                   p    : Base) : MyAnimRequestQueue =
  BEGIN
    EVAL AnimRequestQueue.T.init (self, ah);
    self.p := p;
    RETURN self;
  END MyAnimRequestQueue_Init;

PROCEDURE MyAnimRequestQueue_Value (self : MyAnimRequestQueue;
                                    time : LONGREAL) : Base
    RAISES {Prop.BadMethod} =
  VAR
    l       := self.list;
    req     : Request;
    p       : Base;
    reltime : REAL;
  BEGIN
    IF self.ah.activated THEN
      reltime := FLOAT (time - self.ah.starttime);
      p := self.p;
      WHILE l # NIL DO
        req := l.req;
        IF reltime < req.start  THEN
          RETURN p;
        ELSIF reltime < req.start + req.dur THEN
          RETURN req.value (p, reltime);
        ELSE
          p := req.value (p, req.start + req.dur);
          l := l.next;
        END;
      END;
      RETURN p;
    ELSE
      RETURN self.p;
    END;
  END MyAnimRequestQueue_Value;

PROCEDURE MyAnimRequestQueue_Flush (self : MyAnimRequestQueue) =
  VAR
    req : Request;
  BEGIN
    WHILE self.list # NIL DO
      req := self.list.req;
      TRY
        self.p := req.value (self.p, req.start + req.dur);
      EXCEPT
        Prop.BadMethod (msg) => AnimServer.ReportError (msg);
      END;
      self.list := self.list.next;
    END;
  END MyAnimRequestQueue_Flush;

REVEAL
  Stack = PublicStack BRANDED OBJECT
    cnt  : INTEGER;
    vals : REF ARRAY OF Base;
  METHODS
    init (top : Base) : Stack := InitStack;
  OVERRIDES
    push := PushStack;
    pop  := PopStack;
  END;

PROCEDURE InitStack (self : Stack; top : Base) : Stack =
  BEGIN
    self.cnt  := 0;
    self.vals := NEW (REF ARRAY OF Base, 10);
    self.top  := top;
    RETURN self;
  END InitStack;

PROCEDURE PushStack (self : Stack; val : Base) =
  BEGIN
    IF self.cnt >= LAST (self.vals^) THEN
      WITH tmp = NEW (REF ARRAY OF Base, 2 * NUMBER (self.vals^)) DO
        SUBARRAY (tmp^, 0, NUMBER (self.vals^)) := self.vals^;
        self.vals := tmp;
      END;
    END;
    self.vals[self.cnt] := self.top;
    self.top := val;
    INC (self.cnt);
  END PushStack;

PROCEDURE PopStack (self : Stack) : Base =
  BEGIN
    DEC (self.cnt);
    self.top := self.vals[self.cnt];
    RETURN self.top;
  END PopStack;

BEGIN
END PointProp.