Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Libraries/PNL Libraries/MyCleverAlerts.p

Text File | 1995-10-27 | 11.7 KB | 504 lines | [TEXT/CWIE]

unit MyCleverAlerts;

interface

    uses
        Types;

    procedure StartupCleverAlerts;
    procedure ConfigureCleverAlerts(icon_id: integer; icon_ndx: integer);

    procedure CleverParamText(param0,param1,param2,param3:Str255);
    function CleverAlert(id:integer):integer;
    procedure CleverNotifyAlert(id:integer);

    procedure CleverAlertTest;

{ text format:
[SCN][B-][MSW](:button)...
text of message

where S=Stop, C=Caution, N=Note; B=beep,-=dont; M=Main Screen,S=Parent Screen, W=Parent Window
}

implementation

    uses
        Resources,TextEdit,Fonts,LowMem,
        MyAssertions, MyStrH, MyDialogs,MyWindows, MyTypes, MyStrings, MyCursors,
        MyHandles, MyNotifier, MyMathUtils, MySystemGlobals, MyStartup;

    type
        DelayedAlertRecord=record
            id:integer;
            params:StrHHandle;
        end;

    var
        param_text:StrHHandle;
        delayed:HandleArray;
        alert_icon_id, alert_icon_ndx:integer;

    const
        alert_width = 432;
        alert_icon_left = 20;
        alert_icon_top = 10;
        alert_text_left = 74;
        alert_text_right = alert_width-10;
        alert_text_top = 7;
        alert_text_bottom = 40;
        alert_text_minimum_height = 32;
        alert_button_top = 30;
        alert_button_height = 20;
        alert_button_min_width = 58;
        alert_button_first_separation = 14;
        alert_button_separation = 10;
        alert_button_left = alert_text_left;
        alert_button_right = alert_text_right;
        alert_button_extra_width = 22;

    const { If you reorder these, change NewDITL! }
        o_useritem=1;
        o_icon=2;
        o_text=3;

    const
        no_command_key = spc;

    procedure CleverParamText(param0,param1,param2,param3:Str255);
    begin
        if param_text=nil then begin
            param_text:=NewStrH;
        end;
        if param_text<>nil then begin
            SetIndStrH(param_text,1,param0);
            SetIndStrH(param_text,2,param1);
            SetIndStrH(param_text,3,param2);
            SetIndStrH(param_text,4,param3);
        end;
    end;

    procedure InsertParamateres(te:TEHandle; pt:StrHHandle);
        var
            s:Str255;
            n:longInt;
    begin
        n:=0;
        while n<te^^.teLength-1 do begin
            if (CharsHandle(te^^.hText)^^[n]='^') & (CharsHandle(te^^.hText)^^[n+1] in ['0'..'3']) then begin
                if pt=nil then begin
                    s:='';
                end else begin
                    s:=GetIndStrH(pt,ord(CharsHandle(te^^.hText)^^[n+1])-48+1);
                end;
                TESetSelect(n,n+2,te);
                TEDelete(te);
                TEInsert(@s[1],length(s),te);
                n:=n+length(s);
            end else begin
                n:=n+1;
            end;
        end;
    end;

    procedure GetFirstLine(data:Handle; var s:Str255);
        var
            n:integer;
            found:boolean;
    begin
        s:='';
        n:=0;
        found:=false;
        while (n<GetHandleSize(data)) & (n<255) & not found do begin
            found:=(CharsHandle(data)^^[n]=cr);
            if not found then begin
                n:=n+1;
            end;
        end;
        if found then begin
            BlockMoveData(data^,@s[1],n);
            s[0]:=chr(n);
        end;
    end;

    procedure RemoveFirstLine(te:TEHandle);
        var
            s:Str255;
    begin
        GetFirstLine(te^^.hText,s);
        TESetSelect(0,length(s)+1,te);
        TEDelete(te);
    end;

    function NewDITL(theline:Str255; var icon,buttons:integer; var cmdkeys:Str15):handle;
        var
            list:Handle;
        procedure AppendWord(n:integer);
            var
                junk:OSErr;
        begin
            junk:=PtrAndHand(@n,list,SizeOf(n));
        end;
        procedure AppendByte(n:integer);
            var
                junk:OSErr;
        begin
            n:=BAND(n,$FF);
            n:=BOR(BSL(n,8),n);
            junk:=PtrAndHand(@n,list,1);
        end;
        procedure AppendLong(n:longInt);
            var
                junk:OSErr;
        begin
            junk:=PtrAndHand(@n,list,SizeOf(n));
        end;
        procedure AppendItem(top,left,bottom,right,kind,len:integer);
        begin
            AppendLong(0);
            AppendWord(top);
            AppendWord(left);
            AppendWord(bottom);
            AppendWord(right);
            AppendByte(kind);
            AppendByte(len);
        end;
        var
            s:Str255;
            i:integer;
            junk:OSErr;
            left,right:integer;
            onleft:boolean;
            width:integer;
            pos:integer;
            gp: GrafPort;
    begin
        OpenPort(@gp); { Need to set the font and size for StringWidth }
        SetMyFont(MFT_System0);
        cmdkeys:='';
        buttons:=0;
        for i:=1 to length(theline) do begin
            if theline[i]=':' then begin
                buttons:=buttons+1;
                cmdkeys:=concat(cmdkeys,no_command_key);
            end;
        end;
        if (buttons>=1) & (cmdkeys[1]=no_command_key) then begin
            cmdkeys[1]:=cr;
        end;
        if (buttons>=2) & (cmdkeys[2]=no_command_key) then begin
            cmdkeys[2]:='.';
        end;
        case theline[1] of
            'S':begin
                icon:=stopIcon;
            end;
            'C':begin
                icon:=cautionIcon;
            end;
            'N':begin
                icon:=noteIcon;
            end;
            otherwise begin
                Assert(false);
            end;
        end;
        list:=NewHandle(0);
        AppendWord(buttons+3-1);
        SplitBy(theline,':',s,theline);
        left:=alert_button_left;
        right:=alert_button_right;
        for i:=1 to buttons do begin
            SplitBy(theline,':',s,theline);
            onleft:=false;
            if s[1]='-' then begin
                onleft:=true;
                Delete(s,1,1);
            end;
            if (length(s)>2) & (s[length(s)-1]='/') then begin
                cmdkeys[i]:=UpCase(s[length(s)]);
                Delete(s,length(s)-1,2);
            end;
            width:=Max(StringWidth(s)+alert_button_extra_width,alert_button_min_width);
            if onleft then begin
                pos:=left;
                left:=left+width+alert_button_separation;
            end else begin
                pos:=right-width;
                if i=1 then begin
                    right:=right-width-alert_button_first_separation;
                end else begin
                    right:=right-width-alert_button_separation;
                end;
            end;
            AppendItem(0,pos,alert_button_height,pos+width,ctrlItem+btnCtrl,length(s));
            junk:=PtrAndHand(@s[1],list,length(s));
            if odd(length(s)) then begin
                AppendByte(0);
            end;
        end;
        AppendItem(0,0,0,0,userItem+itemDisable,0);
        AppendItem(alert_icon_top,alert_icon_left,alert_icon_top+32,alert_icon_left+32,iconItem+itemDisable,2);
        AppendWord(icon);
        AppendItem(alert_text_top,alert_text_left,alert_text_top+1000,alert_text_right,userItem+itemDisable,0);
        ClosePort(@gp);
        NewDITL:=list;
    end;

    var
        gTE:TEHandle;

    procedure DrawOurText(dlg:DialogPtr; item:integer);
        var
            bounds:Rect;
    begin
        GetDItemRect(dlg,item,bounds);
        TEUpdate(bounds,gTE);
    end;

    var
        button_command_keys:Str15;

    function OurModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
        var
            ret:boolean;
        procedure DoCommand(ch:Char);
            var
                i:integer;
                found:boolean;
        begin
            ch:=UpCase(ch);
            i:=1;
            found:=false;
            while (i<=length(button_command_keys)) & not found do begin
                if button_command_keys[i]=ch then begin
                    found:=true;
                end;
                if not found then begin
                    i:=i+1;
                end;
                if found then begin
                    item:=i;
                    FlashDItem(dlg, item);
                    ret:=true;
                end;
            end;
        end;
        var
            ch: integer;
    begin
        ret := false;
        if (er.what = keyDown) or (er.what = autoKey) then begin
            ch := BAND(er.message, $FF);
            if (ch = ord(cr)) or (ch = ord(enter)) then begin
                DoCommand(cr);
            end else if ((ch = ord('.')) and (BAND(er.modifiers, cmdKey) <> 0)) or (ch = 27) then begin
                DoCommand('.');
            end else if (BAND(er.modifiers, cmdKey) <> 0) then begin
                DoCommand(chr(ch));
            end;
        end;
        OurModalFilter:=ret;
    end;

    function DisplayAlert(id:integer; pt:StrHHandle; may_sound:boolean):integer;
        var
            txt,styl:Handle;
            dlg:DialogPtr;
            bounds:Rect;
            idealsize:Point;
            theline:Str255;
            i,button_count:integer;
            itemlist:Handle;
            icon:integer;
            item:integer;
            DrawOurTextProc:UniversalProcPtr;
            OurModalFilterProc:UniversalProcPtr;
            height:integer;
            filter:UniversalProcPtr;
            wpos:Point;
            wrect:Rect;
            fw:WindowPtr;
            srect:rect;
            onmain:boolean;
            savedport:GrafPtr;
    begin
        GetPort(savedport);
        DrawOurTextProc:=NewUserItemProc(@DrawOurText);
        OurModalFilterProc:=NewModalFilterProc(@OurModalFilter);
        txt:=GetResource('TEXT',id);
        Assert(txt<>nil);
        styl:=GetResource('styl',id);
        GetFirstLine(txt,theline);
        itemlist:=NewDITL(theline,icon,button_count,button_command_keys);
        SetRect(bounds,100,100,102,102); { Must have area or zoom code fails to find best monitor }
        if has_colorQD then begin
            dlg:=NewColorDialog(nil,bounds,'',false,dBoxProc,POINTER(-1),false,0,itemlist);
        end else begin
            dlg:=NewDialog(nil,bounds,'',false,dBoxProc,POINTER(-1),false,0,itemlist);
        end;
        SetPort(dlg);
        SetMyFont(MFT_System0);
        SetRect(bounds,alert_text_left,alert_text_top,alert_text_right,1000);
        gTE:=TEStyleNew(bounds,bounds);
        HLock(txt);
        TESetText(txt^, GetHandleSize(txt), gTE);
        if styl<>nil then begin
            TEUseStyleScrap(0, GetHandleSize(txt), STScrpHandle(styl), false, gTE);
            ReleaseResource(styl);
        end;
        ReleaseResource(txt);
        RemoveFirstLine(gTE);
        InsertParamateres(gTE,pt);
        height:=alert_text_top + Max(TEGetHeight(gTE^^.teLength,0,gTE),alert_text_minimum_height) + alert_text_bottom;
        SetPt(wpos,0,LMGetMBarHeight);
        fw:=FrontWindow;
        if fw<>nil then begin
            GetWindowRect(fw,wrect);
            case theline[3] of
                'M':begin
                    { do nothing }
                end;
                'W':begin
                    wpos.h:=wrect.left;
                    wpos.v:=wrect.top;
                end;
                'S':begin
                    GetBestScreenRect(wrect,srect,onmain);
                    wpos:=srect.topleft;
                end;
                otherwise begin
                    Assert(false);
                end;
            end;
        end;
        wpos.h:=wpos.h+40;
        wpos.v:=wpos.v+20;
        MoveWindow(dlg,wpos.h,wpos.v,true);
        idealsize.h:=432;
        idealsize.v:=height;
        ZoomWindowOut (dlg,0,idealsize);
        SetDItemHandle(dlg,button_count+o_text,Handle(DrawOurTextProc));
        for i:=1 to button_count do begin
            GetDItemRect(dlg,i,bounds);
            OffsetRect(bounds,0,height-alert_button_top);
            SetDItemRect(dlg,i,bounds);
            MoveControl(GetDControlHandle(dlg,i),bounds.left,bounds.top);
        end;
        SetUpDefaultOutline(dlg,1,button_count+o_useritem);
        if theline[2]='B' then begin
            if may_sound then begin
                CallSoundProc(1,LMGetDABeeper);
            end;
        end else begin
            Assert(theline[2]='-');
        end;
        ShowWindow(dlg);
        if button_count>1 then begin
            filter:=gCancelModalFilterProc;
        end else begin
            filter:=gStandardModalFilterProc;
        end;
        CursorSetArrow;
        CursorSetProcessing (false);
        repeat
            ModalDialog(OurModalFilterProc,item);
        until (1<=item) & (item<=button_count);
        DisposeDialog(dlg);
        DisplayAlert:=item;
        DisposeRoutineDescriptor(OurModalFilterProc);
        DisposeRoutineDescriptor(DrawOurTextProc);
        SetPort(savedport);
    end;

    function CleverAlert(id:integer):integer;
    begin
        CleverAlert:=DisplayAlert(id,param_text,true);
        DisposeStrH(param_text);
        param_text:=nil;
    end;

    procedure CleverNotifyAlert(id:integer);
        var
            dr:DelayedAlertRecord;
            junk:OSErr;
            a:integer;
    begin
        if InForeground then begin
            a:=CleverAlert(id);
        end else begin
            dr.params:=param_text;
            dr.id:=id;
            junk:=HandleArrayAppend(delayed,@dr);
            param_text:=nil;
            Notify (true,false,alert_icon_id, alert_icon_ndx, -1, -1,0);
        end;
    end;

    procedure IdleCleverAlert;
        var
            dr:DelayedAlertRecord;
            a:integer;
    begin
        if InForeground then begin
            while (HandleArrayCount(delayed)>0) do begin
                HandleArrayGet(delayed,1,@dr);
                HandleArrayDelete(delayed,1);
                a:=DisplayAlert(dr.id,dr.params,false);
                DisposeStrH(param_text);
            end;
        end;
    end;

    procedure CleverAlertTest;
        var
            i:integer;
            txt:Handle;
            id:integer;
            typ:ResType;
            name:Str255;
            a:integer;
            er:EventRecord;
            dummy:boolean;
    begin
        for i:=1 to Count1Resources('TEXT') do begin
            txt:=Get1IndResource('TEXT',i);
            GetResInfo(txt,id,typ,name);
            ReleaseResource(txt);
            CleverParamText('Param1','Param2','Param3','Param4');
            a:=CleverAlert(id);
            dummy:=OSEventAvail(everyEvent,er);
            if BAND(er.modifiers,optionKey)<>0 then begin
                leave;
            end;
        end;
    end;

    function InitCleverAlerts(var msg: integer): OSStatus;
    begin
        msg := msg; { Unused }
        param_text:=nil;
        InitCleverAlerts := HandleArrayCreate(delayed, SizeOf(DelayedAlertRecord));
    end;

    procedure ConfigureCleverAlerts(icon_id: integer; icon_ndx: integer);
    begin
        StartupCleverAlerts;
        alert_icon_id:=icon_id;
        alert_icon_ndx:=icon_ndx;
    end;

    procedure FinishCleverAlerts;
    begin
        DisposeStrH(    param_text)
    end;

    procedure StartupCleverAlerts;
    begin
        StartupDialogs;
        StartupCursors;
        StartupNotifier;
        SetStartup(InitCleverAlerts, IdleCleverAlert, 15, FinishCleverAlerts);
    end;

end.