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

Text File | 1992-09-06 | 7.7 KB | 315 lines

{    ircle - Internet Relay Chat client    }
{    File: IRCPreferences    }
{    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 IRCPreferences;
{ deals with the Preferences settings and files }

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

procedure InitIRCPreferences;
{ startup }

function GetPrefs (request: boolean): boolean;
{ get prefs from file (request=false)/ inquire (request=true) }

procedure GetShortcuts;
{ inquire new shortcuts }

implementation

{$SETC DEBUG=false}

const
    MAXMENU = 16;

var
    shcd: DialogPtr;

function NewClearHandle (nbytes: longint): Handle;
inline
    $201F,        {    MOVE.L (A7)+, D0        }
    $A322,        {    _NewHandle,Clear        }
    $2E88,        {    MOVE.L A0,(A7)        }
    $31C0, $0220;    {    MOVE.W D0,MemError    }

procedure defTODia (d: DialogPtr);
    var
        h: Handle;
        i, j: integer;
        l: longint;
        s: Str255;
        r: Rect;
    begin
        GetDItem(d, 3, i, h, r);
        SetIText(h, default^^.Server);
        GetDItem(d, 4, i, h, r);
        NumToString(default^^.Port, s);
        SetIText(h, s);
        GetDItem(d, 5, i, h, r);
        SetIText(h, default^^.Nick);
        GetDItem(d, 6, i, h, r);
        SetIText(h, default^^.userLoginName);
        GetDItem(d, 7, i, h, r);
        SetIText(h, default^^.userName);
        GetDItem(d, 8, i, h, r);
        SetIText(h, default^^.autoExec);
        for i := 1 to 4 do begin
            GetDItem(d, i + 8, j, h, r);
            SetCtlValue(ControlHandle(h), ord(default^^.notify[i]))
        end;
    end;

procedure defFROMDia (d: DialogPtr);
    var
        h: Handle;
        i, j: integer;
        l: longint;
        s: Str255;
        r: Rect;
    begin
        GetDItem(d, 3, i, h, r);
        GetIText(h, default^^.Server);
        GetDItem(d, 4, i, h, r);
        GetIText(h, s);
        StringToNum(s, l);
        default^^.Port := loword(l);
        GetDItem(d, 5, i, h, r);
        GetIText(h, default^^.Nick);
        GetDItem(d, 6, i, h, r);
        GetIText(h, default^^.userLoginName);
        GetDItem(d, 7, i, h, r);
        GetIText(h, default^^.userName);
        GetDItem(d, 8, i, h, r);
        GetIText(h, default^^.autoExec);
        for i := 1 to 4 do begin
            GetDItem(d, i + 8, j, h, r);
            default^^.notify[i] := boolean(GetCtlValue(ControlHandle(h)))
        end;
    end;

procedure SetShortcutsMenu;
    var
        m: MenuHandle;
        i: integer;
        s: str255;
    begin
        m := GetMHandle(261);
        for i := 1 to 10 do begin
            if Shortcuts^^[i] = '' then
                s := ' '
            else if length(Shortcuts^^[i]) > MAXMENU then
                s := concat(copy(Shortcuts^^[i], 1, MAXMENU), '...')
            else
                s := Shortcuts^^[i];
            SetItem(m, i + 2, s);
        end;
    end;

function CloseShortcuts (var e: eventRecord): boolean;
    var
        i, j: integer;
        h: Handle;
        r: Rect;
    begin
        if shcd <> nil then
            if DialogPtr(e.message) = shcd then
                if TrackGoAway(shcd, e.where) then begin
                    for i := 1 to 10 do begin
                        GetDItem(shcd, i, j, h, r);
                        GetIText(h, Shortcuts^^[i]);
                        if Shortcuts^^[i] = ' ' then
                            Shortcuts^^[i] := '';
                    end;
                    SetShortcutsMenu;
                    DisposDialog(shcd);
                    shcd := nil;
                    ChangedResource(Handle(shortcuts));
                    WriteResource(Handle(shortcuts));
                    CloseShortcuts := true;
                    exit(CloseShortcuts)
                end;
        CloseShortcuts := false
    end;

procedure savefont;
    begin
        with defFont^^ do begin
            fnt := MWdefaultFont;
            siz := MWdefaultSize
        end;
        ChangedResource(Handle(defFont));
        WriteResource(Handle(defFont));
    end;

procedure InitIRCPreferences;
    var
        i, j: integer;
        a: AppFile;
        s: string;
        p: Point;
        t: SFTypeList;
        r: SFReply;
    begin
        ValidPrefs := false;
        shcd := nil;
{$IFC DEBUG}
        if SetVol(nil, 0) = 0 then begin
            i := OpenResFile('ircleTest');
            if ResError = 0 then
                exit(InitIRCPreferences);
        end;
{$ENDC}
        CountAppFiles(i, j);
        if j = 0 then begin
            repeat
                s := NewFileName('Save Preferences as:');
                if s = '' then begin
                    SetPt(p, 80, 30);
                    t[0] := 'Pref';
                    SFGetFile(p, '', nil, 1, t, nil, r);
                    if r.good then
                        if SetVol(nil, r.vRefNum) <> 0 then
                            cycle;
                    i := OpenResFile(r.fName);
                end
                else begin
                    if Create(s, 0, 'pr╛C', 'Pref') <> 0 then
                        cycle;
                    CreateResFile(s);
                    if ResError = 0 then
                        i := OpenResFile(s)
                end;
            until ResError = 0;
        end
        else begin
            GetAppFiles(1, a);
            if SetVol(nil, a.vrefnum) = 0 then
                i := OpenResFile(a.fname);     {this really should not fail }
        end;
    end;

function GetPrefs (request: boolean): boolean;
    var
        d: DialogPtr;
        h: Handle;
        i, j: integer;
        r: Rect;
        m: MenuHandle;
        s: str255;
    begin
        if not ValidPrefs then begin
            default := defaultHndl(GetResource('Pref', 256));
            if default = nil then begin
                default := defaultHndl(NewClearHandle(sizeof(defaultType)));
                AddResource(Handle(default), 'Pref', 256, 'ircle Prefs');
                default^^.port := 6667
            end;
            if gethandlesize(handle(default)) < sizeof(defaultType) then begin
                sethandlesize(handle(default), sizeof(defaultType));
                for i := 1 to 4 do
                    default^^.notify[i] := false
            end;
            shortcuts := shortcutsHndl(GetResource('Pref', 257));
            if shortcuts = nil then begin
                shortcuts := shortcutsHndl(NewClearHandle(sizeof(ShortcutsType)));
                AddResource(Handle(shortcuts), 'Pref', 257, 'ircle Shortcuts');
            end;
            EnableItem(GetMHandle(M_SHCUTS), 0);
            SetShortcutsMenu;
            defFont := FSHndl(GetResource('Pref', 258));
            if defFont = nil then begin
                defFont := FSHndl(NewClearHandle(sizeof(FSType)));
                with defFont^^ do begin
                    fnt := monaco;
                    siz := 9
                end;
                AddResource(Handle(defFont), 'Pref', 258, 'ircle Font');
            end;
            with defFont^^ do begin
                MWdefaultFont := fnt;
                MWdefaultSize := siz
            end;
            i := ApplTask(@CloseShortcuts, mouseMsg + inGoAway);
            m := GetMHandle(M_FONT);
            EnableItem(m, 0);
            AddResMenu(m, 'FONT');
            DrawMenuBar;
            CheckItem(m, 1, (MWdefaultSize = 9));
            CheckItem(m, 2, (MWdefaultSize = 10));
            CheckItem(m, 3, (MWdefaultSize = 12));
            CheckItem(m, 4, (MWdefaultSize = 14));
            for i := 6 to CountMItems(m) do begin
                GetItem(m, i, s);
                GetFNum(s, j);
                CheckItem(m, i, (j = MWdefaultFont));
            end;
            ApplExitproc(@saveFont);
        end;
        if (default^^.server = '') or (default^^.nick = '') or (default^^.userLoginName = '') then
            request := true;
        if request then begin
            d := GetNewDialog(D_PREFS, nil, WindowPtr(-1));
            defTODia(d);
            repeat
                ModalDialog(nil, i);
                if i = 2 then begin
                    DisposDialog(d);
                    GetPrefs := false;
                    exit(GetPrefs)
                end;
                if (i >= 9) and (i <= 12) then begin
                    GetDItem(d, i, j, h, r);
                    default^^.notify[i - 8] := not default^^.notify[i - 8];
                    SetCtlValue(ControlHandle(h), ord(default^^.notify[i - 8]));
                end;
            until i = 1;
            defFROMDia(d);
            DisposDialog(d)
        end;
        GetPrefs := (default^^.server <> '') and (default^^.nick <> '') and (default^^.userLoginName <> '');
        default^^.nick := copy(default^^.nick, 1, 9);
        ChangedResource(Handle(default));
        WriteResource(Handle(default));
    end;

procedure GetShortcuts;
    var
        m: MenuHandle;
        i, j: integer;
        h: Handle;
        r: Rect;
    begin
        if shcd = nil then begin
            shcd := GetNewDialog(D_SHCUTS, nil, WindowPtr(-1));
            m := GetMHandle(261);
            for i := 1 to 10 do begin
                GetDItem(shcd, i, j, h, r);
                if Shortcuts^^[i] = ' ' then
                    SetIText(h, '')
                else
                    SetIText(h, Shortcuts^^[i]);
            end;

        end
        else
            SelectWindow(shcd);
    end;

end.