(* ------------------------------------------------------------------------
  :Program.       ImageConvert
  :Contents.      Umwandlung von IFF-Brushes in M2-Source-Code.
  :Author.        Kai Bolay
  :Address.       Hoffmannstraße 168
  :Address.       D-7250 Leonberg 1
  :Phone.         (0)7152/22135
  :History.       V1.0 25-Nov-89
  :Copyright.     PD
  :Language.      Modula-2
  :Translator.    M2Amiga 3.2d
  :Imports.       IFFSupport1.5 [fbs], InOut2 [Bernd Preusing]
------------------------------------------------------------------------ *)

MODULE ImageConvert;

(* FOLD: IMPORT *)
FROM SYSTEM     IMPORT ADR, ADDRESS;
FROM Arts       IMPORT Assert, TermProcedure, Terminate, CurrentLevel;
FROM Arguments  IMPORT NumArgs, GetArg;
FROM Str        IMPORT Copy, Concat;
FROM FileNames  IMPORT GetPath;
FROM IFFSupport IMPORT ReadILBM, ReadILBMFlags, ReadILBMFlagSet, IFFInfo;
FROM InOut2     IMPORT SetOutput, WriteString, WriteLn, WriteCard,
                       ReadString, done, CloseOutput, WriteHex, WriteInt;
FROM Graphics   IMPORT RastPortPtr, BitMapPtr;
FROM Icon       IMPORT GetDiskObject, PutDiskObject, FreeDiskObject;
FROM Workbench  IMPORT DiskObjectPtr;
FROM Intuition  IMPORT ScreenPtr, CloseScreen, WindowPtr, DisplayBeep;
(* ENDFD *)

VAR num, len         : INTEGER;
    Output, Argument : ARRAY [1..200] OF CHAR;
    DefOpen, ModOpen : BOOLEAN;
    MyScreen         : ScreenPtr;

(* FOLD: MakeIcon *)
PROCEDURE MakeIcon (name : ARRAY OF CHAR);

CONST IconName = "M2:Icons/txt";

VAR Icon : DiskObjectPtr;

BEGIN
   Icon := GetDiskObject (ADR (IconName));
   IF Icon # NIL THEN
      IF PutDiskObject (ADR (name), Icon) = 0 THEN END;
      FreeDiskObject (Icon);
   END; (* IF *)
END MakeIcon;
(* ENDFD *)
(* FOLD: WriteName *)
PROCEDURE WriteName (name : ARRAY OF CHAR);

VAR path : ARRAY [0..100] OF CHAR;
    len  : INTEGER;

BEGIN
   GetPath (name, path, len);
   WriteString (name);
END WriteName;
(* ENDFD *)
(* FOLD: CloseDef *)
PROCEDURE CloseDef;

BEGIN
   IF DefOpen THEN
      CloseOutput ();
   END; (* IF *)
END CloseDef;
(* ENDFD *)
(* FOLD: OpenDef *)
PROCEDURE OpenDef;

VAR DefName : ARRAY [1..200] OF CHAR;

BEGIN
   TermProcedure (CloseDef);
   Copy (DefName, Output);
   Concat (DefName, ".def");
   SetOutput (DefName);
   DefOpen := done;
   Assert (DefOpen, ADR ("Can't open DEFINITION-File!"));
   MakeIcon (DefName);
END OpenDef;
(* ENDFD *)
(* FOLD: CloseMod *)
PROCEDURE CloseMod;

BEGIN
   IF ModOpen THEN
      CloseOutput ();
   END; (* IF *)
END CloseMod;
(* ENDFD *)
(* FOLD: OpenMod *)
PROCEDURE OpenMod;

VAR ModName : ARRAY [1..200] OF CHAR;

BEGIN
   TermProcedure (CloseMod);
   Copy (ModName, Output);
   Concat (ModName, ".mod");
   SetOutput (ModName);
   ModOpen := done;
   Assert (ModOpen, ADR ("Can't open IMPLEMENTATION-File!"));
   MakeIcon (ModName);
END OpenMod;
(* ENDFD *)
(* FOLD: WriteModProcs *)
PROCEDURE WriteModProcs (name : ARRAY OF CHAR);

VAR Depth, Width, Height,
    ByteWidth, ScrByteWidth : INTEGER;
    RP                      : RastPortPtr;
    BM                      : BitMapPtr;
    Plane, Line, Step       : INTEGER;
    MyWindow                : WindowPtr;
    NewLine                 : BOOLEAN;
    Location                : POINTER TO CARDINAL;
    Num                     : CARDINAL;

BEGIN
   IF NOT (ReadILBM (name, ReadILBMFlagSet {visible}, MyScreen, MyWindow)) THEN
      DisplayBeep (NIL);
   ELSE
      WITH IFFInfo.BMHD DO
         Depth  := depth;
         Width  := width;
         Height := height;
      END; (* WITH *)
      ByteWidth := Width DIV 8;
      IF (ByteWidth * 8) < Width THEN
         INC (ByteWidth);
      END; (* IF *)
      IF ODD (ByteWidth) THEN
         INC (ByteWidth);
      END; (* IF *)
      WITH MyScreen^ DO
         ScrByteWidth := width DIV 8;
         RP := ADR (rastPort);
         BM := RP^.bitMap;
      END; (* WITH *)

      WriteLn;
      WriteString ("(* $E- *)"); WriteLn; (* I don't know the Copiler Flag *)
                                          (* v3.3 for Chip-Mem!            *)
      WriteString ("PROCEDURE "); WriteName (name); WriteString ("Dat;");
      WriteLn; WriteLn;
      WriteString ("BEGIN"); WriteLn;
      FOR Plane := 0 TO Depth-1 DO
         WriteString ("   (* Plane "); WriteInt (Plane+1, 1);
         WriteString (" *)"); WriteLn;
         NewLine := TRUE;
         FOR Line := 0 TO Height-1 DO
            FOR Step := 0 TO ByteWidth-2 BY 2 DO
               IF NewLine THEN
                  WriteString ("   INLINE (");
                  NewLine := FALSE;
                  Num := 0;
               END; (* IF *)
               WriteString ("0");
               Location := ADDRESS (BM^.planes[Plane] + Step +
                                    ScrByteWidth * Line);
               WriteHex (Location^, 4); (* Hex-Wert schreiben *)
               WriteString ("H");
               INC (Num);
               IF (Num = 8) OR
                  ((Step = ByteWidth-2) AND (Line = Height-1)) THEN
                  WriteString (");"); WriteLn;
                  NewLine := TRUE;
               ELSE
                  WriteString (", ");
               END; (* IF *)
            END; (* FOR Step *)
         END; (* FOR Line *)
      END; (* FOR Plane *)
      WriteString ("END "); WriteName (name); WriteString ("Dat;"); WriteLn;
      WriteLn; WriteLn;
      CloseScreen (MyScreen); MyScreen := NIL;
      WriteString ("PROCEDURE Init"); WriteName (name); WriteString (";");
      WriteLn; WriteLn;
(*** if less than v3.3 ***)
      WriteString ("CONST "); WriteName (name); WriteString ("Size =");
      WriteInt (Height * ByteWidth * Depth, 5); WriteString (";");
      WriteLn; WriteLn;
(*** endif ***)
      WriteString ("BEGIN"); WriteLn;
      WriteString ("   WITH "); WriteName (name); WriteString (" DO");
      WriteLn;
      WriteString ("      leftEdge   := 0;"); WriteLn;
      WriteString ("      topEdge    := 0;"); WriteLn;
      WriteString ("      width      := "); WriteInt (Width, 3);
      WriteString (";"); WriteLn;
      WriteString ("      height     := "); WriteInt (Height, 3);
      WriteString (";"); WriteLn;
      WriteString ("      depth      := "); WriteInt (Depth, 1);
      WriteString (";"); WriteLn;
(*** if Compiler v3.3 ***
      WriteString ("      imageData  := ADR ("); WriteName (name);
      WriteString ("Dat);"); WriteLn;
 *** endif ***)
      WriteString ("      planePick  := 255;"); WriteLn;
      WriteString ("      planeOnOff := 0;"); WriteLn;
      WriteString ("      nextImage  := NIL;"); WriteLn;
(*** if less than v3.3 ***)
      WriteString ("      AllocMem (imageData, "); WriteName (name);
      WriteString ("Size, TRUE);"); WriteLn;
      WriteString ("      CopyMem (ADR ("); WriteName (name);
      WriteString ("Dat), imageData, "); WriteName (name);
      WriteString ("Size);"); WriteLn;
(*** endif ***)
      WriteString ("   END; (* WITH *)"); WriteLn;
      WriteString ("END Init"); WriteName (name); WriteString (";");
      WriteLn;
   END; (* IF *)
END WriteModProcs;
(* ENDFD *)
(* FOLD: CleanUp *)
PROCEDURE CleanUp;

BEGIN
   IF MyScreen # NIL THEN
      CloseScreen (MyScreen);
      MyScreen := NIL;
   END; (* IF *)
END CleanUp;
(* ENDFD *)

BEGIN
   TermProcedure (CleanUp);
   WriteString ("Image Convert 1.0.  © 1989 by Kai Bolay"); WriteLn;
   WriteLn;
   IF NumArgs() = 0 THEN
      WriteString ("No Input!"); WriteLn;
      Terminate (CurrentLevel());
   END; (* IF *)
   WriteString ("Name of Module to be generated (without Extension):"); WriteLn;
   ReadString (Output);
   (* FOLD: DEFINITION *)
   OpenDef;
   WriteString ("DEFINITION MODULE ");
   WriteName (Output); WriteString (";"); WriteLn;
   WriteLn;
   WriteString ("FROM Intuition IMPORT Image;"); WriteLn; WriteLn;
   FOR num := 1 TO NumArgs() DO
      GetArg (num, Argument, len);
      IF num = 1 THEN
         WriteString ("VAR ");
      ELSE
         WriteString ("    ");
      END; (* IF *)
      WriteName (Argument); WriteString (" : Image;"); WriteLn;
   END; (* FOR *)
   WriteLn;
   WriteString ("END "); WriteName (Output); WriteString ("."); WriteLn;
   CloseDef;
   (* ENDFD *)
   (* FOLD: IMPLEMENTATION *)
   OpenMod;
   WriteString ("IMPLEMENTATION MODULE ");
   WriteName (Output); WriteString (";"); WriteLn;
   WriteLn;
   WriteString ("FROM SYSTEM IMPORT ADR, INLINE;"); WriteLn;
(*** if less than v3.3 ***)
   WriteString ("FROM Heap   IMPORT AllocMem;"); WriteLn;
   WriteString ("FROM Exec   IMPORT CopyMem;"); WriteLn;
(*** endif ***)
   WriteLn;
   FOR num := 1 TO NumArgs() DO
      GetArg (num, Argument, len);
      WriteModProcs (Argument);
   END; (* FOR *)
   WriteLn; WriteString ("BEGIN"); WriteLn;
   FOR num := 1 TO NumArgs() DO
      GetArg (num, Argument, len);
      WriteString ("  Init"); WriteName (Argument); WriteString (";");
      WriteLn;
   END; (* FOR *)
   WriteString ("END "); WriteName (Output); WriteString ("."); WriteLn;
   CloseMod;
   (* ENDFD *)
   WriteLn;
   WriteString ("Done."); WriteLn;
END ImageConvert.