maclab@reed.UUCP (Mac DLab) (12/20/85)
Here is IconMaker's source. The procedure 'force' does the resource
file mucking.
----------------------------------------------------------------------------
Happy Holidays from the Reed Academic Software Development Laboratory!
Richard Crandall
Marianne Colgrove
Josh Doenias
Scott Gillespie
Michael McGreevy
Greg Stein (in absentia)
Ann Muir Thomas
and :-)
"Ohhhh. Wash Day. No *clothes*, right?" (punk)
{decvax, ucbvax, pur-ee, uw-beaver, masscomp, cbosg, aat,
mit-ems, psu-cs, uoregon, orstcs, ihnp4, uf-cgrl, ssc-vax}!tektronix
\
+--!reed!maclab
{teneron, ogcvax, muddcs, cadic, oresoft, grpwre, /
harvard, psu-cs, omen, isonvax, nsc-pdc}-------------+
------------------------------------------------------------------------------
Program IconMaker;
(*
IconMaker.
Provides Method for Changing Application Icons. Accompanying
help File (IconMaker.help) explains options.
By J. Doenias and S. Gillespie
..... 85.12.19.spg
*)
Uses __QuickTraps, __ToolTraps, __OSTraps,
(*$U+*)
uToolIntf,
uOSIntf;
Link __QuickDraw, __EasyMenus, __OSTraps, __PackTraps,
__SFNames, __Extras, __IO, __Help :;
Type
IList = Byte[4][32][2];
IconRec = Record
Id: Integer;
I: IList;
End;
IconArray = Record
Count: Integer;
members: IconRec[1];
End;
IAHand = ^^IconArray;
FileName = Byte[64];
Var
ApplName: FileName;
Applref: Integer;
WhichIcon: Integer;
ApplMenu: MenuHandle;
H : IAHand;
iconbox, maskbox : Rect;
Ibuf, IClip, ILast, ITemp, ILastClip : IList;
screen : Grafptr;
BM,BitBM : Bitmap;
ChangeFlag, ApplFlag : Boolean;
BitBuf:Integer[6];
Function getvol(): Integer; (* Get the current default volume *)
var Param: ParamBlockRec;
err : OSErr;
{
Param.IOCompletion := 0;
Param.IONamePtr := 0;
err := PBGetVol(Param,False);
getvol := Param.IOVrefNum;
};
procedure setvol(vref: integer); (* Set the current default volume *)
var Param: ParamBlockRec;
err : OSErr;
{
Param.IOCompletion := 0;
Param.IONamePtr := 0;
Param.IOVrefNum := vref;
err := PBSetVol(Param,False);
};
Proc Force();
Var oldvol,TRref,i,j,myref,item,atype,err: Integer;
BundHand: ^^Byte[4];
BHand: ^^Longint;
CrHand: Handle;
TStr: Byte[10];
MyLog : DialogPtr;
box: rect;
ihand: handle;
F: Finfo;
NewCr: Longint;
anID,NumRes: Integer;
temp: Longint;
Name: FileName;
Point,
CountT,
CountR: Integer;
{
If !ApplFlag Then
Return;
oldvol := GetVol();
SetVol(Applref);
TRref := OpenResFile(ApplName);
SetVol(oldvol);
If TRref = -1 then Return;
BundHand := GetIndResource(ptrl(" BNDL"+2)^,1);
Crhand := GetResource(ptrL(@BundHand^^)^,0);
If !CrHand Then { CloseResFile(TRref); Return };
TStr[0] :=4;
Loop(,i:=0,,++i=4)
TStr[i+1] := BundHand^^[i];
ParamText(TStr,"","","");
ApplVref(@myref);
UseResFile(myref);
MyLog := GetNewDialog(3000,Nil,-1L);
UseResFile(TRref);
GetDItem(MyLog,4,@atype,@ihand,@box);
SetIText(ihand,TStr);
SelIText(MyLog,4,0,10);
SetWTitle(MyLog,ApplName);
ShowWindow(MyLog);
Loop(,,,(item=1) or (item=2))
ModalDialog(Nil,@item);
If item=2 Then { DisposDialog(mylog); CloseResFile(TRref); Return };
GetIText(ihand,@Tstr);
DisposDialog(MyLog);
If TStr[0] <> 4 Then { CloseResFile(TRref); Return };
Watch();
Loop(,i:=0,,++i=4)
BundHand^^[i] := TStr[i+1];
NewCr := Ptrl(@BundHand^^)^;
ChangedResource(BundHand);
RmveResource(CrHand);
AddResource(CrHand,NewCr,0,"");
CloseResFile(TRRef);
err:= GetFInfo(ApplName,Applref,F);
F.FDCreator := NewCr;
err := SetFInfo(ApplName,Applref,F);
SetVol(Applref);
TRref := OpenResFile("DeskTop");
SetVol(oldvol);
If TRref = -1 then { arrow(); Return };
NumRes := CountResources(ptrl(" BNDL"+2)^);
loop(NumRes>0,i:=1,,++i>NumRes) {
SetResLoad(False);
BHand := GetIndResource(ptrl(" BNDL"+2)^,i);
SetResLoad(True);
if (HomeResFile(Bhand)=TRref) then {
LoadResource(Bhand);
If !(Bhand^^ = NewCr) Then
Continue;
GetResInfo(Bhand,@anID,@temp,@Name);
Break;
};
};
If !NumRes or (i>NumRes) Then { arrow(); CloseResFile(TRref); Return };
CrHand := GetResource(NewCr,ptrw(@BHand^^ + 4)^);
If CrHand Then {
RmveResource(CrHand); DisposHandle(Crhand);
};
CountT := ptrw(@BHand^^ + 6)^;
loop(,Point := 8; i:=0,,++i>CountT) {
NewCr := ptrL(@BHand^^+ Point)^;
Point += 4;
CountR := ptrw(@BHand^^+ Point)^;
Loop(,j:= 0,,++j>CountR) {
Point += 4;
CrHand := GetResource(NewCr,ptrw(@BHand^^+Point)^);
If CrHand Then {
RmveResource(CrHand); DisposHandle(Crhand);
};
};
Point += 2;
};
RmveResource(BHand); DisposHandle(BHand);
CloseResFile(TRref);
Arrow();
};
Function OktoCream(Doing: Ptrb): Boolean;
var item: Integer;
{
arrow();
If !ChangeFlag Then
Return(True);
paramtext(ApplName,Doing,"","");
item := CautionAlert(303,0L); (* Alert in Rascal....... *)
Case item of
1: { Save(); OkToCream := True };
2: OkToCream := True;
3: OkToCream := False;
End;
};
Proc Undo();
{
ChangeFlag := True;
Swap(IBuf,ILast);
Swap(IClip, ILastclip);
redraw (0); redraw(1);
};
Proc Cut();
{
ChangeFlag := True;
ILast := IBuf;
ILastClip := IClip;
IClip := IBuf;
TotalZero();
};
Proc Copy();
{
ILastClip := IClip;
IClip := IBuf;
};
Proc Paste();
{
ChangeFlag := True;
ILast := IBuf;
IBuf := IClip;
redraw (0); redraw(1);
};
Proc Clear();
{
ChangeFlag := True;
ILast := IBuf;
TotalZero();
};
proc CloseAppl();
{
If !ApplMenu Then
Return;
DeleteMenu(8000);
DrawMenuBar();
DisposeMenu(ApplMenu);
ApplMenu := 0;
ApplFlag := False;
SetHandleSize(H,2L);
H^^.Count := 0;
whichicon := 0;
};
Proc PutApplMenu();
Var i: Integer;
S: Byte[20];
{
ApplMenu := NewMenu(8000,ApplName);
InsertMenu(ApplMenu,0);
DrawMenuBar();
Loop(,i:=0,,++i=H^^.Count) {
NumToString(Longint(H^^.Members[i].id),S);
AppendMenu(ApplMenu,S);
};
Whichicon := 0;
};
Proc Open();
var
TName: Filename;
TPtr: ^Filename;
TVref,
TRref: Integer;
OK: integer;
oldvol: integer;
RsrcType: Longint;
j,anID,NumRes: Integer;
aHand: ^^IList;
temp: Longint;
Name: FileName;
{
If ApplFlag Then
If !OKToCream("Opening") Then Return;
Ngetfile(100,70,@TPtr," APPL"+2,1,@TVref,@OK);
If !OK Then Return;
TName := TPtr^;
oldvol := GetVol();
SetVol(TVref);
TRref := OpenResFile(TName);
SetVol(oldvol);
If TRref = -1 then Return;
CloseAppl();
ApplName := TName;
Applref := TVref;
RsrcType := ptrl(" ICN#"+2)^;
NumRes := CountResources(RsrcType);
loop(NumRes>0,j:=1,,++j>NumRes) {
SetResLoad(False);
aHand := GetIndResource(RsrcType,j);
SetResLoad(True);
if (HomeResFile(ahand)=TRref) then {
LoadResource(ahand);
GetResInfo(ahand,@anID,@temp,@Name);
SetHandleSize(H,GetHandleSize(H) + Sizeof(IconRec));
H^^.members[H^^.Count].id := anID;
H^^.members[H^^.Count].I := ahand^^;
++H^^.Count;
};
};
CloseResFile(TRRef);
If !H^^.Count Then
Return;
ApplFlag := True;
ChangeFlag := False;
PutApplMenu();
PutIcon(1);
ValidRect(Screen^.PortRect);
};
Proc PutIcon(it: Integer);
{
If WhichIcon Then {
H^^.Members[WhichIcon-1].I := IBuf;
CheckItem(ApplMenu,WhichIcon,False);
};
IBuf := H^^.Members[it-1].I;
CheckItem(ApplMenu,it,True);
WhichIcon := it;
_Update();
};
Proc New();
{
If ApplFlag Then
If !OKToCream("Opening") Then Return;
CloseAppl();
Clear();
ValidRect(Screen^.PortRect);
DoOutLine();
};
Proc Save();
Var
oldvol,
TRRef,i : Integer;
RsrcType: Longint;
aHand: ^^IList;
{
If !ApplFlag Then Return;
H^^.Members[WhichIcon-1].I := IBuf;
oldvol := GetVol();
SetVol(Applref);
TRref := OpenResFile(ApplName);
SetVol(oldvol);
If TRref = -1 then Return;
RsrcType := ptrl(" ICN#"+2)^;
loop(,i:=0,,++i=H^^.count) {
aHand := GetResource(RsrcType,H^^.Members[i].id);
if !aHand^ Then Continue;
if HomeResFile(ahand)=TRref Then {
aHand^^ := H^^.Members[i].I;
ChangedResource(aHand);
};
};
CloseResFile(TRref);
ChangeFlag := False;
};
Procedure _MENU(id,it : integer);
{
Case id of
5000: Case it of
1: Undo();
3: Cut();
4: Copy();
5: Paste();
6: Clear();
8: IcontoMask();
End;
6000: Case it of
1: New();
2: Open();
3: Save();
4: Help("IconMaker.Help",0);
6: Force();
End;
8000:
Puticon(it);
End;
};
Procedure _INIT();
Var
i: Integer;
{
initeasymenus();
Addmenu(5000,"Edit");
Additem (5000,"Undo/Z");
Additem (5000,"(-");
Additem (5000,"Cut/X");
Additem (5000,"Copy/C");
Additem (5000,"Paste/V");
Additem (5000,"Clear");
Additem (5000,"(-");
Additem (5000,"Icon --> Mask");
Addmenu (6000,"Icon");
Additem (6000,"New");
Additem (6000,"Open...");
Additem (6000,"Save");
Additem (6000,"Help");
Additem (6000,"(-");
Additem (6000,"Enable New Icons");
getport (@screen);
MoveWindow (screen,30,50,False);
SizeWindow (screen,410,280,False);
BM.rowbytes := 4;
setrect (@BM.Bounds,0,0,32,32);
BitBM.rowbytes := 2;
setrect(@BitBM.Bounds,0,0,5,5);
BitBM.baseaddr := BitBuf;
loop(,i:=0,,++i>5)
BitBuf[i] := $FFFF;
Zero(IBuf);
IClip := IBuf;
ILast := IBuf;
ITemp := IBuf;
ILastClip := IBuf;
setrect(@iconbox,12,18,203,209);
setrect(@maskbox,210,18,401,209);
Clear();
DoOutLine();
H := NewHandle(2L);
H^^.Count := 0;
ChangeFlag := False;
ApplFlag := False;
ApplMenu := 0;
whichicon := 0;
};
Proc _Key(c,mods: Integer);
Var
Result: longint;
{
If Mods and CmdKey Then {
Result := MenuKey(c);
If Result Then {
_Menu(Hiword(Result),Loword(Result));
Result := TickCount() + 20;
Loop(,,,TickCount()>Result);
HiliteMenu(0);
};
};
};
Procedure _HALT();
{
If ApplFlag Then
Loop(,,,OKToCream("Quitting"));
halteasymenus();
DisposHandle(H);
};
Proc Swap(I,J: IList);
{
ITemp := I;
I := J;
J := ITemp;
};
Proc Zero(I: IList);
Var
j,a: register integer;
{
loop (, j:=0,++j, j>31)
loop (,A:=0,++A, A>3)
{I[A][j][0]:=0B;I[A][j][1]:=0B};
};
Procedure NormalDraw(destrect: Rect);
{
BM.baseaddr := @IBuf[1];
Copybits(BM,screen^.portBits,BM.bounds,destrect,srcBic,NIL);
BM.baseaddr := @IBuf[0];
Copybits(BM,screen^.portBits,BM.bounds,destrect,srcOr,NIL);
};
Procedure InvertDraw(destrect: Rect);
{
BM.baseaddr := @IBuf[1];
Copybits(BM,screen^.portBits,BM.bounds,destrect,srcOr,NIL);
BM.baseaddr := @IBuf[0];
Copybits(BM,screen^.portBits,BM.bounds,destrect,srcXor,NIL);
};
Procedure DrawIcons();
Var destrect : Rect;
{
setrect (@destrect,42,230,74,262);
EraseRect(DestRect);
NormalDraw(DestRect);
OffSetRect(@destrect,70,0);
InsetRect(@destrect,-4,-4);
FillRect(destrect,_Gray());
InsetRect(@destrect,4,4);
NormalDraw(DestRect);
setrect (@destrect,240,230,272,262);
EraseRect(DestRect);
InvertDraw(DestRect);
OffSetRect(@destrect,70,0);
InsetRect(@destrect,-4,-4);
FillRect(destrect,_Gray());
InsetRect(@destrect,4,4);
InvertDraw(DestRect);
};
Proc BBlack(destrect: rect);
{
Copybits(BitBM,screen^.portBits,BitBM.bounds,destrect,srcor,NIL);
};
Proc BWhite(destrect: rect);
{
Copybits(BitBM,screen^.portBits,BitBM.bounds,destrect,srcbic,NIL);
};
Procedure Drawbit(x,y,b: integer);
var bitrect : Rect;
{
x *= 6;
y *= 6;
setrect(@bitrect,x,y,x+5,y+5);
if b then BWhite(bitrect) else BBlack(bitrect);
};
Procedure _MOUSE(x,y : integer);
var b, Icon,a,bb, left : register integer;
xold,yold: integer;
Mice : Point;
current : rect;
{
Mice.v := y;
Mice.h := x;
if ptinrect(Mice.vh,iconbox) then {current := iconbox; Icon :=0; left :=
2}
else if ptinrect(Mice.vh,maskbox) then {current:=maskbox; Icon :=1; left:=35}
else return;
ChangeFlag := True;
ILast := IBuf;
b := getpixel (x,y);
Drawbit (Mice.h/6,Mice.v/6,b);
loop (,,,!stilldown())
{
getmouse(@mice.vh);
x := Mice.h/6;
y := Mice.v/6;
if ptinrect(Mice.vh,current) then
{
Drawbit (x,y,b);
bb := (y-3);
a:= (x-left)/8;
if b then Ibuf[a][bb][Icon]:= ( Ibuf[a][bb][Icon] and not (1<<7-(x-left-8*a))
)
else Ibuf[a][bb][Icon]:= ( Ibuf[a][bb][Icon] or (1<<7-(x-left-8*a))
);
};
};
DrawIcons();
};
Procedure redraw(x:integer);
var I, A, Bit, M : register integer;
{
watch();
loop (,I:=0,++I,I>31)
loop (,A:=0,++A,A>3)
loop (,Bit:=0,++Bit,Bit>7)
{M := Ibuf[A][I][x] and (1<<(7-Bit));
Drawbit(Integer(A*8+Bit+2+33*x),I+3,Integer(M=0));
};
DrawIcons();
arrow();
};
Procedure TotalZero();
{
eraserect (Iconbox);
eraserect (Maskbox);
Zero(Ibuf);
DrawIcons();
};
proc IcontoMask();
{
ILast := IBuf;
IBuf[1] := Ibuf[0];
Redraw(1);
};
Proc DoOutLine();
{
setrect(@iconbox,10,16,205,211);
setrect(@maskbox,208,16,403,211);
framerect(iconbox);
framerect(maskbox);
setrect(@iconbox,12,18,203,209);
setrect(@maskbox,210,18,401,209);
moveto (87,13);
drawstring ("ICON");
moveto (285,13);
drawstring ("MASK");
};
Procedure _UPDATE();
{
DoOutLine();
redraw (0); redraw(1);
};