home *** CD-ROM | disk | FTP | other *** search
/ Treasure Hunt 2001 PRESSKIT / TH2001_PRESSKIT.iso / demo / scol_install / Partition / comm / comutron1.pkg < prev    next >
Encoding:
Text File  |  2000-10-17  |  12.6 KB  |  507 lines
  1. /* Comutron1.pkg */
  2.  
  3. typeof server=Srv;; 
  4. typeof serverenv=Env;; 
  5. typeof Serverenv=Env;; 
  6. typeof roomenv=Env;; 
  7. typeof APIchn=Chn;; 
  8. typeof MainChn=Chn;; 
  9. typeof Lines=[Chn r1];; 
  10. typeof SLines=[S r1];; 
  11. typeof mainw=ObjWin;; 
  12. typeof address=ObjText;; 
  13. typeof connectbtn=ObjButton;; 
  14. typeof mainstatus=ObjText;; 
  15. typeof mainmenu=ObjMenu;; 
  16. typeof filemenu=ObjMenu;; 
  17. typeof littlefont=ObjFont;; 
  18. typeof mediumfont=ObjFont;; 
  19. typeof bigfont=ObjFont;; 
  20. typeof searchdns=ObjCheck;; 
  21. typeof nickname=ObjText;; 
  22. typeof chatroom=ObjCheck;; 
  23. typeof book=[S r1];; 
  24.  
  25. var NickName="Nick";; 
  26. var packsusers=["Comm/recon.bmp" 3 0]:: ["Comm/recoff.bmp" 3 0]:: ["Comm/playon.bmp" 3 0]
  27.              ::["Comm/playoff.bmp" 3 0]:: ["Comm/playmute.bmp" 3 0]:: ["locked/lib/const.pkg" 7 0]
  28.              ::["Comm/comapi.pkg" 2 0]:: ["Comm/comapi2.pkg" 1 0]:: ["Comm/comapi3.pkg" 3 0]
  29.              ::["Comm/comchat.pkg" 20 0]:: ["Comm/comclient.pkg" 2 0]:: ["Comm/comphone.pkg" 7 0]
  30.              ::["Comm/comroomenv.pkg" 5 0]:: ["Comm/comutron1.pkg" 12 0]:: ["Comm/stdlib.pkg" 2 0]
  31.              ::["Comm/comroom.scol" 1 0]:: ["Comm/scolcomm1.scol" 1 0]::["Comm/redirect.pkg" 1 0]:: nil;; 
  32. var scriptserver="_load \"comm/comclient.pkg\"\n_connected";; 
  33. /*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";;*/
  34. var scriptuser="_load \"locked/lib/const.pkg\"\n_load \"comm/stdlib.pkg\"\n_load \"comm/redirect.pkg\"\nmain ";;
  35. var PortComutron=1290;; 
  36. var Address="";; 
  37. var ChatRoom=0;; 
  38. var APIconnect=0;; 
  39.  
  40. defcom loadscr=_load S;; 
  41. defcom mainscr=main S I;; 
  42. defcom status=status S;; 
  43. defcom Cpublic=public S I;; 
  44.  
  45. var _clientonly=0;; 
  46.  
  47. fun cutlist(l,n,s)= 
  48.   if l==nil || n==0 then nil 
  49.   else let l-> [a nxt] in 
  50.   if !strcmp a s then cutlist nxt n s 
  51.   else [a cutlist nxt n-1 s];; 
  52.  
  53. fun rebuildbook(l)= 
  54.   if l==nil then nil 
  55.   else [hd hd l rebuildbook tl l] ;; 
  56.  
  57. fun initbookmarks()= 
  58.   set book=rebuildbook strextr _getpack _checkpack "commark.txt" ;; 
  59.  
  60. fun buildbook(l)= if l==nil then nil 
  61. else [hd l:: nil buildbook tl l] ;; 
  62.  
  63. fun savebookmark()= 
  64.   _fooS strbuild buildbook book; 
  65.   _storepack strbuild buildbook book "commark.txt"; 
  66.   0 ;; 
  67.  
  68. proto Contact=fun [S] I;; 
  69.  
  70. fun MenuGoto (obj,t)= 
  71. { 
  72.   Contact t; 
  73.   0 
  74. };; 
  75.  
  76. fun createback(menu,l) = 
  77.   if l==nil then menu 
  78.   else let l -> [name nxt] in 
  79.     ( 
  80.       _CBmenu (_APPitem _channel menu ME_ENABLED name) @MenuGoto name; 
  81.       createback menu nxt
  82.     ) ;; 
  83.  
  84. proto _addbook=fun [u0 u1] I;; 
  85. proto _removebook=fun [u0 u1] I;; 
  86. proto MenuQuit=fun [u0 u1] I;; 
  87.  
  88. fun createmenus()= 
  89.   let _CRmenu MainChn mainw -> root in 
  90.   ( 
  91.     let _APPpopup MainChn root "File"->filemenu in 
  92.     _CBmenu (_APPitem MainChn filemenu ME_ENABLED "Quit") @MenuQuit 0; 
  93.     createback (_APPpopup MainChn root "Goto History") SLines; 
  94.     let _APPpopup MainChn root "BookMark" -> bookm in 
  95.     (
  96.       _CBmenu (_APPitem MainChn bookm ME_ENABLED "Add Bookmark") @_addbook 0;
  97.       _CBmenu (_APPitem MainChn bookm ME_ENABLED "Remove") @_removebook 0; 
  98.       _APPitem MainChn bookm ME_SEPARATOR ""; 
  99.       createback bookm book 
  100.     ); 
  101.     if mainmenu!=nil then _DSmenu mainmenu 
  102.     else nil; 
  103.     set mainmenu=root 
  104.   ) ;; 
  105.  
  106. fun _addbook(t,x)= 
  107.   let _GETtext address ->s in 
  108.     if s==nil || (strlen s)<1 then 0 
  109.     else 
  110.     (
  111.       set book=[s cutlist book 40 s]; 
  112.       savebookmark; 
  113.       createmenus; 
  114.       0
  115.     );; 
  116.  
  117. fun _removebook(t,x)= 
  118.   set book=cutlist book 40 _GETtext address; 
  119.   savebookmark; createmenus; 
  120.   0;; 
  121.  
  122. fun cutbypoints(l)= 
  123.   if l==nil then [nil nil] 
  124.   else let l -> [a nxt] in 
  125.   if a==': then [nil l] 
  126.   else let cutbypoints nxt -> [x y] in 
  127.     [[a x] y];; 
  128.  
  129. fun isIP(l)= 
  130.   if l==nil then 1 
  131.   else let l -> [a nxt] in 
  132.   if a!='. && (a<'0 || a>'9) then 0 
  133.   else isIP nxt;; 
  134.  
  135. fun isPORT(l)= 
  136.   if l==nil then 1 
  137.   else let l-> [a nxt] in if a<'0 || a>'9 then 0 else isPORT nxt;; 
  138.  
  139. fun mainwpaint (obj,r)= 
  140. { 
  141.   _fooS "MainWindowPaint"; 0 
  142. };; 
  143.  
  144. fun mainwdestroy (obj,r)= 
  145. { 
  146.   _fooS "MainWindowDestroy"; 
  147.   _closemachine 
  148. };; 
  149.  
  150. fun MenuQuit (obj,r)= 
  151. { 
  152.   _closemachine 
  153. };; 
  154.  
  155. fun _status (s)= 
  156. { 
  157.   _ADDtext mainstatus s; 
  158.   LimitText mainstatus 200 10; 
  159. };; 
  160.  
  161. fun IsPort (s)= 
  162. { 
  163.   let (strlen s)-> len in 
  164.   { 
  165.     while (len>0 && (nth_char s (len-1)!=':)) do 
  166.     {
  167.       if ((nth_char s (len-1))==':) then 
  168.       { 
  169.         set len=0; 
  170.         1 
  171.       } 
  172.       else 
  173.       { 
  174.         set len=len-1; 
  175.         0 
  176.       } 
  177.     } 
  178.   } 
  179. };; 
  180.  
  181. fun cmpline(x,c)=
  182.   if x==c then 1 
  183.   else 0;; 
  184.  
  185. fun cmplineIP(x,c)= 
  186. { 
  187.   _status strcat strcat strcat (_channelIP x) " * " c "\n"; 
  188.   if (!strcmp (_channelIP x) c) then 1 
  189.   else 0; 
  190. };;  
  191.  
  192. typeof videoready=S;; 
  193. typeof video=Video;; 
  194. var vx=160;; 
  195. var vy=120;;
  196.  
  197.  
  198. var quality=20;; 
  199. var videoinit=0;; 
  200. var globalframe=0;;
  201.  
  202. fun GetVideo (obj,i,s)= 
  203.   _JCompInit quality;
  204.   set globalframe=globalframe+1;
  205.   let (_c15to32 s)->ss2 in 
  206.   set videoready=_JComp ss2 vx vy 
  207. ;; 
  208.  
  209. fun initvideo ()= 
  210. _fooS "INITVIDEO";
  211.   if (videoinit<=0) then 
  212.   { 
  213.     _fooS "INITVIDEOSTART";
  214. /*    _JCompInit quality; */
  215.     let (atoi _getress "videocapture") -> temp in
  216.     let if temp==nil || temp==-1 then 0 else temp -> vid in
  217.         set video=_CRcapWindow _channel nil vid 100 300 vx vy 1 1000000; 
  218.     if (video!=nil) then _SETcapVideoStart video @GetVideo 0 
  219.     else nil; 
  220.     set videoinit=1
  221.   } 
  222.   else set videoinit=videoinit+1
  223. ;; 
  224.  
  225. fun stopvideo ()= 
  226.   set videoinit=videoinit-1; 
  227.   if (videoinit==0) then _DScapWindow video
  228.   else 
  229.   {
  230.     if (videoinit<0) then set videoinit=0 else 0;
  231.     nil
  232.   };
  233.   0;; 
  234.  
  235. fun _delline (chn)= 
  236. { 
  237.   _fooS "Deleting from list!"; 
  238.   set Lines=deletelist Lines chn; 
  239.   _killchannel chn;   
  240. /*  if _clientonly==1 then _closemachine 
  241.   else nil; */
  242. };; 
  243.  
  244. fun searchline(IP)= 
  245. { 
  246.   search_in_list Lines @cmplineIP IP; 
  247. };; 
  248.  
  249. fun ConnectTo (obj,r)= 
  250. { 
  251.   set Address=_GETtext address; 
  252.   let cutbypoints strtolist Address -> [a b] in 
  253.   { 
  254.   let (if isIP a then listtostr a 
  255.        else 
  256.        (
  257.          _status _fooS strcatn ["looking up host "[listtostr a ["\n" nil]]];
  258.          _gethostbyname listtostr a))-> adip in 
  259.          { 
  260.            if (IsPort listtostr b)==nil then 
  261.            { 
  262.              set adip=strcat strcat adip ":" itoa PortComutron;
  263.              0 
  264.            } 
  265.            else 
  266.            { 
  267.              set adip=strcat strcat adip ":" listtostr tl b;
  268.              0 
  269.            }; 
  270.            _status strcat strcat strcat strcat "Trying " Address " (" adip ")...\n"; 
  271.            _openchannel adip "" Serverenv; 
  272.          } 
  273.        } 
  274.      };; 
  275.               
  276. fun findline (line,ip)= 
  277.   if line==nil then 0 
  278.   else let line->[ch next] in 
  279.     let _channelIP ch->ip2 in 
  280.       if !strcmp ip ip2 then 1 
  281.       else findline next ip;; 
  282.               
  283. fun Contact (Address)= 
  284. { 
  285.   _fooS "Contact...";
  286.   if (findline Lines (_channelIP _channel))!=nil then 
  287.     let cutbypoints strtolist Address -> [a b] in 
  288.     let 
  289.     (
  290.       if isIP a then listtostr a 
  291.       else 
  292.       (
  293.         _status _fooS strcatn ["looking up host "[listtostr a ["\n" nil]]]; 
  294.         _gethostbyname listtostr a
  295.       )
  296.     )-> adip in 
  297.     { 
  298.       if (IsPort listtostr b)==nil then 
  299.       { 
  300.         set adip=strcat strcat adip ":" itoa PortComutron; 
  301.         0 
  302.       } 
  303.       else 
  304.       { 
  305.         set adip=strcat strcat adip ":" listtostr tl b; 
  306.         0 
  307.       }; 
  308.       _status strcat strcat strcat strcat "Trying " Address " (" adip ")...\n"; 
  309.       _openchannel adip "" Serverenv; 
  310.       _SETtext address adip; 
  311.       0 
  312.     } 
  313.   else (_fooS "Can't contact: Line Allready connected";0)
  314. };; 
  315.  
  316. fun _AddLine (name,chn)= 
  317. { 
  318.   set Lines=chn::Lines; 
  319.   set SLines=(_channelIP chn)::SLines; 
  320.   createmenus; 
  321.   0 
  322. };; 
  323.  
  324. fun ChatRoomCB (obj,r,i)= 
  325. { 
  326.   set ChatRoom=i; 
  327.   if (ChatRoom==0) then 
  328.   { 
  329.     _closeserver server; 
  330.     _setenv _channel Serverenv; 
  331.     set serverenv=Serverenv; 
  332.     set server=_setserver Serverenv 1290 "_load \"locked/stdsrv.pkg\""; 
  333.     set scriptserver="_load \"comm/comclient.pkg\"\n_connected"; 
  334.     _status "Room Mode disabled.\n"; 
  335.   } 
  336.   else 
  337.   {  
  338.     _closeserver server; 
  339.     _load "comm/comroomenv.pkg"; 
  340.     set roomenv=_envchannel _channel; 
  341.     set serverenv=roomenv; 
  342.     set server=_setserver roomenv 1290 "_load \"locked/stdsrv.pkg\"" ; 
  343.     set scriptserver="_connected"; 
  344.     _status "Room Mode enabled.\n"; 
  345.   } 
  346. };; 
  347.  
  348. fun InitWindows ()= 
  349. { 
  350.   _fooS "InitWindows"; 
  351.   set littlefont=_CRfont _channel atoi loc "LITFONTSZ" 0 0 loc "LITFONT"; 
  352.   set mediumfont=_CRfont _channel atoi loc "MEDFONTSZ" 0 0 loc "MEDFONT"; 
  353.   set bigfont=_CRfont _channel atoi loc "BIGFONTSZ" 0 FF_WEIGHT loc "BIGFONT"; 
  354.   set mainw=_CRwindow _channel nil 512 10 315 165 WN_MENU+WN_MINBOX+WN_SIZEBOX+WN_MINIMIZE+WN_HIDDEN "Commutron"; 
  355.   _CBwinPaint mainw @mainwpaint 0; 
  356.   _CBwinDestroy mainw @mainwdestroy 0; 
  357.   set address=_CReditText _channel mainw 160 5 150 25 ET_DOWN|ET_AHSCROLL ""; 
  358.   set connectbtn=_CRbutton _channel mainw 5 5 150 25 0 "Connect to :"; 
  359.   _CBbutton connectbtn @ConnectTo 0; 
  360.   set mainstatus=_CRtext _channel mainw 5 60 305 80 ET_DOWN|ET_AVSCROLL|ET_VSCROLL "Comutron started\n"; 
  361.   _AFFfontText mainstatus littlefont; 
  362.   _AFFfontButton connectbtn bigfont; 
  363.   _AFFfontText address mediumfont; 
  364.   initbookmarks; createmenus; 
  365.   _CRtext _channel mainw 5 32 150 22 ET_BORDER "Your name :"; 
  366.   set nickname=_CReditText _channel mainw 160 30 150 25 ET_DOWN|ET_AHSCROLL "NickName"; 
  367.   _AFFfontText nickname mediumfont; 
  368.   _PAINTwindow mainw; 
  369.   _fooS "End InitWindows"; 
  370.   0 
  371. };; 
  372.  
  373. fun Main (port,nick,serv)= 
  374. {  
  375.   startloc "Comm/comm"; 
  376.   set MainChn=_channel; 
  377.   if port!=nil then 
  378.   {   
  379.     set PortComutron=port 
  380.   } 
  381.   else 
  382.   { 
  383.     set port=atoi _getress "PortComutron"; 
  384.     if port!=nil then 
  385.     { 
  386.       set PortComutron=port 
  387.     } 
  388.     else 0 
  389.   }; 
  390.   _fooS "ComPort OK"; 
  391.   if nick!=nil then 
  392.   { 
  393.     set NickName=nick; 
  394.     0 
  395.   } 
  396.   else 
  397.   { 
  398.     set nick=_getress "DefaultName"; 
  399.     if nick==nil then set nick=_getpack _checkpack "pseudo.txt" 
  400.     else nil; 
  401.     if nick!=nil then 
  402.     { 
  403.       set NickName=nick; 
  404.       0 
  405.     } 
  406.     else 0
  407.   }; 
  408.   _fooS "ComNick OK"; 
  409.   set Serverenv=_envchannel _channel; 
  410.   set serverenv=Serverenv; 
  411.   set server=_setserver serverenv PortComutron "_load \"locked/stdsrv.pkg\""; 
  412.   if (server==nil) then 
  413.   {  
  414.     set _clientonly=1; 
  415.     _fooS "Not Server"; 
  416.     initbookmarks; 
  417.     InitWindows; 
  418.     _SETtext nickname NickName; 
  419.     0 
  420.   } 
  421.   else 
  422.   { 
  423.     _fooS "Server"; 
  424.     initbookmarks; 
  425.     InitWindows; 
  426.     _SETtext nickname NickName; 
  427.     _scriptc _masterchannel mkscript Cpublic ["Commutron" PortComutron]; 
  428.     0 
  429.   }; 
  430.   if (serv==1) then 
  431.   { 
  432.     _closeserver server; 
  433.     _load "comroomenv.pkg"; 
  434.     set roomenv=_envchannel _channel; 
  435.     set serverenv=roomenv; 
  436.     set server=_setserver roomenv 1290 "_load \"locked/stdsrv.pkg\"" ; 
  437.     set scriptserver="_connected"; 
  438.     _status "Room Mode enabled.\n"; 
  439.     0 
  440.   } 
  441.   else 0; 
  442.   
  443.   set scriptuser=strcatn scriptuser::"\""::(_hostIP)::"\""::"\n"::nil;
  444.   
  445.   _JCompInit quality; 
  446.  
  447.   _fooS "End Main"; 
  448.   0 
  449. };; 
  450.  
  451. defcom ChatStart = ChatStart S;; 
  452. defcom skip=skip;; 
  453. defcom InitChat = InitChat S I;; 
  454.  
  455. fun __ChatACK (nick)= 
  456. { 
  457.   _status strcat strcat strcat nick " on IP " _channelIP _channel " opens a new chat window."; 
  458.   _load "comm/comphone.pkg"; 
  459.   _load "comm/comchat.pkg"; 
  460.   _script mkscript InitChat [nick ChatRoom]; 
  461.   0 
  462. };; 
  463.  
  464. fun __ChatNACK (nick,message)= 
  465. { 
  466.   _DLGMessageBox _channel nil loc "REFUSED" strloc loc "REFUSED2" nick::(_channelIP _channel)::nil 0; 
  467.   _status message;   
  468.   _delline _channel; 
  469.   _closechannel;  
  470.   0 
  471. };; 
  472.  
  473. fun _connected ()= 
  474. { 
  475.   _on _channel skip []; 
  476.   _SETfocus mainw; 
  477.   _status "Connection.\n"; 
  478.   _on _channel ChatStart [_GETtext nickname]; 
  479.   _AddLine _channelIP _channel _channel; 
  480. };; 
  481.  
  482. fun _closed ()= 
  483. {  
  484.   _status "Deconnection.\n"; 
  485. };;
  486.  
  487.  
  488. fun __redirect (ip)=
  489.   if (!strcmp _fooS _channelIP _channel "127.0.0.1")||(!strcmp _channelIP _channel _fooS _hostIP) then Contact ip else nil;
  490.   _closechannel;;
  491.  
  492. fun APIContact (Address)= 
  493. { 
  494.   __redirect Address
  495. /*
  496.   if (IsPort Address) then { 0 } 
  497.   else 
  498.   { 
  499.     set Address=strcat strcat Address ":" itoa PortComutron;
  500.     0 
  501.   }; 
  502.   _status strcat strcat "API Trying " Address " ...\n"; 
  503.   set APIconnect=1; _openchannel Address "_load \"comm/comapi2.pkg\"\nAPIcnx\n" _envchannel _channel;  
  504.   0 */
  505. };;  
  506.  
  507.