/*******************************************************************************
 Module Pager3
 Client part
 Version: 1.0
 Authors: Bob Le Gob
 Code based on Pager2 v3.0 - Authors: Laurent PLUMAT, Marc BARILLEY, Christophe LOREK
 Last update: 02/02/2003
 Page Module
*******************************************************************************/

struct TClients =
[
  login : S,                              /* Login de l'utilisateur*/
  online : I,                             /* Statut du client Online/Offline (0 offline with message, 1 online, 2 online with message)*/
  startchat: I,                           /* marque que le chat a commencé */
  message : [[S I] r1],                   /* le smessages echangé entre les deux utilisateurs*/
  chatwindow : ObjWin,                    /* fenetre de chat pour cet uilisateur*/ 
  hwindow   : I,                          /* hauteur de la fenetre*/
  wwindow   : I,                          /* largeur de la fenetre*/
  chattxt : ObjRichText,                  /* texte de la fenetre de chat*/
  chatcmd : ObjText,                      /* linge de saisie*/ 
  showhistory : I                         /* 1 when history has been load.*/
]mkClients;;

struct TDatas = 
[
  Zx : I,
  Zy : I,
  Zw : I,
  Zh : I
]mkDatas;;

/***************/
/*communication*/
/***************/
defcom Spage = page S S;;                 /*envoi d'un message à quelqu'un [sender's login, message] */


/*******************/
/*globales variable*/
/*******************/
typeof BoxWin = ObjWin;;                  /*fenetre contenant le clignotant*/
typeof BoxBMP = ObjBitmap;;               /*image courante affiché */
typeof BoxW   = I;;                       /*largeur de la zone d'affichage*/
typeof BoxH   = I;;                       /*hauteur de la zone d'affichage */

typeof allClients = [TClients r1];;        /*listes des clients*/

/*pager*/
typeof contPager  = ObjContainer;;        /*container du pager*/
typeof listPager  = CompList;;            /*liste des utilisateurs*/

/*pictures*/
typeof NoMsgS             = S;;           /*path de l'image sans message */
typeof IncomingMsgS       = S;;           /*path de l'image avec message */
typeof IncomingMsgGoneS   = S;;           /*path de l'image avec message mais partie */
typeof BlinkUpS           = S;;           /*path de l'image Blink haut */
typeof BlinkDownS         = S;;           /*path de l'image Blink bas */
typeof NoMsgBMP           = AlphaBitmap;; /*bitmap sans message*/
typeof IncomingMsgBMP     = AlphaBitmap;; /*bitmap avec message*/
typeof IncomingMsgGoneBMP = AlphaBitmap;; /*bitmap avec message mais partie*/
typeof BlinkUpBMP         = ObjBitmap;;   /*bitmap Blink haut*/
typeof BlinkDownBMP       = ObjBitmap;;   /*bitmap Blink bas*/

/* slide bar*/
typeof topBMP             = AlphaBitmap;; /*image du haut de la slide bar*/
typeof downBMP            = AlphaBitmap;; /*image du bas de la slide bar*/
typeof middleBMP          = AlphaBitmap;; /*image du millieu de la slide bas*/
typeof liftBMP            = AlphaBitmap;; /*image de l'ascenseur de la slide bar*/

/*blink*/
typeof BlinkTimer = Timer;;               /*timer du blink*/
var    Blinkon = 0;;                      /*nombre de nouveau message avant arret du timer*/

/* history */
typeof histoWinList = ObjList;;           /* list des historique disponible pour ce pseudo */
typeof histoWin   = ObjWin;;              /*fenetre d'historique*/
typeof histoList  = [[S ObjWin]r1];;      /*liste des historiques avec leur fenetre*/
typeof KeepHistory = I;;                  /*1 si conservation de l'historique*/
var SaveHistory = 0;;                  /*user choice to keep or not history*/                   

typeof inZone = I;;
typeof aloneMessage = CompText;;
typeof ztaille = TDatas;;

/*path*/
typeof modulePath = S;;

/*prototype */
proto suppHistory = fun [S] I;;
proto cbcontResize = fun [ObjContainer u0 I I I] I;;
proto cbcontZoneResize = fun [[ObjWin I I I I] S] I;;

/***************************************************************************
  comparaison de deux chaine de caractère
    text1 -> S    : premier texte
    text2 -> S    : deuxième text
****************************************************************************/
fun cbtextBytext (text1, text2)=
  !strcmp text1 text2
;;

/*****************************************************************************
  transformation des liste en tuples 
    message -> [[I text] r1]  : liste de message stocké dans la structure
            <- [[S r1] r1] 
*****************************************************************************/
fun assemble (message)=
  if message == nil then
    nil
  else
    let hd message -> [color text] in
      [linebuild text atoi color]::assemble (tl message) 
;;

/******************************************************************************
  count the list size
    list -> [U0 r1]       : list to count
    init -> I             : Offset
*******************************************************************************/
fun ListCount (list, init) = 
  if list == nil then
    init
  else
    ListCount (tl list) (init + 1)
;;

/********************************************************************************
  trunc a list
    list -> [U0 r1]     : list to trunc
    param -> I          : Number of element to trunc
********************************************************************************/
fun TruncList (list, param) = 
  if (list == nil) || (param < 1) then
    list
  else
    TruncList (tl list) (param -1)
;;

/*****************************************************************************
  remplisasge de la liste des historiques
    nlogin -> S              : login a ajouter
    list -> [[S ObjWin] r1] : liste des historiques
*******************************************************************************/
fun insert (nlogin, list) =
  if list == nil then
    [nlogin nil]::list 
  else
    let (hd list) -> [login _ ] in  
      let strcmpi login nlogin -> r in
        if r > 0 then
          [nlogin nil]::list
        else
          (hd list)::(insert nlogin (tl list))
;;

/******************************************************************************
  remplissage de la liste des historiques
    nlogin -> [S ObjWin]  : un historique
    param -> paramater    : not used
******************************************************************************/
fun cbfillHistoList (nlogin, param)=
  set histoList = insert nlogin histoList
;;

/******************************************************************************
  recherche d'un login dans la liste d'historique
    param -> [S ObjWin]   : un historique
    rlogin -> S           : login a trouver
*******************************************************************************/
fun cbfindHisto (param, rlogin) = 
  let param -> [login _] in
    !strcmp login rlogin
;;

/********************************************************************************
  load the Alpha Bitmap
  name -> S     : name of the bitmap
  valuer -> I   : number of the variable
  fichier -> S  : nome of the file 
*********************************************************************************/
fun PNGdownload(param)=
  let param -> [valeur fichier] in
    if fichier == nil then
      nil
    else
    (
      let _LDalphaBitmap _channel _checkpack fichier -> tempalpha in
      (
        if tempalpha == nil then
           set tempalpha =  _CRalphaBitmap _channel _LDjpeg _channel (_checkpack fichier) nil nil nil  
        else
          nil;
      
        let _GETalphaBitmapSize tempalpha -> [w h] in
        let _GETalphaBitmapBackground  tempalpha -> backround in
        let _GETalphaBitmapTransparency tempalpha -> transparency in
        let _CRbitmap _channel 16 16 -> tempbmp in
        (
          _SCPalphaBitmap tempbmp 0 0 15 15 tempalpha 0 0 w-1 h-1 ;
          if valeur == 1 then
            set NoMsgBMP = _CRalphaBitmap _channel tempbmp nil backround transparency
          else
            if valeur == 2 then
              set IncomingMsgBMP = _CRalphaBitmap _channel tempbmp nil backround transparency
            else
              set IncomingMsgGoneBMP = _CRalphaBitmap _channel tempbmp nil backround transparency
        );
  
     );
     0
    )

;;

/********************************************************************************
  load the BMP or jpeg Bitmap
  name -> S                : name of the bitmap
  param -> [ObjBitmap S I] : variable to fill with the bitmap, name of the bitmap
*********************************************************************************/
fun BMPdownload(param)=
  if param == nil then
    nil
  else
    let param -> [obbmp fichier] in
    (
      set obbmp = _CRbitmap _channel BoxW BoxH;
      let _LDbitmap _channel _checkpack fichier -> bmp in
      (
        if bmp==nil then
          set bmp = _LDjpeg _channel _checkpack fichier
        else
          nil;
          
        let _GETbitmapSize bmp -> [bmpw bmph] in
        (
          _SCPbitmap obbmp 0 0 BoxW-1 BoxH-1 bmp 0 0 bmpw-1 bmph-1 nil;
          _DSbitmap bmp
        )
      )
    );
  0
;;

/****************************************************************************
  downloading all picture needed
    l : module parameter
*****************************************************************************/
fun getBitmaps(l)=
  
 set NoMsgS  = 
    let (getInfo l "NoMsgBMP") -> string in
      if string == nil then
        strcat modulePath "images/tree.nomsg.png"
      else
        string; 
  
  set IncomingMsgS = 
    let (getInfo l "IncomingMsgBMP") -> string in
      if string == nil then
        strcat modulePath "images/tree.incomingmsg.png"
      else
        string;
  
  set IncomingMsgGoneS = 
    let (getInfo l "IncomingMsgGoneBMP") -> string in
      if string == nil then
        strcat modulePath "images/tree.incomingmsg.gone.png"
      else
        string;
  
  set BlinkUpS = 
    let (getInfo l "BlinkUpBMP") -> string in
      if string == nil then
        strcat modulePath "images/blinkup.bmp"
      else
        string;
  
  set BlinkDownS = 
    let (getInfo l "BlinkDownBMP") -> string in
      if string == nil then
        strcat modulePath "images/blinkdown.bmp"
      else
        string; 
 
  set KeepHistory =
    if !strcmp (getInfo l "KeepHistory") "yes" then
      1
    else
      0;    

  /*telechargement des images*/
  PNGdownload [1 NoMsgS] ;
  PNGdownload [2 IncomingMsgS] ;
  PNGdownload [3 IncomingMsgGoneS] ;
  BMPdownload [BlinkUpBMP BlinkUpS] ;
  BMPdownload [BlinkDownBMP BlinkDownS]  ;
  
  0
;;

/***************************************************************************
  fontion transformant les tuples des messages en liste
    message -> [[S I] r1]   : message sous format de la structure
            <- [[S r1] r1]  : retour de tou en liste de string
****************************************************************************/
fun separe (message)=
  if message == nil then
    nil
  else
    let hd message -> [text color] in
      ((itoa color)::(substr text 0 ((strlen text)-1))::nil)::separe tl message 
;;

/*****************************************************************************
  fonction callback pour redimensionner la fenetre du texte de l'historique
    wn -> ObjWin      : fenetre d'historique
    list -> listTab   : liste des historique
    w h -> I I        : nouvelle dimension
*******************************************************************************/
fun cbResizeHistoTxt (wn, Txt, w, h) =
  _SIZErichText Txt w h 0 0
;;

/******************************************************************************
  fonction a executer à la destruction de la fenetre
    wn -> ObjWin          : fenetre qui vient d'être fermé
    chateur -> [S ObjWin] : historique de la fenetre
*******************************************************************************/
fun cbDestroyHistoWin (wn, chatteur) = 
  mutate chatteur <- [_ nil]
;;

/******************************************************************************
  search a login in the historyList
*******************************************************************************/
fun cbHistoryByLogin (histo, slogin) = 
  let histo -> [login _] in
    !strcmp login slogin
;;

/*********************************************************************************
  Add a text in the Objrichtext
    text -> [S I]       : texte to add and a color
    txt -> objrichetext : where to add the text
*********************************************************************************/
fun cbfilltext (text, txt)=
  let text -> [ntext color] in
    if color == 1 then
      _ADDtextRichText txt ntext "Arial" 8 (make_rgb 255 0 0) 0
    else
      if color == 2 then
        _ADDtextRichText txt ntext "Arial" 8 (make_rgb 0 0 255) 0
      else
        _ADDtextRichText txt ntext "Arial" 8 (make_rgb 0 155 0) 0;
  
  let ((_GETlineCountRichText txt) - 200) -> number in
    if number > 0 then
       _DELlineRichText txt 0
    else
      nil; 
       
  _SCROLLrichText txt 0 _GETlineCountRichText txt;
  _PAINTrichText  txt
;;

/******************************************************************************
  delete one of the history
    bt -> Button        : Delete history button
    list -> ObjList     : list of history 
*******************************************************************************/
fun cbDeleteHistory (bt, list) = 
  let _GETlist list -> [pos element] in
  (
    _DELlist list pos;
    
    if element == nil then
      nil
    else
      suppHistory element;
    0
  )      
;; 

/******************************************************************************
  clear all history
    bt -> Button        : Clear history button
    list -> ObjList     : list of history 
******************************************************************************/
fun cbClearHistory (bt, list) = 
  if histoList == nil then
  (
     _RSTlist list;
     0
  )
  else
  (
    let histoList -> [[login _ ] _] in
      suppHistory login;
    cbClearHistory bt list;
    0
  )
;;

/*****************************************************************************
  fonction callback pour redimensionner la fenetre d'historique
    wn -> ObjWin              : fenetre d'historique
    object -> [listTab button : liste des historique and delete button
    w h -> I I                : nouvelle dimension
*******************************************************************************/
fun cbResizeHisto (wn, object, w, h) =
  let object -> [list bt btAll] in
  (
    _SIZElist list w-10 h-30 5 5;
    _SIZEbutton bt (w-10)/2 20 5 h-22;
    _SIZEbutton btAll (w-10)/2 20 5+(w-10)/2 h-22;
  )
;;

/******************************************************************************
  fonction qui affiche un historique choisie
    wn -> ObjWin          : fenetre de choix de l'historique
    param -> paramater    : path
    pos -> I              : position dans la liste
    login -> S            : login de l'historique choisi
*******************************************************************************/
fun cbChooseHisto (wn, param, pos, login) = 
  let search_in_list histoList @cbfindHisto login -> f in
  if f == nil then
    nil
  else
    let f -> [_ win] in
      if win == nil then
      (
        set win = _CRwindow _channel nil 10 10 400 250 WN_MENU|WN_SIZEBOX|WN_DOWN login;
        mutate f <- [_ win];
        _CBwinDestroy win @cbDestroyHistoWin f;
        let _CRrichText _channel win 0 0 395 245 ET_VSCROLL|ET_AVSCROLL|ET_DOWN|ET_NOEDIT "" -> txt in
        (  
          _CBwinSize win @cbResizeHistoTxt txt;
          let _getlongname "" strcat param (substr (_getlongname login "" "#") 1 16) ";" -> signature in
          apply_on_list assemble strextr _getpack _checkpack signature @cbfilltext txt; 
          _PAINTrichText txt
        );  
        0
      )
      else
      (
        _SETfocus win;
        0
      )
;;

/******************************************************************************
  fonction detruisant la fenetre d'historique
  wn -> ObjWin        : fenetre d'historique
  param -> paramater  : not used
*******************************************************************************/
fun cbDestroyHisto (wn, param)=
  set histoWin = nil
;;

/******************************************************************************
  remplissage de la fenetre des historiques
    histo -> [S ObjWin]   : un historique
    list  -> ObjList      : liste des historiques
******************************************************************************/
fun cbfillHistoWin (histo, list) =
  let histo -> [login _] in  
    _ADDlist list 2000 login
;;

/******************************************************************************
  fonction callback affichant la liste des historiques 
  from   -> DMI       : not used
  user   -> User      : the user that run the action
  action -> S         : not used
  param  -> S         : not used
  others -> [User r1] : not used
  tag    -> Tag       : not used
        <- I         : nothing special
********************************************************************************/
fun cbHistorique (from, action, param, others, tag)= 
  let strcatn "tmp/pager/"::
              (substr (_getlongname strcatn DMSname::(_DMSgetName this)::DMSlogin::nil "" "#") 1 16)::
              "/"::
              nil
  -> fichier in
  if KeepHistory == 1 then
  (
    set histoList = nil;
    apply_on_list lineextr _getpack _checkpack strcat fichier (_getlongname "" "data.rep" ";") @cbfillHistoList nil;
    
    if histoWin == nil then
    (
      set histoWin = _CRwindow _channel nil 10 10 250 300 WN_MENU|WN_DOWN|WN_SIZEBOX (_loc this "TILTE-HISTO-LIST" nil);
      set histoWinList = _CRlist _channel histoWin 5 5 235 265 LB_DOWN;
      let _CBbutton _CRbutton _channel histoWin 5 275 117 20 0 (_loc this "DELETE" nil) @cbDeleteHistory histoWinList -> bt in
      let _CBbutton _CRbutton _channel histoWin 122 275 117 20 0 (_loc this "DELETE-ALL" nil)@cbClearHistory histoWinList -> btAll in
      _CBwinSize histoWin @cbResizeHisto [histoWinList bt btAll];
      _CBlistDclick histoWinList @cbChooseHisto fichier;                  
      apply_on_list histoList @cbfillHistoWin histoWinList;
      
      _CBwinDestroy histoWin @cbDestroyHisto nil;0 
    )   
    else
      nil;
      
  )
  else
    nil;
  0
;;

/*****************************************************************************
  delete file
    login -> S      : login to delete
*****************************************************************************/
fun suppHistory (login) =
  let strcatn "tmp/pager/"::
              (substr (_getlongname strcatn DMSname::(_DMSgetName this)::DMSlogin::nil "" "#") 1 16)::
              "/"::
              nil
  -> fichier in
  let lineextr _getpack _checkpack strcat fichier (_getlongname "" "data.rep" ";") -> list in
  (
    let search_in_list list @cbtextBytext login -> f in 
    (
      set list = remove_from_list list f;
      _storepack (linebuild list) (strcat fichier (_getlongname "" "data.rep" ";"))
    );
    
    /*(_deletepack _checkpack _getlongname "" strcat fichier (substr (_getlongname login "" "#") 1 16) ";");*/ 
    _storepack "" _getlongname "" strcat fichier (substr (_getlongname login "" "#") 1 16) ";" ; 
        
    let search_in_list histoList @cbHistoryByLogin login -> f in
      set histoList = remove_from_list histoList f;
    0 
  )
;;      

/****************************************************************************
  sauvegarde de l'historique
    login -> S            : login du client
    message -> [[S I] r1] : message à enregistrer dans le fichier d'historique
*****************************************************************************/
fun saveRep (login, message)=
  if (KeepHistory == 1) && (SaveHistory == 1) then
  (  
    
    /*troncage de l'historique*/
    set message = TruncList message ((ListCount message 0) - 200);
    
    /*ajout du login dans l'historique s'il n'y est pas*/
    let search_in_list histoList @cbfindHisto login -> f in
    if f == nil then
    (
      cbfillHistoList login nil;
      if histoWin == nil then
        nil
      else
      (
        _DSwindow histoWin;
        set histoWin = nil;
        cbHistorique nil nil nil nil nil
      );
      0
    )
    else
      nil;
    
    let nil -> liste in
    let strcatn "tmp/pager/"::
                (substr (_getlongname strcatn DMSname::(_DMSgetName this)::DMSlogin::nil "" "#") 1 16)::
                "/"::
                nil
               
    -> fichier in 
    let _checkpack strcat fichier (_getlongname "" "data.rep" ";")-> rep in 
    (
      if rep == nil then
        nil
      else
        set liste  = lineextr _getpack rep;
    
      let search_in_list liste @cbtextBytext login -> f in
      if f == nil then
        set liste = login::liste
      else
        nil;  
      
      _storepack linebuild liste strcat fichier (_getlongname "" "data.rep" ";");
      let 
        _getlongname "" strcat fichier (substr (_getlongname login "" "#") 1 16) ";" 
      -> signature in
        _storepack strbuild separe message signature
    )
  )
  else
    nil
;;

/*****************************************************************************
  fonction sauvegardant les historiques necessaire
    chatteur -> Client  : client a sauvagarder
    param -> parameter  : not used
******************************************************************************/
fun cbsaveHisto (chatteur, param)=
  if  (chatteur.message != nil) && 
      (strcmp (strlowercase (substr chatteur.login 0 5)) "guest") &&  
      (chatteur.startchat == 1)&&
      (chatteur.online < 3)
  then
  (  
    let (strcat (_loc this "3020-PAGERC-end" nil) (ctime time)) -> fin in
      set chatteur.message = listcat chatteur.message [fin 1]::nil;
    set chatteur.startchat = 0;
    saveRep chatteur.login chatteur.message
  )
  else
    nil
;;

/********************************************************************************
  turn off or on the histor saving
    menuitem -> ObjMenuItem   : option menu
    chatteur -> TClients      : user 
*********************************************************************************/
fun cbSaveHistory (menuitem, chatteur) =
  let strcatn "tmp/pager/"::
      (substr (_getlongname strcatn DMSname::(_DMSgetName this)::DMSlogin::nil "" "#") 1 16)::
      "/"::
      nil 
  -> fichier in
  if SaveHistory == 0 then
  (
    cbfilltext [(strcat (_loc this "SAVE_HISTORY_ON" nil) "\n") 1] chatteur.chattxt;
    _storepack "1" (strcat fichier (_getlongname "" "save.dat" ";"))
  )
  else
  (
    cbfilltext [(strcat (_loc this "SAVE_HISTORY_OFF" nil) "\n") 1] chatteur.chattxt;
    _storepack "0" (strcat fichier (_getlongname "" "save.dat" ";"))
  );
     
  set SaveHistory = SaveHistory ^ 1
;;

/*******************************************************************************
  add history in the chatwindow
    menuitem -> ObjMenuItem   : option menu
    chatteur -> TClients  : user 
********************************************************************************/
fun cbAddHistory (menuitem, chatteur) =
  if (KeepHistory==1) then
  (
    if chatteur.showhistory == 1 then
    (
      if chatteur.online == 0 then
        0
      else
      (
        cbfilltext [(strcat (_loc this "HISTO-READY" nil) "\n") 1] chatteur.chattxt;
        0
      )
    )
    else
    (
      let strcatn "tmp/pager/"::
        (substr (_getlongname strcatn DMSname::(_DMSgetName this)::DMSlogin::nil "" "#") 1 16)::
        "/"::
        nil 
      -> fichier in
        let search_in_list lineextr _getpack _checkpack strcat fichier (_getlongname "" "data.rep" ";") @cbtextBytext chatteur.login -> fh in
      
        if fh == nil then
        (
          if chatteur.message == nil then
            cbfilltext [(strcat (_loc this "NOHISTORY" nil) "\n") 1] chatteur.chattxt
          else
            if chatteur.online == 0 then
              nil
            else
              cbfilltext [(strcat (_loc this "HISTO-READY" nil) "\n") 1] chatteur.chattxt;
            
          0
        )
        else
        (
          let _getlongname "" strcat fichier (substr (_getlongname chatteur.login "" "#") 1 16) ";" -> signature in
          set chatteur.message = listcat (assemble strextr _getpack _checkpack signature) chatteur.message;
          if chatteur.chatwindow == nil then
            nil
          else
          (
            let  _GETrichTextPositionSize chatteur.chattxt -> [ _ _ w h] in
            (
              _DSrichText chatteur.chattxt;
              set chatteur.chattxt = _CRrichText _channel chatteur.chatwindow 0 0 w (h-1) ET_VSCROLL|ET_AVSCROLL|ET_DOWN|ET_NOEDIT ""
            );
            set chatteur.showhistory = 1;
            if chatteur.online == 0 then
              0
            else
            (
              apply_on_list chatteur.message @cbfilltext chatteur.chattxt;
              0
            )
          );
        
          0
        );
      0
    ) 
  )
  else
    nil
;;
 
/******************************************************************************
  function call to redraw the blink
    win -> winobj       : blink window
    param -> parameter  : not used
*******************************************************************************/
fun cbpaintBlinkBox(win, param)=
  if BoxWin == nil then
    nil
  else
    _BLTbitmap BoxWin BoxBMP 0 0
;;

/******************************************************************************
  resizing the blink window
    coord -> [ObjWin I I I I] : Blink window and new size 
    zone -> S                 : name of the blink zone
********************************************************************************/
fun cbResizeBox(coord, zone) = 
  let coord -> [wn x y w h] in
    let BoxBMP == BlinkUpBMP -> UpDown in
    (
      _DSbitmap BlinkUpBMP;
      _DSbitmap BlinkDownBMP;

      _SIZEwindow BoxWin w h x y;   
      set BoxW = w;
      set BoxH = h;
     
      set BlinkUpBMP = _CRbitmap _channel w h;
      set BlinkDownBMP = _CRbitmap _channel w h;

      let _LDbitmap _channel _checkpack BlinkUpS -> bmp in
      (
        if bmp==nil then
          set bmp = _LDjpeg _channel _checkpack BlinkUpS
        else
          nil;
        let _GETbitmapSize bmp -> [bmpw bmph] in
        (
          _SCPbitmap BlinkUpBMP 0 0 w-1 h-1 bmp 0 0 bmpw-1 bmph-1 nil;
          _DSbitmap bmp
        )
      );
      
      let _LDbitmap _channel _checkpack BlinkDownS -> bmp in
      (
        if bmp==nil then
          set bmp = _LDjpeg _channel _checkpack BlinkDownS 
        else
          nil;
        
        let _GETbitmapSize bmp -> [bmpw bmph] in
        (
          _SCPbitmap BlinkDownBMP 0 0 w-1 h-1 bmp 0 0 bmpw-1 bmph-1 nil;
          _DSbitmap bmp
        )
    ); 
  
    if UpDown then 
    (
      set BoxBMP = BlinkUpBMP;
      cbpaintBlinkBox nil nil   
    )
    else
    (
      set BoxBMP = BlinkDownBMP;
      cbpaintBlinkBox nil nil   
    );
  );
  0
;;

/********************************************************************************
  loking for a client by its login
    x -> TClients   : one client of the list
    login2 -> S     : The login we looking for
*********************************************************************************/
fun cbloginBylogin (x, login2)=
  !strcmp x.login login2
;;

/*********************************************************************************
  use to blink the box
    timer -> timer      : control timer
    param -> parameters : not used
**********************************************************************************/
fun cbBlinkBox(timer,param)= 
  set BoxBMP =  if BoxBMP == BlinkUpBMP then
                  BlinkDownBMP
                else
                  BlinkUpBMP;
  
  if BoxWin == nil then
    nil
  else
    (_BLTbitmap BoxWin BoxBMP 0 0;_PAINTwindow BoxWin;);
  0
;;

/*******************************************************************************
  receive a message
    from -> S      : login of the sender
    text -> S      : message
********************************************************************************/
fun __page (from, text)=
  let search_in_list allClients @cbloginBylogin from -> f in
  if f == nil then
    nil
  else
    if f.online > 2 then
      nil
    else
    (
      let (strcatn "<"::from::"> "::text::"\n"::nil) -> ntext in
      (
        if f.startchat == 0 then
        (
          let strcat (_loc this "3010-PAGERC-begin" nil) (ctime time) -> debut in
          (
            set f.message = listcat f.message [debut 1]::nil;
            set f.startchat = 1;
            if f.chatwindow == nil then
              nil
            else
              cbfilltext [debut 1] f.chattxt
          ) 
        )
        else
          nil;
      
        set f.message = listcat f.message [ntext 3]::nil; 
        if f.chatwindow == nil then
        (
          if f.online == 2 then
            nil
          else
            set Blinkon = Blinkon + 1;
            
          _SSETcompListValue listPager f.login [f.login IncomingMsgBMP];
          _PAINTcontainer (contPager);
          if (Blinkon == 1)&&(f.online != 2) then
            set BlinkTimer = _rfltimer _starttimer _channel 250 @cbBlinkBox 0
          else
            nil;
          set f.online = 2;
    
          0
        )
        else
        (     
          cbfilltext [ntext 3] f.chattxt;
          0
        );
              
        _DMSevent this "incomingMsg" nil nil
      )
    ) 
;;

/*******************************************************************************
  fill the complist whith login
    nclient -> TClients        :client to add
    param -> paramtre         : not used
********************************************************************************/
fun cbfillCompList(nclient, param)=
  if (nclient.online == 1)||(nclient.online == 3) then 
    _ADDcompList listPager 10000 [nclient.login NoMsgBMP]
  else
    _ADDcompList listPager 10000 [nclient.login IncomingMsgBMP] 
;;

/********************************************************************************
  call when a chatwindow was destroy
    window -> winobj       : chatwindow
    chatteur -> TClients   : the Client of the chatwindow 
*********************************************************************************/
fun cbdestroyChat (window, chatteur)=
  set chatteur.chatwindow = nil;
  if chatteur.online == 0 then
  ( 
    _SDELcompList listPager chatteur.login;
    
    cbAddHistory nil chatteur;
    cbsaveHisto chatteur nil;
    
    set allClients = remove_from_list allClients chatteur;
    
    if allClients == nil then
    if inZone == 1 then
      cbcontZoneResize [nil ztaille.Zx ztaille.Zy ztaille.Zw ztaille.Zh] nil
    else
      cbcontResize nil nil nil ztaille.Zw ztaille.Zh
    else
      nil;
    _PAINTcontainer (contPager);
    0
  )
  else
    nil
;;    

/*********************************************************************************
  callback resize chatwindow
    window -> winobj                        : chatwindow
    object -> [ObjText TClients optbutton]  : the Client of the chatwindow 
    w h -> I                                : new size
*********************************************************************************/
fun cbresizeChat(window, object, w, h)=
  let object -> [cmd chatteur optbutton] in
  (
    _SIZEtext cmd (w-20) 20 0 h-30;
    _SIZErichText chatteur.chattxt w h-30 0 0;
    _SIZEbutton optbutton 20 20 (w-20) (h-30);
    _PAINTrichText chatteur.chattxt; 
    
    if (w<chatteur.wwindow) || (h<chatteur.hwindow) then
    (
      set chatteur.wwindow = w; 
      set chatteur.hwindow = h;
      let _GETwindowPositionSize window -> [x y _ _] in
        _SIZEwindow window (w + 2) (h + 2) x y   
    )
    else
      nil;
    
    set chatteur.wwindow = w; 
    set chatteur.hwindow = h;
        
    0
  )
;;

/*********************************************************************************
  callback paint chatwindow    
*********************************************************************************/
fun cbPaintChat(win, chatteur) =  
  _PAINTrichText chatteur.chattxt; 
  0
;;

/*********************************************************************************
  send à message to an other user
    cmd -> objtext                    : Objtext where the text was entry
    chatteur -> TClients              : the Client of the chatwindow 
    text -> S                         : text to send
*********************************************************************************/
fun cbcmdChat(cmd, chatteur, text)=
  let (strlen text) -> taille in
  if taille > 1024 then
    (_DLGMessageBox _channel nil (_loc this "LIMIT_TITLE" nil) (_loc this "LIMIT_BODY" nil) 0;0)
  else
  (  
  
    let (strcatn "<"::DMSlogin::"> "::text::"\n"::nil) -> ntext in
    (
      if chatteur.startchat == 0 then
      (
        let (strcat (_loc this "3010-PAGERC-begin" nil) (ctime time)) -> debut in
        (
          set chatteur.message = listcat chatteur.message [debut 1]::nil; 
          cbfilltext [debut 1] chatteur.chattxt
        );
        set chatteur.startchat = 1
      )
      else
        nil;
  
      set chatteur.message = listcat chatteur.message [ntext 2]::nil;
      cbfilltext [ntext 2] chatteur.chattxt;   
      _SETtext cmd "";
      _DMSsend this Spage [chatteur.login text]
    );
  
    /*troncage de l'historique*/
    set chatteur.message = TruncList chatteur.message ((ListCount chatteur.message 0) - 200);
    0
  )
;;

/******************************************************************************
  callback to hide the user list
  from   -> DMI       : not used
  user   -> User      : the user that run the action
  action -> S         : not used
  param  -> S         : not used
  others -> [User r1] : not used
  tag    -> Tag       : not used
        <- I          : nothing special
********************************************************************************/
fun cbHide (from, action, param, others, tag)=
  _DScompList listPager;
  set listPager = nil;
  _DScontainer contPager;
  set contPager = nil;
  _DMSreleaseZone this "pager";
  _DMSevent this "hidden" nil nil
;;

/********************************************************************************
  callback for destroy the user list
    container -> objcontainer   : The container with user list
    param -> paramaters         : not used
*********************************************************************************/
fun cbContpreDestroy (container, param)=
  cbHide nil nil nil nil nil
;;

/********************************************************************************
  call back for show popopmenu
    bt -> Button          : option button
    chatteur -> TClients  : user 
*********************************************************************************/
fun cbOption (bt, chatteur) =
  let _GETwindowPositionSize chatteur.chatwindow -> [x y w h] in
  let _CRpopupMenu _channel -> optionMenu in
  (
    _CBmenu _APPitem _channel optionMenu ME_ENABLED (_loc this "ADD_HISTORY" nil) @cbAddHistory chatteur;
        
    let _APPitem _channel optionMenu ME_ENABLED (_loc this "CHK_SAVE_HISTORY" nil) -> Msavehistory in      
    ( 
      _CBmenu  Msavehistory @cbSaveHistory chatteur; 
      _CHKmenu Msavehistory SaveHistory
    );  

    _DRAWmenu chatteur.chatwindow optionMenu w h PM_RIGHT_ALIGN+PM_BOTTOM_ALIGN
  )
;;

/********************************************************************************
  callback when you choose someone to talk
    list -> complist        : list of user
    param -> S              : login
    place ->  I             : place of t
    he user choose
*********************************************************************************/
fun cbChooseList (list, param, place)=
  let 
    if place == nil then
      param
    else
    (
      let _GETcompListValue list place -> [temp _] in  
        temp
    )
  -> login2 in 
    
    let search_in_list allClients @cbloginBylogin login2 -> f in
      if f == nil then
        nil
      else
      (
        if f.chatwindow == nil then
        (
          set f.chatwindow = _CRwindow   _channel 
                                         nil  
                                         60  60 400 250 
                                         WN_NORMAL 
                                         strcatn (_loc this "WIN-TITLE" nil)::" "::login2::" "::
                                                 if f.online == 0 then
                                                   (_loc this "OFFLINE" nil)::nil
                                                 else
                                                   nil;        
          set f.wwindow = 400;
          set f.hwindow = 250;
          
          set f.chattxt =  _CRrichText _channel 
                                       f.chatwindow 
                                       0 0 400 220 
                                       ET_VSCROLL|ET_AVSCROLL|ET_DOWN|ET_NOEDIT 
                                       "";
          
                               
          let _CReditLine _channel f.chatwindow 0 220 380 20 ET_DOWN|ET_AHSCROLL "" -> cmd in
          (
            apply_on_list f.message @cbfilltext f.chattxt;
            _PAINTrichText  f.chattxt;
            if f.online == 0 then
            (
              _ENtext cmd 0;   
              cbfilltext [strcatn (_loc this "USER" nil)::" "::f.login::" "::(_loc this "ISOFFLINE" nil)::nil 1] f.chattxt
            )
            else
              nil;
            _CBwinDestroy f.chatwindow @cbdestroyChat f;
            let _CBbutton 
                  _CRbuttonBitmap 
                    _channel 
                    f.chatwindow 
                    _LDbitmap _channel _checkpack strcat modulePath "images/option.bmp"
                    380 220 20 20 0
                  @cbOption f
            -> optbutton in
            _CBwinSize f.chatwindow @cbresizeChat [cmd f optbutton];
            _CBwinPaint f.chatwindow @cbPaintChat f;
            _CBlineOk cmd @cbcmdChat f;
            _SETtextFocus cmd;
            set f.chatcmd = cmd;
          );
          
          if (f.online ==2) || (f.online ==0) || (f.online ==4) then
          (
            if f.online > 1 then
              set f.online = f.online -1
            else
              nil;
            set Blinkon = Blinkon -1;
            if Blinkon == 0 then
            (
              _deltimer BlinkTimer;
              set BoxBMP = BlinkUpBMP;
              _BLTbitmap BoxWin BoxBMP 0 0;
              _PAINTwindow BoxWin
            )
            else
              nil
          )
          else
            nil; 
          
          _SSETcompListValue listPager f.login [f.login NoMsgBMP];
                    
          _PAINTcontainer (contPager);
          
          0
        )
        
        else
        (
          _SETfocus f.chatwindow;
          0
        );
        
        _DMSevent this "select" f.login nil;
        _PAINTrichText  f.chattxt;
        0
      )  
;;

/*****************************************************************************
  open a chat window on a server order
    login -> S    : login of the chat window
******************************************************************************/
fun __SendMessage (login) =
  cbChooseList listPager login nil
;;

/******************************************************************************
  resize list of user 
    obcont -> ObjContainer    : container with the user list
    param -> parameter        : not used
    state -> I                : state of the container
    w h -> I I                : new size
*******************************************************************************/
fun cbcontResize (obcont, param, state, w, h)=
  set ztaille.Zw = w; 
  set ztaille.Zh = h;
  
  set h = h +2;
  _DScompList listPager;
  _DScompText aloneMessage;
  
  if allClients == nil then 
  (
    set aloneMessage = _CRcompText _channel contPager nil [0 0] CT_CENTER|CT_LABEL 0 w h (_loc this "NO_ONE" nil) 
                                      (_CRfont _channel 14 0 0 "Arial") [0 0 0 0] [0 0] nil nil;
    0
  )
  else
    let _CRbitmap _channel 64 (h+25) -> temp in
    (
      _CPalphaBitmap temp 0 0 topBMP 0 0 64 18;
      _CPalphaBitmap temp 0 h-20 downBMP 0 0 64 17;
      let 18 -> i in
      while (i<h-20) do
            (
              _CPalphaBitmap temp 0 i middleBMP 0 0 64 2;
              set i=i+2
            );
      _CPalphaBitmap temp 0 h liftBMP 0 0 64 25;
      let _CRalphaBitmap _channel temp nil nil nil -> vlift in
  
      set listPager = _CRcompList _channel 
                                  contPager nil [0 0]
                                  OBJ_ENABLE|OBJ_VISIBLE|LST_HIGHLIGHT_CLICKED|LST_LEFT 
                                  OBJ_CONTAINER_DBLCLICK 
                                  w-25 h (h/16) 
                                  LST_VERTICAL
                                  (_CRfont _channel 16 0 0 "Arial") 20 [0 0 0 0] 
                                  [0 50]
                                  [[w-16 0] OBJ_MW_FLEX|OBJ_MH_FLEX|OBJ_RH_FLEX|OBJ_LH_FLEX vlift [17 h-20 h]];
      0
    );
  _CBcompListDblClick listPager @cbChooseList nil;
  
  apply_on_list allClients @cbfillCompList nil;
  _PAINTcontainer contPager;
  0
;;

/******************************************************************************
  resize list of user 
    obcont -> ObjContainer    : container with the user list
    param -> parameter        : not used
    state -> I                : state of the container
    w h -> I I                : new size
*******************************************************************************/
fun cbcontZoneResize (param, zone)=
  let param -> [wn x y w h] in
  (
    set ztaille.Zx = x;
    set ztaille.Zy = y;
    set ztaille.Zw = w; 
    set ztaille.Zh = h;
    
    set w = w -4;
    
    _SIZEcontainer contPager x y w (h-4);
    set h = h -2;
    
    _DScompList listPager;
    _DScompText aloneMessage;
    
    if allClients == nil then
    (
      set aloneMessage = _CRcompText _channel contPager nil [0 0] CT_CENTER|CT_LABEL 0 w h (_loc this "NO_ONE" nil)
                                      (_CRfont _channel 16 0 0 "Arial") [0 0 0 0] [0 0] nil nil;
      0
    )
    else    
      let _CRbitmap _channel 64 (h+25) -> temp in
      (
        _CPalphaBitmap temp 0 0 topBMP 0 0 64 18;
        _CPalphaBitmap temp 0 h-20 downBMP 0 0 64 17;
        let 18 -> i in
        while (i<h-20) do
              (
                _CPalphaBitmap temp 0 i middleBMP 0 0 64 2;
                set i=i+2
              );
        _CPalphaBitmap temp 0 h liftBMP 0 0 64 25;
        let _CRalphaBitmap _channel temp nil nil nil -> vlift in
    
        set listPager = _CRcompList _channel 
                                    contPager nil [0 0]
                                    OBJ_ENABLE|OBJ_VISIBLE|LST_HIGHLIGHT_CLICKED|LST_LEFT 
                                    OBJ_CONTAINER_DBLCLICK 
                                    w-25 h (h/16) 
                                    LST_VERTICAL
                                    (_CRfont _channel 14 0 0 "Arial") 20 [0 0 0 0] 
                                    [0 50]
                                    [[w-16 0] OBJ_MW_FLEX|OBJ_MH_FLEX|OBJ_RH_FLEX|OBJ_LH_FLEX vlift [17 h-20 h]];
        _CBcompListDblClick listPager @cbChooseList nil;
        apply_on_list allClients @cbfillCompList nil;
        0
      )
  );
  _PAINTcontainer contPager;
  0
;;

/*******************************************************************************
  This fonction is called if the module try to use an alredy used zone
  zone -> S : zone name
       <- I : always 0
*******************************************************************************/
fun cbDestroyZone (zone) =
  _DScontainer contPager;
  set contPager = nil;
  _DMSreleaseZone this zone;
  0
;;

/******************************************************************************
  callback for show the list of the users
  from   -> DMI       : not used
  user   -> User      : the user that run the action
  action -> S         : not used
  param  -> S         : not used
  others -> [User r1] : not used
  tag    -> Tag       : not used
        <- I         : nothing special
********************************************************************************/
fun cbShow (from, action, param, others, tag)=
  if contPager != nil then
  (
    _SETfocusContainer contPager; 
    0
  )
  else
  (
    let _DMSgetZone this "pager" @cbDestroyZone @cbcontZoneResize @cbDestroyZone ->[wn x y w h] in
    (
      if wn==nil then
      let 150 -> wdef in
      let 300 -> hdef in
      (
        set contPager = _CRcontainerFromObjWin _channel 
                                               nil 
                                               nil nil wdef hdef
                                               CO_MENU|CO_3DBORDER|CO_SIZEBOX 
                                               (make_rgb 255 255 255) 
                                               "pager";
                                               
        _CBcontainerPreDestroy contPager @cbContpreDestroy nil;
        _CBcontainerSize contPager @cbcontResize nil;
        set w = wdef; 
        set h = hdef;
        cbcontResize contPager nil nil (w-4) (h-4);
        set inZone = 0
      )
      else
      (
        set contPager = _CRcontainerFromObjWin _channel 
                                               wn 
                                               x y w h 
                                               CO_CHILDINSIDE|CO_3DBORDER 
                                               (make_rgb 255 255 255) 
                                               "pager";
        
        cbcontZoneResize [nil x y w h] nil;
        set inZone = 1
      );
      
    );
    _DMSevent this "shown" nil nil;
    0
  )       
;;

/*****************************************************************************
  function call with a click on the blink
    win -> winobj     : window if the blink
    param -> paramater: not used
    x et y -> I       : click position
    b -> I            : Button bushed
******************************************************************************/
fun cbBoxWinClick(win, param, x, y, b)=
  cbShow nil nil nil nil nil;
  _DMSevent this "boxClick" nil nil
;;

/*****************************************************************************
  give the place of the client in the list
    login2 -> S             : new login
    place -> I              : place in the list
    liste -> [TClients r1]  : list of users
          <- I              : place the new login must have
******************************************************************************/
fun order(login2,place, liste)=
  if liste == nil then 
    place
  else
    let hd liste -> comp in
      let comp.login -> nlogin in
        let strcmpi nlogin login2 -> r in
          if r>0 then
            place
          else
            order login2 (place +1) (tl liste) 
;;

/*******************************************************************************
  add a login at the good place in the list
    nclient -> TClients     : new client
    liste -> [CLients r1]   : list of clients
    place -> I              : place of the new client in the list
    number -> I             : current place
********************************************************************************/
fun addlogin(nclient, liste, place,number)=
  if place == number then
    nclient::liste
  else
    (hd liste)::addlogin nclient (tl liste) place (number+1) 
;; 

/*****************************************************************************
  fonction de rempllissage de la liste utilisateur
    login -> S    : login utilisateur à ajouter à la liste
    
******************************************************************************/
fun __addUser(login) =
  let search_in_list allClients @cbloginBylogin login -> f in
  
  if f == nil then
  (  
    let nil -> message in 
    let order login 0 allClients -> place in
    (  
      set allClients = addlogin (mkClients [login 1 0 message nil 0 0 nil nil 0]) allClients place 0;
    
      if contPager == nil then
        nil
      else
      (
        if (nth_list allClients 1) == nil then
          if inZone == 1 then
            cbcontZoneResize [nil ztaille.Zx ztaille.Zy ztaille.Zw ztaille.Zh] nil
          else
            cbcontResize nil nil nil ztaille.Zw ztaille.Zh
        else
        (
          _ADDcompList listPager place [login NoMsgBMP];
          0
        );       
        
        _PAINTcontainer (contPager)
      )
    
    );
    0
  )
  else
  (
    set f.online = 2; 
    _SSETcompListValue listPager login [login IncomingMsgBMP];
    _PAINTcontainer (contPager);
    0
  );
  
  0
;; 

/*****************************************************************************
  Un client vient de changer de login
    ologin -> S     : ancien login
    nlogin -> S     : nouveau login
******************************************************************************/
fun __changeLogin (ologin, nlogin) =
  let search_in_list allClients @cbloginBylogin ologin -> f in
    if f == nil then
      nil
    else
    (
      set allClients = remove_from_list allClients f;
      if contPager == nil then
        nil
      else
      (
        _SDELcompList listPager ologin;
        
        if allClients == nil then
          if inZone == 1 then
            cbcontZoneResize [nil ztaille.Zx ztaille.Zy ztaille.Zw ztaille.Zh] nil
          else
            cbcontResize nil nil nil ztaille.Zw ztaille.Zh
        else
          nil;
        
        _PAINTcontainer (contPager)
      );
      
      set f.login = nlogin;
      set f.showhistory = 0;
        
       /* verification que le login n'existe pas encore (deconnexion reconnexion) */
      let search_in_list allClients @cbloginBylogin nlogin -> fu in
      if fu == nil then
        let order nlogin 0 allClients -> place in
        (
          set allClients = addlogin f allClients place 0;
      
          if contPager == nil then
            nil
          else
          (
            /* Bug correction from Pager2 - Bob Le Gob Feb. 2003 */
            if ((sizelist allClients) == 1) then
            (
              if inZone == 1 then
                cbcontZoneResize [nil ztaille.Zx ztaille.Zy ztaille.Zw ztaille.Zh] nil
              else
                cbcontResize nil nil nil ztaille.Zw ztaille.Zh;
              _SDELcompList listPager nlogin;
              0;
            )
            else
              0;
            /* End of correction - Bob Le Gob Feb. 2003 */
            _ADDcompList listPager place [nlogin if (f.online == 1)||(f.online == 3) then NoMsgBMP else IncomingMsgBMP];
            _PAINTcontainer (contPager)
          )
        )
      else
      (
        set fu.online = 2;
        _SSETcompListValue listPager fu.login [fu.login if (fu.online == 1)||(fu.online == 3) then NoMsgBMP else IncomingMsgBMP];
        _PAINTcontainer (contPager)
      );
      
      if f.chatwindow == nil then
        nil
      else
        _SETwindowName f.chatwindow (strcatn (_loc this "WIN-TITLE" nil)::" "::f.login::nil);
     
      0  
    );
    
    /*chargement de l'option de sauvegarde*/
    let strcatn "tmp/pager/"::
      (substr (_getlongname strcatn DMSname::(_DMSgetName this)::DMSlogin::nil "" "#") 1 16)::
      "/"::
      nil 
    -> fichier in
      let _getpack _checkpack (strcat fichier (_getlongname "" "save.dat" ";")) -> test in
        if !strcmp test "1" then
          set SaveHistory = 1
        else
          set SaveHistory = 0;
  0;; 

/*****************************************************************************
  fonction déclancher avant la fermeture du module
******************************************************************************/
fun cbBeforeClose () =
  apply_on_list allClients @cbsaveHisto nil;
  if contPager == nil then
    nil
  else
    cbHide nil nil nil nil nil
;;

/*****************************************************************************
  Un client vient de ce deconnecter
    login -> S    : login utilisateur à supprimer de la liste
******************************************************************************/
fun __delUser(login) =
  let search_in_list allClients @cbloginBylogin login -> f in
    if f == nil then
      nil
    else
    (
      let (strcat (_loc this "3020-PAGERC-end" nil) (ctime time)) -> fin in
      (
        if f.chatwindow == nil then
          nil
        else
        (
          _SETwindowName f.chatwindow strcatn (_loc this "WIN-TITLE" nil)::" "::login::" "::(_loc this "OFFLINE" nil)::nil;
          cbfilltext [fin 1] f.chattxt;
          cbfilltext [strcatn (_loc this "USER" nil)::" "::login::" "::(_loc this "ISOFFLINE" nil)::nil 1] f.chattxt;
          0
        )
      );
      
      if contPager == nil then
        if (f.online == 1)||(f.online == 3) then
        (
          set allClients = remove_from_list allClients f;
          0
        )
        else
        (
          set f.online = 0;
          0
        )
      else
        if ((f.online == 1)||(f.online == 3)) && (f.chatwindow == nil) then
        (
          cbAddHistory nil f;
          cbsaveHisto f nil;
          _SDELcompList listPager login;
          set allClients = remove_from_list allClients f;
          if allClients == nil then
          if inZone == 1 then
            cbcontZoneResize [nil ztaille.Zx ztaille.Zy ztaille.Zw ztaille.Zh] nil
          else
            cbcontResize nil nil nil ztaille.Zw ztaille.Zh
          else
            nil;
          
          _PAINTcontainer (contPager);
          0
        )
        else
        (
          set f.online = 0;
          _ENtext f.chatcmd 0; 
          _SSETcompListValue listPager login [login IncomingMsgGoneBMP];
          
          _PAINTcontainer (contPager);
          0
        );
     
      0
    );
  
  0
;; 

/******************************************************************************
  ignore un client
  from   -> DMI       : not used
  user   -> User      : the user that run the action
  action -> S         : not used
  param  -> S         : user to ignore
  others -> [User r1] : not used
  tag    -> Tag       : not used
        <- I         : nothing special
*******************************************************************************/    
fun cbIgnoreFlag (from, action, param, others, tag) =
  let (lineextr param) -> list in
  if !strcmpi (hd list) "pager" then
    let search_in_list allClients @cbloginBylogin (hd (tl (tl list))) -> f in
      if (atoi (hd (tl (tl (tl list))))) then
      (
        set f.online = f.online + 2
      )
      else
      (
        set f.online = f.online - 2;
      )
  else
    nil;
  _PAINTcontainer (contPager);
  0  
;;

/******************************************************************************
  fonction d'initailaisation du client
  
******************************************************************************/
fun IniDMI (parameter) =

  set modulePath = _DMSgetpath _DMSgetClass this;

  _DMSdefineActions this (["show" @cbShow])::
                         (["hide" @cbHide])::
                         (["IgnoreFlag" @cbIgnoreFlag])::
                         (["show.history" @cbHistorique])::nil;
               
                         
  /*telechargement des images du serveur*/
  getBitmaps (strextr parameter);
  
  /*affichage de la boite clignotante*/
  let _DMSgetZone this "box" nil @cbResizeBox nil -> [wn x y w h] in
    if wn==nil then
      nil  
    else
    (
      set BoxWin = _CRwindow _channel wn x y w h WN_CHILDINSIDE|WN_NOCAPTION|WN_NOBORDER nil;
      set BoxW   = w;
      set BoxH   = h;
      _CBwinPaint BoxWin @cbpaintBlinkBox 0;
      _CBwinClick BoxWin @cbBoxWinClick 0;
      set BoxBMP = BlinkUpBMP;
      cbResizeBox [wn x y w h] "box";
      cbpaintBlinkBox nil nil;
    );
  
  /*chargement de l'option de sauvegarde*/
  let strcatn "tmp/pager/"::
      (substr (_getlongname strcatn DMSname::(_DMSgetName this)::DMSlogin::nil "" "#") 1 16)::
      "/"::
      nil 
  -> fichier in
  let _getpack _checkpack (strcat fichier (_getlongname "" "save.dat" ";")) -> test in
  if !strcmp test "1" then
    set SaveHistory = 1
  else
    set SaveHistory = 0;
          
  /*telechargement de la slide bar*/
  set topBMP = _LDalphaBitmap _channel _checkpack strcat modulePath "images/top.png";
  set downBMP = _LDalphaBitmap _channel _checkpack strcat modulePath "images/down.png";
  set middleBMP = _LDalphaBitmap _channel _checkpack strcat modulePath "images/middle.png";
  set liftBMP = _LDalphaBitmap _channel _checkpack strcat modulePath "images/lift.png";
  
  set ztaille = mkDatas [0 0 0 0];
  
  _DMSregister this @cbBeforeClose;
  _DMSevent this "in" nil nil;
  0
;;