home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Applications / ircle 1.5.1 / source / ircle sources / ircle.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-10-30  |  3.7 KB  |  153 lines  |  [TEXT/PJMM]
  1. {    ircle - Internet Relay Chat client    }
  2. {    File: ircle    }
  3. {    Copyright © 1992 Olaf Titz (s_titz@ira.uka.de)    }
  4.  
  5. {    This program is free software; you can redistribute it and/or modify    }
  6. {    it under the terms of the GNU General Public License as published by    }
  7. {    the Free Software Foundation; either version 2 of the License, or    }
  8. {    (at your option) any later version.    }
  9.  
  10. {    This program is distributed in the hope that it will be useful,    }
  11. {    but WITHOUT ANY WARRANTY; without even the implied warranty of    }
  12. {    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    }
  13. {    GNU General Public License for more details.    }
  14.  
  15. {    You should have received a copy of the GNU General Public License    }
  16. {    along with this program; if not, write to the Free Software    }
  17. {    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    }
  18.  
  19. program ircle;
  20. { This is a small IRC client for the Macintosh. }
  21. { Written by Olaf Titz (s_titz@ira.uka.de), Karlsruhe, July/August 1992. }
  22. { The TCP interface code written  by Peter N.Lewis and Harry Chesley/Apple Computer Inc. }
  23. { Parts of the command protocol handling, and many ideas }
  24. {   derived from IRCII by Michael Sandrof }
  25.  
  26. uses
  27.     TCPTypes, TCPStuff, TCPConnections,{}
  28.     Coroutines, ApplBase, MiscGlue, MsgWindows, InputLine, {}
  29.     IRCGlobals, IRCaux, IRCPreferences, IRCInput, {}
  30.     IRCCommands, IRCChannels, IRCNotify, IRCSComm, IRCHelp, IRCInit;
  31.  
  32. const
  33.     NOTIFY_INTERVAL = 30; { Seconds between notify checks }
  34.  
  35. var
  36.     i, notify: integer;
  37.     fmem, lofmem, t0: longint;
  38.     purged: boolean;
  39.  
  40. {$SETC autoopen=false}
  41.  
  42. {$IFC DISTRIBUTION }
  43. {$SETC autoopen=true }
  44. {$ENDC}
  45.  
  46. { CheckMem gets called once in each run through the main event loop. }
  47. { If free memory runs low, first memory is compacted, then an alert is displayed }
  48. { and subsequent memory checking disabled for 30 seconds, or until more memory gets freed, }
  49. { e.g. by closing a window. }
  50. procedure CheckMem;
  51.     var
  52.         i: longint;
  53.     begin
  54.         if fmem < 0 then begin
  55.             getdatetime(i);
  56.             if (abs(i - lofmem) > MEMTIME) or (freemem > HIFREEMEM) then
  57.                 fmem := LOFREEMEM;
  58.         end
  59.         else if freemem < fmem then begin
  60.             if purged then begin
  61.                 fmem := -1;
  62.                 getdatetime(lofmem);
  63.                 if not MWFreeMem then
  64.                     i := Alert(A_LOWMEM, nil)
  65.             end
  66.             else begin
  67.                 PurgeMem(maxSize);
  68.                 purged := true
  69.             end
  70.         end
  71.         else
  72.             purged := false;
  73.     end;
  74.  
  75. function Clock (var e: EventRecord): boolean;
  76.     begin
  77.         CheckMem;
  78. {    if GetWRefCon(FrontWindow) = 0 then}
  79. {    DisableItem(FMenu, M_F_CLOSE)}
  80. {    else}
  81. {    EnableItem(FMenu, M_F_CLOSE);}
  82.         if abs(e.when - t0) >= 60 then begin
  83.             t0 := e.when;
  84.             UpdateStatusLine;
  85.             notify := notify + 1;
  86.             if notify >= NOTIFY_INTERVAL then begin
  87.                 notify := 0;
  88.                 if not IsAway then
  89.                     RunNotify
  90.             end
  91.         end;
  92.         Clock := false
  93.     end;
  94.  
  95. procedure ReadInitFile;
  96.     var
  97.         s: string;
  98.         b1, b2: boolean;
  99.     begin
  100.         while not eof(initFile) do begin
  101.             readln(initFile, s);
  102.             b1 := (copy(s, 1, 6) = 'SERVER');
  103.             b2 := (copy(s, 1, 4) = 'JOIN');
  104.             HandleCommand(s);
  105.             if b1 then { on SERVER command, wait for connection starting up }
  106.                 begin
  107.                 flushing := true;
  108.                 repeat
  109.                     ApplRun
  110.                 until not flushing;
  111.             end;
  112.             if b2 then
  113.                 repeat
  114.                     ApplRun
  115.                 until EmptyRect(windowarg);
  116.         end;
  117.         close(initFile);
  118.         SetShortcutsMenu;
  119.     end;
  120.  
  121. procedure ExitTCP;
  122.     var
  123.         i: integer;
  124.     begin
  125.         if logging then
  126.             close(logfile);
  127.         FinishEverything
  128.     end;
  129.  
  130. begin
  131.     serverStatus := S_OFFLINE;
  132.     fmem := LOFREEMEM;
  133.     purged := false;
  134.     if IRCInitAll then begin
  135.         notify := 0;
  136.         i := ApplTask(@Clock, nullEvent);
  137.         ApplExitproc(@ExitTCP);
  138.         UnloadSeg(@IRCInitAll);
  139.         t0 := -maxlongint;
  140.         if readPrefs then
  141.             ReadInitFile;
  142. {$IFC autoopen}
  143.         OpenConnection;
  144.         if serverStatus = S_CONN then
  145.             RegUser;
  146. {$ENDC}
  147.         InitCursor;
  148.         repeat
  149.             ApplRun;
  150.         until QuitRequest;
  151.         ApplExit;
  152.     end;
  153. end.