/* browser SCOL 1.0 */
var stdport1="8080";;
var stdport2="80";;

typeof screen=Chn;;
typeof win=ObjWin;;
typeof winAX=ObjWin;;
typeof message=ObjText;;
typeof site=ObjText;;
typeof barre=ObjBitmap;;

typeof server=Chn;;

defcom Smainapplet=main S S;;
defcom Sipreq=ipreq S;;

proto contact=fun[S] I;;

var sizeload=1;;
var sizeloaded=0;;
var rights=0;;
typeof ContactS=S;;

fun multiress(res)=
 if res==nil then 0
 else let res ->[l nxt] in
 (_setress hd l hd tl l;
  multiress nxt);;

fun isIP(s,i)=
 if i>=strlen s then 1
 else let nth_char s i-> a in
 if a!='. && (a<'0 || a>'9) then 0
 else isIP s i+1;;

fun isPORT(s,i)=
 if i>=strlen s then 1
 else let nth_char s i-> a in
 if a<'0 || a>'9 then 0
 else isPORT s i+1;;

fun getip(a)=
if a==nil || !strlen a then "127.0.0.1"
 else if isIP a 0 then a
 else
 (_SETtext message strloc loc "LOOKUP" a::nil;
  _gethostbyname a);;

fun cutbyslash(s,i)=
 if i>=strlen s then if i==0 then nil else s::nil
 else if (nth_char s i)=='/ then (substr s 0 i)::cutbyslash substr s i+1 1000 0
 else cutbyslash s i+1;;

fun cutbypoints(s,i)=
 if i>=strlen s then if i==0 then nil else s::nil
 else if (nth_char s i)==': then (substr s 0 i)::cutbypoints substr s i+1 1000 0
 else cutbypoints s i+1;;

fun convertp(l)=
 if l==nil then nil else let l->[a n] in
 (hd strextr webtostr a)::convertp n;;

typeof NEXTtry=S;;
typeof URLservice=S;;
typeof req1=INET;;
typeof req2=INET;;

typeof tim=Timer;;
typeof remain=I;;

fun retryFirewall()=
  if !strcmpi _getress "Firewall" "strong"
  then
   (_SETtext message strloc loc "BADAD" URLservice::nil;nil)
  else
   (_setress "Firewall" "strong";
    contact NEXTtry);;

fun stoptry()=
 _deltimer tim;
 INETStopURL req1;
 INETStopURL req2;;

fun _time(tim,b)=
 _SETtext message strloc loc "TIMEOUT" URLservice::(itoa remain)::nil;
 set remain=remain-1;
 if remain>=0 then nil
 else
 (stoptry;
  retryFirewall);;

fun wait()=
 set remain=10;
 set tim=_rfltimer _starttimer screen 1000 @_time 0;
 0;;

fun cb(inet,z,s,reason)=
 let z->[curres port] in
 if reason==0 then
 (mutate z<-[strcat curres s _];
  0)
 else if reason==1
 then let substr curres 0 7 -> z in
  if (!strcmpi z "scol://")||(!strcmpi z "http://") then
  (stoptry;
   _setress "FirewallPort" port;
   contact curres)
  else if !strcmpi curres "OFF" then
  (stoptry;
   _SETtext message loc "NOTAVAIL";nil)
  else
  (_deltimer tim;
   retryFirewall;nil)
 else
  (_deltimer tim;
   retryFirewall;nil);;

/* essai via http */
fun tryviahttp(ad,name)=
 if strcmpi _getress "Firewall" "strong"
 then let strcatn "http://"::ad::":1199/"::name::nil ->url in
 (set URLservice=url;
  set NEXTtry=strcatn "scol://"::ad::":"::name::nil;
  let strcat strcat ad "." name -> s in _setCookies substr s (strlen s)-10 10;
  _SETtext message strloc loc "CONT" name::nil;
  set req1=INETGetURL screen url 0 @cb [nil nil];
  if req1==nil then (retryFirewall;0)
  else wait)
 else let [strcatn "http://"::ad::":"::nil strcat "/" name] ->[pref suff] in
 (set URLservice=strcatn "http://"::ad::"/"::name::nil;
  _setCookies strcat strcat ad "." name;
  _SETtext message strloc loc "CONT" name::nil;
  set req1=INETGetURL screen strcat strcat pref stdport1 suff 0 @cb [nil stdport1];
  set req2=INETGetURL screen strcat strcat pref stdport2 suff 0 @cb [nil stdport2];
  if req1==nil && req2==nil then (_SETtext message strloc loc "BADAD" URLservice::nil;0)
  else wait);;

/* essai adresse:nom (port du scol engine)*/
fun tryscoldns(ad,name,port)=
 set NEXTtry=strcatn ad::":"::name::"-via_http"::nil;
 let getip ad ->ip in
 if ip==nil then (contact NEXTtry;0)
 else let strcat ip if port==nil then ":1200" else strcat ":" port -> cor in
 (set URLservice=strcatn ad::":"::name::nil;  
  _SETtext message strloc loc "SOLV" ip::name::nil;
  if (_openchannel cor strcat "_load \"locked/iprequest.pkg\"\n" mkscript Sipreq [name] _envchannel screen)==nil
  then (contact NEXTtry;0)
  else 0);;

/* essai adresse:port */
fun trydirect(ad,port)=
 let getip ad ->ip in
 if ip==nil then (_SETtext message strloc loc "BADAD" ad::nil;0)
 else let strcat strcat ip ":" port -> cor in
 (_SETtext message strloc loc "CONT" cor::nil;
  _setCookies strcat strcat ad "." port;
  set server= _openchannel cor "_load \"locked/stdusr2.pkg\"" _envchannel screen;
  if server==nil then (_SETtext message strloc loc "BADAD" cor::nil;0)
  else 0);;

/* contact scol */
fun contact2(s)=
 let cutbyslash s 0 ->[ad params] in
 (if params==nil then nil
  else _setress "parameters" strbuild convertp params;
  
  let cutbypoints ad 0 -> [a [x [c _]]] in
  let if x==nil then "1200" else x -> b in
  if isPORT b 0 then trydirect a b
  else if strcmp substr b (strlen b)-9 9 "-via_http"
  then tryscoldns a b c
  else tryviahttp a b);;

fun _endV(a,b,r)=
 	_closemachine;;

fun __badversion()=
  _closechannel;
  _DLGrflmessage _DLGMessageBox screen win loc "DECNX" 
  loc "TOOOLD" 2 @_endV 0;
  0;;

fun _end(t,u)=
	_closemachine
;;

fun contact(s)=
  if !strcmp substr s 0 7 "http://" then (_openbrowserhttp s; _rfltimer _starttimer screen 3000 @_end 0; 1)
  else
  (
    if !strcmp substr s 0 14 "scol://applet:" then
    (
      set ContactS=s;
      _load "locked/stdapplt.pkg";
      _script mkscript Smainapplet [substr s 14 strlen s "100"];
    )
    else if !strcmp substr s 0 19 "scol://applet/?app=" then
    (
      set ContactS= strcat "scol://applet:" (substr s 19 strlen s);
      _load "locked/stdapplt.pkg";
      _script mkscript Smainapplet [substr s 19 strlen s "100"];
    )
    else if !strcmp substr s 0 7 "scol://" then
    let strfindi "/?app=" s 0 -> appos in
    (
      if appos == nil then
      (
        set ContactS= s;
        contact2 substr s 7 strlen s;
      )
      else
      (
        set ContactS= strcatn (substr s 0 appos)::":"::(substr s appos + 6 strlen s)::nil;
        contact2 substr ContactS 7 strlen ContactS;
      );
    )
    else contact2 s
  );;

fun _destroyevent(a,b)=_closemachine;;

fun _paintevent(a,b)= _BLTbitmap win barre 5 75;;


fun cbWinAxSize(winax, p, w, h)=
  _SIZEwindow win w h 0 0;
  _SIZEtext site (w-10) 20 5 5;
  _SIZEtext message (w-10) 40 5 30;
  _DSbitmap barre;
  set barre=_CRbitmap screen (w-10) 20;
  _DRAWrectangle barre 0 0 (w-9) 21 DRAW_SOLID 2 0 DRAW_SOLID 0xffffff;
  _DRAWrectangle barre 5 5 (w-10)*sizeloaded/sizeload 10 DRAW_INVISIBLE 0 0 DRAW_SOLID 0xff;
  _paintevent nil nil;
  0;;


fun cbWinAxDestroy(winax, p)=
  _closemachine;
  0;;


fun mainEx(name,r,s,versionmin)=
 startloc "locked/lang/master";
 _SETdefaultFont _CRfont _channel 14 0 0 loc "FONT";
 set rights=r;
 multiress strextr s;
 _setress "firsturl" name;
 set screen=_channel;
 
 set winAX = _GETactiveXWindow screen 0 "axscol";
 _CBwinDestroy winAX @cbWinAxDestroy nil;
 _CBwinSize winAX @cbWinAxSize nil;
 
 let if winAX != nil then _GETwindowPositionSize winAX else [80 80 310 100] -> [x y w h] in
 (
    set win=_CRwindow screen winAX x y w h (if winAX != nil then WN_CHILDINSIDE else WN_MENU|WN_MINBOX) name;
    _CBwinDestroy win @_destroyevent 0;
    _CBwinPaint win @_paintevent 0;
    set site=_CRtext screen win 5 5 (w-10) 20 ET_ALIGN_CENTER+ET_BORDER name;
    set message=_CRtext screen win 5 30 (w-10) 40 ET_ALIGN_CENTER+ET_AHSCROLL strloc loc "CONT" name::nil;
    set barre=_CRbitmap screen (w-10) 20;
    _DRAWrectangle barre 0 0 (w-9) 21 DRAW_SOLID 2 0 DRAW_SOLID 0xffffff;
    _paintevent nil nil;
 );
 if (_version<versionmin) then __badversion
 else contact name;;

fun main(name,r,s)=mainEx name r s 0;;