/***************************************************************************************/
/*                                                                                     */
/*  SCS editor Version 2                                                               */
/*  File : ToolTip.pkg                                                                 */
/*  Version : 27 juillet 2000                                                          */
/*  Tool-Tips package                                                                  */
/*                                                                                     */
/***************************************************************************************/

struct ScsToolTip =
[
  TOOLTIPchannel:                       Chn,/* Canal de création et destruction des tooltips */
  TOOLTIPfont:                          ObjFont,/* Fonte des tooltips */
  TOOLTIPfgColors:                      [I I I I],/* font and selection colors */
  TOOLTIPbgColor:                       I,/* background color */
  TOOLTIPbgMotif:                       AlphaBitmap,/* bitmap for the tooltips background */
  TOOLTIPbgCoord:                       [I I I I],/* coordinates for bg cut */
  TOOLTIPclass:                         S /* parameters name to test in order to know if the tooltip must be displayed */
] mkScsToolTip;;

fun TOOLTIP_Create (font, fgColors, bgColors, bgBitmap, bgCoord, class) =
  mkScsToolTip [ 
              nil
              font
              fgColors
              bgColors
              bgBitmap
              bgCoord
              class
            ]
;;

fun _reflexShowToolTip (pere, params, text, posx, posy) =
  let params -> [con toolTip] in
  let _openchannel nil nil nil -> chnl in
  /* Position & Size */
  let realGETstringSize toolTip.TOOLTIPfont text -> [w h] in
  let toolTip.TOOLTIPbgCoord -> [p1x p1y p2x p2y] in
  let (
        if toolTip.TOOLTIPbgMotif!=nil 
        then _GETalphaBitmapSize toolTip.TOOLTIPbgMotif
        else [p2x+3 p2y+3] 
      )
        -> [mw mh] in
  let [p1x mw-p2x p1y mh-p2y] -> [eg ed eh eb] in
  let _GETscreenSize -> [sw sh] in
  let if (posx+w+p1x+10)>sw then posx-w-eg-5 else posx+10 -> x in
  let if (posy+h+p1y+10)>sh then posy-h-eh-10 else posy+10 -> y in
  /*.................*/
  let _CRcontainerFromObjCont chnl con x y w+eg+ed h+eh+eb CO_NOCAPTION|CO_NOBORDER toolTip.TOOLTIPbgColor nil 
      -> cont in 
  (
    /* create background */
    if toolTip.TOOLTIPbgMotif!=nil then
    let _CRbitmap chnl w+eg+ed h+eh+eb -> bmp in
    (
      let [0 0]::[eg eg]::[p2x eg+w]::[mw w+eg+ed]::nil -> xCoord in
      let [0 0]::[eh eh]::[p2y eh+h]::[mh h+eh+eb]::nil -> yCoord in
        _STRETCHalphaBitmap bmp toolTip.TOOLTIPbgMotif xCoord yCoord;
      let _CRalphaBitmap chnl bmp nil 0 0 -> abmp in
        _CRcompBitmap chnl cont nil [0 0] OBJ_ENABLE|OBJ_VISIBLE 0 abmp 0 0 w+eg+ed h+eh+eb;
      _DSbitmap bmp
    )
    else 
      nil;
    /* write text */
    _CRcompText chnl cont nil [eg eh] OBJ_ENABLE|OBJ_VISIBLE|CT_LEFT 
                0 w h text toolTip.TOOLTIPfont toolTip.TOOLTIPfgColors nil nil nil;
    /* end */            
    /*_TOPcontainer cont;      */
    _PAINTcontainer cont;
    
    set toolTip.TOOLTIPchannel = chnl;
    0
  )
;;

fun _reflexShowStaticToolTip (pere, params, text, posx, posy) =
  let params -> [con dynaText toolTip] in
  if (text!=nil) && (PARAMS_GetI SCSparameters toolTip.TOOLTIPclass)!=0
  then
    _reflexShowToolTip pere [con toolTip] text posx posy
  else
    nil
;;      

fun _reflexShowDynamicToolTip (pere, params, text, posx, posy) =
  let params -> [con dynaText toolTip] in
  if (dynaText!=nil) && (PARAMS_GetI SCSparameters toolTip.TOOLTIPclass)!=0
  then
    let exec dynaText with [] -> txt in
    if txt == nil then nil else _reflexShowToolTip pere [con toolTip] txt posx posy
  else
    nil
;; 

fun _reflexHideTip (pere, toolTip, text) =  
  if toolTip.TOOLTIPchannel != nil 
  then
  ( 
    _killchannel toolTip.TOOLTIPchannel;
    set toolTip.TOOLTIPchannel=nil;
    0
  )
  else
    0
;;

fun TOOLTIP_StaticLink (con, pere, toolTip, text) =
  let PARAMS_GetI SCSparameters "TOOLTIP_TIME_BEFORE_OPENING" -> timeout in
   _CRtoolTip pere timeout text @_reflexShowStaticToolTip [con nil toolTip] 
                                @_reflexHideTip toolTip 
;;   

fun TOOLTIP_DynamicLink (con, pere, toolTip, dynaText) =
  let PARAMS_GetI SCSparameters "TOOLTIP_TIME_BEFORE_OPENING" -> timeout in
   _CRtoolTip pere timeout "" @_reflexShowDynamicToolTip [con dynaText toolTip] 
                              @_reflexHideTip toolTip 
;;

fun TOOLTIP_UnLink (pere) = _DStoolTip pere;;