/*******************************************************************************
 Module Whiteboard
 Server part
 Version: 1.0
 Authors: LEBLOND Gregory & BRESCIA Franck & OHAYON Franck
 Last update: 28/02/2001
 Whiteboard Module
*******************************************************************************/

defcom CcleanCanvasC = cleanCanvasC;;
defcom CJPEG_new = JPEG_new S S I I;;
defcom CgetLines = getLines S I I I;;
defcom CgetCircle = getCircle I I I I I;;
defcom CgetRect = getRect I I I I I I;;
defcom CgetLigne = getLigne I I I I I I;;
defcom CsetText = setText S I I I I;;
defcom CgetListeName = getListeName S;;
defcom CUndoCli = UndoCli;;
defcom CUndoCopyCli = UndoCopyCli;;
/*defcom CFillColorCli = FillColorCli I I I;;*/ /* permet d'effectuer le remplissage de surface : posx,posy,color */
defcom CPasteCli = PasteCli I I I I;;       /* posx, posy, W, H */
defcom CCutCli = CutCli I I I I;;


/* principal window */
typeof canvas=ObjWin;;
typeof button=ObjButton;;

/* List of Client */
typeof cliListe=[[CLIENT S] r1];;
typeof allCli=[[CLIENT I] r1];;

/* Drawing Buffer */
typeof grafbuf=ObjBitmap;;
typeof UndobufS=ObjBitmap;;
typeof CopybufS=ObjBitmap;;


typeof Largeur=I;;
typeof Hauteur=I;;
typeof BlocJpeg=ObjBitmap;;

typeof Noir=I;;
typeof Rouge=I;;
typeof Vert=I;;
typeof Bleu=I;;
typeof Blanc=I;;
typeof Transparent=I;;

typeof clnEnable=I;;

/* List of Brush type */
typeof brosListe=[AlphaBitmap r1];;

/*path*/
typeof modulePath = S;;

/*register*/
typeof CKregister = I;;

var JPEG_cpt=0;;


/*******************************************************************************
  Creation of a List of Brush   
*******************************************************************************/
fun LDbrosses()=
  set brosListe = ((_LDalphaBitmap _channel _checkpack strcat modulePath "brush/01.png") )::
    ( (_LDalphaBitmap _channel _checkpack strcat modulePath "brush/02.png") )::
    ( (_LDalphaBitmap _channel _checkpack strcat modulePath "brush/03.png") )::
    ( (_LDalphaBitmap _channel _checkpack strcat modulePath "brush/04.png") )::
    ( (_LDalphaBitmap _channel _checkpack strcat modulePath "brush/05.png") )::
    ( (_LDalphaBitmap _channel _checkpack strcat modulePath "brush/06.png") )::nil
;;

/*******************************************************************************
  find a client in cliListe
    client -> CLIENT  : part of the client list
    cli2 -> CIENT     : client to find
********************************************************************************/
fun cbclientByclient(client, cli2)=
  let client -> [cli _] in
    cli2 == cli
;;

/*******************************************************************************
  find a client in allCli
    client -> CLIENT  : part of the client list
    cli2 -> CIENT     : client to find
********************************************************************************/
fun cballclientByallclient(client, cli)=
  let client -> [cli2 _] in
    cli2 == cli
;;

/*******************************************************************************
   Remove Client from the client list   
    list       -> [[CLIENT S] r1] : List of Client
    client2del -> CLIENT          : Client to Delete
               <-           
*******************************************************************************/
fun remove_client_in_list (list, client2del) =
  let search_in_list list @cbclientByclient client2del -> f in
    remove_from_list list f
;;

/*******************************************************************************/
/*                         Send messages to clients                            */
/*******************************************************************************/

/*******************************************************************************
   Send Message to client to Cut Zone
    client    -> CLIENT            : client to send     
    posx        -> I               : posX
    posy        -> I               : posY
    Wcopy       -> I               : W
    Hcopy       -> I               : H
                <-                      
*******************************************************************************/
fun cbCutAll(client, param) =
  let client -> [cli _] in
  let param -> [posx posy Wcopy Hcopy] in
    _DMSsend this cli CCutCli [posx posy Wcopy Hcopy]
;;

/*******************************************************************************
   Send Message to client to Paste Zone
    client    -> CLIENT            : client to send      
    posx        -> I               : posX
    posy        -> I               : posY
    Wcopy       -> I               : W
    Hcopy       -> I               : H
                <-                      
*******************************************************************************/
fun cbPasteAll(client, param) =
  let client -> [cli _] in
  let param -> [posx posy Wcopy Hcopy] in
    _DMSsend this cli CPasteCli [posx posy Wcopy Hcopy]
;;

/*******************************************************************************
   Send Message to client to Fill Color
    client    -> CLIENT            : client to send    
    posx        -> I               : posX
    posy        -> I               : posY
    color       -> I               : Color to fill
                <-                      
*******************************************************************************/
/*fun cbFillColorAll(client, param) =
  let param -> [posx posy color] in
    _DMSsend this client CFillColorCli [posx posy color]
;;*/ 

/*******************************************************************************
   Send Message to client to Undo command   
    client    -> CLIENT            : client to send
    param     -> paramater         : not used              
*******************************************************************************/
fun cbUndoAll(client, param) =
  let client -> [cli _] in
    _DMSsend this cli CUndoCli []
;;

/*******************************************************************************
   Send Message to client to Copy Bitmap (courant) 
    client    -> CLIENT            : client to send
    param     -> paramater         : not used               
*******************************************************************************/
fun cbUndoCopyAll(client, param)=
  let client -> [cli _] in
    _DMSsend this cli CUndoCopyCli []
;;

/*******************************************************************************
   Send Message to client to clean Canvas
    client    -> CLIENT            : client to send
    param     -> paramater         : not used                      
*******************************************************************************/
fun cbCleanAllCan(client, param)=
  let client -> [cli _] in
    _DMSsend this cli CcleanCanvasC []
;;

/*******************************************************************************
   Send Message to clients for Drawing      
    client    -> CLIENT            : client to send
    tamponTrace -> [[S r1] r1]     : Tampon de trace
    brtype      -> I               : Type
    wid         -> I               : Width
    col         -> I               : Color
    cli         -> CLIENT          : Client
                <-           
*******************************************************************************/
fun cbEnvoiMsg(client, param) =
  let client -> [cli _] in
  let param -> [tamponTrace brtype wid col] in
    _DMSsend this cli CgetLines [tamponTrace brtype wid col] /* envoie aux clients du nouveau tracé */
;;

/*******************************************************************************
   Drawing Circle to client's whiteboard      
    client    -> CLIENT          : client to send
    x         -> I               : X pos
    y         -> I               : Y pos
    r         -> I               : Ray
    wid       -> I               : Width
    col       -> I               : Color
              <-           
*******************************************************************************/
fun cbTraceCircle (client, param) =
  let client -> [cli _] in
  let param -> [x y r wid col] in
    _DMSsend this cli CgetCircle [x y r wid col]
;;

/*******************************************************************************
   Drawing Square on client's whiteboard      
    client    -> CLIENT          : client to send
    x1        -> I               : X1 pos
    y1        -> I               : Y1 pos
    x2        -> I               : X2 pos
    y2        -> I               : Y2 pos
    wid       -> I               : Width
    col       -> I               : Color
              <-           
*******************************************************************************/
fun cbTraceRect (client, param) =
  let client -> [cli _] in
  let param -> [x1 y1 x2 y2 wid col] in
    _DMSsend this cli CgetRect [x1 y1 x2 y2 wid col]
;;

/*******************************************************************************
   Drawing Line on client's whiteboard    
    client    -> CLIENT          : client to send
    x1        -> I               : X1 pos
    y1        -> I               : Y1 pos
    x2        -> I               : X2 pos
    y2        -> I               : Y2 pos
    wid       -> I               : Width
    col       -> I               : Color
              <-          
*******************************************************************************/
fun cbTraceLigne (client, param) =
 let client -> [client _] in
 let param -> [x1 y1 x2 y2 wid col] in
   _DMSsend this client CgetLigne [x1 y1 x2 y2 wid col]
;;

/*******************************************************************************
   Writing Text on client's whiteboard     
    client    -> CLIENT          : client to send
    TextString -> S               : Text
    TextPosX   -> I               : X pos
    TextPosY   -> I               : Y pos
    col        -> I               : Color 
    TextSize   -> I               : Size of Font
               <-
*******************************************************************************/
fun cbTraceText (client, param) =
  let client -> [cli _] in
  let param -> [TextString TextPosX TextPosY col TextSize] in
    _DMSsend this cli CsetText [TextString TextPosX TextPosY col TextSize]
;;

/*******************************************************************************
   Send Jpeg Image to other Clients  
    client    -> CLIENT          : client to send
    cli        -> CLIENT          : Client
    name       -> S               : 
    x          -> I               : X pos
    y          -> I               : Y pos
               <-          
*******************************************************************************/
fun cbJPEG_TransfertOthers(client, param) =
  let client -> [client _] in
  let param -> [name x y] in
    _DMSsend this client CJPEG_new["" name x y] 
;;

/*******************************************************************************
  renvoie la liste des utilisateurs son le whiteboard est ouvert
    list -> [[CLIENT S] r1]     : liste des clients
    client -> CLIENT            : client a supprimer
********************************************************************************/
fun ListName (list, client) = 
  if list == nil then
    nil
  else
    let hd list -> fclient in
    let fclient -> [cli login] in
      if client == cli then
        ListName (tl list) client
      else 
        login::(ListName (tl list) client)
;;

/*******************************************************************************
   envoi à tous les clients la nouvelle liste des connectés   
    client    -> CLIENT            : client to send
    param     -> paramater         : not used    
*******************************************************************************/
fun cbRafraichiConnectes(client, param)=
  let client -> [cli _] in
    _DMSsend this cli CgetListeName [strbuild (ListName cliListe cli)::nil]
;;


/*******************************************************************************/
/*                      Reception of the Client messages                       */
/*******************************************************************************/

/*******************************************************************************
   Drawing
    l           -> [[S r1] r1] : Tampon de tracé
    x2          -> I           : X pos 
    y2          -> I           : Y pos
    brtype      -> I           : Type
    wid         -> I           : Width
    col         -> I           : Color
                <-           
*******************************************************************************/
fun Trace(l, x2, y2, brtype, wid, col) =
  if l==nil then 
    nil
  else
    let l->[h t] in
    (
      if (brtype==nil) then
      (
        _DRAWline grafbuf (atoi nth_list h 0) (atoi nth_list h 1) x2 y2 DRAW_SOLID wid col;
        0
      )
      else
      (
        let nth_list brosListe brtype->abmp in
        let _GETalphaBitmapSize abmp->[l h ] in
        let (max 0 y2-h/2)->ybros in
        let _GETalphaBitmaps abmp->[b _] in 
        (
          _FILLbitmap b col;
          _CPalphaBitmap grafbuf x2-l/2 ybros abmp 0 0 l h;
          _FILLbitmap b 0;
        );
        /* _CPbitmap16 grafbuf x2-32 y2-32 nth_list brosListe brtype 0 0 64 64 Transparent;*/
        0
      );
      Trace t (atoi nth_list h 0) (atoi nth_list h 1) brtype wid col
    );
   0
;;

/*******************************************************************************
   Drawing    
    l           -> [[S r1] r1] : Tampon de trace
    brtype      -> I           : Type
    wid         -> I           : Width
    col         -> I           : Color
                <-          
*******************************************************************************/
fun AfficheLignes(l, brtype, wid, col) =
  let (strextr l)->[h t] in
  (
    Trace t (atoi nth_list h 0) (atoi nth_list h 1) brtype wid col;
    _BLTbitmap canvas grafbuf 0 0;
  )
;;

/*******************************************************************************
   Trace Line in Server Buffer and send message to all clients to update   
    tamponTrace -> [[S r1] r1] : Tampon du trace 
    brtype      -> I           : Type
    wid         -> I           : Width of the line
    col         -> I           : Color
                <-          
*******************************************************************************/
fun __setLines(ZIPtamponTrace, brtype, wid, col) =
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  if f == nil then
    nil
  else
  (
    let unzip ZIPtamponTrace -> tamponTrace in
    (
      AfficheLignes tamponTrace brtype wid col;  
      let search_in_list allCli @cballclientByallclient DMSsender -> f in
        apply_on_list (remove_from_list allCli f) @cbEnvoiMsg [tamponTrace brtype wid col]
    )
  );
  0
;;

/*******************************************************************************
   Trace Circle in Server Buffer and send message to all client to update   
    x         -> I         : X center
    y         -> I         : Y center
    r         -> I         : Ray
    wid       -> I         : Width
    col       -> I         : Color
              <-           
*******************************************************************************/
fun __setCircle(x, y, r, wid, col) =
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  if f == nil then
    nil
  else
  (
    _DRAWcircle grafbuf x y r DRAW_SOLID wid col DRAW_INVISIBLE nil;
    _BLTbitmap canvas grafbuf 0 0;
    let search_in_list allCli @cballclientByallclient DMSsender -> f in
      apply_on_list (remove_from_list allCli f) @cbTraceCircle [x y r wid col];
  
    let (_getmodifypack "test1.jpg")->hd in 
    _SAVEjpeg grafbuf hd 100;
  );
  0
;;

/*******************************************************************************
   Trace Square in Server Buffer and send message to all client to update 
    x1        -> I         : X1 pos
    y1        -> I         : Y1 pos
    x2        -> I         : X2 pos
    y2        -> I         : Y2 pos
    wid       -> I         : Width
    col       -> I         : Color
              <-          
*******************************************************************************/
fun __setRect(x1, y1, x2, y2, wid, col) =
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  if f == nil then
    nil
  else
  (
    _DRAWrectangle grafbuf x1 y1 x2-x1 y2-y1 DRAW_SOLID wid col DRAW_INVISIBLE nil;
    _BLTbitmap canvas grafbuf 0 0;
    let search_in_list allCli @cballclientByallclient DMSsender -> f in
      apply_on_list (remove_from_list allCli f) @cbTraceRect [x1 y1 x2 y2 wid col];
  );
  0
;;

/*******************************************************************************
   Trace Line in Server Buffer and send message to all client to update     
    x1        -> I         : X1 pos
    y1        -> I         : Y1 pos
    x2        -> I         : X2 pos
    y2        -> I         : Y2 pos
    wid       -> I         : Width
    col       -> I         : Color
              <-           
*******************************************************************************/
fun __setLigne(x1, y1, x2, y2, wid, col) =
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  if f == nil then
    nil
  else
  (
    _DRAWline grafbuf x1 y1 x2 y2 DRAW_SOLID wid col;
    _BLTbitmap canvas grafbuf 0 0;
    let search_in_list allCli @cballclientByallclient DMSsender -> f in
      apply_on_list (remove_from_list allCli f) @cbTraceLigne [x1 y1 x2 y2 wid col];
  );
  0
;;

/*******************************************************************************
   Write text in Server Buffer and send message to all clients to update  
    TextString ->  S        : Text
    TextPosX   ->  I        : Pos X
    TextPosY   ->  I        : Pos Y
    col        ->  I        : Color
    TextSize   ->  I        : Size of font
               <-          
*******************************************************************************/
fun __getText(TextString,TextPosX,TextPosY,col,TextSize)=
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  if f == nil then
    nil
  else
  (
    let _CRfont _channel TextSize 0 0 (_loc this "FONT" nil) -> TextFont in 
    (
      _CPbitmap16 UndobufS 0 0 grafbuf 0 0 Largeur Hauteur nil; /* Pour le Undo */
      set grafbuf=_DRAWtext grafbuf TextFont TextPosX TextPosY TD_LEFT|TD_BASELINE col TextString;
      _DSfont TextFont;
    );
    let search_in_list allCli @cballclientByallclient DMSsender -> f in
      apply_on_list (remove_from_list allCli f) @cbTraceText [TextString TextPosX TextPosY col TextSize];
    _BLTbitmap canvas grafbuf 0 0
  );
  0
;;

/*******************************************************************************
   Initialisation of the size  
    width       -> I         : Width 
    height      -> I         : Height
                <-           
*******************************************************************************/
fun __initSize(width, height) =
  if ((sizelist cliListe)==0 && Largeur==0) then 
  (
    set Largeur=width;
    set Hauteur=height;
    LDbrosses;
    set grafbuf=_FILLbitmap (_CRbitmap _channel Largeur Hauteur) Blanc;
    set UndobufS=_FILLbitmap (_CRbitmap _channel Largeur Hauteur) Blanc;
    set CopybufS=_FILLbitmap (_CRbitmap _channel Largeur Hauteur) Blanc;
  )
  else nil;;

/*******************************************************************************
  Clean WhiteBoard and send message to all clients to update
*******************************************************************************/
fun __EffacerCanvas() =
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  if f == nil then
    nil
  else
  (
    apply_on_list allCli @cbCleanAllCan nil;
    _FILLbitmap grafbuf Blanc;
  );
  0
;;

/*******************************************************************************
  Client Asking for Client List
*******************************************************************************/
fun __getListCli() =
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  if f == nil then
    nil
  else
  (
    apply_on_list allCli @cbRafraichiConnectes nil
  )
;;

/*******************************************************************************
  Client Asking for Undo Command
*******************************************************************************/
fun __Undo() =
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  if f == nil then
    nil
  else
  (
    let search_in_list allCli @cballclientByallclient DMSsender -> f in
      apply_on_list (remove_from_list allCli f) @cbUndoAll nil;
    _CPbitmap16 grafbuf 0 0 UndobufS 0 0 Largeur Hauteur nil;
    _BLTbitmap canvas UndobufS 0 0;
  );
  0 
;;

/*******************************************************************************
  Client Asking for Copy Bitmap (courant)
*******************************************************************************/
fun __UndoCopy() =
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  if f == nil then
    nil
  else
  (
    let search_in_list allCli @cballclientByallclient DMSsender -> f in
      apply_on_list (remove_from_list allCli f) @cbUndoCopyAll nil;
    _CPbitmap16 UndobufS 0 0 grafbuf 0 0 Largeur Hauteur nil;
  );
  0 
;;

/*******************************************************************************
   Decal + Color (for Picking)
    color     -> I : color to adjust
    color     <- I : color adjusted 
*******************************************************************************/
fun DecalColor_plus(C) =
  if C<0 then
  (
    set C = C + 255;
    C
  )
  else
    C
;;

/*******************************************************************************
   Decal - Color (for Picking)
    color     -> I : color to adjust
    color     <- I : color adjusted 
*******************************************************************************/
fun DecalColor_moins(C) =
  if C>255 then
  (
    set C = C - 255;
    C
  )
  else
    C
;;

/*******************************************************************************
   Adjust Color (for Picking) 
    color     -> I : color to adjust
    decal     -> I : decal 
              <- I : color adjusted 
*******************************************************************************/
fun AdjustColor(color, decal) = 

  let ((color&255) + decal ) -> B in
  let ((color>>8)&255 + decal ) -> G in
  let ((color>>16) + decal ) -> R in
  ( 
       
    if decal then
    (
      set G = DecalColor_moins G ;
      set R = DecalColor_moins R ;
      set B = DecalColor_moins B ;
      
      set color  = make_rgb B G R
      
    )
    else
    (
      set G = DecalColor_moins G;
      set R = DecalColor_moins R;
      set B = DecalColor_moins B;
    
      set color  = make_rgb B G R
    )
        
  )
;;

/*******************************************************************************
   Flood Fill at all 4 neighbors
    x         -> I : posX
    y         -> I : posY
    old       -> I : old color
    new       -> I : new color
              <- 
*******************************************************************************/
/*fun FloodFill4(x,y,Old,New) =
  if ((_GETpixel16 grafbuf x y) == Old) then
  (
    let (AdjustColor New (-5)) -> Color in
    _PUTpixel16 grafbuf x y Color;
         
    FloodFill4 x y+1 Old New;
    FloodFill4 x y-1 Old New;
    FloodFill4 x+1 y Old New;
    FloodFill4 x-1 y Old New;
    
    0
  )
  else 
    nil  
;;*/

/*******************************************************************************
  Client Asking for Color Filling
    posx       -> I         : PosX
    posy       -> I         : PosY
    color      -> I         : Color to fill 
               <-            
*******************************************************************************/
/*fun __FillColor(posx, posy, color) =
  
  apply_on_list (remove_from_list allCli DMSsender) @cbFillColorAll [posx posy color]; /* message for client to fill */
  _CPbitmap16 UndobufS 0 0 grafbuf 0 0 Largeur Hauteur nil;
  
  if (AdjustColor (_GETpixel16 grafbuf posx posy) (8) ) != color then
    FloodFill4 posx posy (_GETpixel16 grafbuf posx posy) color /* Filling for server */
  else 
    nil
;;*/
  
/*******************************************************************************
  Client Asking for Paste zone
    posx       -> I         : PosX
    posy       -> I         : PosY
    Wcopy      -> I         : W
    Hcopy      -> I         : H 
               <-            
*******************************************************************************/
fun __Paste (posx, posy, Wcopy, Hcopy) =
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  if f == nil then
    nil
  else
  (
    _CPbitmap16 UndobufS 0 0 grafbuf 0 0 Largeur Hauteur nil; /* Pour le Undo */
    _CPbitmap16 grafbuf posx posy CopybufS 0 0 Wcopy Hcopy nil;
    let search_in_list allCli @cballclientByallclient DMSsender -> f in
      apply_on_list (remove_from_list allCli f) @cbPasteAll [posx posy Wcopy Hcopy]
  );
  0
;;  

/*******************************************************************************
  Client Asking for Cut zone
    posx       -> I         : PosX
    posy       -> I         : PosY
    Wcopy      -> I         : W
    Hcopy      -> I         : H 
              <-             
*******************************************************************************/
fun __Cut (posx, posy, Wcopy, Hcopy) =
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  if f == nil then
    nil
  else
  (
    _CPbitmap16 CopybufS 0 0 grafbuf posx posy Wcopy Hcopy nil;
    let search_in_list allCli @cballclientByallclient DMSsender -> f in
      apply_on_list (remove_from_list allCli f) @cbCutAll [posx posy Wcopy Hcopy]
  );
  0
;;

/*******************************************************************************
   Upload Picture to server  (picture from client to server)
    cli        -> CLIENT    :
    param      -> S         : name of the File t upload
    contenu    -> S         : content of the picture
               <-           
*******************************************************************************/
fun JPEG_uploadS(cli, param, contenu) =
  let strextr param->[h _] in
  let atoi (nth_list h 0)->x in
  let atoi (nth_list h 1)->y in
  let strcatn "tmp/wb/NewJpeg"::(itoa JPEG_cpt)::".jpg"::nil->filejpeg in 
  (
    _RSunregister this filejpeg;
    _storepack contenu filejpeg;
    _RSunregister this filejpeg;
    _RSregister this filejpeg RSfile|RScontrol filejpeg;
      
      if cli!=nil then 
      (
        let search_in_list allCli @cballclientByallclient cli -> f in
          apply_on_list (remove_from_list allCli f) @cbJPEG_TransfertOthers [filejpeg x y]; /* envoie le message pour que les clients download la new image */
      
        let _LDjpeg _channel (_checkpack filejpeg)->BlocJpeg in  /*  copie l'image dans le buffer du server */ 
        let _GETbitmapSize BlocJpeg->[l h] in
        _CPbitmap16 grafbuf x y BlocJpeg 0 0 l h nil;
        _BLTbitmap canvas grafbuf 0 0;
        0
      ) 
      else 
        nil;
        
    set JPEG_cpt=JPEG_cpt+1;
    filejpeg; /* valeur de renvoie de la fonction */
  )
;;

/*******************************************************************************
   CallBack of reception of document (_DMSupload for clients)  
    cli        ->  CLIENT   : Client
    nom        ->  S        : name of the document
    contenu    ->  S        : the document (contenu)
               <-           
*******************************************************************************/
fun JPEG_uploadI(cli, nom, contenu) =
  JPEG_uploadS cli nom contenu;
  0
;;

/*******************************************************************************
  Client Asking for WhiteBoard server
*******************************************************************************/
fun __getPicture() =
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  if f == nil then
    nil
  else
  (
    if (grafbuf!=nil) then 
    ( 
      let (_getmodifypack "bufferSSS.jpg")->hd in 
      (
        _SAVEjpeg grafbuf hd 100;
        _DMSsend this DMSsender CJPEG_new  /*["" "name"  0 0];*/  ["" (JPEG_uploadS nil "" (_getpack _WtoP hd)) 0 0];
      )
    )
    else
      nil;
  );
  0
;;

/*******************************************************************************
  Client Asking for Undo Buffer server
*******************************************************************************/
fun __getUndoPicture()=
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  if f == nil then
    nil
  else
  (
    if (UndobufS!=nil) then 
    (
      let "UndoSERVER.jpg" -> name in
      let (_getmodifypack name)->hd in 
      (
        _SAVEjpeg UndobufS hd 100;
      
        let "tmp/wb/NewUndoJpeg" ->fileUndojpeg in 
        (
          _RSunregister this fileUndojpeg;
          _storepack (_getpack _WtoP hd) fileUndojpeg;
          _RSunregister this fileUndojpeg;
          _RSregister this fileUndojpeg RSfile|RScontrol fileUndojpeg;  
      
          _DMSsend this DMSsender CJPEG_new[name fileUndojpeg 0 0];
        )
      );
      0
    ) 
    else 
      nil
  );
  0
;;

/*******************************************************************************
  send to Client the WhiteBoard server
*******************************************************************************/
fun getPicture(cli) =
  if (grafbuf!=nil) then 
  ( 
    let (_getmodifypack "bufferSSS.jpg")->hd in 
    (
      _SAVEjpeg grafbuf hd 100;
      _DMSsend this cli CJPEG_new  /*["" "name"  0 0];*/  ["" (JPEG_uploadS nil "" (_getpack _WtoP hd)) 0 0];
    )
  )
  else
    nil;
  0
;;

/*******************************************************************************
  send to Client the Undo WhiteBoard server
*******************************************************************************/
fun getUndoPicture(cli)=
  if (UndobufS!=nil) then 
  (
    let "UndoSERVER.jpg" -> name in
    let (_getmodifypack name)->hd in 
    (
      _SAVEjpeg UndobufS hd 100;
    
      let "tmp/wb/NewUndoJpeg" ->fileUndojpeg in 
      (
        _RSunregister this fileUndojpeg;
        _storepack (_getpack _WtoP hd) fileUndojpeg;
        _RSunregister this fileUndojpeg;
        _RSregister this fileUndojpeg RSfile|RScontrol fileUndojpeg;  
      
        _DMSsend this cli CJPEG_new[name fileUndojpeg 0 0];
      )
    );
    0
  ) 
  else 
    nil;
  0
;;

/*******************************************************************************
   Retreive Client disconnect from Client List   
*******************************************************************************/
fun __ClientDeleted() =
  set cliListe = remove_client_in_list cliListe DMSsender;
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  (
    apply_on_list (remove_from_list allCli f) @cbRafraichiConnectes nil;
    let f -> [_ test] in
    if test == 1 then
      nil
    else
      set allCli = remove_from_list allCli f
  );
  0
;;

/*******************************************************************************
   Add Client from Client List when Hide -> Show whiteBoard  
*******************************************************************************/
fun __ClientAdd() =
  let search_in_list allCli @cballclientByallclient DMSsender -> f in
  if f == nil then
  (
    getPicture (DMSsender);
    getUndoPicture (DMSsender);
    let search_in_list allCli @cballclientByallclient DMSsender -> f in
      set allCli = [DMSsender 0]::(remove_from_list allCli f)
  )
  else
    nil;
  
  let _DMSgetLogin DMSsender -> cliName in
  let search_in_list cliListe @cbclientByclient DMSsender -> f in
    if f != nil then
      nil
    else
      set cliListe=[DMSsender cliName]::cliListe
  ;
  0
;;

/*******************************************************************************
   start the module     
    from       ->           :
    cli        -> CLIENT    :
    action     ->           :
    param      ->           :
    rep        ->           :
               <-          
*******************************************************************************/
fun cbStart (from, user, action, param, others, tag) =
  _DMScreateClientDMI this (UtoC user) nil;
  if CKregister == 0 then
    let UtoC user -> cli in
      let search_in_list allCli @cballclientByallclient cli -> f in
        set allCli = [cli 1]::(remove_from_list allCli f)
  else
    nil; 
  0
;;

/*******************************************************************************
   a client whant to be register 
    from       ->           :
    cli        -> CLIENT    :
    action     ->           :
    param      ->           :
    rep        ->           :
               <-          
*******************************************************************************/
fun cbRegister (from, user, action, param, others, tag) =
  if CKregister == 1 then
    let UtoC user -> cli in
      let search_in_list allCli @cballclientByallclient cli -> f in
      (
        if f == nil then
        (
          getPicture(cli); 
          getUndoPicture (cli)
        )
        else
          nil;
        
        set allCli = [cli 1]::(remove_from_list allCli f)
      )
  else
    nil; 
  0
;;

/*******************************************************************************
   a client whant to be unregister 
    from       ->           :
    cli        -> CLIENT    :
    action     ->           :
    param      ->           :
    rep        ->           :
               <-          
*******************************************************************************/
fun cbUnRegister (from, user, action, param, others, tag) =
  if CKregister == 1 then
    let UtoC user -> cli in
    (
      set cliListe = remove_client_in_list cliListe cli;
      let search_in_list allCli @cballclientByallclient cli -> f in
      (
        apply_on_list (remove_from_list allCli f) @cbRafraichiConnectes nil;
        set allCli = (remove_from_list allCli f)
      )
    )
  else
    nil; 
  0
;;

/*******************************************************************************
   Changement de login  
    from       ->           :
    cli        -> CLIENT    :
    action     ->           :
    param      ->           :
    rep        ->           :
               <-          
*******************************************************************************/
fun cbChgLogin (from, user, action, param, others, tag) =
  let UtoC user -> cli in
  let search_in_list cliListe @cbclientByclient cli -> f in
  if f == nil then
    nil
  else
  ( 
    mutate f <- [ _ (_DMSgetLogin cli)];
    let search_in_list allCli @cballclientByallclient DMSsender -> f in
      apply_on_list (remove_from_list allCli f) @cbRafraichiConnectes nil
  );
  0
;;

/*******************************************************************************
   Destructions des Instances Clientes            
    cli        -> CLIENT    : client to delete
               <-              
*******************************************************************************/
fun Client2Delete(cli) =

  set cliListe = remove_client_in_list cliListe cli;
  let search_in_list allCli @cballclientByallclient cli -> f in
    set allCli = remove_from_list allCli f;
  apply_on_list allCli @cbRafraichiConnectes nil;
  0
;;

/***********************************************************************************/
/*                            Initialisation du DMI                                */
/***********************************************************************************/
fun IniDMI(param)=
  
  set Largeur=0;
  set Hauteur=0;
  set grafbuf=nil;
  set Noir=0;
  
  set Rouge=make_rgb 255 0 0;
  set Vert=make_rgb 0 255 0;
  set Bleu=make_rgb 0 0 255;
  set Blanc=make_rgb 255 255 255;
  

  _DMScbUpload this @JPEG_uploadI; /* callback de réception de documents (fonction _DMSupload de l'Api client) */
  
  set modulePath = _DMSgetpath _DMSgetClass this; 
  
  let _DMSgetDef this "dmi" -> dataDef in
  let getInfo dataDef "CKregister" -> register in
    if !strcmp register "yes" then
      set CKregister = 1
    else
      set CKregister = 0;
  
  _DMSregister this nil @Client2Delete nil;  
  _DMSdefineActions this (["start" @cbStart])::
                         (["register" @cbRegister])::
                         (["unregister" @cbUnRegister]):: 
                         (["chgLogin" @cbChgLogin])::
                           nil
;;