home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / code / ras_icon.sit < prev    next >
Encoding:
Text File  |  1988-06-20  |  12.9 KB  |  668 lines
  1. 18-Jun-88 14:32:21-MDT,13846;000000000000
  2. Return-Path: <u-lchoqu%sunset@cs.utah.edu>
  3. Received: from cs.utah.edu by SIMTEL20.ARPA with TCP; Sat, 18 Jun 88 14:32:03 MDT
  4. Received: by cs.utah.edu (5.54/utah-2.0-cs)
  5.     id AA22260; Sat, 18 Jun 88 14:32:01 MDT
  6. Received: by sunset.utah.edu (5.54/utah-2.0-leaf)
  7.     id AA24645; Sat, 18 Jun 88 14:31:57 MDT
  8. Date: Sat, 18 Jun 88 14:31:57 MDT
  9. From: u-lchoqu%sunset@cs.utah.edu (Lee Choquette)
  10. Message-Id: <8806182031.AA24645@sunset.utah.edu>
  11. To: rthum@simtel20.arpa
  12. Subject: Iconmaker.ras
  13.  
  14. Program IconMaker;
  15. (*
  16.   IconMaker.
  17.     Provides Method for Changing Application Icons.  Accompanying
  18.     help File (IconMaker.help) explains options.
  19.  
  20.     By J. Doenias and S. Gillespie
  21.  
  22.   ..... 85.12.19.spg
  23. *)
  24.  
  25. Uses __QuickTraps, __ToolTraps, __OSTraps,
  26. (*$U+*)
  27.      uToolIntf,
  28.      uOSIntf;
  29.  
  30. Link  __QuickDraw, __EasyMenus, __OSTraps, __PackTraps,
  31.       __SFNames, __Extras, __IO, __Help :;
  32.  
  33. Type
  34.  
  35.    IList = Byte[4][32][2];
  36.    IconRec = Record
  37.      Id: Integer;
  38.      I: IList;
  39.    End;
  40.    IconArray = Record
  41.      Count: Integer;
  42.      members: IconRec[1];
  43.    End;
  44.    IAHand = ^^IconArray;
  45.  
  46.    FileName = Byte[64];
  47.  
  48. Var
  49.   ApplName: FileName;
  50.   Applref: Integer;
  51.   WhichIcon: Integer;
  52.   ApplMenu: MenuHandle;
  53.   H : IAHand;
  54.   iconbox, maskbox : Rect;
  55.   Ibuf, IClip, ILast, ITemp, ILastClip : IList;
  56.   screen : Grafptr;
  57.   BM,BitBM : Bitmap;
  58.   ChangeFlag, ApplFlag : Boolean;
  59.   BitBuf:Integer[6];
  60.  
  61.  
  62. Function getvol(): Integer;     (* Get the current default volume *)
  63. var Param: ParamBlockRec;
  64.     err : OSErr;
  65.   {
  66.       Param.IOCompletion := 0;
  67.       Param.IONamePtr := 0;
  68.       err := PBGetVol(Param,False);
  69.       getvol := Param.IOVrefNum;
  70.   };
  71.  
  72. procedure setvol(vref: integer);    (* Set the current default volume *)
  73. var Param: ParamBlockRec;
  74.     err : OSErr;
  75. {
  76.       Param.IOCompletion := 0;
  77.       Param.IONamePtr := 0;
  78.       Param.IOVrefNum := vref;
  79.       err := PBSetVol(Param,False);
  80. };
  81.  
  82. Proc Force();
  83. Var oldvol,TRref,i,j,myref,item,atype,err: Integer;
  84.     BundHand: ^^Byte[4];
  85.     BHand: ^^Longint;
  86.     CrHand: Handle;
  87.     TStr: Byte[10];
  88.     MyLog : DialogPtr;
  89.     box: rect;
  90.     ihand: handle;
  91.     F: Finfo;
  92.     NewCr: Longint;
  93.     anID,NumRes: Integer;
  94.     temp: Longint;
  95.     Name: FileName;
  96.     Point,
  97.     CountT,
  98.     CountR: Integer;
  99.  
  100. {
  101.   If !ApplFlag Then
  102.     Return;
  103.   oldvol := GetVol();
  104.   SetVol(Applref);
  105.   TRref := OpenResFile(ApplName);
  106.   SetVol(oldvol);
  107.   If TRref = -1 then Return;
  108.   BundHand := GetIndResource(ptrl(" BNDL"+2)^,1);
  109.   Crhand := GetResource(ptrL(@BundHand^^)^,0);
  110.   If !CrHand Then { CloseResFile(TRref); Return };
  111.   TStr[0] :=4;
  112.   Loop(,i:=0,,++i=4)
  113.     TStr[i+1] := BundHand^^[i];
  114.   ParamText(TStr,"","","");
  115.   ApplVref(@myref);
  116.   UseResFile(myref);
  117.   MyLog := GetNewDialog(3000,Nil,-1L);
  118.   UseResFile(TRref);
  119.   GetDItem(MyLog,4,@atype,@ihand,@box);
  120.   SetIText(ihand,TStr);
  121.   SelIText(MyLog,4,0,10);
  122.   SetWTitle(MyLog,ApplName);
  123.   ShowWindow(MyLog);
  124.   Loop(,,,(item=1) or (item=2))
  125.     ModalDialog(Nil,@item);
  126.  
  127.   If item=2 Then { DisposDialog(mylog); CloseResFile(TRref); Return };
  128.  
  129.   GetIText(ihand,@Tstr);
  130.   DisposDialog(MyLog);
  131.  
  132.   If TStr[0] <> 4 Then { CloseResFile(TRref); Return };
  133.  
  134.   Watch();
  135.  
  136.   Loop(,i:=0,,++i=4)
  137.     BundHand^^[i] := TStr[i+1];
  138.   NewCr := Ptrl(@BundHand^^)^;
  139.   ChangedResource(BundHand);
  140.   RmveResource(CrHand);
  141.  
  142.   AddResource(CrHand,NewCr,0,"");
  143.  
  144.   CloseResFile(TRRef);
  145.  
  146.   err:= GetFInfo(ApplName,Applref,F);
  147.  
  148.   F.FDCreator := NewCr;
  149.  
  150.   err := SetFInfo(ApplName,Applref,F);
  151.  
  152.   SetVol(Applref);
  153.   TRref := OpenResFile("DeskTop");
  154.   SetVol(oldvol);
  155.   If TRref = -1 then { arrow(); Return };
  156.  
  157.   NumRes := CountResources(ptrl(" BNDL"+2)^);
  158.  
  159.   loop(NumRes>0,i:=1,,++i>NumRes) {
  160.     SetResLoad(False);
  161.     BHand := GetIndResource(ptrl(" BNDL"+2)^,i);
  162.     SetResLoad(True);
  163.     if (HomeResFile(Bhand)=TRref) then {
  164.        LoadResource(Bhand);
  165.        If !(Bhand^^ = NewCr) Then
  166.          Continue;
  167.        GetResInfo(Bhand,@anID,@temp,@Name);
  168.        Break;
  169.        };
  170.     };
  171.  
  172.   If !NumRes or (i>NumRes) Then { arrow(); CloseResFile(TRref); Return };
  173.  
  174.   CrHand := GetResource(NewCr,ptrw(@BHand^^ + 4)^);
  175.     If CrHand Then {
  176.        RmveResource(CrHand); DisposHandle(Crhand);
  177.        };
  178.  
  179.   CountT := ptrw(@BHand^^ + 6)^;
  180.  
  181.  
  182.   loop(,Point := 8; i:=0,,++i>CountT) {
  183.     NewCr := ptrL(@BHand^^+ Point)^;
  184.     Point += 4;
  185.     CountR := ptrw(@BHand^^+ Point)^;
  186.     Loop(,j:= 0,,++j>CountR) {
  187.       Point += 4;
  188.       CrHand := GetResource(NewCr,ptrw(@BHand^^+Point)^);
  189.       If CrHand Then {
  190.          RmveResource(CrHand); DisposHandle(Crhand);
  191.          };
  192.       };
  193.  
  194.     Point += 2;
  195.     };
  196.  
  197.     RmveResource(BHand); DisposHandle(BHand);
  198.  
  199.    CloseResFile(TRref);
  200.    Arrow();
  201. };
  202.  
  203. Function OktoCream(Doing: Ptrb): Boolean;
  204. var item: Integer;
  205. {
  206.   arrow();
  207.   If !ChangeFlag Then
  208.     Return(True);
  209.   paramtext(ApplName,Doing,"","");
  210.   item := CautionAlert(303,0L);    (* Alert in Rascal....... *)
  211.   Case item of
  212.     1:  { Save(); OkToCream := True };
  213.     2:  OkToCream := True;
  214.     3:  OkToCream := False;
  215.   End;
  216. };
  217.  
  218. Proc Undo();
  219. {
  220.   ChangeFlag := True;
  221.   Swap(IBuf,ILast);
  222.   Swap(IClip, ILastclip);
  223.   redraw (0); redraw(1);
  224. };
  225.  
  226. Proc Cut();
  227. {
  228.   ChangeFlag := True;
  229.   ILast := IBuf;
  230.   ILastClip := IClip;
  231.   IClip := IBuf;
  232.   TotalZero();
  233.   };
  234.  
  235. Proc Copy();
  236. {
  237.   ILastClip := IClip;
  238.   IClip := IBuf;
  239.   };
  240.  
  241. Proc Paste();
  242. {
  243.   ChangeFlag := True;
  244.   ILast := IBuf;
  245.   IBuf := IClip;
  246.   redraw (0); redraw(1);
  247.   };
  248.  
  249. Proc Clear();
  250. {
  251.   ChangeFlag := True;
  252.   ILast := IBuf;
  253.   TotalZero();
  254. };
  255.  
  256. proc CloseAppl();
  257. {
  258.   If !ApplMenu Then
  259.     Return;
  260.   DeleteMenu(8000);
  261.   DrawMenuBar();
  262.   DisposeMenu(ApplMenu);
  263.   ApplMenu := 0;
  264.   ApplFlag := False;
  265.   SetHandleSize(H,2L);
  266.   H^^.Count := 0;
  267.   whichicon := 0;
  268. };
  269.  
  270. Proc PutApplMenu();
  271. Var i: Integer;
  272.     S: Byte[20];
  273. {
  274.   ApplMenu := NewMenu(8000,ApplName);
  275.   InsertMenu(ApplMenu,0);
  276.   DrawMenuBar();
  277.   Loop(,i:=0,,++i=H^^.Count) {
  278.     NumToString(Longint(H^^.Members[i].id),S);
  279.     AppendMenu(ApplMenu,S);
  280.     };
  281.   Whichicon := 0;
  282. };
  283.  
  284. Proc Open();
  285. var
  286.   TName: Filename;
  287.   TPtr: ^Filename;
  288.   TVref,
  289.   TRref: Integer;
  290.   OK: integer;
  291.   oldvol: integer;
  292.   RsrcType: Longint;
  293.     j,anID,NumRes: Integer;
  294.     aHand: ^^IList;
  295.     temp: Longint;
  296.     Name: FileName;
  297. {
  298.   If ApplFlag Then
  299.     If !OKToCream("Opening") Then Return;
  300.  
  301.   Ngetfile(100,70,@TPtr," APPL"+2,1,@TVref,@OK);
  302.   If !OK Then Return;
  303.  
  304.   TName := TPtr^;
  305.   oldvol := GetVol();
  306.   SetVol(TVref);
  307.  
  308.   TRref := OpenResFile(TName);
  309.  
  310.   SetVol(oldvol);
  311.  
  312.   If TRref = -1 then Return;
  313.   CloseAppl();
  314.  
  315.   ApplName := TName;
  316.   Applref := TVref;
  317.  
  318.   RsrcType := ptrl(" ICN#"+2)^;
  319.  
  320.   NumRes := CountResources(RsrcType);
  321.   loop(NumRes>0,j:=1,,++j>NumRes) {
  322.     SetResLoad(False);
  323.     aHand := GetIndResource(RsrcType,j);
  324.     SetResLoad(True);
  325.     if (HomeResFile(ahand)=TRref) then {
  326.        LoadResource(ahand);
  327.        GetResInfo(ahand,@anID,@temp,@Name);
  328.        SetHandleSize(H,GetHandleSize(H) + Sizeof(IconRec));
  329.        H^^.members[H^^.Count].id := anID;
  330.        H^^.members[H^^.Count].I := ahand^^;
  331.        ++H^^.Count;
  332.        };
  333.     };
  334.  
  335.   CloseResFile(TRRef);
  336.  
  337.   If !H^^.Count Then
  338.     Return;
  339.  
  340.   ApplFlag := True;
  341.   ChangeFlag := False;
  342.  
  343.   PutApplMenu();
  344.   PutIcon(1);
  345.   ValidRect(Screen^.PortRect);
  346.  
  347. };
  348.  
  349. Proc PutIcon(it: Integer);
  350. {
  351.   If WhichIcon Then {
  352.     H^^.Members[WhichIcon-1].I := IBuf;
  353.     CheckItem(ApplMenu,WhichIcon,False);
  354.     };
  355.   IBuf := H^^.Members[it-1].I;
  356.   CheckItem(ApplMenu,it,True);
  357.   WhichIcon := it;
  358.   _Update();
  359. };
  360.  
  361.  
  362. Proc New();
  363. {
  364.   If ApplFlag Then
  365.     If !OKToCream("Opening") Then Return;
  366.   CloseAppl();
  367.   Clear();
  368.   ValidRect(Screen^.PortRect);
  369.   DoOutLine();
  370. };
  371.  
  372. Proc Save();
  373. Var
  374.   oldvol,
  375.   TRRef,i : Integer;
  376.   RsrcType: Longint;
  377.   aHand: ^^IList;
  378. {
  379.   If !ApplFlag Then Return;
  380.  
  381.   H^^.Members[WhichIcon-1].I := IBuf;
  382.  
  383.   oldvol := GetVol();
  384.   SetVol(Applref);
  385.   TRref := OpenResFile(ApplName);
  386.   SetVol(oldvol);
  387.   If TRref = -1 then Return;
  388.   RsrcType := ptrl(" ICN#"+2)^;
  389.   loop(,i:=0,,++i=H^^.count) {
  390.     aHand := GetResource(RsrcType,H^^.Members[i].id);
  391.     if !aHand^ Then Continue;
  392.     if HomeResFile(ahand)=TRref Then {
  393.       aHand^^ := H^^.Members[i].I;
  394.       ChangedResource(aHand);
  395.       };
  396.     };
  397.   CloseResFile(TRref);
  398.   ChangeFlag := False;
  399. };
  400.  
  401.  
  402. Procedure _MENU(id,it : integer);
  403. {
  404.   Case id of
  405.     5000: Case it of
  406.             1: Undo();
  407.             3: Cut();
  408.             4: Copy();
  409.             5: Paste();
  410.             6: Clear();
  411.             8: IcontoMask();
  412.           End;
  413.  
  414.     6000: Case it of
  415.             1: New();
  416.             2: Open();
  417.             3: Save();
  418.             4: Help("IconMaker.Help",0);
  419.             6: Force();
  420.           End;
  421.     8000:
  422.          Puticon(it);
  423.    End;
  424. };
  425.  
  426.  
  427. Procedure _INIT();
  428. Var
  429.   i: Integer;
  430. {
  431. initeasymenus();
  432.   Addmenu(5000,"Edit");
  433.   Additem (5000,"Undo/Z");
  434.   Additem (5000,"(-");
  435.   Additem (5000,"Cut/X");
  436.   Additem (5000,"Copy/C");
  437.   Additem (5000,"Paste/V");
  438.   Additem (5000,"Clear");
  439.   Additem (5000,"(-");
  440.   Additem (5000,"Icon --> Mask");
  441.  
  442.   Addmenu (6000,"Icon");
  443.   Additem (6000,"New");
  444.   Additem (6000,"Open...");
  445.   Additem (6000,"Save");
  446.   Additem (6000,"Help");
  447.   Additem (6000,"(-");
  448.   Additem (6000,"Enable New Icons");
  449.  
  450.   getport (@screen);
  451.   MoveWindow (screen,30,50,False);
  452.   SizeWindow (screen,410,280,False);
  453.  
  454.   BM.rowbytes := 4;
  455.   setrect (@BM.Bounds,0,0,32,32);
  456.  
  457.   BitBM.rowbytes := 2;
  458.   setrect(@BitBM.Bounds,0,0,5,5);
  459.   BitBM.baseaddr := BitBuf;
  460.   loop(,i:=0,,++i>5)
  461.     BitBuf[i] := $FFFF;
  462.  
  463.   Zero(IBuf);
  464.  
  465.   IClip := IBuf;
  466.   ILast := IBuf;
  467.   ITemp := IBuf;
  468.   ILastClip := IBuf;
  469.  
  470.   setrect(@iconbox,12,18,203,209);
  471.   setrect(@maskbox,210,18,401,209);
  472.  
  473.   Clear();
  474.   DoOutLine();
  475.  
  476.   H := NewHandle(2L);
  477.   H^^.Count := 0;
  478.  
  479.   ChangeFlag := False;
  480.   ApplFlag := False;
  481.   ApplMenu := 0;
  482.   whichicon := 0;
  483. };
  484.  
  485.  
  486. Proc _Key(c,mods: Integer);
  487. Var
  488.   Result: longint;
  489. {
  490.   If Mods and CmdKey Then {
  491.     Result := MenuKey(c);
  492.     If Result Then {
  493.       _Menu(Hiword(Result),Loword(Result));
  494.       Result := TickCount() + 20;
  495.       Loop(,,,TickCount()>Result);
  496.       HiliteMenu(0);
  497.       };
  498.     };
  499. };
  500.  
  501. Procedure _HALT();
  502. {
  503.   If ApplFlag Then
  504.     Loop(,,,OKToCream("Quitting"));
  505.  
  506.   halteasymenus();
  507.   DisposHandle(H);
  508. };
  509.  
  510. Proc Swap(I,J: IList);
  511. {
  512.   ITemp := I;
  513.   I := J;
  514.   J := ITemp;
  515. };
  516.  
  517. Proc Zero(I: IList);
  518. Var
  519.   j,a: register integer;
  520. {
  521.     loop (, j:=0,++j, j>31)
  522.     loop (,A:=0,++A, A>3)
  523.       {I[A][j][0]:=0B;I[A][j][1]:=0B};
  524. };
  525.  
  526. Procedure NormalDraw(destrect: Rect);
  527. {
  528.   BM.baseaddr := @IBuf[1];
  529.   Copybits(BM,screen^.portBits,BM.bounds,destrect,srcBic,NIL);
  530.   BM.baseaddr := @IBuf[0];
  531.   Copybits(BM,screen^.portBits,BM.bounds,destrect,srcOr,NIL);
  532. };
  533.  
  534. Procedure InvertDraw(destrect: Rect);
  535. {
  536.   BM.baseaddr := @IBuf[1];
  537.   Copybits(BM,screen^.portBits,BM.bounds,destrect,srcOr,NIL);
  538.   BM.baseaddr := @IBuf[0];
  539.   Copybits(BM,screen^.portBits,BM.bounds,destrect,srcXor,NIL);
  540. };
  541.  
  542. Procedure DrawIcons();
  543. Var  destrect : Rect;
  544. {
  545.   setrect (@destrect,42,230,74,262);
  546.   EraseRect(DestRect);
  547.     NormalDraw(DestRect);
  548.   OffSetRect(@destrect,70,0);
  549.   InsetRect(@destrect,-4,-4);
  550.   FillRect(destrect,_Gray());
  551.   InsetRect(@destrect,4,4);
  552.     NormalDraw(DestRect);
  553.  
  554.   setrect (@destrect,240,230,272,262);
  555.   EraseRect(DestRect);
  556.     InvertDraw(DestRect);
  557.   OffSetRect(@destrect,70,0);
  558.   InsetRect(@destrect,-4,-4);
  559.   FillRect(destrect,_Gray());
  560.   InsetRect(@destrect,4,4);
  561.     InvertDraw(DestRect);
  562. };
  563.  
  564. Proc BBlack(destrect: rect);
  565. {
  566.   Copybits(BitBM,screen^.portBits,BitBM.bounds,destrect,srcor,NIL);
  567. };
  568.  
  569. Proc BWhite(destrect: rect);
  570. {
  571.   Copybits(BitBM,screen^.portBits,BitBM.bounds,destrect,srcbic,NIL);
  572. };
  573.  
  574. Procedure Drawbit(x,y,b: integer);
  575. var bitrect : Rect;
  576. {
  577.   x *= 6;
  578.   y *= 6;
  579.   setrect(@bitrect,x,y,x+5,y+5);
  580.   if b then BWhite(bitrect) else BBlack(bitrect);
  581. };
  582.  
  583. Procedure _MOUSE(x,y : integer);
  584.  
  585. var b, Icon,a,bb, left : register integer;
  586.     xold,yold: integer;
  587.     Mice : Point;
  588.     current : rect;
  589. {
  590. Mice.v := y;
  591. Mice.h := x;
  592. if ptinrect(Mice.vh,iconbox) then {current := iconbox; Icon :=0; left :=
  593. 2}
  594.   else if ptinrect(Mice.vh,maskbox) then {current:=maskbox; Icon :=1; left:=35}
  595.   else return;
  596. ChangeFlag := True;
  597. ILast := IBuf;
  598. b := getpixel (x,y);
  599. Drawbit (Mice.h/6,Mice.v/6,b);
  600. loop (,,,!stilldown())
  601.  {
  602.    getmouse(@mice.vh);
  603.    x := Mice.h/6;
  604.    y := Mice.v/6;
  605.    if ptinrect(Mice.vh,current) then
  606.   {
  607.    Drawbit (x,y,b);
  608.    bb := (y-3);
  609.    a:= (x-left)/8;
  610.    if b then Ibuf[a][bb][Icon]:= ( Ibuf[a][bb][Icon] and not (1<<7-(x-left-8*a))
  611. )
  612.         else Ibuf[a][bb][Icon]:= ( Ibuf[a][bb][Icon] or (1<<7-(x-left-8*a))
  613. );
  614.    };
  615.  };
  616. DrawIcons();
  617. };
  618.  
  619.  
  620. Procedure redraw(x:integer);
  621. var I, A, Bit, M : register integer;
  622. {
  623. watch();
  624. loop (,I:=0,++I,I>31)
  625.   loop (,A:=0,++A,A>3)
  626.     loop (,Bit:=0,++Bit,Bit>7)
  627.       {M := Ibuf[A][I][x] and (1<<(7-Bit));
  628.        Drawbit(Integer(A*8+Bit+2+33*x),I+3,Integer(M=0));
  629.       };
  630. DrawIcons();
  631. arrow();
  632. };
  633.  
  634. Procedure TotalZero();
  635. {
  636.   eraserect (Iconbox);
  637.   eraserect (Maskbox);
  638.   Zero(Ibuf);
  639.   DrawIcons();
  640. };
  641.  
  642. proc IcontoMask();
  643. {
  644.   ILast := IBuf;
  645.   IBuf[1] := Ibuf[0];
  646.   Redraw(1);
  647. };
  648.  
  649. Proc DoOutLine();
  650. {
  651.   setrect(@iconbox,10,16,205,211);
  652.   setrect(@maskbox,208,16,403,211);
  653.   framerect(iconbox);
  654.   framerect(maskbox);
  655.   setrect(@iconbox,12,18,203,209);
  656.   setrect(@maskbox,210,18,401,209);
  657.   moveto (87,13);
  658.   drawstring ("ICON");
  659.   moveto (285,13);
  660.   drawstring ("MASK");
  661. };
  662.  
  663. Procedure _UPDATE();
  664. {
  665.   DoOutLine();
  666.   redraw (0); redraw(1);
  667. };
  668.