/**************************************************
 Module SkinButton
 Client part
 Version: 1.0
 Author: Julien Zorko
 Last update: 01/06/2001
 Roll over button with customisable bitmap
 
 Add to change skin by client : iri, october 2004 - http://www.irizone.net
**************************************************/


typeof ZoneCont = ObjContainer;; /* Main container of the module interface */
typeof ZoneSize = [I I I I];;    /* [x y width height] */
typeof Button = CompRollOver;;   /* Button */
typeof Skin = AlphaBitmap;;      /* bitmap for the comprollover */

typeof sBitmap = S;;             /* bitmap file name */
typeof sText = S;;               /* button text reference */

typeof iTextSize = I;;           /* button text font size */
typeof iTextColor = I;;          /* button text font color */
typeof fontText = ObjFont;;      /* text font */

typeof sBubble = S;;             /* bubble text reference */
typeof iBubbleColor = I;;        /* bubble text font color */
typeof iBubbleBackColor = I;;    /* bubble back color */
typeof fontBubble = ObjFont;;    /* bubble font */

typeof iDisable = I;;            /* option disable or not */

typeof image = S;;
typeof bulle = S;;
typeof locBulle = [[S r1] r1];;
typeof font = ObjFont;;

/*path*/
typeof modulePath = S;;
var allArrive = 0;;

var beforeToolTipDelay=250;;
var hideToolTipDelay=4000;;

var XLeftBorderSize = 4;;
var XRightBorderSize = 4;;
var YLeftBorderSize = 4;;
var YRightBorderSize = 4;;

var DEFAULT_SKIN = "ressources/defaultskin.png";;


/*******************************************************************************
 Functions
*******************************************************************************/

fun cbClickButton (obj, param, posx, posy, etat, mask) =
  _DMSevent this "click" nil nil;
  0
;;

fun cbHideToolTip (node, toolTipChannel, txt) =
  _killchannel toolTipChannel
;;

fun GetButtonStretchLists (w, h, nw, nh) =
  if iDisable then
    [
      [0 0]::[XLeftBorderSize XLeftBorderSize]::
      [w-XRightBorderSize nw-XRightBorderSize]::
      [w nw]::nil

      [0 0]::[YLeftBorderSize YLeftBorderSize]::
      [h-YRightBorderSize nh-YRightBorderSize]::
      [h+YLeftBorderSize  nh+YLeftBorderSize ]::
      [2*h-XRightBorderSize 2*nh-XRightBorderSize]::
      [2*h+YLeftBorderSize  2*nh+YLeftBorderSize ]::
      [3*h-XRightBorderSize 3*nh-XRightBorderSize]::
      [3*h+YLeftBorderSize  3*nh+YLeftBorderSize ]::
      [4*h-XRightBorderSize 4*nh-XRightBorderSize]::
      [4*h+YLeftBorderSize  4*nh+YLeftBorderSize ]::
      [5*h-XRightBorderSize 5*nh-XRightBorderSize]::
      [5*h 5*nh]::nil
    ]
  else
    [
      [0 0]::[XLeftBorderSize XLeftBorderSize]::
      [w-XRightBorderSize nw-XRightBorderSize]::
      [w nw]::nil

      [0 0]::[YLeftBorderSize YLeftBorderSize]::
      [h-YRightBorderSize nh-YRightBorderSize]::
      [h+YLeftBorderSize  nh+YLeftBorderSize ]::
      [2*h-XRightBorderSize 2*nh-XRightBorderSize]::
      [2*h+YLeftBorderSize  2*nh+YLeftBorderSize ]::
      [3*h-XRightBorderSize 3*nh-XRightBorderSize]::
      [3*h+YLeftBorderSize  3*nh+YLeftBorderSize ]::
      [4*h-XRightBorderSize 4*nh-XRightBorderSize]::
      [4*h 4*nh]::nil
    ]
;;


/*******************************************************************************
 This function stretches a bitmap according to the xList and yList which are
 lists if [I I] where the first I is the coordinate in the motif and the second
 I is the corresponding coordinate in the streched bmp.
*******************************************************************************/
fun STRETCHalphaBitmap2 (bmp,motif,xList,yList,oxList) =
  let xList -> [x1 [x2 nextx]] in
  let yList -> [y1 [y2 nexty]] in
  if y2 == nil then bmp
  else let x1 -> [ox1 nx1] in
       let x2 -> [ox2 nx2] in
       let y1 -> [oy1 ny1] in
       let y2 -> [oy2 ny2] in
       (
         _SCPalphaBitmap bmp nx1 ny1 nx2-1 ny2-1 motif ox1 oy1 ox2-1 oy2-1;
         if (hd nextx)!=nil then STRETCHalphaBitmap2 bmp motif (tl xList) yList oxList
                            else STRETCHalphaBitmap2 bmp motif oxList (tl yList) oxList
       );;
/* here is the function to use */
fun STRETCHalphaBitmap (bmp, motif, xList, yList) = 
  STRETCHalphaBitmap2 bmp motif xList yList xList
;;

/*
fun _CBtimerHideToolTip(t,b)=
  _deltimer t;
  _killchannel b
;;
*/

/*******************************************************************************
 Display the button tooltip
*******************************************************************************/
fun cbShowToopTip(node,b,txt,x,y)=
  let b -> [toolTipChannel cont param] in
  (
    let _GETwindowPositionSize DMSwin -> [xp yp wp hp] in
    let _GETcursorPos DMSwin -> [xx yy] in
    let (xp + xx) + 30 -> x in
    let (yp + yy) + 30 -> y in
    if txt==nil || (!strcmp txt "") then
      nil
    else
      let _GETstringSize fontBubble txt -> [w h] in
      let [w+1 h+1] -> [w h] in
      let [((w*3)/4) h*2] -> [w h] in
      let _GETscreenSize -> [sw sh] in
      let if (x+w)>sw-10 then sw-w-10 else x -> x in /*si depassement ecran, on decale à gauche*/
      let 4 -> dw in
      let 4 -> dh in
      let _CRcontainerFromObjCont toolTipChannel cont x y w+dw h+dh
                                  CO_NOCAPTION iBubbleBackColor nil -> cont in
      (
        _CRcompText toolTipChannel cont nil [dw/2+1 dh/2]
                    OBJ_ENABLE|OBJ_VISIBLE|CT_CENTER|CT_WORDWRAP 0
                    w h txt fontBubble [iBubbleColor nil nil nil] nil nil nil;
        _PAINTcontainer cont;
        _TOPcontainer cont;
/*
        _rfltimer _starttimer toolTipChannel hideToolTipDelay @_CBtimerHideToolTip toolTipChannel
*/
      );
  )
;;

fun CreateToolTip (cont, node, txt, param) =
  let _openchannel nil nil nil -> toolTipChannel in
  (
    _CRtoolTip node beforeToolTipDelay txt @cbShowToopTip [toolTipChannel cont param] @cbHideToolTip toolTipChannel;
    toolTipChannel
  )
;;

/*******************************************************************************
 Get the flag for the font style according to the combobox index
*******************************************************************************/
fun fontFlag(iValue) =
  if(iValue == 1) then
    FF_WEIGHT
  else if(iValue == 2) then
    FF_ITALIC
  else if(iValue == 3) then
    FF_UNDERLINE
  else if(iValue == 4) then
    FF_STRIKED
  else
    0
;;

/*******************************************************************************
  Draw a text line on a bitmap
  bmp   -> ObjBitmap : bitamp destination
  font  -> ObjFont   : text font
  x     -> I         : horizontal position
  y     -> I         : vertical position
  marge -> I         : space between lines
  space -> [[S r1]r1]: line string list
        <- ObjBimap  : the modified bitmap
*******************************************************************************/
fun DrawTextLines (bmp, font, x, y, space, list) =
  if list == nil then
    bmp
  else
    let list -> [first next] in
    (
      _DRAWtext bmp font x y TD_BASELINE|TD_CENTER iTextColor first;
      DrawTextLines bmp font x y+space space next
    )
;;


/*******************************************************************************
 Write text on button bitmap
 bmp  -> ObjBitmap : destination bitmap
 text -> S         : text to write
      <- ObjBitmap : modified bitmap
*******************************************************************************/
fun locBitmap(bmp, text)=
  let _GETbitmapSize bmp -> [w h] in

  /* calcule la hauteur d'une case, et le centrage horizontal et vertical du
     texte dans la case */
  let if iDisable == 0 then 4 else 5 -> divis in
  let h/(2*(divis+1)) + iTextSize/2 -> h2 in
  let [(h/divis) (w/2) (3*(h/divis)/divis)] -> [h1 w2 _] in
  let lineextr text -> liste in
  let sizelist liste -> lenght in
  let ( (h/(divis+1)) - lenght*iTextSize)/(lenght+1) -> reste in
  (
    /* Draw the text on bitmap for the different button states */
    DrawTextLines bmp fontText w2 (reste+iTextSize) (reste+iTextSize) liste;
    DrawTextLines bmp fontText w2 (h1+reste+iTextSize) (reste+iTextSize) liste;
    DrawTextLines bmp fontText w2 (2*h1+reste+iTextSize) (reste+iTextSize) liste;
    if divis == 5 then
      DrawTextLines bmp fontText w2 (3*h1+reste+iTextSize) (reste+iTextSize) liste
    else
      bmp
  )
;;

/*******************************************************************************
  Zone resize management
*******************************************************************************/
fun cbResizeZone (coord, zone) =
  let coord -> [win x y w h] in
    _SIZEcontainer ZoneCont x y w h;
  0
;;

/*******************************************************************************
  Button destruction
*******************************************************************************/
fun DestroyButton () =
  _DMSreleaseZone this "button";
  _DMSdelete this;
  0
;;

/*******************************************************************************
  Load the button bimat and write text on it
  fileName -> S : bitmap file name (.jpg, .jpeg or .png)
  text     -> S : text to write on the button
*******************************************************************************/
fun LoadBitmap (fileName, text) =
  let substr fileName (strlen fileName)-4 4 -> extension in
  let substr fileName (strlen fileName)-5 5 -> extension2 in
  if !(strcmpi extension ".jpg") || !(strcmpi extension2 ".jpeg") then
    let _LDjpeg _channel _checkpack fileName -> bmp in
      set Skin = _CRalphaBitmap _channel bmp nil nil nil
  else if !(strcmpi extension ".bmp") then
    let _LDbitmap _channel _checkpack fileName -> bmp in
      set Skin = _CRalphaBitmap _channel bmp nil nil nil
  else if !(strcmpi extension ".png") then
    set Skin = _LDalphaBitmap _channel _checkpack fileName
  else
    nil;
    
  if Skin == nil then
  (
    set iDisable = 1;
    let strcat _DMSgetpath _DMSgetClass this DEFAULT_SKIN -> file in
      set Skin = _LDalphaBitmap _channel _checkpack file
  )
  else
    nil;
    
  let ZoneSize -> [_ _ nw nh] in
  let if iDisable then 5 else 4 -> coeff in
  let _CRbitmap _channel nw nh*coeff -> bmp in
  let _GETalphaBitmapSize Skin -> [w sh] in
  let if iDisable then sh/5 else sh/4 -> h in
  let GetButtonStretchLists w h nw nh -> [xList yList] in
  let STRETCHalphaBitmap bmp Skin xList yList -> finalBmp in
  let _CRalphaBitmap _channel (locBitmap finalBmp text) nil nil nil -> abmp in
  (
    _DSbitmap finalBmp;
    abmp
  )
;;

fun cbResizeRollOverRessource (cRollOver, text, nw, nnh) = 
  let if iDisable then nnh/5 else nnh/4 -> nh in
  let _CRbitmap _channel nw nnh -> bmp in
  let _GETalphaBitmapSize Skin -> [w sh] in
  let if iDisable then sh/5 else sh/4 -> h in
  let GetButtonStretchLists w h nw nh -> [xList yList] in
  let STRETCHalphaBitmap bmp Skin xList yList -> finalBmp in
  let _CRalphaBitmap _channel (locBitmap finalBmp text) nil nil nil -> abmp in
  (
    _DSbitmap finalBmp;
    abmp
  )
;;
   
/*******************************************************************************
  change cursor when enter in the button
    roll -> RollOver
    win -> ObjWin
    x, y, mask -> I I I
*******************************************************************************/
fun cbMoveEnter (roll, win, x, y, mask) = 
  _SETwinCursor win HandCursor
;;

/*******************************************************************************
  change cursor when get out of the button
    roll -> RollOver
    win -> ObjWin
    x, y, mask -> I I I
*******************************************************************************/
fun cbMoveOut (roll, win, x, y, mask) = 
  _SETwinCursor win StdCursor
;;      

/*******************************************************************************
 Interface creation (rollover component creation + tooltip creation)
    <- I: unused
*******************************************************************************/
fun CreateInterface()=
  let _DMSgetZone this "button" nil @cbResizeZone nil ->[win x y w h] in
  if win==nil then
  /* the client module instance is destroyed if there's not an alocated zone */
    DestroyButton
  else
    (
      set ZoneSize = [x y w h];
      let _CRcontainerFromObjWin _channel win x y w h CO_CHILDINSIDE|CO_NOBORDER|CO_NOCAPTION 0 "" -> cont in
      let LoadBitmap sBitmap sText -> alphaBmp in      
      let if iDisable == 0 then
        _CRcompRollOver _channel cont nil [0 0] ROL_MASK|OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_CLICK alphaBmp
        else
        _CRcompRollOver _channel cont nil [0 0] ROL_MASK|OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_CLICK alphaBmp
      -> rotmp in
        if rotmp == nil then
          /* button can not be created */
          DestroyButton
        else
        (
          set Button = rotmp;
          _CBcompRollOverCursorMoveIn Button @cbMoveEnter win; /*???*/
          _CBcompRollOverCursorMoveOut Button @cbMoveOut win;
          set ZoneCont = cont;
          if (sBubble == nil) || (!strcmp sBubble "") then
            nil
          else
            CreateToolTip cont (_CONVERTcompRollOverToObjNode rotmp) sBubble nil;
          _CBcompRollOverClick rotmp @cbClickButton 0;
          _CBcompRollOverResizeResource rotmp @cbResizeRollOverRessource sText;
          _PAINTcontainer cont;
          0
        )
    )
;;

/* Callback caled when the button picture is loaded */
fun cbEndDownloadButtonPicture (s) =
  CreateInterface;
  0
;;

/* */
fun cbBeforeClose () =
  _DMSreleaseZone this "button";
  0
;;

/*******************************************************************************
 Hide the button
 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) =
  _SHOWcontainer ZoneCont CONTAINER_HIDDEN;
  _DMSeventTag this "hidden" nil nil nil;
  0
;;

/*******************************************************************************
 Show the button
 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) =
  _SHOWcontainer ZoneCont CONTAINER_UNHIDDEN;
  _DMSeventTag this "shown" nil nil nil;
  0
;;

/*******************************************************************************
 Simulate the button click
 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 cbClick (from, action, param, others, tag) =
/*
  let ZoneSize -> [x y w h] in
    _METHODcontainerClick ZoneCont x+w/2 y+h/2 LBUTTON;
*/
    _DMSeventTag this "click" nil nil nil;
  0
;;

/*******************************************************************************
 Enable the button
 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 cbEnable (from, action, param, others, tag) =
  _CHANGEobjNodeFlags _CONVERTcompRollOverToObjNode Button ROL_MASK|OBJ_ENABLE|OBJ_VISIBLE 1;
  _DMSeventTag this "enabled" nil nil nil;
  0
;;

/*******************************************************************************
 Disable the button
 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 cbDisable (from, action, param, others, tag) =
  _CHANGEobjNodeFlags _CONVERTcompRollOverToObjNode Button ROL_MASK|OBJ_DISABLE|OBJ_VISIBLE 1;
  _DMSeventTag this "disabled" nil nil nil;
  0
;;

/******************************
   Change SKIN by client
******************************/

fun setShortName(s)=
  let strfind "/" s 0 -> r in
  if r == nil then
    s
  else
    setShortName substr s r+1 strlen s;;
    
fun searchGoodFile(l)=
  if l == nil then
    nil
  else
    let l -> [elt suite] in
    let setShortName elt -> file in
    let setShortName sBitmap -> old in
    if !strcmp file old then
      (set sBitmap = elt;
       _DSalphaBitmap Skin;
       _DScontainer ZoneCont;
       CreateInterface)
    else
      searchGoodFile suite;;

fun cbChange (from, action, param, others, tag) =
  let lineextr param -> files in
  searchGoodFile files;
  0;;
  
/*******************************************************************************
  Module client part initialisation
*******************************************************************************/
fun IniDMI(param)=
  _DMSregister this @cbBeforeClose;
  _DMSdefineActions this (["show" @cbShow])::
                         (["hide" @cbHide])::
                         (["click" @cbClick])::
                         (["enable"  @cbEnable])::
                         (["disable" @cbDisable])::
                         (["change" @cbChange])::nil;
  let strextr param -> params in
  let atoi getInfo params "textType" -> textType in
  let atoi getInfo params "bubbleSize" -> bubbleSize in
  let atoi getInfo params "bubbleType" -> bubbleType in
  (
    set sBitmap = getInfo params "picture";
    set sText = getInfo params "text";
    set iTextSize = atoi getInfo params "textSize";
    set iTextColor = htoi getInfo params "textColor";
    set fontText = _CRfont _channel iTextSize 0 (fontFlag textType) "Arial";

    set sBubble = getInfo params "bubble";
    set iBubbleColor = htoi getInfo params "bubbleColor";
    set iBubbleBackColor = htoi getInfo params "bubbleBackColor";
    set fontBubble = _CRfont _channel bubbleSize 0 (fontFlag bubbleType) "Arial";

    set iDisable = atoi getInfo params "disable";
    set image = sBitmap;

    set modulePath = _DMSgetpath _DMSgetClass this;

    _RSCdownload this image image @cbEndDownloadButtonPicture 1;
    _DMSeventTag this "in" nil nil nil;
  );
  0
;;