/* Morph - DMS - Feb 2000 - by Christophe LOREK */

typeof class=S;;
struct Morph = [Mname:S,
                Mframerate:I,
                Mplaystop:I,
                Mlooponce:I,
                Mstartframe:I,
                Mendframe:I,
                Mcurrentframe:I,
                Mcurrentsequence:S,
                Maccum:I,
                Mtick:I,
                Mfel:[I r1],
                MSeql:[[S [[I I] r1]] r1]] mkMorph;;

fun seqByName(x, name)=
let x -> [currentname _] in
  !strcmp currentname name;;

fun testFrameEvent(fel,prevframe, curframe, fpos)=
if fel == nil then
 nil
else
 let fel -> [keyframe nfel] in
  if ((prevframe < keyframe) && (keyframe <= curframe)) ||
     ((prevframe < keyframe) && (curframe < prevframe))then
   fpos
  else
   testFrameEvent nfel prevframe curframe fpos+1;;

fun getKeys(currentframe,keylist)=
if keylist == nil then
	nil
else
	let keylist -> [[frame1 key1] nl] in
	let nl -> [[frame2 key2] nnl] in
		if currentframe >= frame2 then
			getKeys currentframe nl
		else
			[[frame1 key1][frame2 key2]];;

fun MorphObj(Obj,MorphObjList,keylist,currentframe)=
let getKeys currentframe keylist -> [[frame1 key1][frame2 key2]] in
let ftoi (((itof (currentframe-frame1)) /. (itof (frame2 - frame1))) *. (itof 65536)) -> taux in
(
	let nth_list MorphObjList key1 -> vl1 in
	let nth_list MorphObjList key2 -> vl2 in
	 	M3morphVertices session Obj vl1 vl2 taux
);;

fun morphcallback(o,t,a)=
let t -> [Obj MorphObjList] in
if a.Mplaystop then
(
 if a.Mtick == nil then
  set a.Mtick = _tickcount
 else
  nil;
 let _tickcount -> currenttick in
 let ((currenttick - a.Mtick) * a.Mframerate) -> timeframe in
 let mod timeframe 1000 -> accum in
 let (timeframe / 1000) -> deltaframe in
 let a.Mcurrentframe -> prevframe in
 (
  set a.Maccum = a.Maccum + accum;
  if a.Maccum > 1000 then
   (set deltaframe = deltaframe + 1; set a.Maccum = a.Maccum - 1000;)
  else
   nil;
  set a.Mcurrentframe = a.Mcurrentframe + deltaframe;
  let (testFrameEvent a.Mfel prevframe a.Mcurrentframe 0)-> fpos in
   if fpos == nil then
    nil
   else
    _DMSevent this (strcatn (ObName o)::".Frame#"::(itoa (nth_list a.Mfel fpos))::nil) nil nil;
  let search_in_list a.MSeql @seqByName a.Mcurrentsequence -> [_ keylist] in
  if a.Mcurrentframe < a.Mendframe then
  (
   MorphObj Obj MorphObjList keylist a.Mcurrentframe;
   set a.Mtick = currenttick
  )
  else
  (
   if a.Mlooponce then
    (set a.Mplaystop = 0; set a.Mcurrentframe = a.Mstartframe; set a.Mtick = nil)
   else
    (set a.Mplaystop = 1; set a.Mcurrentframe = a.Mstartframe; set a.Mtick = nil)
  );
  0
 );
)
else nil;;

fun activate(o,from,action,param,reply,a)=
let (strfind "." action 0) -> firstDotPos in
let (strfind "." action firstDotPos+1) -> secondDotPos in
let (substr action 0 firstDotPos) -> current_ObName in
let (substr action firstDotPos+1 secondDotPos-firstDotPos-1) -> current_SeqName in
let (substr action secondDotPos+1 (strlen action)-(secondDotPos)) -> current_action in   
if !strcmp current_ObName (ObName o) then
(
 if !strcmp current_action "playonce" then
  let a.MSeql -> SeqList in
  let search_in_list SeqList @seqByName current_SeqName -> [_ keylist] in
  let hd keylist -> [startframe startkey] in
  let nth_list keylist ((sizelist keylist) - 1) -> [endframe endkey] in 
  (
 	 set a.Mcurrentsequence = current_SeqName;
   set a.Mplaystop = 1;
   set a.Mlooponce = 1;
   set a.Mstartframe = startframe;
   set a.Mendframe = endframe;
   set a.Mcurrentframe = startframe;
   set a.Mtick = nil;
   0  
  )
 else if !strcmp current_action "playloop" then
  let a.MSeql -> SeqList in
  let search_in_list SeqList @seqByName current_SeqName -> [_ keylist] in
  let hd keylist -> [startframe startkey] in
  let nth_list keylist ((sizelist keylist) - 1) -> [endframe endkey] in 
  (
 	 set a.Mcurrentsequence = current_SeqName;
   set a.Mplaystop = 1;
   set a.Mlooponce = 0;
   set a.Mstartframe = startframe;
   set a.Mendframe = endframe;
   set a.Mcurrentframe = startframe;
   set a.Mtick = nil;
   0  
  )
 else if !strcmp current_action "stop" then
  (set a.Mplaystop = 0; set a.Mtick = nil; 0)
 else
  nil 
)
else
 nil;;

fun cbcomm(ui,action,param,a)=
let (strfind "." action 0) -> firstDotPos in
let (substr action 0 firstDotPos) -> current_SeqName in
let (substr action firstDotPos+1 (strlen action)-firstDotPos) -> current_action in
 if !strcmp current_action "playonce" then
  let a.MSeql -> SeqList in
  let search_in_list SeqList @seqByName current_SeqName -> [_ keylist] in
  let hd keylist -> [startframe startkey] in
  let nth_list keylist ((sizelist keylist) - 1) -> [endframe endkey] in 
  (
 	 set a.Mcurrentsequence = current_SeqName;
   set a.Mplaystop = 1;
   set a.Mlooponce = 1;
   set a.Mstartframe = startframe;
   set a.Mendframe = endframe;
   set a.Mcurrentframe = startframe;
   set a.Mtick = nil;
   0  
  ) 
 else if !strcmp current_action "playloop" then
  let a.MSeql -> SeqList in
  let search_in_list SeqList @seqByName current_SeqName -> [_ keylist] in
  let hd keylist -> [startframe startkey] in
  let nth_list keylist ((sizelist keylist) - 1) -> [endframe endkey] in 
  (
 	 set a.Mcurrentsequence = current_SeqName;
   set a.Mplaystop = 1;
   set a.Mlooponce = 0;
   set a.Mstartframe = startframe;
   set a.Mendframe = endframe;
   set a.Mcurrentframe = startframe;
   set a.Mtick = nil;
   0  
  )
 else if !strcmp current_action "stop" then
  (set a.Mplaystop = 0; set a.Mtick = nil; 0)
 else
  nil;;
  
fun FrameEventList(l)=
if l == nil then
 nil
else
 let l -> [[name r] nl] in
  if !strcmp name "FrameEvent" then
   let r -> [frameNum _] in
    (atoi frameNum)::(FrameEventList nl)
  else
   FrameEventList nl;;

fun getkeys(l)=
if l == nil then
	nil
else
	let l -> [frameS [keyS nl]] in
	let atoi keyS -> key in
	let atoi frameS -> frame in
		[frame key]::(getkeys nl);;

fun getsequences(l)=
if l == nil then
 nil
else
 let l -> [paramline nl] in
 let paramline -> [paramname paramvalues] in
  if !strcmp paramname "sequence" then
 (
  let strextr hd paramvalues -> [[name keyparams] _] in
   [name (getkeys keyparams)]::(getsequences nl)
 )
 else
  (getsequences nl);;

fun RegisterSequenceActions(current_Ob,l,a)=
if l == nil then
	nil
else
	let l -> [[SeqName _] nl] in
	(
		ObRegisterAction current_Ob (strcatn (ObName current_Ob)::"."::SeqName::".playonce"::nil) mkfun6 @activate a;
		ObRegisterAction current_Ob (strcatn (ObName current_Ob)::"."::SeqName::".playloop"::nil) mkfun6 @activate a;
		ObRegisterAction current_Ob (strcatn (ObName current_Ob)::"."::SeqName::".stop"::nil)     mkfun6 @activate a;
		RegisterSequenceActions current_Ob nl a;
		0
	);;
 
fun RegisterActions(current_Ob,l,a)=
 let getsequences l -> seqlist in
  RegisterSequenceActions current_Ob seqlist a;;

fun prepanch(l)=
 if l==nil then
  nil
 else
  let l->[a n] in
   match a with
   (objAnchor o -> let o -> [h _ _ _] in h::(prepanch n))
   |(_ -> (prepanch n));;

fun MOdata2vertlist(l)=
if l == nil then
	nil
else
	let l -> [[x [y [z _]]] nl] in
		[(atoi x) (atoi y) (atoi z)]::(MOdata2vertlist nl);;

fun getMorphObjectList(l)=
if l == nil then
 nil
else
	let l -> [[param [morphObjectName [MOdata _]]] nl] in
  if !strcmp param "morphObject" then
   let getMorphObjectList nl -> fmor in
   (
    [(MOdata2vertlist strextr MOdata) fmor]
   )
  else
   getMorphObjectList nl;;   

fun newOb2(molfile,o)=
let UgetParams ObUi o -> paramlist in
let atoi hd UgetParam ObUi o "Framerate" -> framerate in
let atoi hd UgetParam ObUi o "SrvAnimAutoStart" -> SrvAnimAutoStart in
let getMorphObjectList strextr _getpack _checkpack molfile -> MorphObjectList in
let prepanch ObAnchor o -> anchorObjList in
let mkMorph [(ObName o) framerate 0 0 0 0 0 nil 0 _tickcount (FrameEventList paramlist) (getsequences paramlist)] -> a in
(
 UcbComm this ObUi o mkfun4 @cbcomm a;
 let anchorObjList -> [obj nl] in
 (
  ObCbAnim o mkfun2 mkfun3 @morphcallback a [obj MorphObjectList]
 );
 RegisterActions o paramlist a;
 if SrvAnimAutoStart then
  UsendSrv this (ObUi o) "newclient" (ObName o)
 else
  nil;
 0
);;  

fun newOb(o)=
let UgetParams ObUi o -> paramlist in
let getInfo paramlist "MOLfilename" -> MOLfilename in
_RSCdownload this MOLfilename MOLfilename mkfun2 @newOb2 o 1;
0;;

fun IniPlug(file)=
  set class=getInfo strextr _getpack _checkpack file "name";
  PlugRegister class @newOb nil;
  0;;