/* Comutron1.pkg */

typeof server=Srv;; 
typeof serverenv=Env;; 
typeof Serverenv=Env;; 
typeof roomenv=Env;; 
typeof APIchn=Chn;; 
typeof MainChn=Chn;; 
typeof Lines=[Chn r1];; 
typeof SLines=[S r1];; 
typeof mainw=ObjWin;; 
typeof address=ObjText;; 
typeof connectbtn=ObjButton;; 
typeof mainstatus=ObjText;; 
typeof mainmenu=ObjMenu;; 
typeof filemenu=ObjMenu;; 
typeof littlefont=ObjFont;; 
typeof mediumfont=ObjFont;; 
typeof bigfont=ObjFont;; 
typeof searchdns=ObjCheck;; 
typeof nickname=ObjText;; 
typeof chatroom=ObjCheck;; 
typeof book=[S r1];; 

var NickName="Nick";; 
var packsusers=["Comm/recon.bmp" 3 0]:: ["Comm/recoff.bmp" 3 0]:: ["Comm/playon.bmp" 3 0]
             ::["Comm/playoff.bmp" 3 0]:: ["Comm/playmute.bmp" 3 0]:: ["locked/lib/const.pkg" 7 0]
             ::["Comm/comapi.pkg" 2 0]:: ["Comm/comapi2.pkg" 1 0]:: ["Comm/comapi3.pkg" 3 0]
             ::["Comm/comchat.pkg" 20 0]:: ["Comm/comclient.pkg" 2 0]:: ["Comm/comphone.pkg" 7 0]
             ::["Comm/comroomenv.pkg" 5 0]:: ["Comm/comutron1.pkg" 12 0]:: ["Comm/stdlib.pkg" 2 0]
             ::["Comm/comroom.scol" 1 0]:: ["Comm/scolcomm1.scol" 1 0]::["Comm/redirect.pkg" 1 0]:: nil;; 
var scriptserver="_load \"comm/comclient.pkg\"\n_connected";; 
/*var scriptuser="_load \"locked/lib/const.pkg\"\n_load \"comm/stdlib.pkg\"\n_load \"comm/comutron1.pkg\"\nMain NIL NIL 0\nclientonly \n_connected\n";;*/
var scriptuser="_load \"locked/lib/const.pkg\"\n_load \"comm/stdlib.pkg\"\n_load \"comm/redirect.pkg\"\nmain ";;
var PortComutron=1290;; 
var Address="";; 
var ChatRoom=0;; 
var APIconnect=0;; 

defcom loadscr=_load S;; 
defcom mainscr=main S I;; 
defcom status=status S;; 
defcom Cpublic=public S I;; 

var _clientonly=0;; 

fun cutlist(l,n,s)= 
  if l==nil || n==0 then nil 
  else let l-> [a nxt] in 
  if !strcmp a s then cutlist nxt n s 
  else [a cutlist nxt n-1 s];; 

fun rebuildbook(l)= 
  if l==nil then nil 
  else [hd hd l rebuildbook tl l] ;; 

fun initbookmarks()= 
  set book=rebuildbook strextr _getpack _checkpack "commark.txt" ;; 

fun buildbook(l)= if l==nil then nil 
else [hd l:: nil buildbook tl l] ;; 

fun savebookmark()= 
  _fooS strbuild buildbook book; 
  _storepack strbuild buildbook book "commark.txt"; 
  0 ;; 

proto Contact=fun [S] I;; 

fun MenuGoto (obj,t)= 
{ 
  Contact t; 
  0 
};; 

fun createback(menu,l) = 
  if l==nil then menu 
  else let l -> [name nxt] in 
    ( 
      _CBmenu (_APPitem _channel menu ME_ENABLED name) @MenuGoto name; 
      createback menu nxt
    ) ;; 

proto _addbook=fun [u0 u1] I;; 
proto _removebook=fun [u0 u1] I;; 
proto MenuQuit=fun [u0 u1] I;; 

fun createmenus()= 
  let _CRmenu MainChn mainw -> root in 
  ( 
    let _APPpopup MainChn root "File"->filemenu in 
    _CBmenu (_APPitem MainChn filemenu ME_ENABLED "Quit") @MenuQuit 0; 
    createback (_APPpopup MainChn root "Goto History") SLines; 
    let _APPpopup MainChn root "BookMark" -> bookm in 
    (
      _CBmenu (_APPitem MainChn bookm ME_ENABLED "Add Bookmark") @_addbook 0;
      _CBmenu (_APPitem MainChn bookm ME_ENABLED "Remove") @_removebook 0; 
      _APPitem MainChn bookm ME_SEPARATOR ""; 
      createback bookm book 
    ); 
    if mainmenu!=nil then _DSmenu mainmenu 
    else nil; 
    set mainmenu=root 
  ) ;; 

fun _addbook(t,x)= 
  let _GETtext address ->s in 
    if s==nil || (strlen s)<1 then 0 
    else 
    (
      set book=[s cutlist book 40 s]; 
      savebookmark; 
      createmenus; 
      0
    );; 

fun _removebook(t,x)= 
  set book=cutlist book 40 _GETtext address; 
  savebookmark; createmenus; 
  0;; 

fun cutbypoints(l)= 
  if l==nil then [nil nil] 
  else let l -> [a nxt] in 
  if a==': then [nil l] 
  else let cutbypoints nxt -> [x y] in 
    [[a x] y];; 

fun isIP(l)= 
  if l==nil then 1 
  else let l -> [a nxt] in 
  if a!='. && (a<'0 || a>'9) then 0 
  else isIP nxt;; 

fun isPORT(l)= 
  if l==nil then 1 
  else let l-> [a nxt] in if a<'0 || a>'9 then 0 else isPORT nxt;; 

fun mainwpaint (obj,r)= 
{ 
  _fooS "MainWindowPaint"; 0 
};; 

fun mainwdestroy (obj,r)= 
{ 
  _fooS "MainWindowDestroy"; 
  _closemachine 
};; 

fun MenuQuit (obj,r)= 
{ 
  _closemachine 
};; 

fun _status (s)= 
{ 
  _ADDtext mainstatus s; 
  LimitText mainstatus 200 10; 
};; 

fun IsPort (s)= 
{ 
  let (strlen s)-> len in 
  { 
    while (len>0 && (nth_char s (len-1)!=':)) do 
    {
      if ((nth_char s (len-1))==':) then 
      { 
        set len=0; 
        1 
      } 
      else 
      { 
        set len=len-1; 
        0 
      } 
    } 
  } 
};; 

fun cmpline(x,c)=
  if x==c then 1 
  else 0;; 

fun cmplineIP(x,c)= 
{ 
  _status strcat strcat strcat (_channelIP x) " * " c "\n"; 
  if (!strcmp (_channelIP x) c) then 1 
  else 0; 
};;  

typeof videoready=S;; 
typeof video=Video;; 
var vx=160;; 
var vy=120;;


var quality=20;; 
var videoinit=0;; 
var globalframe=0;;

fun GetVideo (obj,i,s)= 
  _JCompInit quality;
  set globalframe=globalframe+1;
  let (_c15to32 s)->ss2 in 
  set videoready=_JComp ss2 vx vy 
;; 

fun initvideo ()= 
_fooS "INITVIDEO";
  if (videoinit<=0) then 
  { 
    _fooS "INITVIDEOSTART";
/*    _JCompInit quality; */
    let (atoi _getress "videocapture") -> temp in
    let if temp==nil || temp==-1 then 0 else temp -> vid in
        set video=_CRcapWindow _channel nil vid 100 300 vx vy 1 1000000; 
    if (video!=nil) then _SETcapVideoStart video @GetVideo 0 
    else nil; 
    set videoinit=1
  } 
  else set videoinit=videoinit+1
;; 

fun stopvideo ()= 
  set videoinit=videoinit-1; 
  if (videoinit==0) then _DScapWindow video
  else 
  {
    if (videoinit<0) then set videoinit=0 else 0;
    nil
  };
  0;; 

fun _delline (chn)= 
{ 
  _fooS "Deleting from list!"; 
  set Lines=deletelist Lines chn; 
  _killchannel chn;   
/*  if _clientonly==1 then _closemachine 
  else nil; */
};; 

fun searchline(IP)= 
{ 
  search_in_list Lines @cmplineIP IP; 
};; 

fun ConnectTo (obj,r)= 
{ 
  set Address=_GETtext address; 
  let cutbypoints strtolist Address -> [a b] in 
  { 
  let (if isIP a then listtostr a 
       else 
       (
         _status _fooS strcatn ["looking up host "[listtostr a ["\n" nil]]];
         _gethostbyname listtostr a))-> adip in 
         { 
           if (IsPort listtostr b)==nil then 
           { 
             set adip=strcat strcat adip ":" itoa PortComutron;
             0 
           } 
           else 
           { 
             set adip=strcat strcat adip ":" listtostr tl b;
             0 
           }; 
           _status strcat strcat strcat strcat "Trying " Address " (" adip ")...\n"; 
           _openchannel adip "" Serverenv; 
         } 
       } 
     };; 
              
fun findline (line,ip)= 
  if line==nil then 0 
  else let line->[ch next] in 
    let _channelIP ch->ip2 in 
      if !strcmp ip ip2 then 1 
      else findline next ip;; 
              
fun Contact (Address)= 
{ 
  _fooS "Contact...";
  if (findline Lines (_channelIP _channel))!=nil then 
    let cutbypoints strtolist Address -> [a b] in 
    let 
    (
      if isIP a then listtostr a 
      else 
      (
        _status _fooS strcatn ["looking up host "[listtostr a ["\n" nil]]]; 
        _gethostbyname listtostr a
      )
    )-> adip in 
    { 
      if (IsPort listtostr b)==nil then 
      { 
        set adip=strcat strcat adip ":" itoa PortComutron; 
        0 
      } 
      else 
      { 
        set adip=strcat strcat adip ":" listtostr tl b; 
        0 
      }; 
      _status strcat strcat strcat strcat "Trying " Address " (" adip ")...\n"; 
      _openchannel adip "" Serverenv; 
      _SETtext address adip; 
      0 
    } 
  else (_fooS "Can't contact: Line Allready connected";0)
};; 

fun _AddLine (name,chn)= 
{ 
  set Lines=chn::Lines; 
  set SLines=(_channelIP chn)::SLines; 
  createmenus; 
  0 
};; 

fun ChatRoomCB (obj,r,i)= 
{ 
  set ChatRoom=i; 
  if (ChatRoom==0) then 
  { 
    _closeserver server; 
    _setenv _channel Serverenv; 
    set serverenv=Serverenv; 
    set server=_setserver Serverenv 1290 "_load \"locked/stdsrv.pkg\""; 
    set scriptserver="_load \"comm/comclient.pkg\"\n_connected"; 
    _status "Room Mode disabled.\n"; 
  } 
  else 
  {  
    _closeserver server; 
    _load "comm/comroomenv.pkg"; 
    set roomenv=_envchannel _channel; 
    set serverenv=roomenv; 
    set server=_setserver roomenv 1290 "_load \"locked/stdsrv.pkg\"" ; 
    set scriptserver="_connected"; 
    _status "Room Mode enabled.\n"; 
  } 
};; 

fun InitWindows ()= 
{ 
  _fooS "InitWindows"; 
  set littlefont=_CRfont _channel atoi loc "LITFONTSZ" 0 0 loc "LITFONT"; 
  set mediumfont=_CRfont _channel atoi loc "MEDFONTSZ" 0 0 loc "MEDFONT"; 
  set bigfont=_CRfont _channel atoi loc "BIGFONTSZ" 0 FF_WEIGHT loc "BIGFONT"; 
  set mainw=_CRwindow _channel nil 512 10 315 165 WN_MENU+WN_MINBOX+WN_SIZEBOX+WN_MINIMIZE+WN_HIDDEN "Commutron"; 
  _CBwinPaint mainw @mainwpaint 0; 
  _CBwinDestroy mainw @mainwdestroy 0; 
  set address=_CReditText _channel mainw 160 5 150 25 ET_DOWN|ET_AHSCROLL ""; 
  set connectbtn=_CRbutton _channel mainw 5 5 150 25 0 "Connect to :"; 
  _CBbutton connectbtn @ConnectTo 0; 
  set mainstatus=_CRtext _channel mainw 5 60 305 80 ET_DOWN|ET_AVSCROLL|ET_VSCROLL "Comutron started\n"; 
  _AFFfontText mainstatus littlefont; 
  _AFFfontButton connectbtn bigfont; 
  _AFFfontText address mediumfont; 
  initbookmarks; createmenus; 
  _CRtext _channel mainw 5 32 150 22 ET_BORDER "Your name :"; 
  set nickname=_CReditText _channel mainw 160 30 150 25 ET_DOWN|ET_AHSCROLL "NickName"; 
  _AFFfontText nickname mediumfont; 
  _PAINTwindow mainw; 
  _fooS "End InitWindows"; 
  0 
};; 

fun Main (port,nick,serv)= 
{  
  startloc "Comm/comm"; 
  set MainChn=_channel; 
  if port!=nil then 
  {   
    set PortComutron=port 
  } 
  else 
  { 
    set port=atoi _getress "PortComutron"; 
    if port!=nil then 
    { 
      set PortComutron=port 
    } 
    else 0 
  }; 
  _fooS "ComPort OK"; 
  if nick!=nil then 
  { 
    set NickName=nick; 
    0 
  } 
  else 
  { 
    set nick=_getress "DefaultName"; 
    if nick==nil then set nick=_getpack _checkpack "pseudo.txt" 
    else nil; 
    if nick!=nil then 
    { 
      set NickName=nick; 
      0 
    } 
    else 0
  }; 
  _fooS "ComNick OK"; 
  set Serverenv=_envchannel _channel; 
  set serverenv=Serverenv; 
  set server=_setserver serverenv PortComutron "_load \"locked/stdsrv.pkg\""; 
  if (server==nil) then 
  {  
    set _clientonly=1; 
    _fooS "Not Server"; 
    initbookmarks; 
    InitWindows; 
    _SETtext nickname NickName; 
    0 
  } 
  else 
  { 
    _fooS "Server"; 
    initbookmarks; 
    InitWindows; 
    _SETtext nickname NickName; 
    _scriptc _masterchannel mkscript Cpublic ["Commutron" PortComutron]; 
    0 
  }; 
  if (serv==1) then 
  { 
    _closeserver server; 
    _load "comroomenv.pkg"; 
    set roomenv=_envchannel _channel; 
    set serverenv=roomenv; 
    set server=_setserver roomenv 1290 "_load \"locked/stdsrv.pkg\"" ; 
    set scriptserver="_connected"; 
    _status "Room Mode enabled.\n"; 
    0 
  } 
  else 0; 
  
  set scriptuser=strcatn scriptuser::"\""::(_hostIP)::"\""::"\n"::nil;
  
  _JCompInit quality; 

  _fooS "End Main"; 
  0 
};; 

defcom ChatStart = ChatStart S;; 
defcom skip=skip;; 
defcom InitChat = InitChat S I;; 

fun __ChatACK (nick)= 
{ 
  _status strcat strcat strcat nick " on IP " _channelIP _channel " opens a new chat window."; 
  _load "comm/comphone.pkg"; 
  _load "comm/comchat.pkg"; 
  _script mkscript InitChat [nick ChatRoom]; 
  0 
};; 

fun __ChatNACK (nick,message)= 
{ 
  _DLGMessageBox _channel nil loc "REFUSED" strloc loc "REFUSED2" nick::(_channelIP _channel)::nil 0; 
  _status message;   
  _delline _channel; 
  _closechannel;  
  0 
};; 

fun _connected ()= 
{ 
  _on _channel skip []; 
  _SETfocus mainw; 
  _status "Connection.\n"; 
  _on _channel ChatStart [_GETtext nickname]; 
  _AddLine _channelIP _channel _channel; 
};; 

fun _closed ()= 
{  
  _status "Deconnection.\n"; 
};;


fun __redirect (ip)=
  if (!strcmp _fooS _channelIP _channel "127.0.0.1")||(!strcmp _channelIP _channel _fooS _hostIP) then Contact ip else nil;
  _closechannel;;

fun APIContact (Address)= 
{ 
  __redirect Address
/*
  if (IsPort Address) then { 0 } 
  else 
  { 
    set Address=strcat strcat Address ":" itoa PortComutron;
    0 
  }; 
  _status strcat strcat "API Trying " Address " ...\n"; 
  set APIconnect=1; _openchannel Address "_load \"comm/comapi2.pkg\"\nAPIcnx\n" _envchannel _channel;  
  0 */
};;