(*---------------------------------------------------------------------------
  :Program.    IFFSupport.mod
  :Author.     Fridtjof Siebert
  :Address.    Nobileweg 67, D-7000-Stuttgart-40
  :Phone.      please let me sleep!
  :Shortcut.   [fbs]
  :Copyright.  Shareware or PD, anyway you like. (I like Shareware better)
  :Language.   Oberon
  :Translator. Amiga Oberon Compiler 1.17.1
  :Imports.    LoadBody.o [fbs]
  :History.    V1.1 [fbs] 27-Jul-88  First published Version
  :History.    V1.2 [fbs] 16-Nov-88: Removed error with NIL-RectanglePtr
  :History.    V1.3 [fbs] 28-Dec-88: Some small changes, inspired by S. Salewski
  :History.    V1.4 [fbs] 23-Mar-89: Removed bug with ExtraHB-Pictures
  :History.    V1.5 [fbs] 03-Jun-89: v3.2, removed Add/RemIntServer()-Bug (3.2)
  :History.    V1.6 [fbs] 01-Dec-90: Ported code to Amiga Oberon
  :Contents.   PROCEDUREs für IFF-Bilder (Load, Save, ColorCycling).
---------------------------------------------------------------------------*)

MODULE IFFSupport;

IMPORT y:  SYSTEM,
       e:  Exec,
       d:  Dos,
       I:  Intuition,
       g:  Graphics,
       h:  Hardware,
       ol: OberonLib;

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

CONST

(* IFFTitles: *)

  BMHD * =  0;
  CMAP * =  1;
  GRAB * =  2;
  DEST * =  3;
  CAMG * =  4;
  CRNG * =  5;
  BODY * =  6;
  SPRT * =  7; (* not supported *)
  CCRT * =  8; (* not supported *)
  CMHD * =  9; (* not supported *)
  DPPV * = 10; (* not supported *)


TYPE
  IFFTitleSet = LONGSET;

CONST

(* ViewTypes: *)

  Ersy  * = 1;
  Lace  * = 2;
  LPen  * = 3;
  Extra * = 7;
  Gaud  * = 8;
  Color * = 9;
  DblPF * = 10;
  HoMod * = 11;
  Hires * = 15;

TYPE

  ViewTypeSet * = LONGSET;

(*-------------  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 * = STRUCT
  (* 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*: STRUCT

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

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

      colorCnt*: INTEGER;      (* Number of Colors used                    *)
      red*,green*,blue*:   ARRAY 64 OF SHORTINT;
       (* the Colors (I hope for 6 Bitplanes to be possible anytime)       *)
    END;

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

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

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

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

(*------  Information on ColorCycling:  ------*)
    CRNG*: STRUCT
      count*: INTEGER;         (* Number of ColorCyclings                  *)
      data*: ARRAY 16 OF STRUCT

        rate*: INTEGER;         (* velocity, 800H is 60 per second          *)
        on*: BOOLEAN;           (* decide, wether CRNG is active or not     *)
        forward*: BOOLEAN;      (* Direction (DPaint)                       *)
        low*,high*: SHORTINT;    (* lower and upper Color of this Range      *)
      END;
    END;
(*------  Internal Information:  ------*)
    Internal: STRUCT
      CycleID: INTEGER;       (* that's to distinguish different cyclings *)
      A5: LONGINT;
    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*: I.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*: I.NewWindow;

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

TYPE
  IFFErrors = SHORTINT;

CONST
  iffNoErr             * = 0;
  iffOutofMem          * = 1;
  iffOpenScreenfailed  * = 2;
  iffOpenWindowfailed  * = 3;
  iffOpenfailed        * = 4;
  iffWrongIFF          * = 5;
  iffReadWritefailed   * = 6;

VAR
  IFFError*: IFFErrors;


(*------ Parameter für ReadILBM(): ------*)

CONST
(*  ReadILBMFlags: *)
  front     * = 0;
  visible   * = 1;
  dontopen  * = 2;
  window    * = 3;
  usebmsize * = 4;

TYPE
  ReadILBMFlagSet * = SET;




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

TYPE
  CyclingInfo = STRUCT                  (* Needed Data for Cycle-Interrupt *)
    int: e.Interrupt;                   (* The Cycling's Interrupt         *)
    VP: g.ViewPortPtr;                    (* The Cycling's ViewPort          *)
    count: ARRAY 16 OF INTEGER;    (* counts Cycling-Positions        *)
    speedCnt: ARRAY 16 OF INTEGER; (* counts Speed                    *)
  END;

VAR
  InH, OutH: d.FileHandlePtr;    (* Files                                    *)
  i,j,k: LONGINT;              (* can be used by everything                *)
  LineLength: LONGINT;         (* Bytes per Image-Line                     *)
  LineWidth: LONGINT;          (* Bytes per Screen-Line                    *)
  BM: g.BitMapPtr;               (* Screen's BitMap                          *)
  Compression: BOOLEAN;        (* Decide, wether data is compressed or not *)
  MaskPlane: BOOLEAN;          (* Is there a Mask-Plane ??                 *)
  Buffer: POINTER TO ARRAY 256 OF BYTE;  (* Buffer for Reading / Writing             *)
  TextBuffer: POINTER TO ARRAY 64 OF ARRAY 4 OF CHAR;
  LONGBuffer: POINTER TO ARRAY 64 OF LONGINT;
  WORDBuffer: POINTER TO ARRAY 128 OF INTEGER;
  BYTEBuffer: POINTER TO ARRAY 256 OF BYTE;
  len: LONGINT;                       (* Receives Length from Read/Write() *)
  BitMaps: ARRAY 8 OF g.PLANEPTR;     (* Pointer to Planes                 *)
  Line,Plane: LONGINT;                (* Count Lines and Planes            *)
  Location,Right: POINTER TO SHORTINT;(* Used while loading Buffer         *)
  RQPos,RQLen: LONGINT;              (* Used by QuickRead-Procedure       *)
  RQBuffer: POINTER TO ARRAY 512 OF SHORTINT; (* ReadQuick's Buffer       *)
  Exit: BOOLEAN;                          (* Exit LOOP ?                   *)
  IntNum: INTEGER;                       (* Interrupt's ID                *)
  IntCount,IntCount2,IntCount3: INTEGER; (* used by Interrupt fo Cycling  *)
  CycleInfos: ARRAY 32 OF CyclingInfo;(* Colorcyclings                 *)

  ColorConv: INTEGER;                    (* converting Colors             *)
  Address: LONGINT;
  FileLength,BodyPos,BodyLength: LONGINT; (* Position and Length in File   *)
  ShiftBuffer: ARRAY 32 OF LONGSET;   (* Buffer for Shifting Graphic   *)
  ShiftSource: POINTER TO ARRAY 32 OF LONGSET; (* Points into Planes   *)
  NeedToShift: BOOLEAN;                   (* is shifting really needed ?   *)
  ShiftWidth,BitsToShift: INTEGER;  (* how far and how many Bits to shift *)
  TrueLeftOffset,TrueWidth: INTEGER;      (* Word-aligned Offset & Width   *)
  DefaultRect: g.Rectangle;


TYPE
  PROC = PROCEDURE();

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

PROCEDURE LoadBody{"LoadBody"}(
                       getData{10}: PROC;
                       buffer{11},bitMapPtrs{12}:e.ADDRESS;
                       lineLengthd{2},lineWidth{3}:LONGINT;
                       height{5},depth{4}:INTEGER;
                       extraPlane{6}:BOOLEAN);


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


PROCEDURE * Read512();

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

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                          R e a d  I L B M :                             *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)
PROCEDURE ReadILBM* (name: ARRAY OF CHAR; Flags: ReadILBMFlagSet;
                     VAR Screen: I.ScreenPtr; VAR Window: I.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.                          *)
(*  -usebmsize: if this is set, the size of the loaded bitmap is used as   *)
(*     screen size, else the screensize from the ilbm file is used.        *)
(* 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
    IF usebmsize IN Flags THEN
      NuScreen.width := IFFInfo.BMHD.width;
      NuScreen.height := IFFInfo.BMHD.height;
    ELSE
      NuScreen.width := IFFInfo.BMHD.scrnWidth;
      IF NuScreen.width<IFFInfo.BMHD.width THEN
        NuScreen.width := IFFInfo.BMHD.width;
      END;
      NuScreen.height := IFFInfo.BMHD.scrnHeight;
      IF NuScreen.height<IFFInfo.BMHD.height THEN
        NuScreen.height := IFFInfo.BMHD.height;
      END;
    END;
    NuScreen.leftEdge := IFFInfo.BMHD.left;
    NuScreen.topEdge := IFFInfo.BMHD.top;
    NuScreen.depth := IFFInfo.BMHD.depth;
    NuScreen.viewModes := {};
    IF (NuScreen.width>400) AND (NuScreen.depth<5) THEN INCL(NuScreen.viewModes,g.hires) END;
    IF NuScreen.height>300 THEN INCL(NuScreen.viewModes,g.lace) END;
    IF (Lace  IN IFFInfo.CAMG.viewType) THEN INCL(NuScreen.viewModes,g.lace  ) END;
    IF (HoMod IN IFFInfo.CAMG.viewType) THEN INCL(NuScreen.viewModes,g.ham   ) END;
    IF (Hires IN IFFInfo.CAMG.viewType) THEN INCL(NuScreen.viewModes,g.hires ) END;
    IF (DblPF IN IFFInfo.CAMG.viewType) THEN INCL(NuScreen.viewModes,g.dualpf) END;
    IF (Extra IN IFFInfo.CAMG.viewType) THEN NuScreen.viewModes := {g.extraHalfbrite} END;
    NuScreen.detailPen := 0; NuScreen.blockPen := 0;
    NuScreen.type := I.customScreen+{I.screenQuiet};
    NuScreen.font := NIL;
    NuScreen.defaultTitle := NIL;
    NuScreen.gadgets := NIL;
    NuScreen.customBitMap := NIL;
    IF NOT(front IN Flags) THEN NuScreen.topEdge := 600 END;
    IF dontopen IN Flags THEN
    INCL(NuScreen.type,I.customBitMap);
      NEW(NuScreen.customBitMap);
      g.InitBitMap(NuScreen.customBitMap^,NuScreen.depth,NuScreen.width,NuScreen.height);
      i:=0;
      REPEAT
        NuScreen.customBitMap.planes[i] := g.AllocRaster(NuScreen.width,NuScreen.height);
        BitMaps[i] := NuScreen.customBitMap.planes[i];
        IF BitMaps[i]=NIL THEN
          IFFError := iffOutofMem;
        ELSE
          g.BltClear(BitMaps[i],LONG(NuScreen.width) DIV 8 * NuScreen.height,LONGSET{});
        END;
        INC(i);
      UNTIL (i=NuScreen.depth) OR (IFFError#iffNoErr);
      IF IFFError#iffNoErr THEN (* error: give allocated Mem back: *)
        WHILE i>1 DO
          DEC(i);
          g.FreeRaster(BitMaps[i],NuScreen.width,NuScreen.height);
        END;
      END;
    ELSE
      Screen := I.OpenScreen(NuScreen);
      IF Screen=NIL THEN
        IFFError := iffOpenScreenfailed;
      ELSE
        IF NOT(front IN Flags) THEN
          I.ScreenToBack(Screen);
          I.MoveScreen(Screen,0,-600);
        END;
        BM := Screen.rastPort.bitMap;
        i := 0;
        WHILE i<NuScreen.depth DO
          BitMaps[i] := BM.planes[i];
          INC(i);
        END;
        i := 0;
        WHILE i<IFFInfo.CMAP.colorCnt DO
          g.SetRGB4(y.ADR(Screen.viewPort),SHORT(i),IFFInfo.CMAP.red[i],
                                             IFFInfo.CMAP.green[i],
                                             IFFInfo.CMAP.blue[i]);
          INC(i);
        END;
      END;
    END;
    NuWindow.leftEdge := 0;
    NuWindow.topEdge := 0;
    NuWindow.width := IFFInfo.BMHD.width;
    NuWindow.height := IFFInfo.BMHD.height;
    NuWindow.detailPen := 1;
    NuWindow.blockPen := 0;
    NuWindow.idcmpFlags := LONGSET{};
    NuWindow.flags := LONGSET{I.borderless,I.noCareRefresh};
    NuWindow.firstGadget := NIL;
    NuWindow.checkMark := NIL;
    NuWindow.title := NIL;
    NuWindow.screen := Screen;
    NuWindow.bitMap := NIL;
    NuWindow.type := I.customScreen;
    IF (window IN Flags) AND (Screen#NIL) THEN
      Window := I.OpenWindow(NuWindow);
      IF Window=NIL THEN
        I.OldCloseScreen(Screen);
        Screen := NIL;
        IFFError := iffOpenWindowfailed;
      END;
    END;
    IF NOT(visible IN Flags) THEN g.OffDisplay() END;
  END OpenScrn;

PROCEDURE ReadQuick(To: y.ADDRESS; Count: INTEGER);

  VAR
    ToPtr: POINTER TO ARRAY 10000 OF SHORTINT;
    i: INTEGER;

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

BEGIN
  IFFInfo.IFFTitle := IFFTitleSet{};

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

  InH := d.Open(name,d.oldFile);
  IF InH=NIL THEN
    IFFError := iffOpenfailed;
  ELSE

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

    len := d.Read(InH,Buffer^,12);
    IF len#12 THEN IFFError := iffReadWritefailed END;
    IF (TextBuffer[0]#"FORM") OR (TextBuffer[2]#"ILBM") THEN
      IFFError := iffWrongIFF;
    END;

    Exit := FALSE;

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

    WHILE (IFFError=iffNoErr) AND NOT(Exit) DO
      len := d.Read(InH,Buffer^,4);

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

      IF TextBuffer[0]="BMHD" THEN
        INCL(IFFInfo.IFFTitle,BMHD);
        len := d.Read(InH,Buffer^,4);
        len := d.Read(InH,Buffer^,LONGBuffer[0]);
        IFFInfo.BMHD.width     := WORDBuffer[0];
        IFFInfo.BMHD.height    := WORDBuffer[1];
        IFFInfo.BMHD.left      := WORDBuffer[2];
        IFFInfo.BMHD.top       := WORDBuffer[3];
        IFFInfo.BMHD.depth     := BYTEBuffer[8];
        IFFInfo.BMHD.masking   := y.VAL(SHORTSET,BYTEBuffer[9]);
        MaskPlane := IFFInfo.BMHD.masking=SHORTSET{0};
        Compression := BYTEBuffer[10]=1X;
        IFFInfo.BMHD.transCol  := WORDBuffer[6];
        IFFInfo.BMHD.xAspect   := BYTEBuffer[14];
        IFFInfo.BMHD.yAspect   := BYTEBuffer[15];
        IFFInfo.BMHD.scrnWidth := WORDBuffer[8];
        IFFInfo.BMHD.scrnHeight:= WORDBuffer[9];

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

      ELSIF TextBuffer[0]="CMAP" THEN
        INCL(IFFInfo.IFFTitle,CMAP);
        len := d.Read(InH,Buffer^,4);
        i := LONGBuffer[0];
        len := d.Read(InH,Buffer^,i);
        IFFInfo.CMAP.colorCnt := SHORT(i DIV 3);
        j := 0;
        k := 0;
        WHILE k<IFFInfo.CMAP.colorCnt DO
          IFFInfo.CMAP.red  [k] := SHORT(ORD(BYTEBuffer[j  ]) DIV 16);
          IFFInfo.CMAP.green[k] := SHORT(ORD(BYTEBuffer[j+1]) DIV 16);
          IFFInfo.CMAP.blue [k] := SHORT(ORD(BYTEBuffer[j+2]) DIV 16);
          INC(j,3);
          INC(k);
        END;

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

      ELSIF TextBuffer[0]="CAMG" THEN
        INCL(IFFInfo.IFFTitle,CAMG);
        len := d.Read(InH,Buffer^,8);
        IFFInfo.CAMG.viewType := y.VAL(ViewTypeSet,LONGBuffer[1]);

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

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

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

      ELSIF TextBuffer[0]="DEST" THEN
        INCL(IFFInfo.IFFTitle,DEST);
        len := d.Read(InH,Buffer^,12);
        IFFInfo.DEST.depth      := BYTEBuffer[4];
        IFFInfo.DEST.planePick  := y.VAL(SET,WORDBuffer[3]);
        IFFInfo.DEST.planeOnOff := y.VAL(SET,WORDBuffer[4]);
        IFFInfo.DEST.planeMask  := y.VAL(SET,WORDBuffer[5]);

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

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

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

      ELSIF TextBuffer[0]="BODY" THEN
        INCL(IFFInfo.IFFTitle,BODY);
        OpenScrn();
        IF IFFError=iffNoErr THEN
          len := d.Read(InH,Buffer^,4);
          LineLength := y.VAL(INTEGER,y.VAL(SET,IFFInfo.BMHD.width+15)
                             * {4..15}) DIV 8;
          LineWidth  := y.VAL(INTEGER,y.VAL(SET,NuScreen.width+15)
                             * {4..15}) DIV 8;
          IF Compression THEN
          (*------  let's load the BitMap's Data:  ------*)
            LoadBody(Read512, RQBuffer, y.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: *)
            Line := 0;
            WHILE Line < IFFInfo.BMHD.height DO
              Plane := 0;
              WHILE Plane < NuScreen.depth DO
                ReadQuick(y.VAL(y.ADDRESS,y.VAL(LONGINT,BitMaps[Plane])+ LineWidth*Line),SHORT(LineLength));
                INC(Plane);
              END;
              IF MaskPlane THEN
                ReadQuick(Buffer,SHORT(LineLength));
              END;
              INC(Line);
            END;
          END;
        END; (* IF NoErr *)
        Exit := TRUE;

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

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

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

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

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

  IF InH#NIL THEN d.OldClose(InH); InH := NIL; END;
  IF IFFError#iffNoErr THEN
    IF Window#NIL THEN I.CloseWindow(Window) END;
    IF Screen#NIL THEN I.OldCloseScreen(Screen) END;
  END;
  g.OnDisplay();
  RETURN IFFError=iffNoErr;
END ReadILBM; (* that's it *)

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

PROCEDURE * CycleInterrupt();  (* $SaveAllRegs+ $StackChk- *)

VAR
  IntInfo: IFFInfoTypePtr;

BEGIN

  IntInfo := y.REG(9);
  y.SETREG(13,IntInfo.Internal.A5);
  IF CRNG IN IntInfo.IFFTitle THEN
    IntNum := IntInfo.Internal.CycleID;

    IntCount := 0;
    WHILE IntCount<IntInfo.CRNG.count DO
      IF IntInfo.CRNG.data[IntCount].on THEN
        INC(CycleInfos[IntNum].speedCnt[IntCount],IntInfo.CRNG.data[IntCount].rate);
        IF CycleInfos[IntNum].speedCnt[IntCount]>=4000H THEN
          DEC(CycleInfos[IntNum].speedCnt[IntCount],4000H);
          IF IntInfo.CRNG.data[IntCount].forward THEN
            IF CycleInfos[IntNum].count[IntCount]<=IntInfo.CRNG.data[IntCount].low THEN
              CycleInfos[IntNum].count[IntCount]:=IntInfo.CRNG.data[IntCount].high;
            ELSE
              DEC(CycleInfos[IntNum].count[IntCount]);
            END;
          ELSE
            IF CycleInfos[IntNum].count[IntCount]>=IntInfo.CRNG.data[IntCount].high THEN
              CycleInfos[IntNum].count[IntCount]:=IntInfo.CRNG.data[IntCount].low;
            ELSE
              INC(CycleInfos[IntNum].count[IntCount]);
            END;
          END;
          IntCount3 := CycleInfos[IntNum].count[IntCount];
          IntCount2 := IntInfo.CRNG.data[IntCount].low;
          WHILE IntCount2<=IntInfo.CRNG.data[IntCount].high DO
            g.SetRGB4(CycleInfos[IntNum].VP,IntCount2,IntInfo.CMAP.red[IntCount3],
                                   IntInfo.CMAP.green[IntCount3],
                                   IntInfo.CMAP.blue[IntCount3]);
            INC(IntCount3);
            IF IntCount3>IntInfo.CRNG.data[IntCount].high THEN IntCount3:=IntInfo.CRNG.data[IntCount].low END;
            INC(IntCount2);
          END;
        END;
      END;
      INC(IntCount);
    END;
  END;

END CycleInterrupt;  (* $StackChk= *)

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

PROCEDURE DoCycle*(VAR Info: IFFInfoType; Screen: I.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 := SHORT(i);
  Info.Internal.A5 := y.REG(13);
  CycleInfos[i].VP := y.ADR(Screen.viewPort);
  IF CRNG IN Info.IFFTitle THEN
    j := 0;
    WHILE j < Info.CRNG.count DO
      CycleInfos[i].count[j] := Info.CRNG.data[j].low;
      CycleInfos[i].speedCnt[j] := 0;
      INC(j);
    END;
  END;
  CycleInfos[i].int.node.type := e.interrupt;
  CycleInfos[i].int.node.pri  := -60;
  CycleInfos[i].int.node.name := NIL;
  CycleInfos[i].int.data := y.ADR(Info);
  CycleInfos[i].int.code := CycleInterrupt;
  e.AddIntServer(h.vertb,y.ADR(CycleInfos[i].int));
  RETURN TRUE;
END DoCycle;

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

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

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

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

PROCEDURE InitIFFInfo*(Info: IFFInfoTypePtr;
                      RP: g.RastPortPtr;
                      VP: g.ViewPortPtr;
                      VAR Rect: g.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                                *)

BEGIN

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

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

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

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

  Info.CMAP.colorCnt := VP.colorMap.count;
  i := 0;
  WHILE i<Info.CMAP.colorCnt DO
    ColorConv := SHORT(g.GetRGB4(VP.colorMap,i));
    IF ColorConv>0FFFH THEN ColorConv := 0 END;
    Info.CMAP.red  [i] := SHORT(ColorConv DIV 100H MOD 10H);
    Info.CMAP.green[i] := SHORT(ColorConv DIV  10H MOD 10H);
    Info.CMAP.blue [i] := SHORT(ColorConv          MOD 10H);
    INC(i);
  END;

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

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

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

END InitIFFInfo;


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

PROCEDURE WriteILBMAll*(Name: ARRAY OF CHAR;
                       Info: IFFInfoTypePtr;
                       BM: g.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 256 OF SHORTINT;

  VAR
    PointerDummy: POINTER TO CHAR;

  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] := CHR(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] := CHR(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 := d.Write(OutH,Buffer^,out);
    INC(BodyLength,out);
    INC(FileLength,out);
    RETURN len;
  END Compress;

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

  VAR
    sourcelong,sourcebit,destlong,destbit: INTEGER;

  BEGIN
    ShiftSource := At;
    sourcelong := 0;
    sourcebit := 31-ShiftWidth;
    destlong := 0;
    destbit := 31;
    ShiftBuffer[0] := LONGSET{};
    i := 1;
    WHILE i<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;
      INC(i);
    END;
  END ShiftLine;

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

BEGIN

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

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

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

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

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

  IF CMAP IN Info.IFFTitle THEN   (* this has to be set, too *)
    TextBuffer[0]  := "CMAP";
    LONGBuffer[1]  := Info.CMAP.colorCnt * 3;
    IF ODD(LONGBuffer[1]) THEN INC(LONGBuffer[1]) END;
    i := 0;
    WHILE i<Info.CMAP.colorCnt DO
      (* $OvflChk- *)
      BYTEBuffer[ 8+3*i] := Info.CMAP.red  [i] * 16;
      BYTEBuffer[ 9+3*i] := Info.CMAP.green[i] * 16;
      BYTEBuffer[10+3*i] := Info.CMAP.blue [i] * 16;
      (* $OvflChk= *)
      INC(i);
    END;
    len := d.Write(OutH,Buffer^,LONGBuffer[1]+8);
    INC(FileLength,LONGBuffer[1]+8);
  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 := d.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] := 0X;
    WORDBuffer[5] := y.VAL(INTEGER,Info.DEST.planePick );
    WORDBuffer[6] := y.VAL(INTEGER,Info.DEST.planeOnOff);
    WORDBuffer[7] := y.VAL(INTEGER,Info.DEST.planeMask );
    len := d.Write(OutH,Buffer^,16);
    INC(FileLength,16);
  END;

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

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

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

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

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

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

  WHILE i<Info.BMHD.depth DO
    BitMaps[i] := BM.planes[i];
    BitMaps[i] := y.VAL(y.ADDRESS,y.VAL(LONGINT,BitMaps[i]) + LONG(FirstLine) * 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<Info.BMHD.depth DO
        IF NeedToShift THEN
          ShiftLine(BitMaps[Plane]);
          len := Compress(y.ADR(ShiftBuffer),LineLength);
        ELSE
          len := Compress(BitMaps[Plane],LineLength);
        END;
        BitMaps[Plane] := y.VAL(y.ADDRESS,y.VAL(LONGINT,BitMaps[Plane]) + BM.bytesPerRow);
        INC(Plane);
      END;
      INC(Line);
    END;
  ELSE
    Line := 0;
    WHILE Line<Info.BMHD.height DO
      Plane := 0;
      WHILE Plane<Info.BMHD.depth DO
        IF NeedToShift THEN
          ShiftLine(BitMaps[Plane]);
          len := d.Write(OutH,ShiftBuffer,LineLength);
        ELSE
          PointerDummy := BitMaps[Plane];
          len := d.Write(OutH,PointerDummy^,LineLength);
        END;
        INC(FileLength,LineLength);
        INC(BodyLength,LineLength);
        BitMaps[Plane] := y.VAL(y.ADDRESS,y.VAL(LONGINT,BitMaps[Plane]) + BM.bytesPerRow);
        INC(Plane);
      END;
      INC(Line);
    END;
  END;
  IF ODD(FileLength) THEN
    BYTEBuffer[0] := 0X;
    len := d.Write(OutH,Buffer^,1);
    INC(FileLength);
  END;

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

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

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

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

PROCEDURE WriteILBM*(Name: ARRAY OF CHAR;
                    RP: g.RastPortPtr;
                    VP: g.ViewPortPtr;
                    Rect: g.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,                                   *)
(*                      y.ADR(MyWindow.screen.viewPort,                    *)
(*                      TRUE);                                             *)

BEGIN

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

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

END WriteILBM;

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

PROCEDURE WriteILBMScreen*(Name: ARRAY OF CHAR;
                          Screen: I.ScreenPtr;
                          Rect: g.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

  RETURN WriteILBM(Name,y.ADR(Screen.rastPort),y.ADR(Screen.viewPort),Rect,CompressIt);

END WriteILBMScreen;

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

BEGIN

  InH := NIL; OutH := NIL;
  NEW(Buffer);
  TextBuffer := y.VAL(e.ADDRESS,Buffer);
  LONGBuffer := y.VAL(e.ADDRESS,Buffer);
  WORDBuffer := y.VAL(e.ADDRESS,Buffer);
  BYTEBuffer := y.VAL(e.ADDRESS,Buffer);
  NEW(RQBuffer);
  IF (Buffer=NIL) OR (RQBuffer=NIL) THEN HALT(20) END;
  i := 0; REPEAT CycleInfos[i].VP:=NIL; INC(i) UNTIL i=32;

CLOSE

  IF InH #NIL THEN d.OldClose(InH ) END;
  IF OutH#NIL THEN d.OldClose(OutH) END;

END IFFSupport.