/* Photo Client - DMS - mar 00 - by Sylvain HUET */
/* rev september 01 - by sebastien DENEUX */

var pref="locked/conf/photo.conf";; /*sd*/

typeof photo  = S;;
typeof shlog  = MCl;;
typeof winb   = ObjWin;;
typeof buf    = ObjBitmap;;
typeof bmpcur = ObjBitmap;;

typeof button = ObjButton;;


var transparencyFlag = 0;;

typeof myUI=UserI;;


typeof dftGrayColor = I;;
typeof dftBlackColor = I;;
typeof dftBlueColor = I;;
typeof dftSweetYellowColor = I;;

defcom Sregister = register;;

fun _paintE(a,b)=
 let _GETbitmapSize buf -> [ww hh] in
 let _GETbitmapSize bmpcur -> [w h] in
  _SCPbitmap buf 0 0 ww-1 hh-1 bmpcur 0 0 w-1 h-1 nil;
 _BLTbitmap winb buf 0 0;;

fun _resizeB(x,s)=
 let x->[win x y w h] in
  (_DSbitmap buf;
   set buf=_CRbitmap _channel w h;
   _SIZEwindow winb w h x y);
 _paintE nil nil;
 0;;

fun _endB(s)=
 _DSbitmap buf;
 set winb=nil;
 _DMSreleaseZone this "Photo";
 0;;

fun _recoverB(s)=
 _DSwindow winb;
 _endB nil;;

fun chklogin(bmp, f)=
 delMCl shlog;
 set shlog=nil; 
 if bmp==nil 
 then nil
 else
 (
   set photo=bmp;
   set transparencyFlag=f; /*sd*/
   _storepack strbuild (bmp::(itoa f)::nil)::nil pref; /*sd*/
   UsendMessage myUI "trans" itoa f;   
   let _getpack _checkpack  bmp -> s 
   in
     if s==nil 
     then nil
     else
    (
      UsendMessage myUI "add" nil;
      let 0->i in 
      while i<strlen s do
      (

        UsendMessage myUI "add" substr s i 1024;
        set i=i+1024
      );
      UsendMessage myUI "add" "";
    );

   if winb==nil 
   then let _DMSgetZone this "Photo" @_recoverB @_resizeB @_endB ->[win x y w h] 
        in
        if win==nil 
        then nil 
	else
        (
	  set winb=_CRwindow _channel win  x y w h
             WN_CHILDINSIDE|WN_NOCAPTION|WN_NOBORDER "photo";
          set buf=_CRbitmap _channel w h;
            _CBwinPaint winb @_paintE 0
	)
   else nil;

   if winb==nil then nil
   else
   (
     _DSbitmap bmpcur;
     let _LDbitmap _channel _checkpack photo -> imagebmp in
     set bmpcur= if imagebmp==nil then _LDjpeg _channel _checkpack photo else imagebmp;
     _paintE nil nil
    )
);
0;;




fun showphoto()=
 if shlog!=nil then nil
 else set shlog=
 
 iniMCl _channel DMSwin nil nil 320 128 (_loc this "SELECT_TITLE" nil) @chklogin 0 photo transparencyFlag;
 0;;


fun closephoto()=
 if shlog==nil then nil
 else
 (delMCl shlog;
  set shlog=nil);
 0;;

fun Ashow(from,action,param,ulist,tag) =
  showphoto;;

fun Ahide(from,action,param,ulist,tag) = 
  closephoto;;

fun pressbut(a,b,x,y,btn,mask) =
 showphoto;;

/* requetes de photos */
fun endDown(sign,b) =
  let b -> [tag trans] in  /*sd*/
   _DMSreplyTag tag strbuild ("sign"::sign::nil)::("trans"::trans::nil)::nil nil 0
;;

fun cbSetbmp(ui,act,param,tag) =
  UremoveMessage ui "set";
  let strextr param -> l in /*sd*/
  let getInfo l "sign" -> sign in
  let getInfo l "trans" -> trans in   
     _RSCdownload this itoa UgetId UgetUser ui sign mknode @endDown [tag trans] 3;
  0
;;


fun AgetPhoto(from,action,param,ulist,tag)=
 let UgetUserI this hd ulist -> ui in
 if ui==nil then
 (
   _DMSreplyTag tag nil nil 0;
 )
 else
 (
   _DMStagKeepAlive tag;
   UcbMessage ui ["set" mkfun4 @cbSetbmp tag]::nil;
   UsendMessage ui "get" nil);;

fun newInst(ui)=
 if DMSid==UgetId UgetUser ui 
 then 
 (
   set myUI=ui ;
   _DMSeventTag this "in" nil nil nil;
   if photo != nil then /* informe le serveur de la photo courante */
     chklogin photo transparencyFlag
   else
     nil;
 )
 else nil;
 0;;


fun _end (win) = 
  _DMSdelete this;
  0;;

fun cbChkLogin(t,b)=
_deltimer t;
if photo != nil then
   chklogin photo transparencyFlag
 else
   nil;
0;;

fun IniDMI(param)=
 _DMSdefineActions this ["getPhoto" @AgetPhoto]::["show" @Ashow]::["hide" @Ahide]::nil;
 UcbCreate this @newInst;  

 let hd strextr _getpack _checkpack pref -> l in
 let hd l -> tmp1 in
 let atoi hd tl l -> tmp2 in  
 (
    set photo = if (tmp1 == nil) || ((strlen (_getpack _checkpack tmp1)) > 16384) then "logo.bmp" else tmp1 ;
    set transparencyFlag = if tmp2 == nil then 0 else tmp2
 );

 _DMSsend this Sregister [];
 
  if !strcmp param "show"
 then
   Ashow nil nil nil nil nil
 else
   nil;

 0
;;