(* ------------------------------------------------------------------------
  :Program.     IItoI (IconImage to other Icon)
  :Author.      Kai Bolay [kai]
  :Author.      Nicolas Benezan [bne]
  :Address.     [kai] Hoffmannstraße 168, D7250 Leonberg 1
  :Copyright.   Public Domain
  :Language.    Oberon
  :Translator.  AMIGA OBERON v1.29, A+L AG
  :Imports.     StringOps [bne]
  :History.     V1.0 [kai] 25-Nov-89 Initial
  :History.     V2.0 [bne] 04-Nov-90 ported to Oberon, multiple args
  :History.     V2.1 [kai] 16-Feb-91 cosmetic Bug in Assert (CLI-start)
------------------------------------------------------------------------ *)
MODULE IItoI;

IMPORT a: Arguments, d: Dos, ic: Icon, i: Intuition, ol: OberonLib,
       rq: Requests, w: Workbench,
       So: StringOps;

CONST
  Usage           = "Usage: IITOI FromIcon {ToIcon}";
  ReadSourceError = "Error reading source icon";
  ReadDestError   = "Error reading destination icon";
  WriteError      = "Error writing destination icon";
  ExamineError    = "Could not Examine() directory";
  OutOfMem        = "Not enough free memory";

VAR
  Source, Dest: w.DiskObjectPtr;
  IconName: ARRAY 30 OF CHAR;
  Num: INTEGER;
  OldGadget: i.Gadget;
  OldDir: d.FileLockPtr;
  Info: d.FileInfoBlockPtr;

PROCEDURE Assert (Condition: BOOLEAN;
                  Text: ARRAY OF CHAR);
  VAR
    Out: d.FileHandlePtr;
    Ok: BOOLEAN;
  BEGIN
    IF NOT Condition THEN
      IF ol.wbStarted THEN
        Ok:= rq.Request ("IItoI error:", Text, "", "Cancel");
      ELSE
        Out:= d.Output ();
        Ok:= d.Write (Out, Text, So.Length (Text)) > 0;
        Ok:= d.Write (Out, "\n", 1) > 0;
      END;
      HALT (20);
    END;
  END Assert;

PROCEDURE ChangeDir (Arg: INTEGER);
  VAR
    Dummy, Parent: d.FileLockPtr;
  BEGIN
    a.GetArg (Arg, IconName);
    IF IconName = "" THEN
      OldDir:= d.CurrentDir (NIL);
      Parent:= d.ParentDir (OldDir);
      IF Parent # NIL THEN
        Dummy:= d.CurrentDir (Parent);
        Assert (d.Examine (OldDir, Info), ExamineError);
        So.Assign (Info.fileName, IconName);
      ELSE
        IconName:= "Disk";
        Dummy:= d.CurrentDir (OldDir);
        OldDir:= NIL;
      END;
    END;
  END ChangeDir;

PROCEDURE ResetDir;
  BEGIN
    IF OldDir # NIL THEN
      OldDir:= d.CurrentDir (OldDir);
      d.UnLock (OldDir);
      OldDir:= NIL;
    END;
  END ResetDir;

BEGIN
  NEW (Info);
  Assert (Info # NIL, OutOfMem);
  Assert (a.NumArgs () > 1, Usage);
  ChangeDir (1);
  Source:= ic.GetDiskObject (IconName);
  Assert (Source # NIL, ReadSourceError);
  Num:= 2;
  REPEAT
    ResetDir;
    ChangeDir (Num);
    Dest:= ic.GetDiskObject (IconName);
    Assert (Dest # NIL, ReadDestError);
    OldGadget:= Dest.gadget;
    Dest.gadget:= Source.gadget;
    Assert (ic.PutDiskObject (IconName, Dest), WriteError);
    Dest.gadget:= OldGadget;
    ic.FreeDiskObject (Dest);
    Dest:= NIL;
    INC (Num);
  UNTIL Num > a.NumArgs ();
CLOSE
  ResetDir;
  IF Source # NIL THEN
    ic.FreeDiskObject (Source);
  END;
  IF Dest # NIL THEN
    ic.FreeDiskObject (Dest);
  END;
END IItoI.