(**************************************************************************

:Program.       RemapInfo

:Contents.      das tausendunderste Programm, das (a) die Farben eines
                Icons an die WBench 2.0 anpasst und (b) aus einem kaputten
                4 Farben Icon (die 3. Bitplane enthält Müll) ein echtes
                4 Farben Icon macht.

:Usage.         RemapInfo [±KILLPLANES] [±REMAP]


:Copyright.     © 1992 by:

:Author.        Thomas Ansorge

:Address.       Dinkelackerring 55, W-6730 Neustadt, Deutschland


:Language.      Modula-2

:Translator.    M2Amiga V4.0 (deutsch)


:Version.       0.9 vom 22. März 1992

:History.       0.9 vom 22.03.1992: es läuft (<=> es stürzt nicht ab)


**************************************************************************)


MODULE RemapInfo;

FROM Arguments IMPORT GetArg, GetLock, NumArgs;

FROM Arts IMPORT Assert, returnVal, Terminate, thisTask, wbStarted;

FROM DosD IMPORT FileHandlePtr, FileInfoBlock, FileLock, FileLockPtr,
   newFile, ticksPerSecond;

FROM DosL IMPORT CurrentDir, Delay, Examine, Output, ParentDir, Write;

FROM DosSupport IMPORT Close, Open;

FROM ExecL IMPORT FreeMem;

FROM IconL IMPORT FindToolType, FreeDiskObject, GetDiskObject,
   PutDiskObject;

FROM IntuitionD IMPORT boolGadget, Gadget, GadgetFlags, GadgetFlagSet,
   Image, ImagePtr;

FROM String IMPORT CapString, Compare, Copy, Length;

FROM SYSTEM IMPORT ADR, ADDRESS, ASSEMBLE;

FROM WorkbenchD IMPORT DiskObject, DiskObjectPtr;

(* --------------------------------------------------------------------- *)

CONST RemapText = " \e[1mRemapInfo\e[0m";
      ErrorText = " ERROR ->";

      RemapOptText = "REMAP";
      KillPOptText = "KILLPLANES";

CONST Copyright = "\n" + RemapText + " © 1992 Thomas Ansorge\n\n\o";

CONST Start1Text = " " + RemapOptText + " is switched ON as default.\n\o";
      Start2Text = " " + KillPOptText + " is switched OFF as default.\n\n\o";

CONST RemapOnText       = "\n " + RemapOptText + " is switched ON now!\n\n\o";
      RemapOffText      = "\n " + RemapOptText + " is switched OFF now!\n\n\o";
      KillPlanesOnText  = "\n " + KillPOptText + " is switched ON now!\n\n\o";
      KillPlanesOffText = "\n " + KillPOptText + " is switched OFF now!\n\n\o";

CONST Processing1Text = " Processing \"\o";
      Processing2Text = ".info\" ...\n\o";

CONST NoIcon1Text = ErrorText + " Could not find icon \"\o";
      NoIcon2Text = ".info\"!\n\o";

      Typ1Text = ErrorText + " Icon \"\o";
      Typ2Text = ".info\" is not of required type!\n\o";

      KeinOutputText = "Could not open output window!\o";

CONST WinDefs = "CON:70/11/540/152/RemapInfo\o";

CONST OptPlus  = "+";
      OptMinus = "-";

      OptKillPlanesPlus     = OptPlus + KillPOptText;
      OptKillPlanesMinus    = OptMinus + KillPOptText;
      OptRemapPlus          = OptPlus + RemapOptText;
      OptRemapMinus         = OptMinus + RemapOptText;

CONST DefKillPlanes = FALSE;
      DefRemap      = TRUE;

CONST Seconds = 10;

CONST StringMax = 255;

TYPE String = ARRAY [0..StringMax] OF CHAR;

TYPE Aktion = RECORD
        KillPlanes   : BOOLEAN;
        Remap        : BOOLEAN;
     END; (* RECORD Aktion *)

TYPE INTPOINTER = POINTER TO INTEGER;

VAR AltDirLockPtr : FileLockPtr;
    Anzahl        : LONGINT;
    DirInfo       : FileInfoBlock;
    DirLockPtr    : FileLockPtr;
    Error         : LONGINT;
    Fehler        : BOOLEAN;
    i             : INTEGER;
    Icon          : DiskObjectPtr;
    IconAktion    : Aktion;
    IconImageGad,
    IconImageSel  : ImagePtr;
    IconName      : String;
    IconNameLaenge: INTEGER;
    OutPut        : FileHandlePtr;
    ParDirLockPtr : FileLockPtr;

(* --------------------------------------------------------------------- *)

PROCEDURE BearbeiteImage (IconImage : ImagePtr;
                          IconAktion: Aktion;
                          OutPut    : FileHandlePtr);

   (* macht die eigentlicht Bearbeitung *)

   CONST PlaneError = ErrorText + " cannot handle this kind of images!\n\o";

   VAR Anzahl       : LONGINT;
       i            : INTEGER;
       ImagePlane,
       ImagePlane2  : INTPOINTER;
       ImageNewSize,
       ImageOldSize : LONGINT;
       IPlaneSize   : INTEGER;
       Maske        : INTEGER;

   (* ------------------------------------------------------------------ *)

   PROCEDURE ExOR (Wort1, Wort2: INTEGER): INTEGER;

      (* wendet den Maschinenbefehl EOR auf Wort1 und Wort2 an *)

      VAR Ergebnis: INTEGER;

      (* --------------------------------------------------------------- *)

      BEGIN (* Funktion ExOR *)

      ASSEMBLE (
         MOVE.W Wort1(A5),D0
         MOVE.W Wort2(A5),D1
         EOR.W  D1,D0
         MOVE.W D0,Ergebnis(A5)
      END);

      RETURN Ergebnis;
   END ExOR (* Funktion *);

   (* ------------------------------------------------------------------ *)

   PROCEDURE LogAND (Byte1, Byte2: SHORTCARD): SHORTCARD;

      (* wendet den Maschinenbefehl AND auf Byte1 und Byte2 an *)

      VAR Ergebnis: SHORTCARD;

      (* --------------------------------------------------------------- *)

      BEGIN (* Funktion LogAND *)

      ASSEMBLE (
         MOVE.B Byte1(A5),D0
         MOVE.B Byte2(A5),D1
         AND.B  D1,D0
         MOVE.B D0, Ergebnis(A5)
      END);

      RETURN Ergebnis;
   END LogAND (* Funktion *);

   (* ------------------------------------------------------------------ *)

   PROCEDURE Wort (Zahl: INTEGER): INTEGER;

      (* vergrößert Zahl so weit, daß Zahl durch 16 teilbar wird *)

      BEGIN (* Funktion Wort *);

      IF Zahl MOD 16 # 0 THEN
         IF (MAX (INTEGER) - 15) >= Zahl THEN
            Zahl := Zahl + (16 - (Zahl MOD 16));
         END (* IF (MAX *);
      END (* IF Zahl MOD 16 *);

      RETURN Zahl;
   END Wort (* Funktion *);

   (* ------------------------------------------------------------------ *)

   BEGIN (* Prozedur BearbeiteImage *)

   WITH IconImage^ DO
      IF IconAktion.KillPlanes THEN
         IF depth > 2 THEN
            planePick := LogAND (planePick, 3);
            planeOnOff := LogAND (planeOnOff, 3);

            (* meiner Meinung nach gehört das folgende dahin, erzeugt
               jedoch einen Guru mit Spätzünder (z. Bsp. 81000005):   *)

            (*
            ImagePlane := imageData;
            INC (ImagePlane, (2 * Wort (width) * height) DIV 8);
            FreeMem (ImagePlane, ((depth - 2) * Wort (width) * height) DIV 8);
            *)

            depth := 2; (* sonst wird die kaputte Bitplane doch gezeichnet *)
         END (* IF depth *);
      END (* IF IconAction.KillPlanes *);

      IF IconAktion.Remap THEN
         IF depth > 1 THEN
            IF LogAND (planePick, 3) = 3 THEN
               ImagePlane := imageData;
               ImagePlane2 := imageData;
               IPlaneSize := (Wort (width) * height) DIV 8;
               INC (ImagePlane2, IPlaneSize);

               FOR i := 1 TO (IPlaneSize DIV 2) DO
                  Maske := ExOR (ImagePlane^, ImagePlane2^);
                  ImagePlane^ := ExOR (ImagePlane^, Maske);
                  ImagePlane2^ := ExOR (ImagePlane2^, Maske);

                  INC (ImagePlane, SIZE (ImagePlane^));
                  INC (ImagePlane2, SIZE (ImagePlane2^));
               END (* FOR i *);

            ELSE (* IF LogAND *)
               Anzahl := Write (OutPut, ADR (PlaneError), SIZE (PlaneError));
            END (* IF LogAND *);
         END (* IF depth *);
      END (* IF IconAction.Remap *);
   END (* WITH IconImage^ *);
END BearbeiteImage (* Prozedur *);

(* --------------------------------------------------------------------- *)

PROCEDURE Usage (OutPut: FileHandlePtr);

   (* zeigt eine Usage und beendet das Programm *)

   CONST Usag1Text = " Usage:\n\o";
         Usag2Text = " ~~~~~~\n\o";
         Usag3Text = " RemapInfo Options/Files Options/Files ...\n\n\o";
         FilesText = " Files  : Icons without .info extension\n\o";
         OptioText = " Options: ±REMAP ±KILLPLANES (both switches)\n\n\o";
         DefauText = " Default is +REMAP -KILLPLANES\n\n\o";
         WarniText = " Please have a look at the manual to avoid damage to" +
                     " Your icons!\n\n\o";

         Clic2Text = " Click at" + RemapText + ", then press and hold down the\n\o";
         Clic3Text = " SHIFT-key, then click at all icons to process and\n\o";
         Clic4Text = " double-click the last one." + RemapText + " will do the rest.\n\n\o";
         Tool1Text = " Tool-Types:\n\o";
         Tool2Text = " ~~~~~~~~~~~\n\o";
         Tool3Text = " ±REMAP, +REMAP is default\n\o";
         Tool4Text = " ±KILLPLANES, -KILLPLANES is default\n\n\o";

   VAR Anzahl: LONGINT;

   (* ------------------------------------------------------------------ *)

   BEGIN (* Prozedur Usage *)

   returnVal := 10;

   Anzahl := Write (OutPut, ADR (Usag1Text), SIZE (Usag1Text));
   Anzahl := Write (OutPut, ADR (Usag2Text), SIZE (Usag2Text));

   IF NOT wbStarted THEN
      Anzahl := Write (OutPut, ADR (Usag3Text), SIZE (Usag3Text));
      Anzahl := Write (OutPut, ADR (FilesText), SIZE (FilesText));
      Anzahl := Write (OutPut, ADR (OptioText), SIZE (OptioText));
      Anzahl := Write (OutPut, ADR (DefauText), SIZE (DefauText));

   ELSE (* IF NOT wbStarted *)
      Anzahl := Write (OutPut, ADR (Clic2Text), SIZE (Clic2Text));
      Anzahl := Write (OutPut, ADR (Clic3Text), SIZE (Clic3Text));
      Anzahl := Write (OutPut, ADR (Clic4Text), SIZE (Clic4Text));
      Anzahl := Write (OutPut, ADR (Tool1Text), SIZE (Tool1Text));
      Anzahl := Write (OutPut, ADR (Tool2Text), SIZE (Tool2Text));
      Anzahl := Write (OutPut, ADR (Tool3Text), SIZE (Tool3Text));
      Anzahl := Write (OutPut, ADR (Tool4Text), SIZE (Tool4Text));
   END (* IF NOT wbStarted *);

   Anzahl := Write (OutPut, ADR (WarniText), SIZE (WarniText));

   Terminate;
END Usage (* Prozedur *);

(* --------------------------------------------------------------------- *)
(* --------------------------------------------------------------------- *)

BEGIN (* Hauptprogramm *)

AltDirLockPtr := NIL;
DirLockPtr := NIL;
Icon := NIL;
OutPut := NIL;
ParDirLockPtr := NIL;

WITH IconAktion DO
   KillPlanes := DefKillPlanes;
   Remap := DefRemap;
END (* WITH IconAktion *);

IF wbStarted THEN
   OutPut := Open (ADR (WinDefs), newFile);

ELSE (* IF wbStarted *)
   OutPut := Output ();
END (* IF wbStarted *);

Assert (OutPut # NIL, ADR (KeinOutputText));

Anzahl := Write (OutPut, ADR (Copyright), SIZE (Copyright));

IF NumArgs () = 0 THEN
   Usage (OutPut);
END (* IF NumArgs () *);

IF NumArgs () = 1 THEN
   GetArg (1, IconName, IconNameLaenge);

   IF IconName [0] = "?" THEN
      Usage (OutPut);
   END (* IF IconName *);
END (* IF NumArgs *);

Anzahl := Write (OutPut, ADR (Start1Text), SIZE (Start1Text));
Anzahl := Write (OutPut, ADR (Start2Text), SIZE (Start2Text));

IF wbStarted THEN
   GetArg (0, IconName, IconNameLaenge);
   Icon := GetDiskObject (ADR (IconName));

   IF Icon # NIL THEN
      IF FindToolType (Icon^.toolTypes, ADR (OptKillPlanesPlus)) # NIL THEN
         IconAktion.KillPlanes := TRUE;
         Anzahl := Write (OutPut, ADR (KillPlanesOnText), SIZE (KillPlanesOnText));
      END (* IF FindToolType *);

      IF FindToolType (Icon^.toolTypes, ADR (OptKillPlanesMinus)) # NIL THEN
         IconAktion.KillPlanes := FALSE;
         Anzahl := Write (OutPut, ADR (KillPlanesOffText), SIZE (KillPlanesOffText));
      END (* IF FindToolType *);

      IF FindToolType (Icon^.toolTypes, ADR (OptRemapPlus)) # NIL THEN
         IconAktion.Remap := TRUE;
         Anzahl := Write (OutPut, ADR (RemapOnText), SIZE (RemapOnText));
      END (* IF FindToolType *);

      IF FindToolType (Icon^.toolTypes, ADR (OptRemapMinus)) # NIL THEN
         IconAktion.Remap := FALSE;
         Anzahl := Write (OutPut, ADR (RemapOffText), SIZE (RemapOffText));
      END (* IF Compare *);

      FreeDiskObject (Icon);
      Icon := NIL;
   END (* IF Icon *);
END (* IF wbStarted *);

FOR i := 1 TO NumArgs () DO
   GetArg (i, IconName, IconNameLaenge);

   IF wbStarted AND (IconNameLaenge = 0) THEN
      DirLockPtr := GetLock (i);

      IF DirLockPtr # NIL THEN
         Fehler := Examine (DirLockPtr, ADR (DirInfo));

         Copy (IconName, DirInfo.fileName);
         IconNameLaenge := Length (IconName);

         ParDirLockPtr := ParentDir (DirLockPtr);

         IF ParDirLockPtr # NIL THEN
            AltDirLockPtr := CurrentDir (ParDirLockPtr);
         END (* IF ParDirLockPtr *);
      END (* IF DirLockPtr *);
   END (* IF wbStarted AND *);

   IF IconNameLaenge < StringMax THEN
      IF (IconName [0] = OptPlus) OR (IconName [0] = OptMinus) THEN
         CapString (IconName);

         IF Compare (IconName, OptKillPlanesPlus) = 0 THEN
            IconAktion.KillPlanes := TRUE;
            Anzahl := Write (OutPut, ADR (KillPlanesOnText), SIZE (KillPlanesOnText));

         ELSIF Compare (IconName, OptKillPlanesMinus) = 0 THEN
            IconAktion.KillPlanes := FALSE;
            Anzahl := Write (OutPut, ADR (KillPlanesOffText), SIZE (KillPlanesOffText));

         ELSIF Compare (IconName, OptRemapPlus) = 0 THEN
            IconAktion.Remap := TRUE;
            Anzahl := Write (OutPut, ADR (RemapOnText), SIZE (RemapOnText));

         ELSIF Compare (IconName, OptRemapMinus) = 0 THEN
            IconAktion.Remap := FALSE;
            Anzahl := Write (OutPut, ADR (RemapOffText), SIZE (RemapOffText));
         END (* IF Compare *);

      ELSE (* IF IconName [0] *)
         Icon := GetDiskObject (ADR (IconName));

         IF Icon # NIL THEN
            Anzahl := Write (OutPut, ADR (Processing1Text), SIZE (Processing1Text));
            Anzahl := Write (OutPut, ADR (IconName), IconNameLaenge);
            Anzahl := Write (OutPut, ADR (Processing2Text), SIZE (Processing2Text));

            IF (Icon^.gadget.gadgetType = boolGadget) AND
               (gadgImage IN Icon^.gadget.flags) THEN
               IconImageGad := Icon^.gadget.gadgetRender;
               IconImageSel := Icon^.gadget.selectRender;

               IF IconImageGad # NIL THEN
                  BearbeiteImage (IconImageGad, IconAktion, OutPut);
               END (* IF IconImageGad *);

               IF gadgHImage IN Icon^.gadget.flags THEN
                  IF IconImageSel # NIL THEN
                     BearbeiteImage (IconImageSel, IconAktion, OutPut);
                  END (* IF IconImageSel *);
               END (* IF gadgHImage *);

               Fehler := PutDiskObject (ADR (IconName), Icon);

            ELSE (* IF (Icon^. *)
               Anzahl := Write (OutPut, ADR (Typ1Text), SIZE (Typ1Text));
               Anzahl := Write (OutPut, ADR (IconName), IconNameLaenge);
               Anzahl := Write (OutPut, ADR (Typ2Text), SIZE (Typ2Text));
            END (* IF (Icon^.gadget.type *);

            FreeDiskObject (Icon);
            Icon := NIL;

         ELSE (* IF Icon # NIL *)
            Anzahl := Write (OutPut, ADR (NoIcon1Text), SIZE (NoIcon1Text));
            Anzahl := Write (OutPut, ADR (IconName), IconNameLaenge);
            Anzahl := Write (OutPut, ADR (NoIcon2Text), SIZE (NoIcon2Text));
         END (* IF Icon # NIL *);
      END (* IF IconName [0] *);
   END (* IF IconNameLaenge *);
END (* FOR i *);

(* --------------------------------------------------------------------- *)

CLOSE; (* aufräumen... *)

IF Icon # NIL THEN
   FreeDiskObject (Icon);
   Icon := NIL;
END (* IF Icon *);

IF wbStarted THEN
   Delay (Seconds * ticksPerSecond);
   Close (OutPut);
   OutPut := NIL;
END (* IF wbStarted *);

END RemapInfo (* Modul *).