<<>>
    <<XTkIconImpl.mesa>>
        <<Copyright Ó 1991, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Created by Christian Jacobi, May 2, 1991 2:46:56 pm PDT>>
        <<Christian Jacobi, July 13, 1992 2:46 pm PDT>>
        <<>>
    DIRECTORY 
        CBitmapReader, ImagerSample, IO, PFS, Rope, Xl, XTk, XTkDB, XTkIcon, XTkShellWidgets;

    XTkIconImpl: CEDAR PROGRAM 
        IMPORTS CBitmapReader, ImagerSample, IO, PFS, Rope, Xl, XTkDB, XTkShellWidgets
        EXPORTS XTkIcon =
    BEGIN 

    SMFromName: PROC [fileName: Rope.ROPE] RETURNS [sm: ImagerSample.RasterSampleMap Ź NIL] = {
        GetStream: PROC [fileName: Rope.ROPE] RETURNS [s: IO.STREAM Ź NIL] = {
            IF Rope.Length[fileName]>0 THEN {
                ENABLE PFS.Error => GOTO oops;
                s Ź PFS.StreamOpen[fileName: PFS.PathFromRope[fileName], accessOptions: read]; 
                EXITS oops => {}
                };
            };
        stream: IO.STREAM ~ GetStream[fileName];
        IF stream#NIL THEN {
            sm Ź CBitmapReader.FromStream[stream 
                ! CBitmapReader.Error => {IO.Close[stream ! IO.Error => GOTO oops]; GOTO oops}
                ].sm;
            IO.Close[stream];
            };
        EXITS oops => {};
        };

    SetIcon: PROC [shell: XTk.Widget, icccmHints: REF XTkShellWidgets.ICCCMHints, baseFileNamePart, maskFileNamePart: Rope.ROPE] = {
        sm: ImagerSample.RasterSampleMap Ź SMFromName[baseFileNamePart];
        IF sm#NIL THEN {
            screen: Xl.Screen ~ shell.screenDepth.screen;
            szVec: ImagerSample.Vec ~ ImagerSample.GetSize[sm];
            size: Xl.Size ~ [width: szVec.f, height: szVec.s];
            base: LONG POINTER ~ LOOPHOLE[ImagerSample.GetBase[sm].word];
            scanLineBytes: INT ~ ImagerSample.GetBitsPerLine[sm]/8;
            iconPixmap: Xl.Pixmap ~ Xl.CreatePixmap[shell.connection, screen.root.drawable, size, 1];  --A pixmap of depth 1 is always 
            supported (Protocol; in prose for connection set up)
            gc: Xl.GContext ~ Xl.MakeGContext[shell.connection, iconPixmap.drawable];
            Xl.SetGCGrounds[gc, 1, 0];
            Xl.PutImage[c: shell.connection, drawable: iconPixmap.drawable, gc: gc, base: base, size: size, dest: [0, 0], offx: 0, offy: 0, 
            scanLineBytes: scanLineBytes, bitsPerPixel: 1];
            icccmHints.wmHints.iconPixmap Ź iconPixmap;
            icccmHints.wmHintsChanged Ź TRUE;
            IF Rope.Equal[baseFileNamePart, maskFileNamePart] THEN {
                icccmHints.wmHints.iconMask Ź iconPixmap; 
                icccmHints.wmHintsChanged Ź TRUE;
                RETURN;
                };
            IF maskFileNamePart#NIL THEN {
                sm: ImagerSample.RasterSampleMap Ź SMFromName[maskFileNamePart];
                IF sm#NIL THEN {
                    szVec: ImagerSample.Vec ~ ImagerSample.GetSize[sm];
                    size: Xl.Size ~ [width: szVec.f, height: szVec.s];
                    base: LONG POINTER ~ LOOPHOLE[ImagerSample.GetBase[sm].word];
                    scanLineBytes: INT ~ ImagerSample.GetBitsPerLine[sm]/8;
                    maskPixmap: Xl.Pixmap ~ Xl.CreatePixmap[shell.connection, screen.root.drawable, size, 1];  --A pixmap of depth 1 is always 
                    supported (Protocol; in prose for connection set up)
                    Xl.PutImage[c: shell.connection, drawable: maskPixmap.drawable, gc: gc, base: base, size: size, dest: [0, 0], offx: 0, offy: 0, 
                    scanLineBytes: scanLineBytes, bitsPerPixel: 1];
                    icccmHints.wmHints.iconMask Ź maskPixmap;
                    icccmHints.wmHintsChanged Ź TRUE;
                    };
                };
            };
        };

    RopeQuery: PROC [shell: XTk.Widget, key: ATOM] RETURNS [Rope.ROPEŹNIL] = {
        q: REF ~ XTkDB.DoQueryFromWidget[shell, FALSE, key];
        WITH q SELECT FROM
            r: Rope.ROPE => RETURN [r];
            ENDCASE => {}
        };

    SetIconName: PUBLIC PROC [shell: XTk.Widget, fromDB: BOOL _ TRUE, default: Rope.ROPE Ź NIL] = {
        icccmHints: REF XTkShellWidgets.ICCCMHints ~ XTkShellWidgets.GetHints[shell]; 
        IF icccmHints.iconName=NIL THEN {
            IF fromDB THEN {
                specified: Rope.ROPE Ź RopeQuery[shell, $iconName];
                IF ~Rope.IsEmpty[specified] THEN {
                    icccmHints.iconName Ź specified; 
                    icccmHints.iconNameChanged Ź TRUE;
                    RETURN
                    }
                };
            icccmHints.iconName Ź default;
            };
        };

    SetIconMask: PUBLIC PROC [shell: XTk.Widget, fromDB: BOOL _ TRUE, packageName, shortName: Rope.ROPE Ź NIL] = {
        fileName: Rope.ROPE Ź NIL;
        icccmHints: REF XTkShellWidgets.ICCCMHints ~ XTkShellWidgets.GetHints[shell]; 
        hasIconWindow: BOOL Ź icccmHints.wmHints.iconWindow#Xl.nullWindow;
        hasIcon: BOOL ~ hasIconWindow OR (icccmHints.wmHints.iconPixmap#Xl.illegalPixmap AND icccmHints.wmHints.iconPixmap#Xl.nullPixmap);
        hasMask: BOOL ~ hasIconWindow OR (icccmHints.wmHints.iconMask#Xl.illegalPixmap AND icccmHints.wmHints.iconMask#Xl.nullPixmap);
        IF ~hasIcon THEN {
            IF fromDB THEN {
                fileName Ź RopeQuery[shell, $iconPixmap];
                IF ~Rope.IsEmpty[fileName] THEN {
                    iconMaskFile: Rope.ROPE Ź NIL;
                    IF ~hasMask THEN iconMaskFile Ź RopeQuery[shell, $iconMask];
                    SetIcon[shell, icccmHints, fileName, iconMaskFile];
                    RETURN;
                    }
                };
            fileName _ IO.PutFR["/cedar/%g/%g.", IO.rope[packageName], IO.rope[shortName]];
            SetIcon[shell, icccmHints, Rope.Concat[fileName, "xIcon"], Rope.Concat[fileName, "xIconMask"]];

            };
        };

    END.