(*---------------------------------------------------------------------------
    :Program.    IFFSupport.mod
    :Author.     Fridtjof Siebert
    :Address.    Nobileweg 67, D-7-Stgt-40
    :Phone.      0711/822509
    :Shortcut.   [fbs]
    :Version.    1.0
    :Date.       27-Jul-88
    :Copyright.  Shareware or PD, anyway you like. (I like Shareware better)
    :Language.   Modula-II
    :Translator. M2Amiga
    :Imports.    LoadBody.asm [fbs]
    :UpDate.     none.
    :Contents.   PROCEDUREs für IFF-Bilder (Load, Save, ColorCycling).
    :Remark.     Let's wave! The Cure. The Mission. Sisters of Mercy !!!
---------------------------------------------------------------------------*)

(* $S- $F- $N- $R- $V- this makes it a bit faster and shorter.             *)
(* I hope that there are no more Errors, so these options can be cleared ! *)

IMPLEMENTATION MODULE IFFSupport;

FROM SYSTEM    IMPORT ADR, ADDRESS, SHIFT, BITSET, LONGSET, CAST, INLINE,
                      REG;
FROM Arts      IMPORT TermProcedure, Assert, BreakPoint;

FROM Exec      IMPORT AllocMem, FreeMem, MemReqs, MemReqSet, UByte,
                      Interrupt, AddIntServer, RemIntServer, NodeType;
FROM Dos       IMPORT FileHandlePtr, Open, Close, Read, oldFile, newFile,
                      Write, DeleteFile, Seek, beginning;
FROM Intuition IMPORT NewScreen, ScreenPtr, OpenScreen, CloseScreen,
                      ScreenToBack, ScreenFlags, ScreenFlagSet,
                      customScreen, MoveScreen, WindowPtr, OpenWindow,
                      CloseWindow, IDCMPFlags, IDCMPFlagSet, WindowFlags,
                      WindowFlagSet;
FROM Graphics  IMPORT SetRGB4, RastPortPtr, BitMapPtr, ViewModes,
                      ViewModeSet, BitMap, InitBitMap, AllocRaster,
                      BltClear, FreeRaster, ViewPortPtr, RectanglePtr,
                      Rectangle, GetRGB4;
FROM GfxMacros IMPORT OffDisplay, OnDisplay;
FROM Hardware  IMPORT vertb;

FROM Strings   IMPORT Compare, first, last;

FROM LoadBody  IMPORT LoadBody;

(*---------------------------------------------------------------------------
!                                                                           !
!                        Variables from Definition:                         !
!                                                                           !
-----------------------------------------------------------------------------

(*---------------------------  Types:  ------------------------------------*)

TYPE
  IFFTitles = (BMHD,CMAP,GRAB,DEST,CAMG,CRNG,BODY,SPRT,CCRT,CMHD,DPPV);
  IFFTitleSet = SET OF IFFTitles;
(* SPRT,CCRT,CMHD,DPPV not implemented !!!                                 *)

  ViewTypes = (vt0,Ersy,Lace,LPen,vt4,vt5,vt6,vt7,Gaud,Color,DblPF,HoMod,
               vt12,vt13,vt14,Hires,v16);
  ViewTypeSet = SET OF ViewTypes;
(* which ViewModes are selected *)

TYPE

(*-------------  The Structure that keeps all the data:  ------------------*)
(* You don't have to understand all variables in this structure! Only some *)
(* are important, like BMHD.width/height or CMAP.red[] etc. The other data *)
(* is used by the Routines that are exported from this module,like DoCycle *)
(* etc.                                                                    *)

  IFFInfoTypePtr = POINTER TO IFFInfoType;
  IFFInfoType = RECORD
  (* This contains all Data needed for a Picture *)

(*------  Which Data is availble:  ------*)
    IFFTitle: IFFTitleSet;     (* all Sub-Records, whose equally named Flag*)
(* is set here, contain readable data                                      *)

(*------  Information on BitMap:  ------*)
    BMHD: RECORD

      width,height: INTEGER;   (* the Picture's Size                       *)
      depth: UByte;            (* it's Depth (how many BitPlanes)          *)
      left,top: INTEGER;       (* it's Location                            *)
      masking: UByte;          (* Masking (see Documentation)              *)
      transCol: INTEGER;       (* Transparent Color                        *)
      xAspect,yAspect: UByte;  (* Verzerrung                               *)
      scrnWidth,scrnHeight: INTEGER; (* The Image's Screen's Size          *)
    END;

(*------  Information on Colors:  ------*)
    CMAP: RECORD

      colorCnt: CARDINAL;      (* Number of Colors used                    *)
      red,green,blue:   ARRAY[0..63] OF UByte;
       (* the Colors (I hope for 6 Bitplanes to be possible anytime)       *)
    END;

(*------  Information on HotSpot:  ------*)
    GRAB: RECORD

      hotX,hotY: INTEGER;      (* Hot-Spot of this Image (if exists        *)
    END;

(*------  Information on Destination-Bitmap:  ------*)
    DEST: RECORD
      depth: UByte;            (* number of Planes                         *)
      planePick: CARDINAL;
      planeOnOff: CARDINAL;    (* set or clear other Planes ?              *)
      planeMask: CARDINAL;     (* planes to be changed                     *)
    END;

(*------  Information on any Special ViewMode:  ------*)
    CAMG: RECORD
      viewType: ViewTypeSet;   (* ViewMode                                 *)
    END;

(*------  Information on ColorCycling:  ------*)
    CRNG: RECORD
      count: CARDINAL;         (* Number of ColorCyclings                  *)
      data: ARRAY[0..15] OF RECORD

        rate: INTEGER;         (* velocity, 800H is 60 per second          *)
        on: BOOLEAN;           (* decide, wether CRNG is active or not     *)
        forward: BOOLEAN;      (* Direction (DPaint)                       *)
        low,high: UByte;       (* lower and upper Color of this Range      *)
      END;
    END;
(*------  Internal Information:  ------*)
    Internal: RECORD
      CycleID: CARDINAL;       (* that's to distinguish different cyclings *)
    END;
  END;

(* That's been quite a complex Variable. If you wanna use it, do it this   *)
(* way:                                                                    *)
(* e.g. You wanna know, how Deep your Image is. Ça marche comme ça:        *)
(* MyDepth := IFFInfo.BMHD.depth;                                          *)
(* You can get the speed of the second Colorcycle this way:                *)
(* speed := IFFInfo.CRNG.data[2].rate;                                     *)

(*--------------  That's the Variable, that contains all Data  ------------*)
(* this should be imported to your Module to get the Data. Don't forget to *)
(* save the data, e.g. to a variable of the same type. Everytime you load  *)
(* a new IFF-File, the data is scratched !!! (i.e. the new data is written *)
(* into this structure.)                                                   *)

VAR
  IFFInfo: IFFInfoType;

(*--------------------  The NewScreen-Structure.  -------------------------*)
(* this can be used to open the Screen, if dontopen is specified           *)

VAR
  NuScreen: NewScreen;

(*--------------------  The NewWindow-Structure.  -------------------------*)
(* this can be used to open the Window later. Don't forget to put Screen-  *)
(* Ptr in NuWindow.screen !!!                                              *)

VAR
  NuWindow: NewWindow;

(*------------------------   Error-Message:  -----------------------------*)
(* IFFError contains Error-Number if ReadILBM or WriteILBM failed.        *)

TYPE
  IFFErrors = (iffNoErr,iffOutofMem,iffOpenScreenfailed,iffOpenWindowfailed,
               iffOpenfailed,iffWrongIFF,iffReadWritefailed);
VAR
  IFFError: IFFErrors;

*)

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                     Internal Variables and Types:                       *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

CONST
    MOVEMS = 48E7H; (* that's the 68000-Instruction MOVEM to save Registers*)
    MOVEML = 4CDFH; (* that's MOVEM to load Registers                      *)

TYPE
  CyclingInfo = RECORD                  (* Needed Data for Cycle-Interrupt *)
    int: Interrupt;                     (* The Cycling's Interrupt         *)
    VP: ViewPortPtr;                    (* The Cycling's ViewPort          *)
    count: ARRAY[0..15] OF CARDINAL;    (* counts Cycling-Positions        *)
    speedCnt: ARRAY[0..15] OF CARDINAL; (* counts Speed                    *)
  END;

VAR
  InH, OutH: FileHandlePtr;    (* Files                                    *)
  i,j,k: LONGINT;              (* can be used by everything                *)
  LineLength: LONGINT;         (* Bytes per Image-Line                     *)
  LineWidth: LONGINT;          (* Bytes per Screen-Line                    *)
  BM: BitMapPtr;               (* Screen's BitMap                          *)
  Compression: BOOLEAN;        (* Decide, wether data is compressed or not *)
  MaskPlane: BOOLEAN;          (* Is there a Mask-Plane ??                 *)
  Buffer: ADDRESS;             (* Buffer for Reading / Writing             *)
  TextBuffer: POINTER TO ARRAY[0..63] OF ARRAY[0..3] OF CHAR;
  LONGBuffer: POINTER TO ARRAY[0..63] OF LONGCARD;
  WORDBuffer: POINTER TO ARRAY[0..127] OF INTEGER;
  BYTEBuffer: POINTER TO ARRAY[0..255] OF UByte;
  len: LONGINT;                       (* Receives Length from Read/Write() *)
  BitMaps: ARRAY[0..7] OF ADDRESS;    (* Pointer to Planes                 *)
  Line,Plane: LONGINT;                (* Count Lines and Planes            *)
  Location,Right: POINTER TO UByte;   (* Used while loading Buffer         *)
  RQPos,RQLen: LONGCARD;              (* Used by QuickRead-Procedure       *)
  RQBuffer: POINTER TO ARRAY[0..511] OF UByte; (* ReadQuick's Buffer       *)
  Exit: BOOLEAN;                          (* Exit LOOP ?                   *)
  NoErr: BOOLEAN;                         (* Error ?                       *)
  CycleInfos: ARRAY[0..31] OF CyclingInfo;(* Colorcyclings                 *)
  IntInfo: IFFInfoTypePtr;                (* Interrupt's IFFInfo           *)
  IntNum: CARDINAL;                       (* Interrupt's ID                *)
  IntCount,IntCount2,IntCount3: CARDINAL; (* used by Interrupt fo Cycling  *)
  ColorConv: LONGCARD;                    (* converting Colors             *)
  Address: ADDRESS;
  FileLength,BodyPos,BodyLength: LONGINT; (* Position and Length in File   *)
  ShiftBuffer: ARRAY[0..31] OF LONGSET;   (* Buffer for Shifting Graphic   *)
  ShiftSource: POINTER TO ARRAY[0..31] OF LONGSET; (* Points into Planes   *)
  NeedToShift: BOOLEAN;                   (* is shifting really needed ?   *)
  ShiftWidth,BitsToShift: CARDINAL;  (* how far and how many Bits to shift *)
  TrueLeftOffset,TrueWidth: INTEGER;      (* Word-aligned Offset & Width   *)


(*-----------  Procedure called by machinecode to get Data:  --------------*)

PROCEDURE Read512();

BEGIN
  len := Read(InH,RQBuffer,512);
END Read512;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                          R e a d  I L B M :                             *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

(*
TYPE
  ReadILBMFlags = (front,visible,dontopen,window);
  ReadILBMFlagSet = SET OF ReadILBMFlags;
*)

PROCEDURE ReadILBM(name: ARRAY OF CHAR; Flags: ReadILBMFlagSet;
                   VAR Screen: ScreenPtr; VAR Window: WindowPtr): BOOLEAN;
(* ReadILBM() lädt ein IFF-Bild und öffnet das geladene Bild als Screen.   *)
(* Name: The IFF-Filename                                                  *)
(* Flags:                                                                  *)
(*  -front: decides whether Screen is first or last one while loading      *)
(*  -visible: decides if display should be turned off (that's faster)      *)
(*  -dontopen: avoids to open the Screen. The Returned value is NIL. The   *)
(*     BitMap of the loaded Imagery can be found in NuScreen.customBitMap. *)
(*     Don't forget to free the image's Memory if it's no more needed and  *)
(*     the Memory needed for the BitMap-Structure.                         *)
(*  -window: if set, an Window of the same size as the Image is opened.    *)
(*           So, Gadgets etc. can be added to it.                          *)
(* Screen: Pointer to Screen-structure of opened Screen                    *)
(* Window: Pointer to the opened Window or NIL if window isn't set.        *)
(* Result: FALSE if error occured. Then there's no Screen opened.          *)

PROCEDURE OpenScrn();
(* this initializes the Screen, Window and Bitmap, if they're needed.      *)
(* Screen and Window are opened.                                           *)

  BEGIN
    WITH NuScreen DO
      width := IFFInfo.BMHD.scrnWidth;
      IF width<IFFInfo.BMHD.width THEN
        width := IFFInfo.BMHD.width;
      END;
      height := IFFInfo.BMHD.scrnHeight;
      IF height<IFFInfo.BMHD.height THEN
        height := IFFInfo.BMHD.height;
      END;
      leftEdge := IFFInfo.BMHD.left;
      topEdge := IFFInfo.BMHD.top;
      depth := IFFInfo.BMHD.depth;
      viewModes := ViewModeSet{};
      IF (width>400) AND (depth<5) THEN INCL(viewModes,hires) END;
      IF height>300 THEN INCL(viewModes,lace) END;
      WITH IFFInfo.CAMG DO
        IF (Lace  IN viewType) THEN INCL(viewModes,lace  ) END;
        IF (HoMod IN viewType) THEN INCL(viewModes,ham   ) END;
        IF (Hires IN viewType) THEN INCL(viewModes,hires ) END;
        IF (DblPF IN viewType) THEN INCL(viewModes,dualpf) END;
        IF (DblPF IN viewType) AND (HoMod IN viewType) AND (depth=6) THEN
          viewModes := ViewModeSet{extraHalfbrite};
        END;
      END;
      detailPen := 0; blockPen := 0;
      type := customScreen+ScreenFlagSet{screenQuiet};
      font := NIL;
      defaultTitle := NIL;
      gadgets := NIL;
      customBitMap := NIL;
      IF NOT(front IN Flags) THEN topEdge := 600 END;
    END;
    IF dontopen IN Flags THEN
      INCL(NuScreen.type,customBitMap);
      WITH NuScreen DO
        customBitMap := AllocMem(SIZE(BitMap),MemReqSet{public});
        InitBitMap(customBitMap^,depth,width,height);
        i:=0;
        REPEAT
          customBitMap^.planes[i] := AllocRaster(width,height);
          BitMaps[i] := customBitMap^.planes[i];
          IF BitMaps[i]=NIL THEN
            NoErr:=FALSE;
            IFFError := iffOutofMem;
          ELSE
            BltClear(BitMaps[i],width DIV 8 * height,0);
          END;
          INC(i);
        UNTIL (i=depth) OR NOT(NoErr);
        IF NOT(NoErr) THEN (* error: give allocated Mem back: *)
          WHILE i>1 DO
            DEC(i);
            FreeRaster(BitMaps[i],width,height);
          END;
        END;
      END;
    ELSE
      Screen := OpenScreen(NuScreen);
      IF Screen=NIL THEN
        NoErr := FALSE;
        IFFError := iffOpenScreenfailed;
      ELSE
        IF NOT(front IN Flags) THEN
          ScreenToBack(Screen);
          MoveScreen(Screen,0,-600);
        END;
        BM := Screen^.rastPort.bitMap;
        FOR i:=0 TO NuScreen.depth-1 DO
          BitMaps[i] := BM^.planes[i];
        END;
        WITH IFFInfo.CMAP DO
          FOR i:=0 TO colorCnt-1 DO
            SetRGB4(ADR(Screen^.viewPort),i,red[i],green[i],blue[i]);
          END;
        END;
      END;
    END;
    WITH NuWindow DO
      leftEdge := 0;
      topEdge := 0;
      width := IFFInfo.BMHD.width;
      height := IFFInfo.BMHD.height;
      detailPen := 1;
      blockPen := 0;
      idcmpFlags := IDCMPFlagSet{};
      flags := WindowFlagSet{borderless,noCareRefresh};
      firstGadget := NIL;
      checkMark := NIL;
      title := NIL;
      screen := Screen;
      bitMap := NIL;
      type := customScreen;
    END;
    IF (window IN Flags) AND (Screen#NIL) THEN
      Window := OpenWindow(NuWindow);
      IF Window=NIL THEN
        CloseScreen(Screen);
        Screen := NIL;
        NoErr := FALSE;
        IFFError := iffOpenWindowfailed;
      END;
    END;
    IF NOT(visible IN Flags) THEN OffDisplay() END;
  END OpenScrn;

PROCEDURE ReadQuick(To: ADDRESS; Count: CARDINAL);

  VAR
    ToPtr: POINTER TO ARRAY[0..9999] OF UByte;
    i: CARDINAL;

  BEGIN
    ToPtr := To;
    i := 0;
    REPEAT
      IF RQPos=RQLen THEN
        RQLen := Read(InH,RQBuffer,512);
        RQPos := 0;
      END;
      ToPtr^[i] := ORD(RQBuffer^[RQPos]);
      INC(RQPos); INC(i);
    UNTIL i=Count;
  END ReadQuick;

BEGIN
  IFFInfo.IFFTitle := IFFTitleSet{};

  IF NOT(visible IN Flags) THEN OffDisplay() END;
  NoErr := TRUE; IFFError := iffNoErr;
  Screen := NIL; Window := NIL;
  RQPos := 0; RQLen := 0;

  InH := Open(ADR(name),oldFile);
  IF InH=NIL THEN
    NoErr := FALSE;
    IFFError := iffOpenfailed;
  END;

  IF NoErr THEN

(*------  File Header:  ------*)

    len := Read(InH,Buffer,12);
    IF (len=NIL) OR (Compare(TextBuffer^[0],first,4,"FORM",TRUE)#0) OR
       (Compare(TextBuffer^[2],first,4,"ILBM",TRUE)#0) THEN
      NoErr := FALSE;
      IFFError := iffReadWritefailed;
    END;

    Exit := FALSE;

(*------  Main Loop:  ------*)

    WHILE NoErr AND NOT(Exit) DO
      len := Read(InH,Buffer,4);

  (*------  BMHD:  ------*)

      IF Compare(TextBuffer^[0],first,4,"BMHD",TRUE)=0 THEN
        INCL(IFFInfo.IFFTitle,BMHD);
        len := Read(InH,Buffer,4);
        len := Read(InH,Buffer,LONGBuffer^[0]);
        WITH IFFInfo.BMHD DO
          width     := WORDBuffer^[0];
          height    := WORDBuffer^[1];
          left      := WORDBuffer^[2];
          top       := WORDBuffer^[3];
          depth     := BYTEBuffer^[8];
          masking   := BYTEBuffer^[9];
          MaskPlane := masking=1;
          Compression := BYTEBuffer^[10]=1;
          transCol  := WORDBuffer^[6];
          xAspect   := BYTEBuffer^[14];
          yAspect   := BYTEBuffer^[15];
          scrnWidth := WORDBuffer^[8];
          scrnHeight:= WORDBuffer^[9];
        END;

  (*------  CMAP:  ------*)

      ELSIF Compare(TextBuffer^[0],first,4,"CMAP",TRUE)=0 THEN
        INCL(IFFInfo.IFFTitle,CMAP);
        len := Read(InH,Buffer,4);
        i := LONGBuffer^[0];
        len := Read(InH,Buffer,i);
        WITH IFFInfo.CMAP DO
          colorCnt := i DIV 3;
          j := 0;
          FOR k:=0 TO colorCnt-1 DO
            red  [k] := BYTEBuffer^[j  ] DIV 16;
            green[k] := BYTEBuffer^[j+1] DIV 16;
            blue [k] := BYTEBuffer^[j+2] DIV 16;
            INC(j,3);
          END;
        END;

  (*------  CAMG:  ------*)

      ELSIF Compare(TextBuffer^[0],first,4,"CAMG",TRUE)=0 THEN
        INCL(IFFInfo.IFFTitle,CAMG);
        len := Read(InH,Buffer,8);
        IFFInfo.CAMG.viewType := CAST(ViewTypeSet,LONGBuffer^[1]);

  (*------  GRAB:  ------*)

      ELSIF Compare(TextBuffer^[0],first,4,"GRAB",TRUE)=0 THEN
        INCL(IFFInfo.IFFTitle,GRAB);
        len := Read(InH,Buffer,8);
        IFFInfo.GRAB.hotX := WORDBuffer^[2];
        IFFInfo.GRAB.hotY := WORDBuffer^[3];

  (*------  DEST:  ------*)

      ELSIF Compare(TextBuffer^[0],first,4,"DEST",TRUE)=0 THEN
        INCL(IFFInfo.IFFTitle,DEST);
        len := Read(InH,Buffer,12);
        WITH IFFInfo.DEST DO
          depth      := BYTEBuffer^[4];
          planePick  := WORDBuffer^[3];
          planeOnOff := WORDBuffer^[4];
          planeMask  := WORDBuffer^[5];
        END;

  (*------  CRNG:  ------*)

      ELSIF Compare(TextBuffer^[0],first,4,"CRNG",TRUE)=0 THEN
        IF NOT(CRNG IN IFFInfo.IFFTitle) THEN
          IFFInfo.CRNG.count := 0;
        END;
        INCL(IFFInfo.IFFTitle,CRNG);
        len := Read(InH,Buffer,12);
        WITH IFFInfo.CRNG.data[IFFInfo.CRNG.count] DO
          rate := WORDBuffer^[3];
          on   := 0 IN CAST(BITSET,WORDBuffer^[4]);
          forward := NOT(1 IN CAST(BITSET,WORDBuffer^[4]));
          low  := BYTEBuffer^[10];
          high := BYTEBuffer^[11];
(* this line is only to identify illegal data, that some IFF-Files contain:*)
          on := on AND (low<IFFInfo.CMAP.colorCnt)
                AND (high<IFFInfo.CMAP.colorCnt);
        END;
        INC(IFFInfo.CRNG.count);

  (*------  BODY:  ------*)

      ELSIF Compare(TextBuffer^[0],first,4,"BODY",TRUE)=0 THEN
        INCL(IFFInfo.IFFTitle,BODY);
        OpenScrn();
        IF NoErr THEN
          len := Read(InH,Buffer,4);
          LineLength := CAST(INTEGER,CAST(BITSET,IFFInfo.BMHD.width+15)
                             * {4..15}) DIV 8;
          LineWidth  := NuScreen.width DIV 8;
          IF Compression THEN
          (*------  let's load the BitMap's Data:  ------*)
            LoadBody(Read512, RQBuffer, ADR(BitMaps[0]), LineLength,
                     LineWidth, IFFInfo.BMHD.height, NuScreen.depth,
                     MaskPlane); (* this does all the work very quickly *)
          ELSE   (* not compressed *)
          (*------  to load uncompressed Images is less time-critical: *)
            FOR Line := 0 TO IFFInfo.BMHD.height-1 DO
              FOR Plane := 0 TO NuScreen.depth-1 DO
                ReadQuick(BitMaps[Plane]+ LineWidth*Line,LineLength);
              END;
              IF MaskPlane THEN
                ReadQuick(Buffer,LineLength);
              END;
            END;
          END;
        END; (* IF NoErr *)
        Exit := TRUE;

  (*------  Ignore unknown data:  ------*)

      ELSE
        len := Read(InH,Buffer,4);
        i := LONGBuffer^[0];
        WHILE i>256 DO
          len := Read(InH,Buffer,256);
          DEC(i,256);
        END;
        len := Read(InH,Buffer,i);
      END;

  (*------  Detect ReadError:  ------*)

      IF len=0 THEN
        NoErr := FALSE;
        IFFError := iffReadWritefailed;
      END;

    END;   (* WHILE NOT(Exit DO *)
  END;   (* IF NoErr *)

  IF InH#NIL THEN Close(InH); InH := NIL; END;
  IF NOT(NoErr) THEN
    IF Window#NIL THEN CloseWindow(Window) END;
    IF Screen#NIL THEN CloseScreen(Screen) END;
  END;
  OnDisplay();
  RETURN NoErr;
END ReadILBM; (* that's it *)

(*---------------  Procedures for ColorCycling:  --------------------------*)

PROCEDURE CycleInterrupt();

BEGIN
  INLINE(MOVEMS,3F3EH);

  IntInfo := ADDRESS(REG(9));
  IF CRNG IN IntInfo^.IFFTitle THEN
    IntNum := IntInfo^.Internal.CycleID;
    WITH CycleInfos[IntNum] DO
      IntCount := 0;
      WHILE IntCount<IntInfo^.CRNG.count DO
        WITH IntInfo^.CRNG.data[IntCount] DO
          IF on THEN
            INC(speedCnt[IntCount],rate);
            IF speedCnt[IntCount]>=4000H THEN
              (* this 4000H should have been 8000H, but then it's to slow. *)
              (* dont know why, but this way, it works correctly           *)
              DEC(speedCnt[IntCount],4000H);
              IF forward THEN
                IF count[IntCount]<=low THEN
                  count[IntCount]:=high;
                ELSE
                  DEC(count[IntCount]);
                END;
              ELSE
                IF count[IntCount]>=high THEN
                  count[IntCount]:=low;
                ELSE
                  INC(count[IntCount]);
                END;
              END;
              IntCount3 := count[IntCount];
              IntCount2 := low;
              WHILE IntCount2<=high DO
                SetRGB4(VP,IntCount2,IntInfo^.CMAP.red[IntCount3],
                                     IntInfo^.CMAP.green[IntCount3],
                                     IntInfo^.CMAP.blue[IntCount3]);
                INC(IntCount3);
                IF IntCount3>high THEN IntCount3:=low END;
                INC(IntCount2);
              END;
            END;
          END;
        END;
        INC(IntCount);
      END;
    END;
  END;

  INLINE(MOVEML,7CFCH);
END CycleInterrupt;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                         Start Colorcycling:                             *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

PROCEDURE DoCycle(Info: IFFInfoTypePtr; Screen: ScreenPtr): BOOLEAN;
(* this creates an interrupt, that does cycling. You needn't worry,        *)
(* whether there's cycling data or not. Don't forget to call EndCycle to   *)
(* remove the Cycling-Interrupt !!!                                        *)
(* If result is false, any error occured. Don't call EndCycle in this case!*)

BEGIN
  i:=0;
  LOOP
    IF CycleInfos[i].VP=NIL THEN EXIT END;
    INC(i);
    IF i=32 THEN RETURN FALSE END;
  END;
  Info^.Internal.CycleID := i;
  WITH CycleInfos[i] DO
    VP := ADR(Screen^.viewPort);
    IF CRNG IN Info^.IFFTitle THEN
      FOR j:=0 TO Info^.CRNG.count-1 DO
        count[j] := Info^.CRNG.data[j].low;
        speedCnt[j] := 0;
      END;
    END;
    WITH int DO
      node.type := interrupt;
      node.pri  := -60;
      node.name := NIL;
      data := Info;
      code := ADR(CycleInterrupt);
    END;
    AddIntServer(vertb,ADR(int));
  END;
  RETURN TRUE;
END DoCycle;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                         End Colorcycling:                               *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

PROCEDURE EndCycle(Info: IFFInfoTypePtr);
(* remove cycling-Interrupt                                                *)

BEGIN
  i := Info^.Internal.CycleID;
  RemIntServer(vertb,ADR(CycleInfos[i].int));
  CycleInfos[i].VP := NIL;
END EndCycle;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*              Initialize BMHD, CMAP & CAMG for WriteILBMAll:             *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

PROCEDURE InitIFFInfo(Info: IFFInfoTypePtr;
                      RP: RastPortPtr;
                      VP: ViewPortPtr;
                      Rect: RectanglePtr);

(* Initialize essential parts of IFFInfoType-Variable.                     *)
(* This can be used to simplify the initialization of an IFFInfoType       *)
(* RP:         RastPort containing the BitMap etc.                         *)
(* VP:         ViewPort containing the Colors, ViewModes etc.              *)
(* Rect:       The Rectangle Region in your RastPort, that should be saved *)
(*             or NIL to save hole RastPort                                *)

VAR
  DefaultRect: Rectangle;

BEGIN

  WITH RP^ DO
    IF Rect=NIL THEN
      Rect := ADR(DefaultRect);
      WITH DefaultRect DO
        minX := 0; minY := 0;
        maxX := bitMap^.bytesPerRow * 8 - 1;
        maxY := bitMap^.rows - 1;
      END;
    END;

(*------  Initialize BMHD:  ------*)

    WITH Info^.BMHD DO
      width := Rect^.maxX - Rect^.minX + 1;
      height := Rect^.maxY - Rect^.minY + 1;
      depth := bitMap^.depth;
      left := 0;
      top := 0;
      masking := 0;
      transCol := 0;
      scrnWidth := bitMap^.bytesPerRow * 8;
      scrnHeight := bitMap^.rows;
      IF scrnWidth<640 THEN
        xAspect := 10;
      ELSE
        xAspect := 5;
      END;
      IF scrnHeight>400 THEN
        INC(xAspect,xAspect);
      END;
      yAspect := 11;
    END;
  END;   (* WITH RP^ DO *)

(*------  Initialize CMAP:  ------*)

  WITH Info^.CMAP DO
    colorCnt := VP^.colorMap^.count;
    FOR i := 0 TO colorCnt-1 DO
      ColorConv := GetRGB4(VP^.colorMap,i);
      IF ColorConv>0FFFH THEN ColorConv := 0 END;
      red  [i] := UByte(CAST(CARDINAL,CAST(BITSET,
                         CARDINAL(SHIFT(ColorConv,-8))) * {0..3}));
      green[i] := UByte(CAST(CARDINAL,CAST(BITSET,
                         CARDINAL(SHIFT(ColorConv,-4))) * {0..3}));
      blue [i] := UByte(CAST(CARDINAL,CAST(BITSET,
                         CARDINAL(ColorConv)) * {0..3}));
    END;
  END;

(*------  Initialize CAMG:  ------*)

  WITH Info^.CAMG DO
    viewType := ViewTypeSet{};
    IF lace           IN VP^.modes THEN INCL(viewType,Lace)  END;
    IF hires          IN VP^.modes THEN INCL(viewType,Hires) END;
    IF dualpf         IN VP^.modes THEN INCL(viewType,DblPF) END;
    IF ham            IN VP^.modes THEN INCL(viewType,HoMod) END;
    IF extraHalfbrite IN VP^.modes THEN
      viewType := ViewTypeSet{HoMod,DblPF};
    END;
  END;

  Info^.IFFTitle := IFFTitleSet{BMHD,CMAP,CAMG};

END InitIFFInfo;


(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                        Save an ILBM-File:                               *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

PROCEDURE WriteILBMAll(Name: ARRAY OF CHAR;
                       Info: IFFInfoTypePtr;
                       BM: BitMapPtr;
                       FirstLine, LeftOffset: INTEGER;
                       CompressIt: BOOLEAN): BOOLEAN;
(* Saves IFF-File named Name                                               *)
(* This is a very Low-Level Procedure. You should use it to save Pictures  *)
(* with ColorCycling and things like that.                                 *)
(* To save Screens, Windows or so use the other Procedures !               *)
(* Info^.IFFTitle must have set the Flags of all initialized Sub-Records   *)
(* BM:            contains the Graphicdata. In fact BM doesn't have to be  *)
(*                part of a RastPort. It can be used to save a MaskPlane.  *)
(*                Then BM has to contain one extra Plane and BM^.depth and *)
(*                Info^.BMHD.depth have to be increased by 1.              *)
(* FirstLine:     is the TopEdge within BM                                 *)
(* LeftOffset:    is the LeftEdge within BM.                               *)
(* an examble to call this can be is the Implementation of WriteILBM()     *)

  TYPE
    BufPtr = POINTER TO ARRAY[0..255] OF UByte;

  PROCEDURE Compress(At: BufPtr; Length: LONGINT): LONGINT;
  (* This compresses a line starting at At that is Length Bytes long.      *)
  (* The compressed Data is Written into Buffer and saved to OutH.         *)
  (* Result is Legth of Compressed Data or zero if Error while writing     *)

  VAR
    at, last, out, len: LONGINT;

    PROCEDURE CopyUnchanged(from,to: LONGINT);

    BEGIN
      BYTEBuffer^[out] := to - from - 1;
      INC(out);
      WHILE from<to DO
        BYTEBuffer^[out] := At^[from];
        INC(out);
        INC(from);
      END;
    END CopyUnchanged;

  BEGIN
    at := 1;
    last := 0;
    out := 0;
    LOOP
      IF (At^[at]=At^[at-1]) AND (At^[at]=At^[at+1]) AND (at+1<Length) THEN
        IF last#at-1 THEN
          CopyUnchanged(last,at-1);
        END;
        last := at-1;
      (*------  Repeat Byte:  ------*)
        REPEAT
          INC(at)
        UNTIL (At^[last]#At^[at]) OR (at-last=128) OR (at=Length);
        BYTEBuffer^[out] := 257+last-at;
        INC(out);
        BYTEBuffer^[out] := At^[last];
        INC(out);
        last := at;
        IF at=Length THEN EXIT END;
      ELSIF (at-last)=128 THEN
      (*------  Copy Unchanged:  ------*)
        CopyUnchanged(last,at);
        last := at;
      END;
      INC(at);
      IF at=Length THEN EXIT END;
    END;
    IF at#last THEN CopyUnchanged(last,at) END;
    len := Write(OutH,Buffer,out);
    INC(BodyLength,out);
    INC(FileLength,out);
    RETURN len;
  END Compress;

  PROCEDURE ShiftLine(At: ADDRESS);
  (* This shifts BitsToShift from At ShiftWidth left and stores them in    *)
  (* ShiftBuffer.                                                          *)

  VAR
    sourcelong,sourcebit,destlong,destbit: CARDINAL;

  BEGIN
    ShiftSource := At;
    sourcelong := 0;
    sourcebit := 31-ShiftWidth;
    destlong := 0;
    destbit := 31;
    ShiftBuffer[0] := LONGSET{};
    FOR i:=1 TO BitsToShift DO
      IF sourcebit IN ShiftSource^[sourcelong] THEN
        INCL(ShiftBuffer[destlong],destbit);
      END;
      IF sourcebit=0 THEN
        sourcebit := 31;
        INC(sourcelong);
      ELSE
        DEC(sourcebit);
      END;
      IF destbit=0 THEN
        destbit := 31;
        INC(destlong);
        ShiftBuffer[destlong] := LONGSET{};
      ELSE
        DEC(destbit);
      END;
    END;
  END ShiftLine;

(*------  MAIN:  ------*)

BEGIN

(*------  Open:  ------*)

  OutH := Open(ADR(Name),newFile);
  IF OutH=NIL THEN
    IFFError := iffOpenfailed;
    RETURN FALSE;
  END;
  TextBuffer^[0] := "FORM";
  TextBuffer^[2] := "ILBM";
  len := Write(OutH,TextBuffer,12);
  IF len#12 THEN
    Close(OutH);
    OutH := NIL;
    len := DeleteFile(ADR(Name));
    IFFError := iffReadWritefailed;
    RETURN FALSE;
  END;
  FileLength := 4;

(*------  BMHD:  ------*)

  IF BMHD IN Info^.IFFTitle THEN   (* in fact, BMHD MUST be set *)
    WITH Info^ DO
      TextBuffer^[ 0] := "BMHD";
      LONGBuffer^[ 1] := 20;              (* Length *)
      WORDBuffer^[ 4] := BMHD.width;
      WORDBuffer^[ 5] := BMHD.height;
      WORDBuffer^[ 6] := BMHD.left;
      WORDBuffer^[ 7] := BMHD.top;
      BYTEBuffer^[16] := BMHD.depth;
      BYTEBuffer^[17] := BMHD.masking;    (* special masking *)
      IF CompressIt THEN                  (* compression *)
        BYTEBuffer^[18] := 1;
      ELSE
        BYTEBuffer^[18] := 0;
      END;
      BYTEBuffer^[19] := 0;               (* pad *)
      WORDBuffer^[10] := BMHD.transCol; (* transparent Color *)
      BYTEBuffer^[22] := BMHD.xAspect;
      BYTEBuffer^[23] := BMHD.yAspect;
      WORDBuffer^[12] := BMHD.scrnWidth;
      WORDBuffer^[13] := BMHD.scrnHeight;
      len := Write(OutH,Buffer,28);
      INC(FileLength,28);
    END;
  END;

(*------  CMAP:  ------*)

  IF CMAP IN Info^.IFFTitle THEN   (* this has to be set, too *)
    WITH Info^ DO
      TextBuffer^[0]  := "CMAP";
      LONGBuffer^[1]  := CMAP.colorCnt * 3;
      IF ODD(LONGBuffer^[1]) THEN INC(LONGBuffer^[1]) END;
      FOR i:=0 TO CMAP.colorCnt-1 DO
        BYTEBuffer^[ 8+3*i] := UByte(ORD(CMAP.red  [i]) * 16);
        BYTEBuffer^[ 9+3*i] := UByte(ORD(CMAP.green[i]) * 16);
        BYTEBuffer^[10+3*i] := UByte(ORD(CMAP.blue [i]) * 16);
      END;
      len := Write(OutH,Buffer,LONGBuffer^[1]+8);
      INC(FileLength,LONGBuffer^[1]+8);
    END;
  END;

(*------  GRAB:  ------*)

  IF GRAB IN Info^.IFFTitle THEN
    TextBuffer^[0] := "GRAB";
    LONGBuffer^[1] := 8;
    WORDBuffer^[4] := Info^.GRAB.hotX;
    WORDBuffer^[5] := Info^.GRAB.hotY;
    len := Write(OutH,Buffer,12);
    INC(FileLength,12);
  END;

(*------  DEST:  ------*)

  IF DEST IN Info^.IFFTitle THEN
    TextBuffer^[0] := "DEST";
    LONGBuffer^[1] := 8;
    BYTEBuffer^[8] := Info^.DEST.depth;
    BYTEBuffer^[9] := 0;
    WORDBuffer^[5] := Info^.DEST.planePick;
    WORDBuffer^[6] := Info^.DEST.planeOnOff;
    WORDBuffer^[7] := Info^.DEST.planeMask;
    len := Write(OutH,Buffer,16);
    INC(FileLength,16);
  END;

(*------  CAMG:  ------*)

  IF CAMG IN Info^.IFFTitle THEN
    TextBuffer^[0] := "CAMG";
    LONGBuffer^[1] := 4;
    LONGBuffer^[2] := CAST(LONGCARD,Info^.CAMG.viewType);
    len := Write(OutH,Buffer,12);
    INC(FileLength,12);
  END;

(*------  CRNG:  ------*)

  IF CRNG IN Info^.IFFTitle THEN
    i := 0;
    WHILE i<LONGINT(Info^.CRNG.count) DO
      WITH Info^.CRNG.data[i] DO
        TextBuffer^[0] := "CRNG";
        LONGBuffer^[1] := 8;
        WORDBuffer^[4] := 0;
        WORDBuffer^[5] := rate;
        IF on THEN
          WORDBuffer^[6] := 1;
        ELSE
          WORDBuffer^[6] := 0;
        END;
        IF NOT(forward) THEN
          INC(WORDBuffer^[6],2);
        END;
        BYTEBuffer^[14] := low;
        BYTEBuffer^[15] := high;
        len := Write(OutH,Buffer,16);
        INC(FileLength,16);
      END;
      INC(i);
    END;
  END;

(*------  BODY:  ------*)

  BodyPos := FileLength;
  TextBuffer^[0] := "BODY";
  len := Write(OutH,Buffer,8);
  INC(FileLength,8);
  BodyLength := 0;
  i := 0;
  TrueLeftOffset := CAST(CARDINAL,CAST(BITSET,LeftOffset) * {4..15});
  TrueWidth := CAST(CARDINAL,CAST(BITSET,Info^.BMHD.width + 15) * {4..15});

  WHILE i<LONGINT(Info^.BMHD.depth) DO
    BitMaps[i] := BM^.planes[i];
    INC(BitMaps[i],FirstLine * LONGINT(BM^.bytesPerRow) +
                   TrueLeftOffset DIV 8);
    INC(i);
  END;

  LineLength := TrueWidth DIV 8;

  NeedToShift := (TrueLeftOffset # LeftOffset)
                  OR (TrueWidth # Info^.BMHD.width);
  IF NeedToShift THEN
    ShiftWidth := LeftOffset - TrueLeftOffset;
    BitsToShift := Info^.BMHD.width;
  END;

  IF CompressIt THEN
    Line := 0;
    WHILE Line<Info^.BMHD.height DO
      Plane := 0;
      WHILE Plane<LONGINT(Info^.BMHD.depth) DO
        IF NeedToShift THEN
          ShiftLine(BitMaps[Plane]);
          len := Compress(ADR(ShiftBuffer),LineLength);
        ELSE
          len := Compress(BitMaps[Plane],LineLength);
        END;
        INC(BitMaps[Plane],BM^.bytesPerRow);
        INC(Plane);
      END;
      INC(Line);
    END;
  ELSE
    Line := 0;
    WHILE Line<Info^.BMHD.height DO
      Plane := 0;
      WHILE Plane<LONGINT(Info^.BMHD.depth) DO
        IF NeedToShift THEN
          ShiftLine(BitMaps[Plane]);
          len := Write(OutH,ADR(ShiftBuffer),LineLength);
        ELSE
          len := Write(OutH,BitMaps[Plane],LineLength);
        END;
        INC(FileLength,LineLength);
        INC(BodyLength,LineLength);
        INC(BitMaps[Plane],BM^.bytesPerRow);
        INC(Plane);
      END;
      INC(Line);
    END;
  END;
  IF ODD(FileLength) THEN
    BYTEBuffer^[0] := 0;
    len := Write(OutH,Buffer,1);
    INC(FileLength);
  END;

  len := Seek(OutH,BodyPos+12,beginning);
  LONGBuffer^[0] := BodyLength;
  len := Write(OutH,Buffer,4);

(*------  Done:  ------*)

  len := Seek(OutH,4,beginning);
  LONGBuffer^[0] := FileLength;
  len := Write(OutH,Buffer,4);
  Close(OutH);
  OutH := NIL;
  IF len#4 THEN
    len := DeleteFile(ADR(Name));
    IFFError := iffReadWritefailed;
    RETURN FALSE;
  ELSE
    RETURN TRUE;
  END;
END WriteILBMAll;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                 Save a RastPort and ViewPort ILBM-File:                 *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

PROCEDURE WriteILBM(Name: ARRAY OF CHAR;
                    RP: RastPortPtr;
                    VP: ViewPortPtr;
                    Rect: RectanglePtr;
                    CompressIt: BOOLEAN): BOOLEAN;

(* Creates an ILBM-File                                                    *)
(* Name:       File's Name                                                 *)
(* RP:         RastPort containing the BitMap etc.                         *)
(* VP:         ViewPort containing the Colors, ViewModes etc.              *)
(* Rect:       The Rectangle Region in your RastPort, that should be saved *)
(*             or NIL to save hole RastPort                                *)
(* Compressit: Create compressed ILBM-File or not ?                        *)
(* Result is FALSE if any Error occured.                                   *)
(* example to save a Window:                                               *)
(*      OK := WriteILBM("Test.iff",                                        *)
(*                      MyWindow^.rPort,                                   *)
(*                      ADR(MyWindow^.screen^.viewPort,                    *)
(*                      TRUE);                                             *)

BEGIN

  InitIFFInfo(ADR(IFFInfo),RP,VP,Rect);

  RETURN WriteILBMAll(Name,ADR(IFFInfo),RP^.bitMap,
                      Rect^.minY,Rect^.minX,CompressIt);

END WriteILBM;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                    Save a Screen as ILBM-File:                          *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

PROCEDURE WriteILBMScreen(Name: ARRAY OF CHAR;
                          Screen: ScreenPtr;
                          Rect: RectanglePtr;
                          CompressIt: BOOLEAN): BOOLEAN;

(* This creates an ILBM-File from a Screen                                 *)
(* Name:       File's Name                                                 *)
(* Screen:     Screen to be saved                                          *)
(* Rect:       The Rectangle Region in your Screen, that should be saved   *)
(*             or NIL to save hole Screen                                  *)
(* CompressIt: Create a Compressed ILBM-File                               *)
(* Returns TRUE if no Error occured.                                       *)
(* example: OK := WriteILBMScreen("Test.iff",MyScreen,NIL,TRUE);           *)

BEGIN

  WITH Screen^ DO
    RETURN WriteILBM(Name,ADR(rastPort),ADR(viewPort),Rect,CompressIt);
  END;

END WriteILBMScreen;

(*------------------------  TermProcedure:  -------------------------------*)

PROCEDURE CleanUp();

BEGIN
  IF InH #NIL THEN Close(InH ) END;
  IF OutH#NIL THEN Close(OutH) END;
  FreeMem(Buffer,768);
END CleanUp;

(*-----------------------  Initialization:  -------------------------------*)

BEGIN
  Buffer := AllocMem(768,MemReqSet{chip,memClear});
  Assert(Buffer#NIL,ADR("Not enough ChipMem !!!"));
  TextBuffer := Buffer;
  LONGBuffer := Buffer;
  WORDBuffer := Buffer;
  BYTEBuffer := Buffer;
  RQBuffer := ADDRESS(Buffer+256);
  InH := NIL; OutH := NIL;
  FOR i:=0 TO 31 DO CycleInfos[i].VP:=NIL END;
  TermProcedure(CleanUp);
END IFFSupport.