Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Peter Lewis/PNL Libraries/MyTextWindow.p

Text File | 1993-06-17 | 7.1 KB | 346 lines | [TEXT/PJMM]

unit MyTextWindow;

interface

    uses
        MyOOMainLoop, MyEditObject;

    const
        WT_EditWindow = 'EdWd';

    type
        TextWindowObject = object(DObject)
                textob: EditObject;
                spec: FSSpec;
                named: boolean;
                function Modified: boolean;
                procedure Create (id: integer);
                override;
                procedure Destroy;
                override;
                procedure Resize;
                override;
                function EditMenuEnabled: boolean;
                override;
                procedure SetEditMenuItem (item: integer);
                override;
                procedure DoEditMenu (item: integer);
                override;
                procedure DoKey (modifiers: integer; ch: char; code: integer);
                override;
                procedure DoItemWhere (er: eventRecord; item: integer);
                override;
                procedure DoActivateDeactivate (activate: boolean);
                override;
                procedure CalculateRegion (var rgn: rgnHandle);
                override;
                procedure DoIdle;
                override;
                procedure DoClose;
                override;
                function InsertText (p: ptr; s: longInt): integer;
                procedure DoNew;
                procedure Open (fs: FSSpec);
                procedure Save;
                procedure SaveAs (fs: FSSpec);
                procedure DoOpen;
                procedure DoSave;
                procedure DoSaveAs;
            end;

implementation

    uses
        MyUtils, BaseGlobals, MyTypes, MyUtilities, MyStandardFile;

    const
        text_window_dialog_id = 600;
        text_item = 1;

    function TextWindowObject.Modified: boolean;
    begin
        Modified := textob.modified;
    end;

    procedure TextWindowObject.Resize;
        var
            kind, fsize, bt, rt: integer;
            h: handle;
            r: rect;
            finfo: FontInfo;
    begin
        SetPort(window);
        GetDItem(window, text_item, kind, h, r);
        r := windowPeek(window)^.port.portRect;
        InsetRect(r, -1, -1);
        SetDItem(window, text_item, kind, h, r);
        textob.Resize;
    end;

    procedure TextWindowObject.DoActivateDeactivate (activate: boolean);
    begin
        textob.DoActivateDeactivate(activate);
    end;

    procedure TextWindowObject.DoIdle;
    begin
        textob.DoIdle;
    end;

    function TextWindowObject.EditMenuEnabled: boolean;
    begin
        EditMenuEnabled := textob.EditMenuEnabled;
    end;

    procedure TextWindowObject.SetEditMenuItem (item: integer);
    begin
        textob.SetEditMenuItem(item);
    end;

    procedure TextWindowObject.DoItemWhere (er: eventRecord; item: integer);
    begin
        textob.DoItemWhere(er, item);
    end;

    procedure TextWindowObject.DoEditMenu (item: integer);
    begin
        textob.DoEditMenu(item);
    end;

    procedure TextWindowObject.DoKey (modifiers: integer; ch: char; code: integer);
    begin
        textob.DoKey(modifiers, ch);
    end;

    procedure TextWindowObject.CalculateRegion (var rgn: rgnHandle);
        var
            pt: point;
            rgn2: rgnHandle;
            r: rect;
    begin
        rgn := NewRgn;

        r := textob.te^^.viewRect;
        SetPort(window);                    {make a global version of the viewRect}
        GetMouse(pt);
        RectRgn(rgn, r);
        if PtInRect(pt, r) then begin
            SetCursor(GetCursor(iBeamCursor)^^);
        end
        else begin
            SetCursor(arrow);
            rgn2 := NewRgn;
            SetRectRgn(rgn2, -30000, -30000, 30000, 30000);
            DiffRgn(rgn2, rgn, rgn);
            DisposeRgn(rgn2);
        end;
    end;

    procedure DrawText (dp: dialogPtr; item: integer);
    begin
        TextWindowObject(GetWObject(dp)).textob.Draw;
    end;

    function TextWindowObject.InsertText (p: ptr; s: longInt): integer;
        var
            t: longInt;
    begin
        t := GetHandleSize(textob.te^^.hText);
        if t + s > 32000 then
            InsertText := paste_to_big
        else begin
            SetHandleSize(textob.te^^.hText, t + s);
            if GetHandleSize(textob.te^^.hText) <> t + s then begin
                InsertText := memFullErr;
            end
            else begin
                BlockMove(p, ptr(longInt(textob.te^^.hText^) + t), s);
                TECalText(textob.te);
                textob.Adjust;
                InsertText := 0;
            end;
        end;
    end;

    procedure TextWindowObject.Create (id: integer);
        var
            kind, lw: integer;
            h: handle;
            r: rect;
            temptextob: EditObject;
            tempname: str63;
    begin
        inherited Create(id);
        window_type := WT_EditWindow;
        spec.vRefNum := 1;
        spec.parID := -1;
        spec.name := GetGlobalString(untitled_name);
        named := false;
        tempname := spec.name;
        SetWTitle(window, tempname);
        SetPort(window);
        TextFont(monaco);
        TextSize(9);
        new(temptextob);
        textob := temptextob;
        lw := CharWidth('a') * 80;
        textob.Create(window, text_item, lw, true, true, true, true, false);
        zoomSize.h := lw + 20;
        GetDItem(window, text_item, kind, h, r);
        SetDItem(window, text_item, kind, handle(@DrawText), r);
        Zoom(inZoomOut);
    end;

    procedure TextWindowObject.Destroy;
    begin
        textob.Destroy;
        inherited Destroy;
    end;

    procedure TextWindowObject.DoNew;
    begin
        Create(text_window_dialog_id);
        ShowWindow(window);
    end;

    procedure TextWindowObject.Open (fs: FSSpec);
        var
            rn: integer;
            oe, ooe: OSErr;
            size: longInt;
            err: integer;
            p: ptr;
    begin
        err := generic_read_error;
        Create(text_window_dialog_id);
        oe := HOpenDF(fs.vRefNum, fs.parID, fs.name, fsRdPerm, rn);
        if oe = noErr then begin
            oe := GetEOF(rn, size);
            if oe = noErr then begin
                if size > 32000 then begin
                    err := paste_to_big;
                    oe := -1;
                end
                else begin
                    p := NewPtr(size);
                    if p = nil then begin
                        err := memFullErr;
                        oe := -1;
                    end
                    else begin
                        oe := FSRead(rn, size, p);
                        if oe = noErr then begin
                            err := InsertText(p, size);
                            if err <> 0 then
                                oe := -1;
                        end;
                        DisposPtr(p);
                    end;
                end;
            end;
            ooe := FSClose(rn);
        end;
        if oe <> noErr then begin
            Destroy;
            AlertUser(err);
        end
        else begin
            spec := fs;
            named := true;
            SetWTitle(window, fs.name);
            ShowWindow(window);
        end;
    end;

    procedure TextWindowObject.Save;
        var
            rn: integer;
            oe, ooe: OSErr;
            size: longInt;
            tempname: str63;
    begin
        tempname := spec.name;
        oe := HCreate(spec.vRefNum, spec.parID, tempname, 'R*ch', 'TEXT');
        oe := HOpenDF(spec.vRefNum, spec.parID, tempname, fsWrPerm, rn);
        if oe = noErr then begin
            ooe := SetEOF(rn, 0);
            size := GetHandleSize(textob.te^^.hText);
            oe := FSWrite(rn, size, textob.te^^.hText^);
            ooe := FSClose(rn);
        end;
        if oe <> noErr then
            AlertUser(generic_write_error)
        else
            textob.modified := false;
    end;

    procedure TextWindowObject.SaveAs (fs: FSSpec);
    begin
        spec := fs;
        named := true;
        SetWTitle(window, fs.name);
        DoSave;
    end;

    procedure TextWindowObject.DoClose;
        var
            sc: SCType;
    begin
        sc := SCDiscard;
        if textob.modified then begin
            sc := SaveChanges;
            if sc = SCSave then begin
                DoSave;
                if textob.modified then
                    sc := SCCancel; { if still modified, then the user didn't save, so they must have canceled }
            end;
        end;
        if sc <> SCCancel then
            Destroy;
    end;

    procedure TextWindowObject.DoOpen;
        var
            reply: MySFReply;
            fs: FSSPec;
    begin
        GetFile1('TEXT', reply);
        with reply do
            if Rgood then begin
                fs.vRefNum := RVRefNum;
                fs.parID := RdirID;
                fs.name := Rfname;
                Open(fs);
            end
            else
                Destroy;
    end;

    procedure TextWindowObject.DoSave;
    begin
        if not named then
            DoSaveAs
        else
            Save;
    end;

    procedure TextWindowObject.DoSaveAs;
        var
            reply: MySFReply;
            tempname: str63;
            fs: FSSpec;
    begin
        if named then
            SetSFFile(spec.vRefNum, spec.parID);
        tempname := spec.name;
        PutFile('Save file as:', tempname, reply);
        with reply do
            if Rgood then begin
                fs.vRefNum := RVRefNum;
                fs.parID := RdirID;
                fs.name := Rfname;
                SaveAs(fs);
            end;
    end;

end.