/*ChangeTexture Plugin - DMS2 - Aug 99 - by Sébastien DENEUX*/

/*TO DO

- precalculer le tab pour l'anim de random


*- version anchor avec plus qu'un objet (voir pb si taille des textures d'origine différentes ?) + precalcul ?

*- anim transparence (en hard uniquement) ?  no ?


*/

typeof class=S;;


var defaultWSize=128;;                               /* default width of the textures */
var defaultHSize=128;;                               /* default height of the textures */
var defaultFlatColor=0;;                             /* default flat color when no texture is already applied */
var materFile="Dms/3d/plugins/changeTexture/x.m3d";;
var defaultMaxTextureFileSize=20480;;                /* default maximum size of a texture that is uploading on the server by a client */
var defaultTimeoutUploadingFile=60;;                 /* default timeout when a client upload a texture file on the server (in seconds) */

var defaultNbBloc=32;;                                /* default number of bloc  used for texture transitions */
var defaultTransitionTime=2000;;                     /* default animation period during textures transition */

struct TmyParam =
[
   ListPosXY                : [[I I] r1]    , /* current list of top left Position XY of each bloc (used for anim texture) */
   CurrentBitmap            : ObjBitmap     , /* current texture of the material */
   ObStatusText             : ObjText       , /* status object used to inform the client about uploading, errors messages... (used in interface to change texture) */
   RscDownloading           : RSC           , /* downloading ressource used when downloading a new texture file, to stop the download if needed (another texture file must be set and the current download is not finished */
   WinChgTexture            : ObjWin        , /* change texture window interface (used in interface to change texture) */
   TextureFileNameUploading : S             , /* name of the texture file to upload on the server (used to send the file by packets) */
   FUploading               : File          , /* file to upload on the server (used to send the file by packets) */
   ObCurrentTexture         : S             , /* the name of the current texture set on the material */
   ObTextureList            : [S r1]        , /* list of textures */ 
   CurrentPosInTexturesList : I             , /* current position in the texture list */ 
   Loop                     : S             , /* indicates that the ObtextureList list loops when uses functions .next, .prev */ 
   UploadingFlag            : I             , /* 1 when client currently uploading a file */ 
   TimerAnim                : Timer         , /* timer (used in random animation) */
   TimerUploading           : Timer         , /* timer to upload file */
   Txt                      : HTx3d
]MyParam;;


/****************************************************************************************/
/*                           Random/Zigzag1-2/Colimasson Animation                      */
/****************************************************************************************/


/* returns a list filled with X Y top left position of each box       scroll vers droite (de haut vers le bas) */

fun fillBlocPosXYList(NbBloc, w, h, PosX, PosY, ListPosXY) =
  if PosX<w then   
  (
    if PosY<h then                       
      fillBlocPosXYList NbBloc w h PosX (PosY+(h/NbBloc)) [PosX PosY]::ListPosXY
    else   
      fillBlocPosXYList NbBloc w h (PosX+(w/NbBloc)) 0 ListPosXY                    
  )
  else ListPosXY
;;


/* returns a list filled with X Y top left position of each box       scroll vers droite (de bas vers le haut)  mettre iniPosY à h */
/*
fun fillBlocPosXYList(NbBloc, w, h, PosX, PosY, ListPosXY) =
  if PosX<w then   
  (
    if PosY>=0 then                       
      fillBlocPosXYList NbBloc w h PosX (PosY-(h/NbBloc)) [PosX PosY]::ListPosXY
    else   
      fillBlocPosXYList NbBloc w h (PosX+(w/NbBloc)) h ListPosXY                    
  )
  else ListPosXY
;;
*/

/* returns a list filled with X Y top left position of each box       scroll vers le bas (de droite vers la gauche) mettre iniPosX à w */
/*
fun fillBlocPosXYList(NbBloc, w, h, PosX, PosY, ListPosXY) =
  if PosY<h then   
  (
    if PosX>=0 then                       
      fillBlocPosXYList NbBloc w h (PosX-(w/NbBloc)) PosY [PosX PosY]::ListPosXY
    else   
      fillBlocPosXYList NbBloc w h w (PosY+(h/NbBloc)) ListPosXY                    
  )
  else ListPosXY
;;
*/

/* returns a list filled with X Y top left position of each box       scroll vers le bas (de gauche vers la droite) */
/*
fun fillBlocPosXYList(NbBloc, w, h, PosX, PosY, ListPosXY) =
  if PosY<h then   
  (
    if PosX<w then                       
      fillBlocPosXYList NbBloc w h (PosX+(w/NbBloc)) PosY [PosX PosY]::ListPosXY
    else   
      fillBlocPosXYList NbBloc w h 0 (PosY+(h/NbBloc)) ListPosXY                    
  )
  else ListPosXY
;;
*/

/*******************************************************************************
   Defines a list filled with XY position from down to up
   
   to        -> I          : the end of the line
   NbBloc    -> I          : Number of bloc
   w         -> I          : width of the texture
   h         -> I          : height of the texture
   column    -> I          : the column of this line
   from      -> I          : the beginning of the line
   ListPosXY -> [[I I] r1] : the tab to be filled with all those position
             <- [[I I] r1] : the tab fill with all those position
*******************************************************************************/
fun up (to, NbBloc, w, h, column, from, ListPosXY)=
  if from < to*(h/NbBloc) then
    up to NbBloc w h column (from+(h/NbBloc)) [column from]::ListPosXY
  else ListPosXY
;;


/*******************************************************************************
   Defines a list filled with XY position from up to down
   
   to        -> I          : the end of the line
   NbBloc    -> I          : Number of bloc
   w         -> I          : width of the texture
   h         -> I          : height of the texture
   column    -> I          : the column of this line
   from      -> I          : the beginning of the line
   ListPosXY -> [[I I] r1] : the tab to be filled with all those position
             <- [[I I] r1] : the tab fill with all those position
*******************************************************************************/
fun down (to, NbBloc, w, h, column, from, ListPosXY) =
  if from >= (w-to*(h/NbBloc)) then
    down to NbBloc w h column (from-(h/NbBloc)) [column from]::ListPosXY
  else ListPosXY
;;


/*******************************************************************************
   Defines a list filled with XY position from left to right
   
   to        -> I          : the end of the line
   NbBloc    -> I          : Number of bloc
   w         -> I          : width of the texture
   h         -> I          : height of the texture
   column    -> I          : the column of this line
   from      -> I          : the beginning of the line
   ListPosXY -> [[I I] r1] : the tab to be filled with all those position
             <- [[I I] r1] : the tab fill with all those position
*******************************************************************************/
fun right(to, NbBloc, w, h, column, from, ListPosXY) =
  if column >= (w-to*(w/NbBloc))  then
    right to NbBloc w h (column-(w/NbBloc)) from [column from]::ListPosXY
  else ListPosXY
;;


/*******************************************************************************
   Defines a list filled with XY position from left to right
   
   to        -> I          : the end of the line
   NbBloc    -> I          : Number of bloc
   w         -> I          : width of the texture
   h         -> I          : height of the texture
   column    -> I          : the column of this line
   from      -> I          : the beginning of the line
   ListPosXY -> [[I I] r1] : the tab to be filled with all those position
             <- [[I I] r1] : the tab fill with all those position
******************************************************************************/
fun left(to, NbBloc, w, h, column, from, ListPosXY) =   
  if column < to*(w/NbBloc) then                       
    left to NbBloc w h (column+(w/NbBloc)) from [column from]::ListPosXY
  else ListPosXY
;;


/*******************************************************************************
   Defines a list filled with XY position of a colimasson
   
   NbBloc    -> I          : Number of bloc
   w         -> I          : width of the texture
   h         -> I          : height of the texture
   ListPosXY -> [[I I] r1] : the tab to be filled with all those position
   i1        -> I          : used for incrementation
   i2        -> I          : used for decrementation
             <- [[I I] r1] : the tab fill with all those position
*******************************************************************************/
fun colimasson(NbBloc, w, h, ListPosXY, i1, i2)=  
  
  if i1<=NbBloc then
  ( 
    let up i1 NbBloc w h i2*(h/NbBloc) ((i2+2)-1)*(w/NbBloc) ListPosXY -> ListPosXY in
    let left i1 NbBloc w h ((i2+2)-1)*(w/NbBloc) (i1-1)*(h/NbBloc) ListPosXY -> ListPosXY in
    let down i1 NbBloc w h (i1-1)*(h/NbBloc) (w-(i2+2)*(w/NbBloc)) ListPosXY -> ListPosXY in
    let right i1 NbBloc w h (w-(i2+2)*(w/NbBloc)) i2*(h/NbBloc) ListPosXY -> ListPosXY in
    colimasson NbBloc w h ListPosXY (i1+1) (i2-1)
  )
  else ListPosXY
;;

/* i1=5 i2=3 pour NB=8  i1=9 i2=7 pour NB=16*/
/*******************************************************************************
   Defines a list filled with XY position of a zigzag (vertical)
   
   NbBloc    -> I          : Number of bloc
   w         -> I          : width of the texture
   h         -> I          : height of the texture
   ListPosXY -> [[I I] r1] : the tab to be filled with all those position
   i1        -> I          : used for incrementation
   i2        -> I          : used for decrementaion
             <- [[I I] r1] : the tab fill with all those position
*******************************************************************************/
fun zigzagv1(NbBloc, w, h, ListPosXY, i)=

  if i<=(NbBloc/2) then
  (
    let up NbBloc NbBloc w h (NbBloc-(2*i+1))*(h/NbBloc) (1-1)*(w/NbBloc) ListPosXY -> ListPosXY in
    let down NbBloc NbBloc w h ((NbBloc-1)-(2*i+1))*(h/NbBloc) (w-1*(w/NbBloc)) ListPosXY -> ListPosXY in
    zigzagv1 NbBloc w h ListPosXY (i+1)
  )
  else ListPosXY
;;


/*******************************************************************************
   Defines a list filled with XY position of a zigzag (horizontal)
   
   NbBloc    -> I          : Number of bloc
   w         -> I          : width of the texture
   h         -> I          : height of the texture
   ListPosXY -> [[I I] r1] : the tab to be filled with all those position
   i1        -> I          : used for incrementation
   i2        -> I          : used for decrementaion
             <- [[I I] r1] : the tab fill with all those position
*******************************************************************************/
fun zigzagh1(NbBloc, w, h, ListPosXY, i)=

  if i<=(NbBloc/2) then
  (
    let left NbBloc NbBloc w h (1-1)*(w/NbBloc) (NbBloc-(2*i+1))*(h/NbBloc) ListPosXY -> ListPosXY in
    let right NbBloc NbBloc w h (w-1*(w/NbBloc)) ((NbBloc-1)-(2*i+1))*(h/NbBloc) ListPosXY -> ListPosXY in
    zigzagh1 NbBloc w h ListPosXY (i+1)
  )
  else ListPosXY
;;


/*******************************************************************************
   Defines a list filled with XY position of a zigzag2 (horizontal)
   
   NbBloc    -> I          : Number of bloc
   w         -> I          : width of the texture
   h         -> I          : height of the texture
   ListPosXY -> [[I I] r1] : the tab to be filled with all those position
   i1        -> I          : used for incrementation
   i2        -> I          : used for decrementaion
             <- [[I I] r1] : the tab fill with all those position
*******************************************************************************/
fun zigzagh2(NbBloc, w, h, ListPosXY, i, j)=

  if i<=(NbBloc/2) then
  (
    let left NbBloc NbBloc w h (1-1)*(w/NbBloc) (NbBloc-(2*i+1))*(h/NbBloc) ListPosXY -> ListPosXY in
    zigzagh2 NbBloc w h ListPosXY (i+1) j
    
  )
  else 
  (
    if j<=(NbBloc/2) then
    (
      let right NbBloc NbBloc w h (w-1*(w/NbBloc)) ((NbBloc-1)-(2*j+1))*(h/NbBloc) ListPosXY -> ListPosXY in
      zigzagh2 NbBloc w h ListPosXY i (j+1)
    )
    else ListPosXY
  )
;;


/*******************************************************************************
   Defines a list filled with XY position of a zigzag2 (vertical)
   
   NbBloc    -> I          : Number of bloc
   w         -> I          : width of the texture
   h         -> I          : height of the texture
   ListPosXY -> [[I I] r1] : the tab to be filled with all those position
   i1        -> I          : used for incrementation
   i2        -> I          : used for decrementaion
             <- [[I I] r1] : the tab fill with all those position
*******************************************************************************/
fun zigzagv2(NbBloc, w, h, ListPosXY, i, j)=

  if i<=(NbBloc/2) then
  (
    let up NbBloc NbBloc w h (NbBloc-(2*i+1))*(h/NbBloc) (1-1)*(w/NbBloc) ListPosXY -> ListPosXY in
    zigzagv2 NbBloc w h ListPosXY (i+1) j
    
  )
  else 
  (
    if j<=(NbBloc/2) then
    (
      let down NbBloc NbBloc w h ((NbBloc-1)-(2*j+1))*(h/NbBloc) (w-1*(w/NbBloc)) ListPosXY -> ListPosXY in
      zigzagv2 NbBloc w h ListPosXY i (j+1)
    )
    else ListPosXY
  )  
;;


/*******************************************************************************
   Defines a list filled with XY position of a zigzag3 (horizontal)
   
   NbBloc    -> I          : Number of bloc
   w         -> I          : width of the texture
   h         -> I          : height of the texture
   ListPosXY -> [[I I] r1] : the tab to be filled with all those position
   i1        -> I          : used for incrementation
   i2        -> I          : used for decrementaion
             <- [[I I] r1] : the tab fill with all those position
*******************************************************************************/
fun zigzagh3(NbBloc, w, h, ListPosXY, i)=

  if i<=(NbBloc) then
  (
    let left NbBloc/2 NbBloc w h (1-1)*(w/NbBloc) (NbBloc-(i+1))*(h/NbBloc) ListPosXY -> ListPosXY in
    let right NbBloc/2 NbBloc w h (w-1*(w/NbBloc)) (NbBloc-(i+1))*(h/NbBloc) ListPosXY -> ListPosXY in
    zigzagh3 NbBloc w h ListPosXY (i+1)
  )
  else ListPosXY    
;;


/*******************************************************************************
   Defines a list filled with XY position of a zigzag3 (vertical)
   
   NbBloc    -> I          : Number of bloc
   w         -> I          : width of the texture
   h         -> I          : height of the texture
   ListPosXY -> [[I I] r1] : the tab to be filled with all those position
   i1        -> I          : used for incrementation
   i2        -> I          : used for decrementaion
             <- [[I I] r1] : the tab fill with all those position
*******************************************************************************/
fun zigzagv3(NbBloc, w, h, ListPosXY, i)=

  if i<=(NbBloc) then
  (
    let up NbBloc/2 NbBloc w h (NbBloc-(i+1))*(h/NbBloc) (1-1)*(w/NbBloc) ListPosXY -> ListPosXY in
    let down NbBloc/2 NbBloc w h (NbBloc-(i+1))*(h/NbBloc) (w-1*(w/NbBloc)) ListPosXY -> ListPosXY in
    zigzagv3 NbBloc w h ListPosXY (i+1)
  )
  else ListPosXY    
;;


/*******************************************************************************
   Defines a list filled with XY position of a zigzag autre (horizontal)
   
   NbBloc    -> I          : Number of bloc
   w         -> I          : width of the texture
   h         -> I          : height of the texture
   ListPosXY -> [[I I] r1] : the tab to be filled with all those position
   i1        -> I          : used for incrementation
   i2        -> I          : used for decrementaion
             <- [[I I] r1] : the tab fill with all those position
*******************************************************************************/
fun zigzagv4(NbBloc, w, h, ListPosXY, i, j)=

  if j<=(NbBloc) then
  (
    let down NbBloc/2 NbBloc w h (/*NbBloc-*/(j/*+1*/))*(h/NbBloc) (w-1*(w/NbBloc)) ListPosXY -> ListPosXY in
    zigzagv4 NbBloc w h ListPosXY i (j+1)
  )
  else 
  (
    if i<=(NbBloc) then
    (
      let up NbBloc/2 NbBloc w h (NbBloc-(i+1))*(h/NbBloc) (1-1)*(w/NbBloc) ListPosXY -> ListPosXY in 
      zigzagv4 NbBloc w h ListPosXY (i+1) j
    )
    else ListPosXY
  )
;;


/*******************************************************************************
   Random the filled list of XY position
   
   ListPosXY    -> [[I I] r1] : the last tab fill with all those position
   NewListPosXY -> [[I I] r1] : the new tab fill with all those position
   i            -> I          : used for incrementation
   nbTot        -> I          : used for stop the loop
                <- [[I I] r1] : the tab fill with all those position
*******************************************************************************/
fun randBlocPosXYList( ListPosXY, NewListPosXY, i, nbTot) =
  if i==nbTot then 
    NewListPosXY   
  else
  (
    let (mod rand (nbTot-i)) -> pos in
    let nth_list ListPosXY pos -> elt in
    randBlocPosXYList (remove_from_list ListPosXY elt) (elt::NewListPosXY) (i+1) nbTot     
  )
;;


/*******************************************************************************
   Define the number of blocs used in the same time in the timer callback
   
   MyStruct     -> TmyParam   : structure  
   nb           -> I          : used for incrementation
   NbBloc       -> I          : number of blocs
   m            -> HMat3d     : material
   newBitmap    -> ObjBitmap  : 
   w            -> I          : weight of the texture
   h            -> I          : height of the texture
*******************************************************************************/
fun decoupage1(MyStruct, nb, NbBloc, m, newBitmap, w, h) =
  if nb != 0 then
  (    
    (
      let MyStruct.ListPosXY -> [[PosX PosY] queue] in
      (     
        _CPbitmap16 MyStruct.CurrentBitmap PosX PosY newBitmap PosX PosY w/NbBloc h/NbBloc nil;
        M3blitTexture16 session MyStruct.Txt MyStruct.CurrentBitmap; /* remplace la texture par le bitmap */
        M3chgMaterialTexture session m MyStruct.Txt;                 /* associer une nouvelle texture au material */
        set MyStruct.ListPosXY = queue;
      )
    );      
  decoupage1 MyStruct (nb-1) NbBloc m newBitmap w h
  )
  else 
    0
;;


/*******************************************************************************
   Timer Callback for Random Animation
   
   timer        ->            : timer 
   param        ->            : 
*******************************************************************************/
fun timerAnimRand(timer, param)= 
  let param->[i j w h m newBitmap NbBloc o MyStruct newName] in
    if MyStruct.ListPosXY != nil then
    (
      /*let ListPosXY -> [[PosX PosY] [[PosX1 PosY1] [[PosX2 PosY2] [[PosX3 PosY3] queue]]]] in*/
      let atoi hd UgetParam ObUi o "decoupage" -> d in
      decoupage1 MyStruct d NbBloc m newBitmap w h;  /* prend les bloc "1" par "1" pour l'animation */
    )   
    else
    (   
      _deltimer timer;
      _DSbitmap newBitmap;
      set MyStruct.ListPosXY = nil;
      set MyStruct.TimerAnim = nil;  
      0
    )
;;


/*******************************************************************************
   Random/zigzag/colimasson animation
   
   transitionType -> S          : type of transition for animation
   m              ->            : list with all the parameters 
   w              -> I          : weight of the texture
   h              -> I          : height of the texture
   newBitmap      -> ObjBitmap  : new bitmap
   o              -> Ob         : 
   MyStruct       -> TmyParam   : structure
   newName        -> S          : 
*******************************************************************************/
fun runAnimRand(transitionType, m, w, h, newBitmap, o, MyStruct, newName) =
  let atoi hd UgetParam ObUi o "NbBlock" -> tmp in
  let (
        if tmp!=nil && (tmp>=2) && (tmp<=32) then 
          tmp 
        else defaultNbBloc
       ) -> NbBloc in

  let (
        if !strcmp transitionType "random" then
        (
          fillBlocPosXYList NbBloc w h 0 0 nil
        )
        else
        (
          if !strcmp transitionType "colimasson" then
          (
            colimasson NbBloc w h nil ((NbBloc/2)+1) ((NbBloc/2)-1)
          )
          else
          (
            if !strcmp transitionType "zigzag" then
            (
              zigzagh1 NbBloc w h nil 0
            )
            else 
            (
              if !strcmp transitionType "zigzag2" then
              (
                zigzagh2 NbBloc w h nil 0 0
              )
              else 
              (
                if !strcmp transitionType "zigzag3" then
                (
                  zigzagh3 NbBloc w h nil 0
                )
                else 
                (
                  if !strcmp transitionType "zigzag4" then
                  (
                    zigzagv1 NbBloc w h nil 0
                  )
                  else 
                  (
                    if !strcmp transitionType "zigzag5" then
                    (
                      zigzagv2 NbBloc w h nil 0 0
                    )
                    else
                    (
                      if !strcmp transitionType "zigzag6" then
                      (
                        zigzagv3 NbBloc w h nil 0
                      )
                      else 
                      ( 
                        if !strcmp transitionType "zigzag7" then
                        (
                          zigzagv4 NbBloc w h nil 0 0
                        )
                        else nil
                      )
                    )
                  )    
                )      
              )
            )
          )
        )
      ) -> ListPosXY2 in
  
  let hd UgetParam ObUi o "transitionTime" -> l in
  let (
    (if l==nil then 
       defaultTransitionTime 
     else atoi l)/(NbBloc*NbBloc)
  ) -> timerPeriod in
  (
    if !strcmp transitionType "random" then
    (
      set MyStruct.ListPosXY = randBlocPosXYList ListPosXY2 nil 0 NbBloc*NbBloc;
      set MyStruct.TimerAnim = _rfltimer _starttimer _channel timerPeriod @timerAnimRand [0 0 w h m newBitmap NbBloc o MyStruct newName];
      0
    )
    else
    (
      set MyStruct.ListPosXY = ListPosXY2; /* randBlocPosXYList ListPosXY2 nil 0 NbBloc*NbBloc;*/
      set MyStruct.TimerAnim = _rfltimer _starttimer _channel timerPeriod @timerAnimRand [0 0 w h m newBitmap NbBloc o MyStruct newName];
      0
    )
  )
;;


/*******************************************************************************
   Timer Callback for Random Animation 
   
   timer        -> Timer      : timer
   b            -> [ObjBitmap I HMat3d ObjBitmap I I Ob MyStruct S]           :
*******************************************************************************/
fun _timerAnimAlpha(timer, b) =
  let b->[fond transparencyLevel m newBitmap w h o MyStruct newName] in
    if transparencyLevel<=255 then
    (
      _FILLbitmap8 fond transparencyLevel;      
      let _CRalphaBitmap _channel newBitmap fond nil nil -> alphabmp in    /* _CRalphaBitmap ??? c quoi donc ??? */
      (
        let _CRbitmap _channel w h -> dest in
        (
          _CPbitmap16 dest 0 0 MyStruct.CurrentBitmap 0 0 w h 0;
          let _CPalphaBitmap dest 0 0 alphabmp 0 0 w h -> newBTrans in   /*_CPalphaBitmap  ??? */ 
          (
            M3setTransparencyColor session MyStruct.Txt 8;
            /*M3renameTexture session t newName;*/
            M3blitTexture16 session MyStruct.Txt newBTrans;
            _DSbitmap dest
          );
        );
        M3chgMaterialTexture session m MyStruct.Txt;
        mutate b <- [_ (transparencyLevel+10) _ _ _ _ _ _ _];
        _DSalphaBitmap alphabmp;
        0
      )
    )
    else
    (
      _DSbitmap MyStruct.CurrentBitmap;
      _deltimer timer;
      set MyStruct.CurrentBitmap = newBitmap ;
      set MyStruct.TimerAnim = nil;                  
      
      M3blitTexture16 session MyStruct.Txt newBitmap;
      M3chgMaterialTexture session m MyStruct.Txt;
      
      _DSbitmap8 fond;
      M3freeMemory session;   
      0
    )  
;;


/*-------------*/
/*fun runAnimTranspOLD(m,t,newBitmap,o)=

 M3blitTexture16 session t newBitmap;
   
 M3chgMaterialTexture session m t;

 M3setType session m (M3getType session m)|1|MAT_TRANSP;
 
 let hd UgetParam ObUi o "param0" -> d in  
 let if d==nil then defaultNbBloc else atoi d -> NbBloc in
 
 let hd UgetParam ObUi o "transitionLength" -> l in   
   let (if l==nil then defaultTransitionTime else atoi l)/255 -> timerPeriod in
    (_fooS "** CREATION TIMER"; _rfltimer _starttimer _channel timerPeriod @_timerAnimTransp [0 m t newBitmap NbBloc o]); 
 0;;   */


/*******************************************************************************
   Alpha  Animation 
   
   m            ->  HMat3d    : material
   newBitmap    ->  ObjBitmap : new Bitmap
   o            ->  Ob        :
   MyStruct     ->  TmyParam  : structure
   newName      ->  S         : new name of the texture
*******************************************************************************/
fun runAnimAlpha(m, newBitmap, o, MyStruct, newName) =  
  let _GETbitmapSize newBitmap -> [w h] in 
  let _CRbitmap8 _channel w h -> fond in    
  let hd UgetParam ObUi o "transitionTime" -> l in  
  let ( 
        if l==nil then 
          defaultTransitionTime 
        else atoi l
      )/255*10 -> timerPeriod in    
        ( 
          set MyStruct.TimerAnim = _rfltimer _starttimer _channel timerPeriod @_timerAnimAlpha [fond 0 m newBitmap w h o MyStruct newName];
          0
        )
;;  


/*******************************************************************************
   No  Animation 
   
   m            ->  HMat3d    : material
   newBitmap    ->  ObjBitmap : new Bitmap
   newName      ->  S         : new name of the texture
*******************************************************************************/
fun runNoAnim(m, newBitmap, newName, t) =
  /* M3setTransparencyColor session t 8;*/
  /* M3renameTexture session t newName; */
  M3blitTexture16 session t newBitmap;
  M3chgMaterialTexture session m t;
  _DSbitmap newBitmap;
  0
;;


/*******************************************************************************
   last percent 
   
   n            ->            : 
   i            ->            : 
   l            ->            : 
*******************************************************************************/
fun lastpercent(n, i, l) =
  if i>=strlen n then 
    l
  else 
    lastpercent n i+1 
      if (nth_char n i)=='% then 
       i 
      else 
       l
;;


/*******************************************************************************
   cutenamefilter 
   
   n            ->            : 
*******************************************************************************/
fun cutnamefilter(n) =
  let lastpercent n 0 nil-> i in
    if i==nil then 
      [n nil] 
    else 
      [substr n i+1 1000 substr n 1 i-1]
;;


/*******************************************************************************
   appply texture on H3D material with different animation
   
   x            ->  objAnchor : anchor 
   param        ->            :
*******************************************************************************/
fun appTexture(x, param) =
  let param -> [newTextureFileName w h o MyStruct] in
    match x with
        (objAnchor [_ m _ _] ->
    (
       if MyStruct.CurrentBitmap==nil then 
       (
         let _CRbitmap _channel w h -> bf in
         let M3getMaterialFlat session m -> fcolor in
         (
           _FILLbitmap bf fcolor;
           set MyStruct.CurrentBitmap = bf;
           0
         )
       )   
       else 
         nil;
      
       let _LDjpeg _channel _checkpack newTextureFileName -> newbTemp in
       let (
         if newbTemp==nil then 
         _LDbitmap _channel _checkpack newTextureFileName 
         else newbTemp
           ) -> newbTemp2 in
         if newbTemp2==nil then 
           nil 
         else 
         (
           let _CRbitmap _channel w h -> newBitmap in
           let M3textureName session M3textureFromMaterial session m -> n in
           let cutnamefilter n -> [_ filter] in
           let strcatn "%"::filter::"%"::newTextureFileName::nil -> newName in
           (
             let _GETbitmapSize newbTemp2 -> [tempW tempH] in /* get the new bitmap size */
             _SCPbitmap newBitmap 0 0 w-1 h-1 newbTemp2 0 0 tempW-1 tempH-1 nil; /* stretch it */
             _DSbitmap newbTemp2;
             M3setType session m (M3getType session m)|MAT_TEXTURED;
             M3filter newBitmap filter;
             let hd UgetParam ObUi o "transitionType" -> transitionType in
               if (!strcmp transitionType "random") || (!strcmp transitionType "colimasson") ||
                  (!strcmp transitionType "zigzag") || (!strcmp transitionType "zigzag2") ||
                  (!strcmp transitionType "zigzag3") || (!strcmp transitionType "zigzag4") ||
                  (!strcmp transitionType "zigzag5") || (!strcmp transitionType "zigzag6") ||
                  (!strcmp transitionType "zigzag7") then /* run differents animation */
                 runAnimRand transitionType m w h newBitmap o MyStruct newName
               else
               (
                 if !strcmp transitionType "alpha" then /* run alpha animation */
                   runAnimAlpha m newBitmap o MyStruct newName
                 else
                   runNoAnim m newBitmap newName MyStruct.Txt /* run no animation */      
               )  
           );
         )  
    )
    )
 |(_->nil)
;;


/*******************************************************************************
   appply texture on H3D material of the anchor list with different animation
                                             (head only)
   o            -> Ob         : 
   texture      -> S          :
   MyStruct     -> TmyParam   : structure
*******************************************************************************/
fun applyTexture(o, texture, MyStruct) = 

    if MyStruct.TimerAnim!=nil then /* to stop current anim */
    (
      _deltimer MyStruct.TimerAnim;
      set MyStruct.ListPosXY = nil;
      set MyStruct.TimerAnim = nil
    )
    else 
      nil;
  let hd UgetParam ObUi o "wSize" -> wParam in
  let (
        if wParam==nil then 
        defaultWSize else atoi wParam
      ) -> w in
  let hd UgetParam ObUi o "hSize" -> hParam in
  let (
        if hParam==nil then 
        defaultHSize else atoi hParam
      ) -> h in 

   apply_on_list ObAnchor o @appTexture [texture w h o MyStruct];
  /*appTexture hd ObAnchor o [texture w h o MyStruct]; */
  0
;;


/*******************************************************************************
   the texture is downloaded
   
   f            ->            : 
   b            ->            :
*******************************************************************************/
fun endDownTexture(f, b) =
  let b->[o textureFileName MyStruct] in 
  ( 
    set MyStruct.TextureFileNameUploading = textureFileName;     
    applyTexture o textureFileName MyStruct
  )
;;    


/*******************************************************************************
   CB interface to choose a texture file
   
   dlg          ->            : 
   param        ->            :
   pack         -> P          : bmp file
*******************************************************************************/
fun rflOpenFile (dlg, param, pack) =
  if pack==nil then
    nil
  else /* the client has choosen a bmp/jpg file */
  (
    let param -> [winChg bpreview txt /*f*/ o MyStruct] in
    let _PtoScol pack -> textureFileNameUploading in    
    (     
      let _LDjpeg _channel pack -> b in
      let (
            if b==nil then 
              _LDbitmap _channel pack 
            else 
              b 
          ) -> b in  
      let _GETbitmapSize b -> [w h] in      
      _SCPbitmap bpreview 0 0 128-1 128-1 b 0 0 w-1 h-1 nil; /* strech image from size a*b to aa*bb */           
      _BLTbitmap winChg bpreview 395-128 5; /* blit image */      
      _SETtext txt textureFileNameUploading;
      /*exec f with [nil textureFileNameUploading];*/  /* a voir : sert a rien !!*/
    )
  )  
;;


/*******************************************************************************
   open a dialog box to choose a jpg/bmp file
   
   button       ->            : 
   param        ->            :
*******************************************************************************/
/* b[window to view bitmap ; bitmap ; nom de la bitmap(zone de saisie);nil;o;a] */
fun rflBrowseFile (button, param) =
  let param -> [winChg _ objtxt /*_*/ _ _] in
  let getPathFile _GETtext objtxt "" -> [dir _] in
  _DLGrflopen _DLGOpenFile _channel winChg dir "" "bitmap (*.bmp,*.jpg)\0*.BMP;*.JPG;*.JPEG\0\0" @rflOpenFile param
;;


/*******************************************************************************
   cancel choose texture
   
   button       -> I          : flag for the mouse button
   MyStruct     -> TmyParam   : structure
*******************************************************************************/
fun cancelChgTexture(button, MyStruct) =
  (
    _DSwindow MyStruct.WinChgTexture;
    set MyStruct.WinChgTexture = nil;   
    0
  )
;;

 
/*******************************************************************************
   ask for changing texture , check if the texture is valid
   
   button       -> I          : flag for the mouse button
   param        ->            :
*******************************************************************************/
fun changeChgTexture(button, param) =
  let param -> [o MyStruct objTxtTextureFileName] in
  let _GETtext objTxtTextureFileName -> textureFileNameUploading in
    if textureFileNameUploading==nil || MyStruct.UploadingFlag then 
      nil
    else
    (
      let _checkpack textureFileNameUploading -> p in  /* on recupere un pointeur sur le fichier bitmap */
        if p==nil then
        (  _SETtext MyStruct.ObStatusText strcatn "Error : file not found"::nil;
           0
        )   
        else
        (   
          let hd UgetParam ObUi o "maxtexturefileSize" -> size in
          let (
                if size==nil then 
                  defaultMaxTextureFileSize 
                else 
                  atoi size
              ) -> maxTextureFileSize in 
            if (_fileSize p) > maxTextureFileSize then /* check the filesize */
            (
              _SETtext MyStruct.ObStatusText strcatn "Error : file is too big (limit is at "::(itoa maxTextureFileSize)::" bytes)"::nil;
              0
            )   
            else
            (
              if ((_LDbitmap _channel p)==nil)  && ((_LDjpeg _channel p)==nil) then /* test if the file format is valid */
              (
                _SETtext MyStruct.ObStatusText "Error : invalid bmp/jpeg file format";
                0    
              )
              else
              (
                set MyStruct.TextureFileNameUploading = textureFileNameUploading;
                set MyStruct.UploadingFlag = 1; 
                UsendMessage ObUi o "UploadingTextureFile?" nil /* ask the server if we can upload a texture file */
              )
            )
        )
    )
;;


/*******************************************************************************
   CB when change texture window interface is destroyed
   
   win          -> ObjWin     : Window
   param        ->            :
*******************************************************************************/
fun destroyEvent(win, param) =
  let param -> [MyStruct bpreview] in
  (
    _DSbitmap bpreview;
    set MyStruct.WinChgTexture = nil;
    0
  )
;; 


/*******************************************************************************
   Callback on end of paint event
   
   a            -> ObjWin     : Window
   b            -> ObjBitmap  : Bitmap
*******************************************************************************/
fun winChgPaintEvent(a, b) =
  _BLTbitmap a b 395-128 5
;;


/*******************************************************************************
   show the interface to choose a texture file
   
   o            ->  Anchor    : ancre
   MyStruct     -> TmyParam   : structure
*******************************************************************************/
fun showChgTextureInterface2(o, MyStruct) =
  if MyStruct.WinChgTexture!=nil then 
    nil         
  else
  (      
    let hd UgetParam ObUi o "maxtexturefileSize" -> size in 
    let (
          if size==nil then 
            defaultMaxTextureFileSize 
          else 
            atoi size 
        ) -> maxTextureFileSize in
    let _CRwindow _channel DMSwin nil nil 400 280 WN_MENU|WN_MINBOX "Change texture interface" -> winChg in
    (                    
      _CRtext _channel winChg 5 30 260 90 ET_ALIGN_LEFT strcatn "You can choose a texture from your SCOL partitions\n(.../SCOL/cache/ or .../SCOL/partition/).\nThe maximum file size is "::(itoa maxTextureFileSize)::" bytes.\nThen click on the <change texture> button."::nil;  
      _CRtext _channel winChg 5 150 100 20 ET_ALIGN_LEFT "Texture filename";             
      let _CRtext _channel winChg 5 240 390 20 ET_BORDER "Status : " -> statusText in
      (
        _SETtext statusText "Status : choose a texture file";
        set MyStruct.ObStatusText = statusText;
        set MyStruct.WinChgTexture = winChg;         
        0
      );                  
        let _CRbitmap _channel 128 128 -> bpreview in
        (
          _FILLbitmap bpreview 0xc0;                
          _CBwinPaint winChg @winChgPaintEvent bpreview;
          _CBwinDestroy winChg @destroyEvent [MyStruct bpreview];
          let _CRtext _channel winChg  120 150 250 20 ET_DOWN|ET_AHSCROLL "" -> objTxtTextureFileName in
          (
            _CBbutton _CRbutton _channel winChg 375 150 20 20 0 "..." @rflBrowseFile [winChg bpreview objTxtTextureFileName /*nil*/ o MyStruct];
            _CBbutton _CRbutton _channel winChg 50 200 150 20 0 "Change texture" @changeChgTexture [o MyStruct objTxtTextureFileName]
          ); 
        );  
      _CBbutton _CRbutton _channel winChg 250 200 100 20 0 "Cancel" @cancelChgTexture MyStruct;               
      0          
    )
  )
;; 


/****************************************************************************************/
/*                                                                                      */
/*     Communication intra module  :   reception des messages serveur                   */
/*                                                                                      */
/*                                                                                      */
/****************************************************************************************/


/*******************************************************************************
  Change Texture Interface Callback
  
  ui     -> UserI          : user instance
  action -> S              : action
  param  -> S              : parameters
  b      -> [Ob  MyStruct] : Ob and data structure
         <- I              : not used
*******************************************************************************/
fun showChgTextureInterface(ui, action, param, b) =
  let b -> [o MyStruct] in
  showChgTextureInterface2 o MyStruct /* show the interface to change a texture */
;;

/*********************************************************************************
  when timer out
    timer -> the upload timer
    MyStruct -> data
**********************************************************************************/
fun cbTimerOut (timer, MyStruct) = 
  _deltimer MyStruct.TimerUploading;
  _SETtext MyStruct.ObStatusText "Status : error upload ...";
  set MyStruct.FUploading = nil;
  set MyStruct.UploadingFlag = 0
;;

/*********************************************************************************
  check if it is the end of the file, if so inform the server and close the file
  else ask the server if we can send a new packet                               
    o -> ob               : instance
    MyStruct -> TmyParam  : struct of data
***********************************************************************************/     
fun processFile(o,MyStruct)= 
  _deltimer MyStruct.TimerUploading;
  if (_FILETell MyStruct.FUploading)>=(_FILESize MyStruct.FUploading) then /*end file*/
  (
    _FILEClose MyStruct.FUploading;/*close the file*/
    set MyStruct.FUploading = nil;
    UsendSrv this ObUi o "TextureFilePacket" nil;
    _SETtext MyStruct.ObStatusText "Status : upload finished...";  
    0
  ) 
  else
  (  
    UsendSrv this ObUi o "nextPacket?" nil;
    set  MyStruct.TimerUploading = _rfltimer _starttimer _channel 4000 @cbTimerOut MyStruct;
    0
  )
;;

/*******************************************************************************
  Click action Callback
  ui     -> UserI           : user instance
  action -> S               : action
  param  -> S               : parameters
  data   -> [Ob Mystruct]   : Ob
*******************************************************************************/
fun cbOkNextPacket (ui, action, param, data) = 
  let data -> [o mystruct] in
  let _FILERead mystruct.FUploading 1024 -> s in
  (    
    _SETtext mystruct.ObStatusText "Status : Uploading...";
    UsendSrv this ObUi o "TextureFilePacket" s; /*send the next packet*/
    processFile o mystruct;
    0
  )
;;

/*******************************************************************************
  Authorizing to upload a texture file
    
  ui     -> UserI          : user instance
  action -> S              : action
  param  -> S              : parameters
  b      -> [Ob  MyStruct] : Ob and data structure
         <- I              : not used
*******************************************************************************/
fun OKuploadingTextureFile(ui, action, param, b) =
  let b -> [o MyStruct] in
  let ObUi o -> ui2 in
  (
    set MyStruct.FUploading = _FILEOpen _channel _checkpack MyStruct.TextureFileNameUploading;
 
    /*send the file to the server*/
    processFile o MyStruct;
    0
  )
;;


/*******************************************************************************
  set the texture uploaded by a client or asked by the client with the ?texture cbcomm
    
  ui     -> UserI          : user instance
  action -> S              : action
  param  -> S              : parameters
  b      -> [Ob  MyStruct] : Ob and data structure
         <- I              : not used
*******************************************************************************/
fun setTextureUploaded(ui, action, param, b) =
  if param!=nil then
  (
    let b -> [o MyStruct] in
    (         
      _RSCabort this MyStruct.RscDownloading; /*stop current download*/
      set MyStruct.RscDownloading = _RSCdownload this param param mknode @endDownTexture [o param MyStruct] 3;
      0
    )
  )
  else 
    nil
;;


/*******************************************************************************
  set the texture choosen by action setTextureS on server
    
  ui     -> UserI          : user instance
  action -> S              : action
  param  -> S              : parameters
  b      -> [Ob  MyStruct] : Ob and data structure
         <- I              : not used
*******************************************************************************/
fun setTexture(ui, action, param, b) =
  if param!=nil then
  (
    let b -> [o MyStruct] in
    (
      set MyStruct.ObCurrentTexture = param;
      applyTexture o param MyStruct;   
      0
    )
  )
  else 
    nil
;;


/*******************************************************************************
  set the position choosen by action setPosS on server
    
  ui     -> UserI          : user instance
  action -> S              : action
  param  -> S              : parameters
  b      -> [Ob  MyStruct] : Ob and data structure
         <- I              : not used
*******************************************************************************/
fun setPos(ui, action, param, b) =
  if param!=nil then
  (
    let b -> [o MyStruct] in
    set MyStruct.CurrentPosInTexturesList = atoi param; 
    0
  )
  else 
    nil
;;


/*******************************************************************************

    
  ui     -> UserI          : user instance
  action -> S              : action
  param  -> S              : parameters
  b      -> [Ob  MyStruct] : Ob and data structure
         <- I              : not used
*******************************************************************************/
fun error(ui, action, param, b) =
  let b -> [o MyStruct] in
    if !strcmp param "1" then
    (
      _FILEClose MyStruct.FUploading;     
      set MyStruct.FUploading = nil;
      set MyStruct.UploadingFlag = 0;
      _SETtext MyStruct.ObStatusText "Error : while transferring file to server : invalid bmp/jpeg file format";
      0
    )       
    else
    ( 
      if !strcmp param "2" then
      (
        _FILEClose MyStruct.FUploading;
        set MyStruct.FUploading = nil;
        set MyStruct.UploadingFlag = 0;
        _SETtext MyStruct.ObStatusText "Error : another client is already uploading a file";
        0
      )         
      else
      ( 
        if !strcmp param "3" then
        (
          let hd UgetParam ObUi o "timeoutUploadingFile" -> timeout in 
          let (
            if timeout==nil then 
              defaultTimeoutUploadingFile 
            else 
              atoi timeout
          ) -> timeoutUploadingFile in  
          (
            _FILEClose MyStruct.FUploading;
            set MyStruct.FUploading = nil;
            set MyStruct.UploadingFlag = 0;
            _SETtext MyStruct.ObStatusText strcatn "Error : timeout has occured while uploading file ("::(itoa timeoutUploadingFile)::" seconds)"::nil;
            0
          )
        )
        else 
          nil
      )
    )                 
;;


/****************************************************************************************/
/*                                                                                      */
/*     Communication inter module  :                                                    */
/*      a = [blocPosXYList currentBitmap ObStatusText rscDownloading winChgTexture      */ 
/*           textureFileNameUploading fUploading ObCurrentTexture ObtextureList         */ 
/*           currentPosInTexturesList loop uploadingFlag timerAnim]                     */ 
/*                                                                                      */
/*                                                                                      */
/*                                                                                      */
/****************************************************************************************/


/*******************************************************************************
   apply a random texture on texture list
   
   o            ->  Ob        : 
   from         ->            :
   action       ->            :
   param        ->            :
   reply        ->            :
   MyStruct     -> TmyParam   : structure
*******************************************************************************/
fun setRandom(o, from, action, param, reply, MyStruct) =
    if MyStruct.ObTextureList==nil then 
      nil
    else
    (
      let mod rand sizelist MyStruct.ObTextureList -> randPos in
      let nth_list MyStruct.ObTextureList randPos -> texture in
      ( 
        set MyStruct.CurrentPosInTexturesList = randPos;
        set MyStruct.ObCurrentTexture = texture;
        applyTexture o MyStruct.ObCurrentTexture MyStruct
      )        
    )
;;


/*******************************************************************************
   apply the given position of a texture on texture list
   
   o            ->  Ob        : 
   from         ->            :
   action       ->  S         :
   param        ->            :
   reply        ->            :
   MyStruct     -> TmyParam   : structure
*******************************************************************************/    
fun setTexturePosInTexturesList(o, from, action, param, reply, MyStruct) =
  if (param!=nil) then
  (   
      if MyStruct.ObTextureList==nil then 
        nil
      else
      (
        let atoi param -> newPos in 
        (   
          if (newPos>=0) && newPos<(sizelist MyStruct.ObTextureList) then
          (
            set MyStruct.ObCurrentTexture = nth_list MyStruct.ObTextureList newPos;
            set MyStruct.CurrentPosInTexturesList = newPos;
            applyTexture o MyStruct.ObCurrentTexture MyStruct  
          ) 
          else
          ( 
            let nth_list MyStruct.ObTextureList MyStruct.CurrentPosInTexturesList -> currentTexture in
            applyTexture o currentTexture MyStruct
          )
        )    
      )
  )
  else 
    nil
;;   


/*******************************************************************************
   apply the next texture on texture list
   
   o            ->  Ob        : 
   from         ->            :
   action       ->  S         :
   param        ->            :
   reply        ->            :
   MyStruct     -> TmyParam   : structure
*******************************************************************************/
fun nextTexture(o, from, action, param, reply, MyStruct) =  
  if MyStruct.ObTextureList==nil then 
   nil
  else
  (
    if MyStruct.CurrentPosInTexturesList == (sizelist MyStruct.ObTextureList)-1 then 
          _DMSevent this strcatn (ObName o)::"."::"endList"::nil nil nil 
        else 
           nil;
           
    if MyStruct.CurrentPosInTexturesList < (sizelist MyStruct.ObTextureList)-1 then 
    (      
      set MyStruct.ObCurrentTexture = nth_list MyStruct.ObTextureList MyStruct.CurrentPosInTexturesList+1;
      set MyStruct.CurrentPosInTexturesList = MyStruct.CurrentPosInTexturesList+1 ;
      applyTexture o MyStruct.ObCurrentTexture MyStruct;     
        
        /*
        if MyStruct.CurrentPosInTexturesList == (sizelist MyStruct.ObTextureList)-2 then 
          _DMSevent this strcatn (ObName o)::"."::"endList"::nil nil nil 
        else 
           nil
        */
    )  
    else
    ( 
      if !strcmp MyStruct.Loop "1" then
      (
        set MyStruct.ObCurrentTexture = nth_list MyStruct.ObTextureList 0 ;
        set MyStruct.CurrentPosInTexturesList = 0 ;
        applyTexture o MyStruct.ObCurrentTexture MyStruct
      )   
      else
      (
        set MyStruct.ObCurrentTexture = nth_list MyStruct.ObTextureList MyStruct.CurrentPosInTexturesList;
        applyTexture o MyStruct.ObCurrentTexture MyStruct
      )  
    )
  )
;;   


/*******************************************************************************
   apply the previous texture on texture list
   
   o            ->  Ob        : 
   from         ->            :
   action       ->  S         :
   param        ->            :
   reply        ->            :
   MyStruct     -> TmyParam   : structure
*******************************************************************************/
fun previousTexture(o, from, action, param, reply, MyStruct) =        
  if MyStruct.ObTextureList==nil then 
    nil /*textures list empty*/
  else
  (
    if MyStruct.CurrentPosInTexturesList == 0 then 
      _DMSevent this strcatn (ObName o)::"."::"beginList"::nil nil nil 
    else 
      nil;
    
    if MyStruct.CurrentPosInTexturesList > 0 then
    (
      set MyStruct.ObCurrentTexture = nth_list MyStruct.ObTextureList MyStruct.CurrentPosInTexturesList-1;
      set MyStruct.CurrentPosInTexturesList = MyStruct.CurrentPosInTexturesList - 1;
           
      applyTexture o MyStruct.ObCurrentTexture MyStruct;
        /*
        if MyStruct.CurrentPosInTexturesList == 1 then 
          _DMSevent this strcatn (ObName o)::"."::"beginList"::nil nil nil 
        else 
          nil
        */  
     
    )         
    else
    ( 
      if !strcmp MyStruct.Loop "1" then
      (
        set MyStruct.ObCurrentTexture = nth_list MyStruct.ObTextureList (sizelist MyStruct.ObTextureList)-1;
        set MyStruct.CurrentPosInTexturesList = (sizelist MyStruct.ObTextureList)-1;
        applyTexture o MyStruct.ObCurrentTexture MyStruct;
      )        
      else
      ( 
        set MyStruct.ObCurrentTexture = nth_list MyStruct.ObTextureList MyStruct.CurrentPosInTexturesList;
        applyTexture o MyStruct.ObCurrentTexture MyStruct;
      )
    )
  )
;;

/*******************************************************************************
   
   
   o            -> Ob         : 
   MyStruct     -> TmyParam   : structure
*******************************************************************************/
fun ObDestroyed(o, MyStruct) =
    _DSbitmap MyStruct.CurrentBitmap;
    set MyStruct.ListPosXY = nil;
    set MyStruct.CurrentBitmap = nil; 
    0
;; 


/*******************************************************************************
   Registered Texture
   
   o            -> Ob         : 
   MyStruct     -> TmyParam   : structure
*******************************************************************************/
fun registerTexturesOK(o, MyStruct) =
 
  ObCbDestroy o mknode @ObDestroyed MyStruct;  
  UsendMessage ObUi o "texture?" nil; /*ask for current server texture*/  
 
  /* inter-module message */
  ObRegisterAction o (strcatn (ObName o)::".setRandom"::nil) mkfun6 @setRandom MyStruct;
  ObRegisterAction o (strcatn (ObName o)::".setTexturePosInTexturesList"::nil) mkfun6 @setTexturePosInTexturesList MyStruct;
  ObRegisterAction o (strcatn (ObName o)::".nextTexture"::nil) mkfun6 @nextTexture MyStruct;
  ObRegisterAction o (strcatn (ObName o)::".previousTexture"::nil) mkfun6 @previousTexture MyStruct;
 
  let [o MyStruct] -> b in
  (
    /* intra-module message */
    UcbMessage ObUi o ["showChgTextureInterface" mkfun4 @showChgTextureInterface b]::
                      ["OKuploadingTextureFile" mkfun4 @OKuploadingTextureFile b]::
                      ["setTextureUploaded" mkfun4 @setTextureUploaded b]::
                      ["setTexture" mkfun4 @setTexture b]::
                      ["setPos" mkfun4 @setPos b]::
                      ["error" mkfun4 @error b]::
                      nil;
  );  
  0
;;


/*******************************************************************************
   Load Texture
   
   doc          ->            : 
   b            ->            :
*******************************************************************************/
fun downloadTexture(doc, b) =
  let b -> [nbTotal nb o MyStruct] in
  let nb -> [nb2] in 
  (  
    if nb2==nbTotal then /* all textures have been downloaded */  
      registerTexturesOK o MyStruct
    else   
      (
        mutate nb <- [nb2+1];
        0
      )    
  )
;;


/*******************************************************************************
   Load Texture
   
   l            ->            : list of the texture
   nbTotal      -> I          : total number of texture
   nb           -> I          : the id of the used texture
   o            ->            : 
   MyStruct     -> TmyParam   : structure
*******************************************************************************/
fun downloadTextures(l, nbTotal, nb, o, MyStruct) =
  if l==nil then 
    nil
  else
  (
    let l -> [t q] in
    (
      _RSCdownload this t t mknode @downloadTexture [nbTotal nb o MyStruct] 3; /* callback lorsque le telechargement texture est fini */
      downloadTextures q nbTotal nb o MyStruct;
      0
    )
  )  
;; 

/*******************************************************************************
  upload is finish and successfull
  ui     -> UserI           : user instance
  action -> S               : action
  param  -> S               : parameters
  data   -> [Ob Mystruct]   : Ob
*******************************************************************************/
fun cbUploadSuccessfull (ui, action, param, data) = 
  let data -> [o mystruct] in
  (
    _SETtext mystruct.ObStatusText "Status : upload successfull !";
    set mystruct.UploadingFlag = 0;
    0
  )
;;

/*******************************************************************************
  New object creation
  o -> Ob  : object
    <- I   : not used
*******************************************************************************/
fun newOb(o) =

  M3load session materFile nil;

  let M3copyMaterialTexture session M3getMat session "snapmater" -> txt in
  let MyParam [nil nil nil nil nil nil nil nil (lineextr hd UgetParam ObUi o "texturesList") nil (hd UgetParam ObUi o "loop") 0 nil nil txt] -> MyStruct in
  ( 
    if MyStruct.ObTextureList==nil then
      registerTexturesOK o MyStruct
    else
    ( 
      downloadTextures MyStruct.ObTextureList (sizelist MyStruct.ObTextureList) [1] o MyStruct;   
      0
    );
  
    UcbMessage ObUi o ["UploadSuccessfull" mkfun4 @cbUploadSuccessfull [o MyStruct]]::nil;
    UcbMessage ObUi o ["OKnextPacket" mkfun4 @cbOkNextPacket [o MyStruct]]::nil;
  );
  0
;;


/*******************************************************************************
  Function to define in all plugins for registration
  file -> S : '*.plug' file name
       <- I : not used
*******************************************************************************/
fun IniPlug(file) =  
  srand _tickcount;/* initialize random */   
  set class=getInfo strextr _getpack _checkpack file "name";
 
  PlugRegister class @newOb nil;
   
  0
;;