/* Banner Client - DMS - Mar 98 - by Sylvain HUET */
/* Rev. - October 99 - by Sébastien DENEUX */

var eneeded= "dms/lib/_mcolormap.bmp"::"dms/lib/_mcolormap.pkg"::
 "Dms/Interf/Banner/bannerw.pkg"::"Dms/Interf/Banner/bannerce.pkg"::nil;;
var escript="_load \"dms/lib/_mcolormap.pkg\"\n_load \"Dms/Interf/Banner/bannerw.pkg\"\n_load \"Dms/Interf/Banner/bannerce.pkg\"\n";;
var edit=0;;

typeof win=ObjWin;;
typeof texts=[[S r1]r1];;
typeof current=I;;
typeof color=I;;
typeof colorF=I;;
typeof currentT=S;;
typeof currentEventParam=S;;
typeof currentFreq=I;;

var sizeX=0;;
var sizeY=0;;
var BaseY = 0 ;;
var TextSize = 0 ;;
var Step = 0 ;;
var CurrentX = 0 ;;

typeof fond=ObjBitmap;;
typeof Font=ObjFont;;
typeof tt=Timer;;

fun InitBitmap()=
 if fond!=nil then _DSbitmap fond else 0;
 set fond=_CRbitmap _channel sizeX sizeY;     
 0;;
 
fun NewText(i)= 
 let nth_list texts i -> l in 
 (set current=i;
  set currentT=hd tl tl l;  
  set color=atoi hd l;
  set colorF=atoi hd tl l;
  
  set currentEventParam=hd tl tl tl tl tl tl tl tl tl l;  
  
  let atoi hd tl tl tl l -> newFreq in
  let atoi hd tl tl tl tl l -> newSize in  
  let atoi hd tl tl tl tl tl l -> newBold in
  let atoi hd tl tl tl tl tl tl l -> newUnderline in
  let atoi hd tl tl tl tl tl tl tl l -> newItalic in
  let (if newBold then FF_WEIGHT else 0)+(if newUnderline then FF_UNDERLINE else 0)+(if newItalic then FF_ITALIC else 0) -> flag in    
  (       
   
   if newSize==nil then /*backwards compatibility*/
   (set newSize=14;
    set flag=0;
    set newFreq=5)   
   else nil;         
   
   if Font != nil then _DSfont Font else 0 ;
   set Font = _CRfont _channel ( newSize * sizeY ) / 20 0 flag "Arial";
   let (_GETstringSize Font "AAp_A") -> [ _ y ] in set BaseY = sizeY / 2 + y / 3;   
   set Step = newFreq;   
   let (_GETstringSize Font currentT)-> [ x _] in set TextSize = x;
   0
  );          
  );;

fun nexttext(i,i0)=
 let nth_list texts i -> l in
 if (hd l)==nil || (strlen hd l)==0 || (sizelist l)<3 || (!strcmp (hd tl tl l) "@nil@") || (atoi hd tl tl tl tl tl tl tl tl l)==0 then
 (    
  if i==i0 then
  (_deltimer tt;
   set tt=nil;
   _FILLbitmap fond 0;
   0)
  else nexttext (i+1)&15 i0   )
 else
 (NewText i;
  set CurrentX = -sizeX);;

fun NextText(i)=nexttext (i+1)&15 i;;

fun _paintW(a,b)= _BLTbitmap win fond 0 0 ;;

fun Scrolling (a,b)=
 _FILLbitmap fond colorF;
 _DRAWtext fond Font 0 - CurrentX BaseY TD_BASELINE color currentT;
 _paintW nil nil;
 if CurrentX < TextSize then set CurrentX = CurrentX + Step else
  NextText current;; 

fun start()= 
 if tt!=nil then nil
 else
 (set tt = _starttimer _channel 100;
  _rfltimer tt @Scrolling 0;
  NextText 15;
  set CurrentX = -sizeX);
 0;;

fun _destroyevent(a,b)=_DMSdelete this;;
fun _end(a)=_DMSdelete this;;

fun _resizeE(a,b,w,h)=
  set sizeX=w; set sizeY=h;
  InitBitmap;
  NewText current;;

fun _resize(x,s)=
 let x->[wn x y w h] in _SIZEwindow win w h x y;
 0;;
 
fun _click(a,b,c,d,bouton)=
 if bouton==1 then
  if (!strcmp currentEventParam "@nil@") || currentEventParam==nil then nil
  else
   _DMSevent this "bannerClick" currentEventParam nil   
 else nil;;
  

fun IniDMI(param)= 
 set current=0;
 let _DMSgetZone this "Banner" nil @_resize @_end ->[wn x y w h] in
 (set win=if wn==nil then
   (set w=280; set h=50;
    _CRwindow _channel DMSwin nil nil w h WN_MENU+WN_MINBOX+WN_SIZEBOX _DMSgetName this)
  else
   _CRwindow _channel wn x y w h WN_CHILDINSIDE|WN_NOCAPTION|WN_NOBORDER _DMSgetName this;
  _CBwinSize win @_resizeE 0;
  _CBwinDestroy win @_destroyevent 0;
  _CBwinPaint win @_paintW 0;
  _CBwinClick win @_click 0;
    
  set sizeX=w; set sizeY=h;
  InitBitmap;
  start);
0;;

fun getFileErr(f,name)=
 if f==nil then
  (_DLGrflmessage _DLGMessageBox _channel DMSwin "Editor Error" 
    strcat name " : file not available" 0 nil 0; nil)
 else set edit=edit+1;;

fun getfile(a,d)=
 _RSCdownload this a a mkfun2 @getFileErr a 3;;

fun ok(a)=
 if edit!=sizelist eneeded then set edit=0
 else (_script escript;_script "main");;

typeof bufb=S;;
fun __banner(s)=
 if s!=nil then
 (set bufb=strcat bufb s;0)
 else
 (set texts=strextr bufb;
  set bufb=nil;  
  set currentEventParam=nil;    
  if tt==nil then start else nil);;

fun __edit()=
 if edit==sizelist eneeded then _script "main"
 else if edit then nil
 else
 (apply_on_list eneeded @getfile 0;
  _RSCdownload this nil nil @ok 1;
  0);;