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.

    └  
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

Э╩Є  Ц(cedarcode) styleХNewlineDelimiter
Щ codeЪЬЩKЪЬ
╧eЬ7ЩBKЪЬ7Щ7KЩ+KЩ ЧЪ╧k	ЬШ
KЪЬЮЬЮЬ1ШUKШ ЧЪ╧nЬЮЬЮЬШKЪЮЬЮЬЮЬ"ШNKЪЮЬ
ШЧKЪЮЬШKШ Ъ
Я
ЬЮЬЮЬЮЬ%ЮЬШ[ЪЯ	ЬЮЬЮЬЮЬЮЬЮЬЮЬШFЪЮЬЮЬШ!KЪЮЬЮЬ
ЮЬШKЪЬЮЬЮЬ/ШOKЪЮЬШKШЧKШЧKЪЬЮЬЮЬШ(ЪЮЬЮЬЮЬШЪЬ%Ш%KЪ	ЬЮЬЮЬ
ЮЬЮЬШNKЪЬШЧKЪЮЬШKШЧKЪЮЬШKЪЬШЧKШ ЪЯЬЮЬ!ЮЬFЮЬШАKЪЬ@Ш@ЪЮЬЮЬЮЬШKЪЬ-Ш-KЪЬ3Ш3KЪЬ2Ш2KЪЬЮЬЮЬЮЬ Ш=KЪЬЮЬ%Ш7KЪЬ[╧cTШпKЪЬIШIKЪЬШKЪЬпШпKЪЬ+Ш+KЪЬЮЬШ!ЪЮЬ0ЮЬШ8KЪЬ*Ш*KЪЬЮЬШ!KЪЮЬШKШЧЪЮЬЮЬЮЬШKЪЬ@Ш@ЪЮЬЮЬЮЬШKЪЬ3Ш3KЪЬ2Ш2KЪЬЮЬЮЬЮЬ Ш=KЪЬЮЬ%Ш7KЪЬ[аTШпKЪЬпШпKЪЬ)Ш)KЪЬЮЬШ!KШЧKЪЬШЧKЪЬШЧKЪЬШЧKШ ЪЯ	ЬЮЬЮЬЮЬЮЬЮЬШJKЪЬЮЬ"ЮЬШ4ЪЮЬЮЬЮШKЪЬЮЬЮЬШKЪЮЬШЧKШЧKШ ЪЯЬЮЬЮЬЮЬЮЬЮЬЮЬШ_KЪЬЮЬ?ШNЪЮЬЮЬЮЬШ!ЪЮЬЮЬШKЪЬЮЬШ3ЪЮЬЮЬШ"KЪЬ!Ш!KЪЬЮЬШ"KЪЮШKЪЬШЧKШЧKЪЬШKШЧKЪЬШЧЪЯЬЮЬЮЬЮЬЮЬЮЬЮЬШnKЪЬЮЬЮЬШKЪЬЮЬ?ШNKЪЬЮЬ/ШBKЪЬ	ЮЬЮЬ1ЮЬ.ШВKЪЬ	ЮЬЮЬ/ЮЬ,Ш~ЪЮЬ
ЮЬШЪЮЬЮЬШKЪЬ)Ш)ЪЮЬЮЬШ!KЪЬЮЬЮЬШKЪЮЬ
ЮЬ,Ш<KЪЬ3Ш3KЪЮЬШKЪЬШЧKШЧKЪЬЮЬЮЬЮЬШOKЪЬ_Ш_KШ KШЧKШЧKШ KЪЮЬШKШ Ч ЕЧ    ·  м  