(*---------------------------------------------------------------------------
:Program.       Brush2Icon.mod
:Contents.      Converts IFF brushes to icons
:Author.        Achim Siebert
:Address.       Nobileweg 67, 7000 Stuttgart 40
:Copyright.     PD
:Language.      Oberon
:Translator.    Amiga Oberon V3.00d
:History.       V1.3, 02.12.92
:History.       V1.4, 26.08.93
:Usage.         Brush2Icon BrushOrIcon/A,BrushOrFile/A,Files/M,T=DefaultTool/K,Replace/S,Dirs/S
---------------------------------------------------------------------------*)

MODULE Brush2Icon;

IMPORT
  NoGuru,
  a  : Arguments,
  s  : SYSTEM,
  fs : FileSystem,
  st : Strings,
  e  : Exec,
  ol : OberonLib,
  I  : Intuition,
  Icon,
  WB: Workbench,
  Dos,
  Requests;

CONST
  readerr  = "Read error\n";
  nomem    = "Out of memory\n";
  usage    = "Usage: Brush2Icon BrushOrIcon [Brush2] {Files}";

CONST  (* Masking *)
  mskHasMask = 1;

CONST (* Compression *)
  cmpByteRun = 1;

TYPE
  BitMapHeader = STRUCT
    width,height          : INTEGER;
    x,y                   : INTEGER;
    nPlanes               : SHORTINT;
    masking               : SHORTINT;
    compression           : SHORTINT;
    pad1                  : SHORTINT;
    transparentColor      : INTEGER;
    xAspect,yAspect       : SHORTINT;
    pageWidth,pageHeight  : INTEGER;
  END;

CONST (* Action *)
  copy   = 0;
  extend = 1;
  nop    = 2;

VAR
  arg,deftool,b1,b2 : e.STRING;
  argNr       : INTEGER;
  in          : fs.File;
  chunk,id,len: LONGINT;
  bmhd        : BitMapHeader;
  bmhdFlag    : BOOLEAN;
  wordsPerLine: INTEGER;
  size,oc     : LONGINT;
  firstLong   : LONGINT;
  x,y,z       : INTEGER;
  compressed  : BOOLEAN;
  zaehler     : LONGINT;
  store,action: SHORTINT;

  WDO         : WB.DiskObject;
  OldWDO      : WB.DiskObjectPtr;
  SourceWDO   : WB.DiskObjectPtr;

  gad         : I.Gadget;
  Images      : ARRAY 2 OF I.Image;
  IntArray    : UNTRACED POINTER TO ARRAY OF INTEGER;
  drawerData  : WB.DrawerData;

  lock,parent : Dos.FileLockPtr;
  myFIBlock   : Dos.FileInfoBlock;

  source      : INTEGER;

  replace     : BOOLEAN;
  dirs        : BOOLEAN;
  doWild,done : BOOLEAN;

  rdargs      : Dos.RDArgsPtr;

  args        : STRUCT
                   b1   : e.STRPTR;
                   b2   : e.STRPTR;
                   files: POINTER TO ARRAY 256 OF e.STRPTR;
                   def  : e.STRPTR;
                   rep  : LONGINT;
                   dirs : LONGINT;
                 END;

  anchor      : Dos.AnchorPath;

CONST (* kinds of source *)
      icon      = 0;
      brush     = 1;
      brushes   = 2;
      plainfile = 3;

PROCEDURE Read(VAR to: ARRAY OF s.BYTE);
BEGIN
  IF ~fs.Read(in,to) THEN
    IF fs.Close(in) THEN END;
    Requests.Assert(FALSE,readerr);
  END;
END Read;

PROCEDURE NextWord():INTEGER;

VAR uword : INTEGER;
    ubyte : SHORTINT;
    bytes : INTEGER;
    n     : SHORTINT;

BEGIN

  IF NOT compressed THEN
    Read(uword);
    RETURN uword
  END;
  uword := 0; bytes := 0;
  REPEAT
    IF zaehler=0 THEN
      Read(n);
      IF n >= 0 THEN
        zaehler := n+1;
        action := copy;
      ELSIF n # -128 THEN
        zaehler:= (-n)+1;
        action := extend;
        Read(store);
      ELSE
        action := nop;
      END;
    ELSE
      CASE action OF
      | copy:   Read(ubyte);
      | extend: ubyte := store
      | nop:
      END;
      (* $OvflChk- *)
      uword := s.LSH(uword,8);
      IF ubyte >= 0 THEN
        uword := uword + ubyte
      ELSE
        uword := uword + (LONG(ubyte)+256)
      END;
      (* $OvflChk= *)
      DEC(zaehler);
      INC(bytes);
    END;
  UNTIL bytes=2;
  RETURN uword;

END NextWord;


PROCEDURE ReadBrush(num:INTEGER):BOOLEAN;

VAR temp:LONGINT;

BEGIN

  IF fs.Open(in,arg,FALSE) THEN

    Read(chunk);
    IF chunk = s.VAL(LONGINT,"FORM") THEN
      Read(len);
      Read(id);
      IF id = s.VAL(LONGINT,"ILBM") THEN

        zaehler := 0;
        bmhdFlag := FALSE;

        LOOP
          Read(chunk);  Read(len);
          IF ODD(len) THEN INC(len) END;

          IF chunk = s.VAL(LONGINT,"BODY") THEN
            IF NOT bmhdFlag THEN
              IF fs.Close(in) THEN END;
              RETURN FALSE;
            END;

            wordsPerLine := (bmhd.width+15) DIV 16;
            compressed   := (bmhd.compression=cmpByteRun);

            size := LONG(wordsPerLine) * bmhd.height * bmhd.nPlanes;

            NEW(IntArray,size);

            FOR y:=0 TO bmhd.height-1 DO
              FOR z:=0 TO (bmhd.nPlanes-1) DO
                temp := (LONG(y) + z * bmhd.height) * wordsPerLine;
                FOR x:=0 TO wordsPerLine-1 DO
                  IntArray[temp + x] := NextWord();
                END;
              END;
              IF bmhd.masking=mskHasMask THEN
                FOR x:=0 TO wordsPerLine-1 DO
                  IF NextWord()=0 THEN END;
                END;
              END;
            END;

            Images[num].width     := bmhd.width;
            Images[num].height    := bmhd.height;
            Images[num].depth     := bmhd.nPlanes;
            Images[num].imageData := s.ADR(IntArray^);
            Images[num].planePick := SHORTSET{3};
            Images[num].planeOnOff:= SHORTSET{0};

            EXIT;
          END;
          IF chunk = s.VAL(LONGINT,"BMHD") THEN

            Read(bmhd);
            bmhdFlag := TRUE;

          ELSE

            IF ~fs.Forward(in,len) THEN
              IF fs.Close(in) THEN END;
              Requests.Assert(FALSE,readerr);
            END;

          END;
        END; (* LOOP *)
        IF fs.Close(in) THEN END;
        RETURN TRUE;
      END;
    END;
    IF fs.Close(in) THEN END;
  END; (* IF fs.Open *)
  RETURN FALSE;

END ReadBrush;


PROCEDURE StripInfo(VAR tostrip:ARRAY OF CHAR);

VAR i : LONGINT;

BEGIN

  IF ~ol.wbStarted THEN
    i := st.Occurs(tostrip,".info");
    IF (i#-1) AND (i=st.Length(tostrip)-5) THEN
      tostrip[st.Length(tostrip)-5]:=0X;
    END;
  END;

END StripInfo;

PROCEDURE GetTools();

VAR string : e.STRPTR;
    MyName : ARRAY 32 OF CHAR;
    wbdop  : WB.DiskObjectPtr;


   PROCEDURE FindTool(findstr: ARRAY OF CHAR):BOOLEAN;

   BEGIN

     string := Icon.FindToolType(wbdop.toolTypes,findstr);
     IF string # NIL THEN RETURN TRUE END;
     RETURN FALSE;

   END FindTool;


BEGIN

  a.GetArg(0,MyName);
  IF MyName # "" THEN
     wbdop := Icon.GetDiskObject(MyName);
     IF wbdop # NIL THEN
        IF FindTool("DEFTOOL") THEN
          deftool := string^;
        END;
        IF FindTool("REPLACE") THEN
          replace:=TRUE;
        END;
        Icon.FreeDiskObject(wbdop);
     END;
  END;

END GetTools;


PROCEDURE GetArgs();

BEGIN

  rdargs := Dos.ReadArgs("BrushOrIcon/A,BrushOrFile/A,Files/M,T=DefaultTool/K,REPLACE/S,DIRS/S",args,NIL);

  IF rdargs=NIL THEN IF Dos.PutStr(
                "\nUsage: BrushOrIcon/A:   IFF-Brush for icon image or existing icon\n"
                  "       BrushOrFile/A:   optional second brush for highlighted icon\n"
                  "                        or first destination file\n"
                  "       Files/M:         files to get the new icon, wildcards allowed\n"
                  "       T=DefaultTool/K: default tool for project icons\n"
                  "       REPLACE/S:       replace existing default tools\n"
                  "       DIRS/S:          if using wildcards, change drawer icons only\n"
                  )#0 THEN END;
     HALT(10);
  END;
  IF args.b1#NIL THEN
     b1 := args.b1^;
  END;
  IF args.b2#NIL THEN
     b2 := args.b2^;
  END;
  IF args.def#NIL THEN
     deftool := args.def^;
  END;
  replace:=args.rep#0;
  dirs:=args.dirs#0;

END GetArgs;


PROCEDURE NextArg():BOOLEAN;

BEGIN

  IF ol.wbStarted THEN
    IF argNr>a.NumArgs() THEN RETURN FALSE END;
    a.GetArg(argNr,arg);
  ELSE
    IF argNr=1 THEN
      arg:=b1;
    ELSIF argNr=2 THEN
      arg:=b2;
    ELSIF (args.files # NIL) AND (args.files[argNr-3] # NIL) THEN
      arg := args.files[argNr-3]^;
    ELSE RETURN FALSE;
    END;
  END;
  INC(argNr);
  RETURN TRUE;

END NextArg;


BEGIN

  Requests.Assert(I.int.libNode.version>=37,"Kickstart 37.x only!");

  deftool := "";
  replace := FALSE;
  dirs    := FALSE;

  anchor.strLen:=256;
  anchor.flags:=SHORTSET{Dos.doWild};

  IF ol.wbStarted THEN
    Requests.Assert(a.NumArgs()>=1,usage);
    GetTools();
  ELSE
    GetArgs();
  END;

  arg := "\o$VER: V1.3 (02.12.92)";

  argNr := 1;

  IF NextArg() THEN END;

  source := icon;
  IF ReadBrush(0) THEN
    source := brush;
    IF NextArg() THEN END;
    IF (ol.wbStarted AND (a.NumArgs()>2))
      OR ((args.files#NIL) AND (args.files[0]#NIL)) THEN
      IF ReadBrush(1) THEN
        source := brushes;
        IF NextArg() THEN END;
      END;
    END;
  END;

  IF source=icon THEN
    IF ol.wbStarted AND (arg = "") THEN
      lock:=a.GetLock(1);
      Requests.Assert((lock#NIL) AND Dos.NameFromLock(lock,arg,LEN(arg)),
      "Couldn't access source directory!");
      IF arg[st.Length(arg)-1]=":" THEN
         st.Append(arg,"Disk");
      END;
    END;
    StripInfo(arg);
    SourceWDO := Icon.GetDiskObject(arg);
    IF SourceWDO#NIL THEN
      IF deftool = "" THEN 
        IF (SourceWDO.type = WB.project)
           AND (SourceWDO.defaultTool#NIL) THEN
         deftool := SourceWDO.defaultTool^;
        END;
      END;
      gad := SourceWDO.gadget;
      Requests.Assert(NextArg(),usage);
    ELSE
      IF ol.wbStarted THEN source := plainfile;
      ELSE
        Requests.Assert(FALSE,"Couldn't open source icon!");
      END;
    END;
  ELSE
    IF Images[0].width>Images[1].width THEN
      gad.width    := Images[0].width;
    ELSE
      gad.width    := Images[1].width;
    END;
    IF Images[0].height>Images[1].height THEN
      gad.height     := Images[0].height+1;
    ELSE
      gad.height     := Images[1].height+1;
    END;
    IF source= brush THEN
      gad.flags      := {I.gadgImage};
    ELSE
      gad.flags      := {I.gadgImage,I.gadgHImage};
      gad.selectRender := s.ADR(Images[1]);
    END;
    gad.activation := {I.relVerify,I.gadgImmediate};
    gad.gadgetType := I.boolGadget;
    gad.gadgetRender := s.ADR(Images[0]);
  END;

  WDO.magic      := WB.diskMagic;
  WDO.version    := WB.diskVersion;
  WDO.gadget     := gad;

  LOOP

    doWild := FALSE; zaehler := 0;
    IF ~ol.wbStarted THEN
      zaehler := Dos.MatchFirst(arg,anchor);
      IF (zaehler=0) AND (Dos.itsWild IN anchor.flags) THEN
        doWild := TRUE;
      ELSE Dos.MatchEnd(anchor);
      END;
    END;

    LOOP

      IF zaehler = Dos.noMoreEntries THEN EXIT END;

      IF doWild THEN
        done := FALSE;
        REPEAT
          arg := anchor.buf;
          IF dirs AND (anchor.info.dirEntryType>0) THEN done := TRUE
          ELSE
            oc := st.Occurs(arg,".info");
            IF dirs OR ((oc#-1) AND (oc=st.Length(arg)-5)) OR (anchor.info.dirEntryType>0) THEN
              IF Dos.MatchNext(anchor)=Dos.noMoreEntries THEN EXIT END;
            ELSE done := TRUE;
            END;
          END;
        UNTIL done;
      END;

      WDO.type       := WB.tool;
      WDO.defaultTool:= NIL;
      WDO.toolTypes  := NIL;
      WDO.currentX   := WB.noIconPosition;
      WDO.currentY   := WB.noIconPosition;
      WDO.drawerData := NIL;
      WDO.toolWindow := NIL;
      WDO.stackSize  := 0;

      IF ~doWild THEN StripInfo(arg) END;

      IF ol.wbStarted AND (arg = "") THEN
        lock:=a.GetLock(argNr-1);
        Requests.Assert((lock#NIL) AND Dos.NameFromLock(lock,arg,LEN(arg)),
        "Couldn't access destination!");
         WDO.drawerData := s.ADR(drawerData);
        IF arg[st.Length(arg)-1]=":" THEN
          WDO.type := WB.disk;
          st.Append(arg,"Disk");
        ELSE
          WDO.type := WB.drawer;
        END;
      ELSE
        lock := Dos.Lock(arg,Dos.accessRead);
        IF lock#NIL THEN
          IF Dos.Examine(lock,myFIBlock) THEN
            IF myFIBlock.dirEntryType>0 THEN
              WDO.drawerData := s.ADR(drawerData);
              parent:= Dos.ParentDir(lock);
              IF parent#NIL THEN
                Dos.UnLock(parent);
                WDO.type := WB.drawer;
              ELSE
                WDO.type := WB.disk;
                st.Append(arg,"Disk");
              END;
            ELSE
              IF fs.Open(in,myFIBlock.fileName,FALSE) THEN
                IF fs.Read(in,firstLong) THEN
                  IF firstLong#03F3H THEN
                    WDO.type := WB.project;
                    WDO.defaultTool := s.ADR(deftool);
                  END;
                END;
                IF fs.Close(in) THEN END;
              END;
            END;
          END;
          Dos.UnLock(lock);
        ELSIF (st.Length(arg)>=4) AND (st.Occurs(arg,"Disk")=st.Length(arg)-4) THEN
          WDO.drawerData := s.ADR(drawerData);
          WDO.type := WB.disk;
        END;
      END;

      OldWDO := Icon.GetDiskObject(arg);
      
      IF (source=plainfile) AND (OldWDO=NIL) THEN
        OldWDO:=Icon.GetDefDiskObject(WDO.type);
        Requests.Assert(OldWDO#NIL,"Couldn't get default icon!");
        WDO.gadget:=OldWDO.gadget;
      ELSE
  
        IF OldWDO # NIL THEN
          WDO.type       := OldWDO.type;
          WDO.currentX   := OldWDO.currentX;
          WDO.currentY   := OldWDO.currentY;
          WDO.defaultTool:= OldWDO.defaultTool;
          WDO.toolTypes  := OldWDO.toolTypes;
          WDO.drawerData := OldWDO.drawerData;
          WDO.toolWindow := OldWDO.toolWindow;
          WDO.stackSize  := OldWDO.stackSize;
        END;

      END;

      IF (WDO.type = WB.project) AND replace
      THEN WDO.defaultTool := s.ADR(deftool);
      END;
      
      IF Icon.PutDiskObject(arg,s.ADR(WDO)) THEN END;
      IF OldWDO#NIL THEN Icon.FreeDiskObject(OldWDO); OldWDO:= NIL; END;

      IF (~ol.wbStarted) AND (Dos.PutStr(arg)=Dos.PutStr(".info\n")) THEN END;

      IF doWild THEN
        IF Dos.MatchNext(anchor)=Dos.noMoreEntries THEN EXIT END;
      ELSE EXIT;
      END;

    END; (* inner LOOP *)

    IF doWild THEN Dos.MatchEnd(anchor) END;

    IF ~NextArg() THEN EXIT END;

  END; (* LOOP *)

  IF (~ol.wbStarted) AND (Dos.PutStr("\n--- done\n")#0) THEN END;

CLOSE

  IF rdargs#NIL THEN Dos.FreeArgs(rdargs);END;
  IF SourceWDO#NIL THEN Icon.FreeDiskObject(SourceWDO);END;
  IF (~ol.wbStarted) AND (Dos.PutStr("\n")#0) THEN END;

END Brush2Icon.