Info-Mac 3/Info_Mac_1994-01.iso/Development/Source/IRC client Source/ircle sources/IRCInput.p

Text File | 1993-06-05 | 5.8 KB | 262 lines | [TEXT/PJMM]

{    ircle - Internet Relay Chat client    }
{    File: IRCInput    }
{    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 IRCInput;
{ Handles input from the user and sends messages to the server. }
{ Handles lines sent from the server. }
{ And handles menu commands. }

interface
uses
    TCPTypes, TCPStuff, TCPConnections, Coroutines, ApplBase, MsgWindows, InputLine, {}
    IRCGlobals, IRCaux, IRCPreferences, IRCChannels, IRCCommands, DCC, IRCSComm;

procedure InitIRCInput;
{ Startup }

implementation

var
    prevcr: boolean;


procedure PasteCommand (s: str20);  { Set the input line to a command }
    begin
        s := concat(cmdchar, s);
        SetInputLine(s);
    end;

function MenuFILE (var e: EventRecord): boolean;
    var
        i: integer;
        s: string;
    begin
        MenuFILE := true;
        case loword(e.message) of
            M_F_OPEN:
                OpenConnection;
            M_F_CLOSE:
                if GetWRefCon(FrontWindow) <> 0 then
                    partWindow(FrontWindow);
            M_F_LOG:
                begin
                if logging then begin
                    close(logfile);
                    logging := false
                end
                else begin
                    s := NewFileName('Save log to file:');
                    if s <> '' then begin
                        rewrite(logfile, s);
                        logging := true
                    end
                end;
            end;
            M_F_FLUSH:
                begin
                flushing := true;
                UpdateStatusLine
            end;
            M_F_PREFS:
                begin
                ValidPrefs := GetPrefs(true);
                if ValidPrefs then
                    EnableItem(GetMHandle(M_SHCUTS), 0);
            end;
            M_F_QUIT:
                begin
                if serverStatus = 0 then begin
                    if Alert(A_QUIT, nil) <> 1 then
                        exit(menuFILE);
                    s := 'QUIT';
                    HandleCommand(s);    { try a regular exit }
                end;
                ApplExit; { Emergency exit - will give 'bad link' as reason }
            end;
        end;
    end;

function MenuCOMMANDS (var e: EventRecord): boolean;
    begin
        case loword(e.message) of
            M_CO_JOIN:
                PasteCommand('join ');
            M_CO_PART:
                PasteCommand('part ');
            M_CO_LIST:
                PasteCommand('list ');
            M_CO_WHO:
                PasteCommand('who ');
            M_CO_QUERY:
                PasteCommand('query ');
            M_CO_WHOIS:
                PasteCommand('whois ');
            M_CO_INVITE:
                PasteCommand('invite ');
            M_CO_KICK:
                PasteCommand('kick ');
            M_CO_AWAY:
                PasteCommand('away ');
            M_CO_MSG:
                PasteCommand('msg ');
        end;
        MenuCOMMANDS := true
    end;


function MenuSHCUTS (var e: EventRecord): boolean;
    var
        s: string;
    begin
        if e.message = M_SH_DEFINE then
            GetShortcuts
        else begin
            s := Shortcuts^^[loword(e.message) - M_SH_FIRST];
            if s <> '' then
                InsertInputLine(s);
        end;
        MenuSHCUTS := true
    end;

function MenuFONTS (var e: EventRecord): boolean;
    var
        s: Str255;
        p0: GrafPtr;
        m: MenuHandle;
        i: integer;
    begin
        m := GetMHandle(262);
        case loword(e.message) of
            M_FO_9:
                MWDefaultSize := 9;
            M_FO_10:
                MWDefaultSize := 10;
            M_FO_12:
                MWDefaultSize := 12;
            M_FO_14:
                MWDefaultSize := 14;
            otherwise
                begin
                GetItem(m, LoWord(e.message), s);
                GetFNum(s, MWDefaultFont);
            end
        end;
        if e.message < 5 then
            for i := 1 to 4 do
                CheckItem(m, i, (i = Loword(e.message)))
        else
            for i := 6 to CountMItems(m) do
                CheckItem(m, i, (i = Loword(e.message)));
        if MWActive <> nil then begin
            GetPort(p0);
            SetPort(MWActive^^.w);
            SetFontSize(MWActive, MWDefaultFont, MWDefaultSize);
            SetPort(p0)
        end;
        MenuFONTS := true;
    end;

{ Process a typed line as message. }
{ This means: convert it to a PRIVMSG command to the current target, }
{ i.e. the channel or query of the active window. }
procedure HandleMessage (var s: string);
    var
        c: string;
    begin
        if currentTarget = '' then
            StatusMsg(E_NOTARGET)
        else if CurrentTarget[1] = '(' then
            StatusMsg(E_NOTARGET)
        else if CurrentTarget[1] = DCC_CHAT_PREFIX then
            DCCChatSend(s)
        else begin
            c := concat('> ', s);
            Message(c);
            c := concat('PRIVMSG ', CurrentTarget, ' :', s);
            HandleCommand(c);
            s := '';
        end;
    end;

{ 'srvHandler' handles lines received from server }
procedure srvHandler (var s: string);
    begin
        if s[0] <> chr(0) then
            if prevcr then
                ServerCommands(s)
            else
                MWMessage(lastwindow, s);
    end;

{ 'InputHandler' process handles input from the user }
procedure InputHandler (var s: string);
    begin
        GetDateTime(idleTime);
        if s[0] <> chr(0) then
            if s[1] = CmdChar then
                HandleCommand(s)
            else
                HandleMessage(s);
    end;

function watchLine (var e: EventRecord): boolean;
    var
        c: CEPtr;
        s: string;
        nn: longint;
        i, j: integer;
        cr: boolean;
    begin
        c := CEPtr(e.message);
        if c^.connection = sSocket then begin
            watchLine := true;
            if c^.event = C_CharsAvailable then begin
                nn := 1;
                i := TCPReceiveUpTo(c^.tcpc, 10, readTimeout, @s[0], 250, nn, cr);
                j := nn - 1;
                while (j > 0) and ((s[j] = chr(10)) or (s[j] = chr(13))) do
                    j := pred(j);
                if j > 0 then begin
                    s[0] := chr(j);
                    for i := 1 to j do
                        s[i] := ISODecode^^[s[i]];
                    srvHandler(s);
                end;
                prevcr := cr;
            end
            else
                serverOk(c^.event)
        end
        else
            watchLine := false;
    end;


procedure InitIRCInput;
    var
        i: integer;
    begin
        OpenInputLine(@InputHandler);
        i := ApplTask(@MenuFILE, menuMsg + fileMenu);
        i := ApplTask(@MenuCOMMANDS, menuMsg + M_COMMANDS);
        i := ApplTask(@MenuSHCUTS, menuMsg + M_SHCUTS);
        i := ApplTask(@MenuFONTS, menuMsg + M_FONT);
        i := ApplTask(@watchLine, TCPMsg);
    end;

end.