Otherware/Otherware_1_SB_Development.iso/mac/developm/source/rclesrc.10/ircle sources/IRCaux.p

Text File | 1992-09-06 | 3.8 KB | 186 lines

{    ircle - Internet Relay Chat client    }
{    File: IRCaux    }
{    Copyright ⌐ 1992 Olaf Titz ([e-mail])    }

{    This program is free software; you can redistribute it and/or modify    }
{    it under the terms of the GNU General Public License as published by    }
{    the Free Software Foundation; either version 2 of the License, or    }
{    (at your option) any later version.    }

{    This program is distributed in the hope that it will be useful,    }
{    but WITHOUT ANY WARRANTY; without even the implied warranty of    }
{    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    }
{    GNU General Public License for more details.    }

{    You should have received a copy of the GNU General Public License    }
{    along with this program; if not, write to the Free Software    }
{    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    }

unit IRCaux;
{ utilities }

interface
uses
    TCPTypes, TCPStuff, TCPConnections, ApplBase, InputLine, MsgWindows, IRCGlobals;

var
    Watch: CursHandle;

procedure ServerOK (status: OSErr);
{ Call this with the result of TCP functions }

procedure PutLine (var s: string);
{ Send a line to the server }

function IsChannel (var s: string): boolean;
{ is it a valid channel name? }

procedure NextArg (var from, arg: string);
{ get next arg out of 'from' into 'arg' }

procedure UpdateStatusLine;
{ Draw the IRC status line }

implementation

type
    str8 = string[8];


procedure ServerOK (status: OSErr);
    var
        n: integer;
        s: Str255;
    begin
        n := 0;
        case connectionEvent(status) of
            C_SearchFailed:
                begin
                status := -1;
                n := E_SFAILED;
            end;
            C_NameSearchFailed:
                begin
                status := -1;
                n := E_NSFAILED;
            end;
            C_FailedToOpen:
                begin
                status := -1;
                n := E_OFAILED;
            end;
            C_Closing:
                begin
                status := -1;
                n := E_CLOSING;
            end;
            C_Closed:
                begin
                status := -1;
                n := E_CLOSED;
            end;
            otherwise
        end;
        serverStatus := status;
        if n <> 0 then begin
            GetIndString(s, 256, n);
            ParamText(s, '', '', '');
            n := Alert(A_SSTAT, nil);
        end;
        UpdateStatusLine;
    end;

procedure PutLine (var s: string);
    var
        i, n, oe: integer;
        p: TCPConnectionPtr;
    begin
        n := length(s);
        for i := 1 to n do
            s[i] := ISOEncode^^[s[i]];
        s[n + 1] := chr(10);
{oe := TCPSend(p, @s^[1], ord(s[0]) + 2);}
        GetConnectionTCPC(sSocket, p);
        i := TCPSendAsync(p, @s[1], n + 1, @oe);
        if i <> 0 then
            serverStatus := i
        else begin
            repeat
                ApplRun
            until oe <> inProgress;
            serverStatus := oe;
        end;
    end;

function IsChannel (var s: string): boolean;
    begin
        IsChannel := (s[1] = '#'); { Strictly speaking, this is for 2.7 servers }
    end;

procedure NextArg (var from, arg: string);
    var
        i: integer;
    begin
        i := pos(' ', from);
        if i = 0 then begin
            arg := from;
            from := ''
        end
        else begin
            arg := copy(from, 1, i - 1);
            delete(from, 1, i);
            if from[1] = ':' then
                delete(from, 1, 1);
        end
    end;

function two (n: integer): str8;
    var
        s: str8;
    begin
        s := stringof(n + 100 : 3);
        two := copy(s, 2, 2)
    end;

procedure UpdateStatusLine;
    var
        s: string[80];
        s0: string[40];
        s1, s2, s3: string[10];
        d: DateTimeRec;
    begin
        case serverStatus of
            S_OFFLINE:
                s := '(Offline)';
            S_LOOKUP:
                s := '(Address lookup)';
            S_OPENING:
                s := '(opening)';
            S_CONN:
                s := CurrentServer;
            otherwise
                s := stringof('Err(', serverStatus : 1, ')');
        end;
        s0 := CurrentTarget;
        if s0 = '' then
            s0 := '(nobody)';
        s0 := concat(s0, '               ');
        if logging then
            s1 := 'Log'
        else
            s1 := '';
        if flushing then
            s2 := 'Flsh'
        else
            s2 := '';
        if NFT > 0 then
            s3 := stringof('FT(', NFT : 1, ')')
        else
            s3 := '';
        GetTime(d);
        s := stringof(CurrentNick : 10, ' talking to', copy(s0, 1, 12) : 13, s : 18, s1 : 4, s2 : 5, s3 : 8, '  ', two(d.hour), ':', two(d.minute), ':', two(d.second));
        StatusLine(s);
    end;


end.