home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / OB3.2D4.DMS / in.adf / IFFSupport1.8 / txt / IFFSupport.mod < prev    next >
Encoding:
Text File  |  1992-11-03  |  41.9 KB  |  1,202 lines
  1. (*---------------------------------------------------------------------------
  2.   :Program.    IFFSupport.mod
  3.   :Author.     Fridtjof Siebert
  4.   :Address.    Nobileweg 67, D-7000-Stuttgart-40
  5.   :Phone.      please let me sleep!
  6.   :Shortcut.   [fbs]
  7.   :Copyright.  PD
  8.   :Language.   Oberon
  9.   :Translator. Amiga Oberon Compiler 3.0
  10.   :Imports.    LoadBody.o [fbs]
  11.   :History.    V1.1 [fbs] 27-Jul-88  First published Version
  12.   :History.    V1.2 [fbs] 16-Nov-88: Removed error with NIL-RectanglePtr
  13.   :History.    V1.3 [fbs] 28-Dec-88: Some small changes, inspired by S. Salewski
  14.   :History.    V1.4 [fbs] 23-Mar-89: Removed bug with ExtraHB-Pictures
  15.   :History.    V1.5 [fbs] 03-Jun-89: v3.2, removed Add/RemIntServer()-Bug (3.2)
  16.   :History.    V1.6 [fbs] 01-Dec-90: Ported code to Amiga Oberon
  17.   :History.    V1.7 [fbs] 01-Dec-90: Small changes for Oberon 2.0
  18.   :History.    V1.8 [fbs] 01-Dec-90: Small changes for Oberon 3.0
  19.   :Contents.   PROCEDUREs für IFF-Bilder (Load, Save, ColorCycling).
  20. ---------------------------------------------------------------------------*)
  21.  
  22. MODULE IFFSupport;
  23.  
  24. IMPORT y:  SYSTEM,
  25.        e:  Exec,
  26.        d:  Dos,
  27.        I:  Intuition,
  28.        g:  Graphics,
  29.        h:  Hardware,
  30.        ol: OberonLib;
  31.  
  32. (* $JOIN LoadBody.o *)
  33.  
  34. (*---------------------------  Types:  ------------------------------------*)
  35.  
  36. CONST
  37.  
  38. (* IFFTitles: *)
  39.  
  40.   BMHD * =  0;
  41.   CMAP * =  1;
  42.   GRAB * =  2;
  43.   DEST * =  3;
  44.   CAMG * =  4;
  45.   CRNG * =  5;
  46.   BODY * =  6;
  47.   SPRT * =  7; (* not supported *)
  48.   CCRT * =  8; (* not supported *)
  49.   CMHD * =  9; (* not supported *)
  50.   DPPV * = 10; (* not supported *)
  51.  
  52.  
  53. TYPE
  54.   IFFTitleSet = LONGSET;
  55.  
  56. CONST
  57.  
  58. (* ViewTypes: *)
  59.  
  60.   Ersy  * = 1;
  61.   Lace  * = 2;
  62.   LPen  * = 3;
  63.   Extra * = 7;
  64.   Gaud  * = 8;
  65.   Color * = 9;
  66.   DblPF * = 10;
  67.   HoMod * = 11;
  68.   Hires * = 15;
  69.  
  70. TYPE
  71.  
  72.   ViewTypeSet * = LONGSET;
  73.  
  74. (*-------------  The Structure that keeps all the data:  ------------------*)
  75. (* You don't have to understand all variables in this structure! Only some *)
  76. (* are important, like BMHD.width/height or CMAP.red[] etc. The other data *)
  77. (* is used by the Routines that are exported from this module,like DoCycle *)
  78. (* etc.                                                                    *)
  79.  
  80.   IFFInfoTypePtr * = UNTRACED POINTER TO IFFInfoType;
  81.   IFFInfoType * = STRUCT
  82.   (* This contains all Data needed for a Picture *)
  83.  
  84. (*------  Which Data is availble:  ------*)
  85.     IFFTitle*: IFFTitleSet;     (* all Sub-Records, whose equally named Flag*)
  86. (* is set here, contain readable data                                      *)
  87.  
  88. (*------  Information on BitMap:  ------*)
  89.     BMHD*: STRUCT
  90.  
  91.       width*,height*: INTEGER;    (* the Picture's Size                       *)
  92.       depth*: SHORTINT;          (* it's Depth (how many BitPlanes)          *)
  93.       left*,top*: INTEGER;        (* it's Location                            *)
  94.       masking*: SHORTSET;        (* Masking (see Documentation)              *)
  95.       transCol*: INTEGER;        (* Transparent Color                        *)
  96.       xAspect*,yAspect*: SHORTINT;(* Verzerrung                               *)
  97.       scrnWidth*,scrnHeight*: INTEGER; (* The Image's Screen's Size          *)
  98.     END;
  99.  
  100. (*------  Information on Colors:  ------*)
  101.     CMAP*: STRUCT
  102.  
  103.       colorCnt*: INTEGER;      (* Number of Colors used                    *)
  104.       red*,green*,blue*:   ARRAY 64 OF SHORTINT;
  105.        (* the Colors (I hope for 6 Bitplanes to be possible anytime)       *)
  106.     END;
  107.  
  108. (*------  Information on HotSpot:  ------*)
  109.     GRAB*: STRUCT
  110.  
  111.       hotX*,hotY*: INTEGER;      (* Hot-Spot of this Image (if exists        *)
  112.     END;
  113.  
  114. (*------  Information on Destination-Bitmap:  ------*)
  115.     DEST*: STRUCT
  116.       depth*: SHORTINT;         (* number of Planes                         *)
  117.       planePick*: SET;
  118.       planeOnOff*: SET;         (* set or clear other Planes ?              *)
  119.       planeMask*: SET;          (* planes to be changed                     *)
  120.     END;
  121.  
  122. (*------  Information on any Special ViewMode:  ------*)
  123.     CAMG*: STRUCT
  124.       viewType*: ViewTypeSet;   (* ViewMode                                 *)
  125.     END;
  126.  
  127. (*------  Information on ColorCycling:  ------*)
  128.     CRNG*: STRUCT
  129.       count*: INTEGER;         (* Number of ColorCyclings                  *)
  130.       data*: ARRAY 16 OF STRUCT
  131.  
  132.         rate*: INTEGER;         (* velocity, 800H is 60 per second          *)
  133.         on*: BOOLEAN;           (* decide, wether CRNG is active or not     *)
  134.         forward*: BOOLEAN;      (* Direction (DPaint)                       *)
  135.         low*,high*: SHORTINT;    (* lower and upper Color of this Range      *)
  136.       END;
  137.     END;
  138. (*------  Internal Information:  ------*)
  139.     Internal: STRUCT
  140.       CycleID: INTEGER;       (* that's to distinguish different cyclings *)
  141.       A5: LONGINT;
  142.     END;
  143.   END;
  144.  
  145. (* That's been quite a complex Variable. If you wanna use it, do it this   *)
  146. (* way:                                                                    *)
  147. (* e.g. You wanna know, how Deep your Image is. Ça marche comme ça:        *)
  148. (* MyDepth := IFFInfo.BMHD.depth;                                          *)
  149. (* You can get the speed of the second Colorcycle this way:                *)
  150. (* speed := IFFInfo.CRNG.data[2].rate;                                     *)
  151.  
  152. (*--------------  That's the Variable, that contains all Data  ------------*)
  153. (* this should be imported to your Module to get the Data. Don't forget to *)
  154. (* save the data, e.g. to a variable of the same type. Everytime you load  *)
  155. (* a new IFF-File, the data is scratched !!! (i.e. the new data is written *)
  156. (* into this structure.)                                                   *)
  157.  
  158. VAR
  159.   IFFInfo*: IFFInfoType;
  160.  
  161. (*--------------------  The NewScreen-Structure.  -------------------------*)
  162. (* this can be used to open the Screen, if dontopen is specified           *)
  163.  
  164. VAR
  165.   NuScreen*: I.NewScreen;
  166.  
  167. (*--------------------  The NewWindow-Structure.  -------------------------*)
  168. (* this can be used to open the Window later. Don't forget to put Screen-  *)
  169. (* Ptr in NuWindow.screen !!!                                              *)
  170.  
  171. VAR
  172.   NuWindow*: I.NewWindow;
  173.  
  174. (*------------------------   Error-Message:  -----------------------------*)
  175. (* IFFError contains Error-Number if ReadILBM or WriteILBM failed.        *)
  176.  
  177. TYPE
  178.   IFFErrors = SHORTINT;
  179.  
  180. CONST
  181.   iffNoErr             * = 0;
  182.   iffOutofMem          * = 1;
  183.   iffOpenScreenfailed  * = 2;
  184.   iffOpenWindowfailed  * = 3;
  185.   iffOpenfailed        * = 4;
  186.   iffWrongIFF          * = 5;
  187.   iffReadWritefailed   * = 6;
  188.  
  189. VAR
  190.   IFFError*: IFFErrors;
  191.  
  192.  
  193. (*------ Parameter für ReadILBM(): ------*)
  194.  
  195. CONST
  196. (*  ReadILBMFlags: *)
  197.   front     * = 0;
  198.   visible   * = 1;
  199.   dontopen  * = 2;
  200.   window    * = 3;
  201.   usebmsize * = 4;
  202.  
  203. TYPE
  204.   ReadILBMFlagSet * = SET;
  205.  
  206.  
  207.  
  208.  
  209. (*-------------------------------------------------------------------------*)
  210. (*                                                                         *)
  211. (*                     Internal Variables and Types:                       *)
  212. (*                                                                         *)
  213. (*-------------------------------------------------------------------------*)
  214.  
  215. TYPE
  216.   CyclingInfo = STRUCT                  (* Needed Data for Cycle-Interrupt *)
  217.     int: e.Interrupt;                   (* The Cycling's Interrupt         *)
  218.     VP: g.ViewPortPtr;                    (* The Cycling's ViewPort          *)
  219.     count: ARRAY 16 OF INTEGER;    (* counts Cycling-Positions        *)
  220.     speedCnt: ARRAY 16 OF INTEGER; (* counts Speed                    *)
  221.   END;
  222.  
  223. VAR
  224.   InH, OutH: d.FileHandlePtr;    (* Files                                    *)
  225.   i,j,k: LONGINT;              (* can be used by everything                *)
  226.   LineLength: LONGINT;         (* Bytes per Image-Line                     *)
  227.   LineWidth: LONGINT;          (* Bytes per Screen-Line                    *)
  228.   BM: g.BitMapPtr;               (* Screen's BitMap                          *)
  229.   Compression: BOOLEAN;        (* Decide, wether data is compressed or not *)
  230.   MaskPlane: BOOLEAN;          (* Is there a Mask-Plane ??                 *)
  231.   Buffer: UNTRACED POINTER TO ARRAY 256 OF y.BYTE;  (* Buffer for Reading / Writing             *)
  232.   TextBuffer: UNTRACED POINTER TO ARRAY 64 OF ARRAY 4 OF CHAR;
  233.   LONGBuffer: UNTRACED POINTER TO ARRAY 64 OF LONGINT;
  234.   WORDBuffer: UNTRACED POINTER TO ARRAY 128 OF INTEGER;
  235.   BYTEBuffer: UNTRACED POINTER TO ARRAY 256 OF y.BYTE;
  236.   len: LONGINT;                       (* Receives Length from Read/Write() *)
  237.   BitMaps: ARRAY 8 OF g.PLANEPTR;     (* Pointer to Planes                 *)
  238.   Line,Plane: LONGINT;                (* Count Lines and Planes            *)
  239.   Location,Right: UNTRACED POINTER TO SHORTINT;(* Used while loading Buffer         *)
  240.   RQPos,RQLen: LONGINT;              (* Used by QuickRead-Procedure       *)
  241.   RQBuffer: UNTRACED POINTER TO ARRAY 512 OF SHORTINT; (* ReadQuick's Buffer       *)
  242.   Exit: BOOLEAN;                          (* Exit LOOP ?                   *)
  243.   IntNum: INTEGER;                       (* Interrupt's ID                *)
  244.   IntCount,IntCount2,IntCount3: INTEGER; (* used by Interrupt fo Cycling  *)
  245.   CycleInfos: ARRAY 32 OF CyclingInfo;(* Colorcyclings                 *)
  246.  
  247.   ColorConv: INTEGER;                    (* converting Colors             *)
  248.   Address: LONGINT;
  249.   FileLength,BodyPos,BodyLength: LONGINT; (* Position and Length in File   *)
  250.   ShiftBuffer: ARRAY 32 OF LONGSET;   (* Buffer for Shifting Graphic   *)
  251.   ShiftSource: UNTRACED POINTER TO ARRAY 32 OF LONGSET; (* Points into Planes   *)
  252.   NeedToShift: BOOLEAN;                   (* is shifting really needed ?   *)
  253.   ShiftWidth,BitsToShift: INTEGER;  (* how far and how many Bits to shift *)
  254.   TrueLeftOffset,TrueWidth: INTEGER;      (* Word-aligned Offset & Width   *)
  255.   DefaultRect: g.Rectangle;
  256.  
  257.  
  258. TYPE
  259.   PROC = PROCEDURE();
  260.  
  261. (*------  LoadBody  ------*)
  262.  
  263. PROCEDURE LoadBody{"LoadBody"}(
  264.                        getData{10}: PROC;
  265.                        buffer{11},bitMapPtrs{12}:e.ADDRESS;
  266.                        lineLengthd{2},lineWidth{3}:LONGINT;
  267.                        height{5},depth{4}:INTEGER;
  268.                        extraPlane{6}:BOOLEAN);
  269.  
  270.  
  271. (*-----------  Procedure called by machinecode to get Data:  --------------*)
  272.  
  273.  
  274. PROCEDURE * Read512();
  275.  
  276. BEGIN
  277.   len := d.Read(InH,RQBuffer^,512);
  278. END Read512;
  279.  
  280. (*-------------------------------------------------------------------------*)
  281. (*                                                                         *)
  282. (*                          R e a d  I L B M :                             *)
  283. (*                                                                         *)
  284. (*-------------------------------------------------------------------------*)
  285. PROCEDURE ReadILBM* (name: ARRAY OF CHAR; Flags: ReadILBMFlagSet;
  286.                      VAR Screen: I.ScreenPtr; VAR Window: I.WindowPtr): BOOLEAN;
  287. (* ReadILBM() lädt ein IFF-Bild und öffnet das geladene Bild als Screen.   *)
  288. (* Name: The IFF-Filename                                                  *)
  289. (* Flags:                                                                  *)
  290. (*  -front: decides whether Screen is first or last one while loading      *)
  291. (*  -visible: decides if display should be turned off (that's faster)      *)
  292. (*  -dontopen: avoids to open the Screen. The Returned value is NIL. The   *)
  293. (*     BitMap of the loaded Imagery can be found in NuScreen.customBitMap. *)
  294. (*     Don't forget to free the image's Memory if it's no more needed and  *)
  295. (*     the Memory needed for the BitMap-Structure.                         *)
  296. (*  -window: if set, an Window of the same size as the Image is opened.    *)
  297. (*           So, Gadgets etc. can be added to it.                          *)
  298. (*  -usebmsize: if this is set, the size of the loaded bitmap is used as   *)
  299. (*     screen size, else the screensize from the ilbm file is used.        *)
  300. (* Screen: Pointer to Screen-structure of opened Screen                    *)
  301. (* Window: Pointer to the opened Window or NIL if window isn't set.        *)
  302. (* Result: FALSE if error occured. Then there's no Screen opened.          *)
  303.  
  304. PROCEDURE OpenScrn();
  305. (* this initializes the Screen, Window and Bitmap, if they're needed.      *)
  306. (* Screen and Window are opened.                                           *)
  307.  
  308.   BEGIN
  309.     IF usebmsize IN Flags THEN
  310.       NuScreen.width := IFFInfo.BMHD.width;
  311.       NuScreen.height := IFFInfo.BMHD.height;
  312.     ELSE
  313.       NuScreen.width := IFFInfo.BMHD.scrnWidth;
  314.       IF NuScreen.width<IFFInfo.BMHD.width THEN
  315.         NuScreen.width := IFFInfo.BMHD.width;
  316.       END;
  317.       NuScreen.height := IFFInfo.BMHD.scrnHeight;
  318.       IF NuScreen.height<IFFInfo.BMHD.height THEN
  319.         NuScreen.height := IFFInfo.BMHD.height;
  320.       END;
  321.     END;
  322.     NuScreen.leftEdge := IFFInfo.BMHD.left;
  323.     NuScreen.topEdge := IFFInfo.BMHD.top;
  324.     NuScreen.depth := IFFInfo.BMHD.depth;
  325.     NuScreen.viewModes := {};
  326.     IF (NuScreen.width>400) AND (NuScreen.depth<5) THEN INCL(NuScreen.viewModes,g.hires) END;
  327.     IF NuScreen.height>300 THEN INCL(NuScreen.viewModes,g.lace) END;
  328.     IF (Lace  IN IFFInfo.CAMG.viewType) THEN INCL(NuScreen.viewModes,g.lace  ) END;
  329.     IF (HoMod IN IFFInfo.CAMG.viewType) THEN INCL(NuScreen.viewModes,g.ham   ) END;
  330.     IF (Hires IN IFFInfo.CAMG.viewType) THEN INCL(NuScreen.viewModes,g.hires ) END;
  331.     IF (DblPF IN IFFInfo.CAMG.viewType) THEN INCL(NuScreen.viewModes,g.dualpf) END;
  332.     IF (Extra IN IFFInfo.CAMG.viewType) THEN NuScreen.viewModes := {g.extraHalfbrite} END;
  333.     NuScreen.detailPen := 0; NuScreen.blockPen := 0;
  334.     NuScreen.type := I.customScreen+{I.screenQuiet};
  335.     NuScreen.font := NIL;
  336.     NuScreen.defaultTitle := NIL;
  337.     NuScreen.gadgets := NIL;
  338.     NuScreen.customBitMap := NIL;
  339.     IF NOT(front IN Flags) THEN NuScreen.topEdge := 600 END;
  340.     IF dontopen IN Flags THEN
  341.     INCL(NuScreen.type,I.customBitMap);
  342.       NEW(NuScreen.customBitMap);
  343.       g.InitBitMap(NuScreen.customBitMap^,NuScreen.depth,NuScreen.width,NuScreen.height);
  344.       i:=0;
  345.       REPEAT
  346.         NuScreen.customBitMap.planes[i] := g.AllocRaster(NuScreen.width,NuScreen.height);
  347.         BitMaps[i] := NuScreen.customBitMap.planes[i];
  348.         IF BitMaps[i]=NIL THEN
  349.           IFFError := iffOutofMem;
  350.         ELSE
  351.           g.BltClear(BitMaps[i],LONG(NuScreen.width) DIV 8 * NuScreen.height,LONGSET{});
  352.         END;
  353.         INC(i);
  354.       UNTIL (i=NuScreen.depth) OR (IFFError#iffNoErr);
  355.       IF IFFError#iffNoErr THEN (* error: give allocated Mem back: *)
  356.         WHILE i>1 DO
  357.           DEC(i);
  358.           g.FreeRaster(BitMaps[i],NuScreen.width,NuScreen.height);
  359.         END;
  360.       END;
  361.     ELSE
  362.       Screen := I.OpenScreen(NuScreen);
  363.       IF Screen=NIL THEN
  364.         IFFError := iffOpenScreenfailed;
  365.       ELSE
  366.         IF NOT(front IN Flags) THEN
  367.           I.ScreenToBack(Screen);
  368.           I.MoveScreen(Screen,0,-600);
  369.         END;
  370.         BM := Screen.rastPort.bitMap;
  371.         i := 0;
  372.         WHILE i<NuScreen.depth DO
  373.           BitMaps[i] := BM.planes[i];
  374.           INC(i);
  375.         END;
  376.         i := 0;
  377.         WHILE i<IFFInfo.CMAP.colorCnt DO
  378.           g.SetRGB4(y.ADR(Screen.viewPort),SHORT(i),IFFInfo.CMAP.red[i],
  379.                                              IFFInfo.CMAP.green[i],
  380.                                              IFFInfo.CMAP.blue[i]);
  381.           INC(i);
  382.         END;
  383.       END;
  384.     END;
  385.     NuWindow.leftEdge := 0;
  386.     NuWindow.topEdge := 0;
  387.     NuWindow.width := IFFInfo.BMHD.width;
  388.     NuWindow.height := IFFInfo.BMHD.height;
  389.     NuWindow.detailPen := 1;
  390.     NuWindow.blockPen := 0;
  391.     NuWindow.idcmpFlags := LONGSET{};
  392.     NuWindow.flags := LONGSET{I.borderless,I.noCareRefresh};
  393.     NuWindow.firstGadget := NIL;
  394.     NuWindow.checkMark := NIL;
  395.     NuWindow.title := NIL;
  396.     NuWindow.screen := Screen;
  397.     NuWindow.bitMap := NIL;
  398.     NuWindow.type := I.customScreen;
  399.     IF (window IN Flags) AND (Screen#NIL) THEN
  400.       Window := I.OpenWindow(NuWindow);
  401.       IF Window=NIL THEN
  402.         I.OldCloseScreen(Screen);
  403.         Screen := NIL;
  404.         IFFError := iffOpenWindowfailed;
  405.       END;
  406.     END;
  407.     IF NOT(visible IN Flags) THEN g.OffDisplay() END;
  408.   END OpenScrn;
  409.  
  410. PROCEDURE ReadQuick(To: y.ADDRESS; Count: INTEGER);
  411.  
  412.   VAR
  413.     ToPtr: UNTRACED POINTER TO ARRAY 10000 OF SHORTINT;
  414.     i: INTEGER;
  415.  
  416.   BEGIN
  417.     ToPtr := To;
  418.     i := 0;
  419.     REPEAT
  420.       IF RQPos=RQLen THEN
  421.         RQLen := d.Read(InH,RQBuffer^,512);
  422.         RQPos := 0;
  423.       END;
  424.       ToPtr[i] := RQBuffer[RQPos];
  425.       INC(RQPos); INC(i);
  426.     UNTIL i=Count;
  427.   END ReadQuick;
  428.  
  429. BEGIN
  430.   IFFInfo.IFFTitle := IFFTitleSet{};
  431.  
  432.   IF NOT(visible IN Flags) THEN g.OffDisplay() END;
  433.   IFFError := iffNoErr;
  434.   Screen := NIL; Window := NIL;
  435.   RQPos := 0; RQLen := 0;
  436.  
  437.   InH := d.Open(name,d.oldFile);
  438.   IF InH=NIL THEN
  439.     IFFError := iffOpenfailed;
  440.   ELSE
  441.  
  442. (*------  File Header:  ------*)
  443.  
  444.     len := d.Read(InH,Buffer^,12);
  445.     IF len#12 THEN IFFError := iffReadWritefailed END;
  446.     IF (TextBuffer[0]#"FORM") OR (TextBuffer[2]#"ILBM") THEN
  447.       IFFError := iffWrongIFF;
  448.     END;
  449.  
  450.     Exit := FALSE;
  451.  
  452. (*------  Main Loop:  ------*)
  453.  
  454.     WHILE (IFFError=iffNoErr) AND NOT(Exit) DO
  455.       len := d.Read(InH,Buffer^,4);
  456.  
  457.   (*------  BMHD:  ------*)
  458.  
  459.       IF TextBuffer[0]="BMHD" THEN
  460.         INCL(IFFInfo.IFFTitle,BMHD);
  461.         len := d.Read(InH,Buffer^,4);
  462.         len := d.Read(InH,Buffer^,LONGBuffer[0]);
  463.         IFFInfo.BMHD.width     := WORDBuffer[0];
  464.         IFFInfo.BMHD.height    := WORDBuffer[1];
  465.         IFFInfo.BMHD.left      := WORDBuffer[2];
  466.         IFFInfo.BMHD.top       := WORDBuffer[3];
  467.         IFFInfo.BMHD.depth     := BYTEBuffer[8];
  468.         IFFInfo.BMHD.masking   := y.VAL(SHORTSET,BYTEBuffer[9]);
  469.         MaskPlane := IFFInfo.BMHD.masking=SHORTSET{0};
  470.         Compression := BYTEBuffer[10]=1X;
  471.         IFFInfo.BMHD.transCol  := WORDBuffer[6];
  472.         IFFInfo.BMHD.xAspect   := BYTEBuffer[14];
  473.         IFFInfo.BMHD.yAspect   := BYTEBuffer[15];
  474.         IFFInfo.BMHD.scrnWidth := WORDBuffer[8];
  475.         IFFInfo.BMHD.scrnHeight:= WORDBuffer[9];
  476.  
  477.   (*------  CMAP:  ------*)
  478.  
  479.       ELSIF TextBuffer[0]="CMAP" THEN
  480.         INCL(IFFInfo.IFFTitle,CMAP);
  481.         len := d.Read(InH,Buffer^,4);
  482.         i := LONGBuffer[0];
  483.         len := d.Read(InH,Buffer^,i);
  484.         IFFInfo.CMAP.colorCnt := SHORT(i DIV 3);
  485.         j := 0;
  486.         k := 0;
  487.         WHILE k<IFFInfo.CMAP.colorCnt DO
  488.           IFFInfo.CMAP.red  [k] := SHORT(ORD(BYTEBuffer[j  ]) DIV 16);
  489.           IFFInfo.CMAP.green[k] := SHORT(ORD(BYTEBuffer[j+1]) DIV 16);
  490.           IFFInfo.CMAP.blue [k] := SHORT(ORD(BYTEBuffer[j+2]) DIV 16);
  491.           INC(j,3);
  492.           INC(k);
  493.         END;
  494.  
  495.   (*------  CAMG:  ------*)
  496.  
  497.       ELSIF TextBuffer[0]="CAMG" THEN
  498.         INCL(IFFInfo.IFFTitle,CAMG);
  499.         len := d.Read(InH,Buffer^,8);
  500.         IFFInfo.CAMG.viewType := y.VAL(ViewTypeSet,LONGBuffer[1]);
  501.  
  502.   (*------  GRAB:  ------*)
  503.  
  504.       ELSIF TextBuffer[0]="GRAB" THEN
  505.         INCL(IFFInfo.IFFTitle,GRAB);
  506.         len := d.Read(InH,Buffer^,8);
  507.         IFFInfo.GRAB.hotX := WORDBuffer[2];
  508.         IFFInfo.GRAB.hotY := WORDBuffer[3];
  509.  
  510.   (*------  DEST:  ------*)
  511.  
  512.       ELSIF TextBuffer[0]="DEST" THEN
  513.         INCL(IFFInfo.IFFTitle,DEST);
  514.         len := d.Read(InH,Buffer^,12);
  515.         IFFInfo.DEST.depth      := BYTEBuffer[4];
  516.         IFFInfo.DEST.planePick  := y.VAL(SET,WORDBuffer[3]);
  517.         IFFInfo.DEST.planeOnOff := y.VAL(SET,WORDBuffer[4]);
  518.         IFFInfo.DEST.planeMask  := y.VAL(SET,WORDBuffer[5]);
  519.  
  520.   (*------  CRNG:  ------*)
  521.  
  522.       ELSIF TextBuffer[0]="CRNG" THEN
  523.         IF NOT(CRNG IN IFFInfo.IFFTitle) THEN
  524.           IFFInfo.CRNG.count := 0;
  525.         END;
  526.         INCL(IFFInfo.IFFTitle,CRNG);
  527.         len := d.Read(InH,Buffer^,12);
  528.         IFFInfo.CRNG.data[IFFInfo.CRNG.count].rate := WORDBuffer[3];
  529.         IFFInfo.CRNG.data[IFFInfo.CRNG.count].on   := 0 IN y.VAL(SET,WORDBuffer[4]);
  530.         IFFInfo.CRNG.data[IFFInfo.CRNG.count].forward := NOT(1 IN y.VAL(SET,WORDBuffer[4]));
  531.         IFFInfo.CRNG.data[IFFInfo.CRNG.count].low  := BYTEBuffer[10];
  532.         IFFInfo.CRNG.data[IFFInfo.CRNG.count].high := BYTEBuffer[11];
  533. (* this line is only to identify illegal data, that some IFF-Files contain:*)
  534.         IFFInfo.CRNG.data[IFFInfo.CRNG.count].on := IFFInfo.CRNG.data[IFFInfo.CRNG.count].on
  535.                    AND (IFFInfo.CRNG.data[IFFInfo.CRNG.count].low<IFFInfo.CMAP.colorCnt)
  536.                    AND (IFFInfo.CRNG.data[IFFInfo.CRNG.count].high<IFFInfo.CMAP.colorCnt);
  537.         INC(IFFInfo.CRNG.count);
  538.  
  539.   (*------  BODY:  ------*)
  540.  
  541.       ELSIF TextBuffer[0]="BODY" THEN
  542.         INCL(IFFInfo.IFFTitle,BODY);
  543.         OpenScrn();
  544.         IF IFFError=iffNoErr THEN
  545.           len := d.Read(InH,Buffer^,4);
  546.           LineLength := y.VAL(INTEGER,y.VAL(SET,IFFInfo.BMHD.width+15)
  547.                              * {4..15}) DIV 8;
  548.           LineWidth  := y.VAL(INTEGER,y.VAL(SET,NuScreen.width+15)
  549.                              * {4..15}) DIV 8;
  550.           IF Compression THEN
  551.           (*------  let's load the BitMap's Data:  ------*)
  552.             LoadBody(Read512, RQBuffer, y.ADR(BitMaps[0]), LineLength,
  553.                      LineWidth, IFFInfo.BMHD.height, NuScreen.depth,
  554.                      MaskPlane); (* this does all the work very quickly *)
  555.           ELSE   (* not compressed *)
  556.           (*------  to load uncompressed Images is less time-critical: *)
  557.             Line := 0;
  558.             WHILE Line < IFFInfo.BMHD.height DO
  559.               Plane := 0;
  560.               WHILE Plane < NuScreen.depth DO
  561.                 ReadQuick(y.VAL(y.ADDRESS,y.VAL(LONGINT,BitMaps[Plane])+ LineWidth*Line),SHORT(LineLength));
  562.                 INC(Plane);
  563.               END;
  564.               IF MaskPlane THEN
  565.                 ReadQuick(Buffer,SHORT(LineLength));
  566.               END;
  567.               INC(Line);
  568.             END;
  569.           END;
  570.         END; (* IF NoErr *)
  571.         Exit := TRUE;
  572.  
  573.   (*------  Ignore unknown data:  ------*)
  574.  
  575.       ELSE
  576.         len := d.Read(InH,Buffer^,4);
  577.         i := LONGBuffer[0];
  578.         WHILE i>256 DO
  579.           len := d.Read(InH,Buffer^,256);
  580.           DEC(i,256);
  581.         END;
  582.         len := d.Read(InH,Buffer^,i);
  583.       END;
  584.  
  585.   (*------  Detect ReadError:  ------*)
  586.  
  587.       IF len=0 THEN
  588.         IFFError := iffReadWritefailed;
  589.       END;
  590.  
  591.     END;   (* WHILE NOT(Exit DO *)
  592.   END;   (* IF NoErr *)
  593.  
  594.   IF InH#NIL THEN d.OldClose(InH); InH := NIL; END;
  595.   IF IFFError#iffNoErr THEN
  596.     IF Window#NIL THEN I.CloseWindow(Window) END;
  597.     IF Screen#NIL THEN I.OldCloseScreen(Screen) END;
  598.   END;
  599.   g.OnDisplay();
  600.   RETURN IFFError=iffNoErr;
  601. END ReadILBM; (* that's it *)
  602.  
  603. (*---------------  Procedures for ColorCycling:  --------------------------*)
  604.  
  605. PROCEDURE * CycleInterrupt();  (* $SaveAllRegs+ $StackChk- *)
  606.  
  607. VAR
  608.   IntInfo: IFFInfoTypePtr;
  609.  
  610. BEGIN
  611.  
  612.   IntInfo := y.REG(9);
  613.   y.SETREG(13,IntInfo.Internal.A5);
  614.   IF CRNG IN IntInfo.IFFTitle THEN
  615.     IntNum := IntInfo.Internal.CycleID;
  616.  
  617.     IntCount := 0;
  618.     WHILE IntCount<IntInfo.CRNG.count DO
  619.       IF IntInfo.CRNG.data[IntCount].on THEN
  620.         INC(CycleInfos[IntNum].speedCnt[IntCount],IntInfo.CRNG.data[IntCount].rate);
  621.         IF CycleInfos[IntNum].speedCnt[IntCount]>=4000H THEN
  622.           DEC(CycleInfos[IntNum].speedCnt[IntCount],4000H);
  623.           IF IntInfo.CRNG.data[IntCount].forward THEN
  624.             IF CycleInfos[IntNum].count[IntCount]<=IntInfo.CRNG.data[IntCount].low THEN
  625.               CycleInfos[IntNum].count[IntCount]:=IntInfo.CRNG.data[IntCount].high;
  626.             ELSE
  627.               DEC(CycleInfos[IntNum].count[IntCount]);
  628.             END;
  629.           ELSE
  630.             IF CycleInfos[IntNum].count[IntCount]>=IntInfo.CRNG.data[IntCount].high THEN
  631.               CycleInfos[IntNum].count[IntCount]:=IntInfo.CRNG.data[IntCount].low;
  632.             ELSE
  633.               INC(CycleInfos[IntNum].count[IntCount]);
  634.             END;
  635.           END;
  636.           IntCount3 := CycleInfos[IntNum].count[IntCount];
  637.           IntCount2 := IntInfo.CRNG.data[IntCount].low;
  638.           WHILE IntCount2<=IntInfo.CRNG.data[IntCount].high DO
  639.             g.SetRGB4(CycleInfos[IntNum].VP,IntCount2,IntInfo.CMAP.red[IntCount3],
  640.                                    IntInfo.CMAP.green[IntCount3],
  641.                                    IntInfo.CMAP.blue[IntCount3]);
  642.             INC(IntCount3);
  643.             IF IntCount3>IntInfo.CRNG.data[IntCount].high THEN IntCount3:=IntInfo.CRNG.data[IntCount].low END;
  644.             INC(IntCount2);
  645.           END;
  646.         END;
  647.       END;
  648.       INC(IntCount);
  649.     END;
  650.   END;
  651.  
  652. END CycleInterrupt;  (* $StackChk= *)
  653.  
  654. (*-------------------------------------------------------------------------*)
  655. (*                                                                         *)
  656. (*                         Start Colorcycling:                             *)
  657. (*                                                                         *)
  658. (*-------------------------------------------------------------------------*)
  659.  
  660. PROCEDURE DoCycle*(VAR Info: IFFInfoType; Screen: I.ScreenPtr): BOOLEAN;
  661. (* this creates an interrupt, that does cycling. You needn't worry,        *)
  662. (* whether there's cycling data or not. Don't forget to call EndCycle to   *)
  663. (* remove the Cycling-Interrupt !!!                                        *)
  664. (* If result is false, any error occured. Don't call EndCycle in this case!*)
  665.  
  666. BEGIN
  667.   i:=0;
  668.   LOOP
  669.     IF CycleInfos[i].VP=NIL THEN EXIT END;
  670.     INC(i);
  671.     IF i=32 THEN RETURN FALSE END;
  672.   END;
  673.   Info.Internal.CycleID := SHORT(i);
  674.   Info.Internal.A5 := y.REG(13);
  675.   CycleInfos[i].VP := y.ADR(Screen.viewPort);
  676.   IF CRNG IN Info.IFFTitle THEN
  677.     j := 0;
  678.     WHILE j < Info.CRNG.count DO
  679.       CycleInfos[i].count[j] := Info.CRNG.data[j].low;
  680.       CycleInfos[i].speedCnt[j] := 0;
  681.       INC(j);
  682.     END;
  683.   END;
  684.   CycleInfos[i].int.node.type := e.interrupt;
  685.   CycleInfos[i].int.node.pri  := -60;
  686.   CycleInfos[i].int.node.name := NIL;
  687.   CycleInfos[i].int.data := y.ADR(Info);
  688.   CycleInfos[i].int.code := CycleInterrupt;
  689.   e.AddIntServer(h.vertb,y.ADR(CycleInfos[i].int));
  690.   RETURN TRUE;
  691. END DoCycle;
  692.  
  693. (*-------------------------------------------------------------------------*)
  694. (*                                                                         *)
  695. (*                         End Colorcycling:                               *)
  696. (*                                                                         *)
  697. (*-------------------------------------------------------------------------*)
  698.  
  699. PROCEDURE EndCycle*(VAR Info: IFFInfoType);
  700. (* remove cycling-Interrupt                                                *)
  701.  
  702. BEGIN
  703.   i := Info.Internal.CycleID;
  704.   e.RemIntServer(h.vertb,y.ADR(CycleInfos[i].int));
  705.   CycleInfos[i].VP := NIL;
  706. END EndCycle;
  707.  
  708. (*-------------------------------------------------------------------------*)
  709. (*                                                                         *)
  710. (*              Initialize BMHD, CMAP & CAMG for WriteILBMAll:             *)
  711. (*                                                                         *)
  712. (*-------------------------------------------------------------------------*)
  713.  
  714. PROCEDURE InitIFFInfo*(Info: IFFInfoTypePtr;
  715.                       RP: g.RastPortPtr;
  716.                       VP: g.ViewPortPtr;
  717.                       VAR Rect: g.RectanglePtr);
  718.  
  719. (* Initialize essential parts of IFFInfoType-Variable.                     *)
  720. (* This can be used to simplify the initialization of an IFFInfoType       *)
  721. (* RP:         RastPort containing the BitMap etc.                         *)
  722. (* VP:         ViewPort containing the Colors, ViewModes etc.              *)
  723. (* Rect:       The Rectangle Region in your RastPort, that should be saved *)
  724. (*             or NIL to save hole RastPort                                *)
  725.  
  726. BEGIN
  727.  
  728.   IF Rect=NIL THEN
  729.     Rect := y.ADR(DefaultRect);
  730.     DefaultRect.minX := 0;
  731.     DefaultRect.minY := 0;
  732.     DefaultRect.maxX := RP.bitMap.bytesPerRow * 8 - 1;
  733.     DefaultRect.maxY := RP.bitMap.rows - 1;
  734.   END;
  735.  
  736. (*------  Initialize BMHD:  ------*)
  737.  
  738.   Info.BMHD.width  := Rect.maxX - Rect.minX + 1;
  739.   Info.BMHD.height := Rect.maxY - Rect.minY + 1;
  740.   Info.BMHD.depth := RP.bitMap.depth;
  741.   Info.BMHD.left := 0;
  742.   Info.BMHD.top := 0;
  743.   Info.BMHD.masking := SHORTSET{};
  744.   Info.BMHD.transCol := 0;
  745.   Info.BMHD.scrnWidth := RP.bitMap.bytesPerRow * 8;
  746.   Info.BMHD.scrnHeight := RP.bitMap.rows;
  747.   IF Info.BMHD.scrnWidth<640 THEN
  748.     Info.BMHD.xAspect := 10;
  749.   ELSE
  750.     Info.BMHD.xAspect := 5;
  751.   END;
  752.   IF Info.BMHD.scrnHeight>400 THEN
  753.     INC(Info.BMHD.xAspect,Info.BMHD.xAspect);
  754.   END;
  755.   Info.BMHD.yAspect := 11;
  756.  
  757. (*------  Initialize CMAP:  ------*)
  758.  
  759.   Info.CMAP.colorCnt := VP.colorMap.count;
  760.   i := 0;
  761.   WHILE i<Info.CMAP.colorCnt DO
  762.     ColorConv := SHORT(g.GetRGB4(VP.colorMap,i));
  763.     IF ColorConv>0FFFH THEN ColorConv := 0 END;
  764.     Info.CMAP.red  [i] := SHORT(ColorConv DIV 100H MOD 10H);
  765.     Info.CMAP.green[i] := SHORT(ColorConv DIV  10H MOD 10H);
  766.     Info.CMAP.blue [i] := SHORT(ColorConv          MOD 10H);
  767.     INC(i);
  768.   END;
  769.  
  770. (*------  Initialize CAMG:  ------*)
  771.  
  772.   Info.CAMG.viewType := ViewTypeSet{};
  773.   IF g.lace           IN VP.modes THEN INCL(Info.CAMG.viewType,Lace)  END;
  774.   IF g.hires          IN VP.modes THEN INCL(Info.CAMG.viewType,Hires) END;
  775.   IF g.dualpf         IN VP.modes THEN INCL(Info.CAMG.viewType,DblPF) END;
  776.   IF g.ham            IN VP.modes THEN INCL(Info.CAMG.viewType,HoMod) END;
  777.   IF g.extraHalfbrite IN VP.modes THEN INCL(Info.CAMG.viewType,Extra) END;
  778.  
  779.   Info.IFFTitle := IFFTitleSet{BMHD,CMAP,CAMG};
  780.  
  781. END InitIFFInfo;
  782.  
  783.  
  784. (*-------------------------------------------------------------------------*)
  785. (*                                                                         *)
  786. (*                        Save an ILBM-File:                               *)
  787. (*                                                                         *)
  788. (*-------------------------------------------------------------------------*)
  789.  
  790. PROCEDURE WriteILBMAll*(Name: ARRAY OF CHAR;
  791.                        Info: IFFInfoTypePtr;
  792.                        BM: g.BitMapPtr;
  793.                        FirstLine, LeftOffset: INTEGER;
  794.                        CompressIt: BOOLEAN): BOOLEAN;
  795. (* Saves IFF-File named Name                                               *)
  796. (* This is a very Low-Level Procedure. You should use it to save Pictures  *)
  797. (* with ColorCycling and things like that.                                 *)
  798. (* To save Screens, Windows or so use the other Procedures !               *)
  799. (* Info.IFFTitle must have set the Flags of all initialized Sub-Records   *)
  800. (* BM:            contains the Graphicdata. In fact BM doesn't have to be  *)
  801. (*                part of a RastPort. It can be used to save a MaskPlane.  *)
  802. (*                Then BM has to contain one extra Plane and BM.depth and *)
  803. (*                Info.BMHD.depth have to be increased by 1.              *)
  804. (* FirstLine:     is the TopEdge within BM                                 *)
  805. (* LeftOffset:    is the LeftEdge within BM.                               *)
  806. (* an examble to call this can be is the Implementation of WriteILBM()     *)
  807.  
  808.   TYPE
  809.     BufPtr = UNTRACED POINTER TO ARRAY 256 OF SHORTINT;
  810.  
  811.   VAR
  812.     PointerDummy: UNTRACED POINTER TO CHAR;
  813.  
  814.   PROCEDURE Compress(At: BufPtr; Length: LONGINT): LONGINT;
  815.   (* This compresses a line starting at At that is Length Bytes long.      *)
  816.   (* The compressed Data is Written into Buffer and saved to OutH.         *)
  817.   (* Result is Legth of Compressed Data or zero if Error while writing     *)
  818.  
  819.   VAR
  820.     at, last, out, len: LONGINT;
  821.  
  822.     PROCEDURE CopyUnchanged(from,to: LONGINT);
  823.  
  824.     BEGIN
  825.       BYTEBuffer[out] := CHR(to - from - 1);
  826.       INC(out);
  827.       WHILE from<to DO
  828.         BYTEBuffer[out] := At[from];
  829.         INC(out);
  830.         INC(from);
  831.       END;
  832.     END CopyUnchanged;
  833.  
  834.   BEGIN
  835.     at := 1;
  836.     last := 0;
  837.     out := 0;
  838.     LOOP
  839.       IF (At[at]=At[at-1]) AND (At[at]=At[at+1]) AND (at+1<Length) THEN
  840.         IF last#at-1 THEN
  841.           CopyUnchanged(last,at-1);
  842.         END;
  843.         last := at-1;
  844.       (*------  Repeat Byte:  ------*)
  845.         REPEAT
  846.           INC(at)
  847.         UNTIL (At[last]#At[at]) OR (at-last=128) OR (at=Length);
  848.         BYTEBuffer[out] := CHR(257+last-at);
  849.         INC(out);
  850.         BYTEBuffer[out] := At[last];
  851.         INC(out);
  852.         last := at;
  853.         IF at=Length THEN EXIT END;
  854.       ELSIF (at-last)=128 THEN
  855.       (*------  Copy Unchanged:  ------*)
  856.         CopyUnchanged(last,at);
  857.         last := at;
  858.       END;
  859.       INC(at);
  860.       IF at=Length THEN EXIT END;
  861.     END;
  862.     IF at#last THEN CopyUnchanged(last,at) END;
  863.     len := d.Write(OutH,Buffer^,out);
  864.     INC(BodyLength,out);
  865.     INC(FileLength,out);
  866.     RETURN len;
  867.   END Compress;
  868.  
  869.   PROCEDURE ShiftLine(At: y.ADDRESS);
  870.   (* This shifts BitsToShift from At ShiftWidth left and stores them in    *)
  871.   (* ShiftBuffer.                                                          *)
  872.  
  873.   VAR
  874.     sourcelong,sourcebit,destlong,destbit: INTEGER;
  875.  
  876.   BEGIN
  877.     ShiftSource := At;
  878.     sourcelong := 0;
  879.     sourcebit := 31-ShiftWidth;
  880.     destlong := 0;
  881.     destbit := 31;
  882.     ShiftBuffer[0] := LONGSET{};
  883.     i := 1;
  884.     WHILE i<BitsToShift DO
  885.       IF sourcebit IN ShiftSource[sourcelong] THEN
  886.         INCL(ShiftBuffer[destlong],destbit);
  887.       END;
  888.       IF sourcebit=0 THEN
  889.         sourcebit := 31;
  890.         INC(sourcelong);
  891.       ELSE
  892.         DEC(sourcebit);
  893.       END;
  894.       IF destbit=0 THEN
  895.         destbit := 31;
  896.         INC(destlong);
  897.         ShiftBuffer[destlong] := LONGSET{};
  898.       ELSE
  899.         DEC(destbit);
  900.       END;
  901.       INC(i);
  902.     END;
  903.   END ShiftLine;
  904.  
  905. (*------  MAIN:  ------*)
  906.  
  907. BEGIN
  908.  
  909. (*------  Open:  ------*)
  910.  
  911.   OutH := d.Open(Name,d.newFile);
  912.   IF OutH=NIL THEN
  913.     IFFError := iffOpenfailed;
  914.     RETURN FALSE;
  915.   END;
  916.   TextBuffer[0] := "FORM";
  917.   TextBuffer[2] := "ILBM";
  918.   len := d.Write(OutH,TextBuffer^,12);
  919.   IF len#12 THEN
  920.     d.OldClose(OutH);
  921.     OutH := NIL;
  922.     IF d.DeleteFile(Name) THEN END;
  923.     IFFError := iffReadWritefailed;
  924.     RETURN FALSE;
  925.   END;
  926.   FileLength := 4;
  927.  
  928. (*------  BMHD:  ------*)
  929.  
  930.   IF BMHD IN Info.IFFTitle THEN   (* in fact, BMHD MUST be set *)
  931.     TextBuffer[ 0] := "BMHD";
  932.     LONGBuffer[ 1] := 20;              (* Length *)
  933.     WORDBuffer[ 4] := Info.BMHD.width;
  934.     WORDBuffer[ 5] := Info.BMHD.height;
  935.     WORDBuffer[ 6] := Info.BMHD.left;
  936.     WORDBuffer[ 7] := Info.BMHD.top;
  937.     BYTEBuffer[16] := Info.BMHD.depth;
  938.     BYTEBuffer[17] := y.VAL(SHORTINT,Info.BMHD.masking);    (* special masking *)
  939.     IF CompressIt THEN                  (* compression *)
  940.       BYTEBuffer[18] := 1X;
  941.     ELSE
  942.       BYTEBuffer[18] := 0X;
  943.     END;
  944.     BYTEBuffer[19] := 0X;               (* pad *)
  945.     WORDBuffer[10] := Info.BMHD.transCol; (* transparent Color *)
  946.     BYTEBuffer[22] := Info.BMHD.xAspect;
  947.     BYTEBuffer[23] := Info.BMHD.yAspect;
  948.     WORDBuffer[12] := Info.BMHD.scrnWidth;
  949.     WORDBuffer[13] := Info.BMHD.scrnHeight;
  950.     len := d.Write(OutH,Buffer^,28);
  951.     INC(FileLength,28);
  952.   END;
  953.  
  954. (*------  CMAP:  ------*)
  955.  
  956.   IF CMAP IN Info.IFFTitle THEN   (* this has to be set, too *)
  957.     TextBuffer[0]  := "CMAP";
  958.     LONGBuffer[1]  := Info.CMAP.colorCnt * 3;
  959.     IF ODD(LONGBuffer[1]) THEN INC(LONGBuffer[1]) END;
  960.     i := 0;
  961.     WHILE i<Info.CMAP.colorCnt DO
  962.       (* $OvflChk- *)
  963.       BYTEBuffer[ 8+3*i] := Info.CMAP.red  [i] * 16;
  964.       BYTEBuffer[ 9+3*i] := Info.CMAP.green[i] * 16;
  965.       BYTEBuffer[10+3*i] := Info.CMAP.blue [i] * 16;
  966.       (* $OvflChk= *)
  967.       INC(i);
  968.     END;
  969.     len := d.Write(OutH,Buffer^,LONGBuffer[1]+8);
  970.     INC(FileLength,LONGBuffer[1]+8);
  971.   END;
  972.  
  973. (*------  GRAB:  ------*)
  974.  
  975.   IF GRAB IN Info.IFFTitle THEN
  976.     TextBuffer[0] := "GRAB";
  977.     LONGBuffer[1] := 8;
  978.     WORDBuffer[4] := Info.GRAB.hotX;
  979.     WORDBuffer[5] := Info.GRAB.hotY;
  980.     len := d.Write(OutH,Buffer^,12);
  981.     INC(FileLength,12);
  982.   END;
  983.  
  984. (*------  DEST:  ------*)
  985.  
  986.   IF DEST IN Info.IFFTitle THEN
  987.     TextBuffer[0] := "DEST";
  988.     LONGBuffer[1] := 8;
  989.     BYTEBuffer[8] := Info.DEST.depth;
  990.     BYTEBuffer[9] := 0X;
  991.     WORDBuffer[5] := y.VAL(INTEGER,Info.DEST.planePick );
  992.     WORDBuffer[6] := y.VAL(INTEGER,Info.DEST.planeOnOff);
  993.     WORDBuffer[7] := y.VAL(INTEGER,Info.DEST.planeMask );
  994.     len := d.Write(OutH,Buffer^,16);
  995.     INC(FileLength,16);
  996.   END;
  997.  
  998. (*------  CAMG:  ------*)
  999.  
  1000.   IF CAMG IN Info.IFFTitle THEN
  1001.     TextBuffer[0] := "CAMG";
  1002.     LONGBuffer[1] := 4;
  1003.     LONGBuffer[2] := y.VAL(LONGINT,Info.CAMG.viewType);
  1004.     len := d.Write(OutH,Buffer^,12);
  1005.     INC(FileLength,12);
  1006.   END;
  1007.  
  1008. (*------  CRNG:  ------*)
  1009.  
  1010.   IF CRNG IN Info.IFFTitle THEN
  1011.     i := 0;
  1012.     WHILE i<Info.CRNG.count DO
  1013.       TextBuffer[0] := "CRNG";
  1014.       LONGBuffer[1] := 8;
  1015.       WORDBuffer[4] := 0;
  1016.       WORDBuffer[5] := Info.CRNG.data[i].rate;
  1017.       IF Info.CRNG.data[i].on THEN
  1018.         WORDBuffer[6] := 1;
  1019.       ELSE
  1020.         WORDBuffer[6] := 0;
  1021.       END;
  1022.       IF NOT(Info.CRNG.data[i].forward) THEN
  1023.         INC(WORDBuffer[6],2);
  1024.       END;
  1025.       BYTEBuffer[14] := Info.CRNG.data[i].low;
  1026.       BYTEBuffer[15] := Info.CRNG.data[i].high;
  1027.       len := d.Write(OutH,Buffer^,16);
  1028.       INC(FileLength,16);
  1029.       INC(i);
  1030.     END;
  1031.   END;
  1032.  
  1033. (*------  BODY:  ------*)
  1034.  
  1035.   BodyPos := FileLength;
  1036.   TextBuffer[0] := "BODY";
  1037.   len := d.Write(OutH,Buffer^,8);
  1038.   INC(FileLength,8);
  1039.   BodyLength := 0;
  1040.   i := 0;
  1041.   TrueLeftOffset := y.VAL(INTEGER,y.VAL(SET,LeftOffset) * {4..15});
  1042.   TrueWidth := y.VAL(INTEGER,y.VAL(SET,Info.BMHD.width + 15) * {4..15});
  1043.  
  1044.   WHILE i<Info.BMHD.depth DO
  1045.     BitMaps[i] := BM.planes[i];
  1046.     BitMaps[i] := y.VAL(y.ADDRESS,y.VAL(LONGINT,BitMaps[i]) + LONG(FirstLine) * BM.bytesPerRow + TrueLeftOffset DIV 8);
  1047.     INC(i);
  1048.   END;
  1049.  
  1050.   LineLength := TrueWidth DIV 8;
  1051.  
  1052.   NeedToShift := (TrueLeftOffset # LeftOffset)
  1053.                   OR (TrueWidth # Info.BMHD.width);
  1054.   IF NeedToShift THEN
  1055.     ShiftWidth := LeftOffset - TrueLeftOffset;
  1056.     BitsToShift := Info.BMHD.width;
  1057.   END;
  1058.  
  1059.   IF CompressIt THEN
  1060.     Line := 0;
  1061.     WHILE Line<Info.BMHD.height DO
  1062.       Plane := 0;
  1063.       WHILE Plane<Info.BMHD.depth DO
  1064.         IF NeedToShift THEN
  1065.           ShiftLine(BitMaps[Plane]);
  1066.           len := Compress(y.ADR(ShiftBuffer),LineLength);
  1067.         ELSE
  1068.           len := Compress(BitMaps[Plane],LineLength);
  1069.         END;
  1070.         BitMaps[Plane] := y.VAL(y.ADDRESS,y.VAL(LONGINT,BitMaps[Plane]) + BM.bytesPerRow);
  1071.         INC(Plane);
  1072.       END;
  1073.       INC(Line);
  1074.     END;
  1075.   ELSE
  1076.     Line := 0;
  1077.     WHILE Line<Info.BMHD.height DO
  1078.       Plane := 0;
  1079.       WHILE Plane<Info.BMHD.depth DO
  1080.         IF NeedToShift THEN
  1081.           ShiftLine(BitMaps[Plane]);
  1082.           len := d.Write(OutH,ShiftBuffer,LineLength);
  1083.         ELSE
  1084.           PointerDummy := BitMaps[Plane];
  1085.           len := d.Write(OutH,PointerDummy^,LineLength);
  1086.         END;
  1087.         INC(FileLength,LineLength);
  1088.         INC(BodyLength,LineLength);
  1089.         BitMaps[Plane] := y.VAL(y.ADDRESS,y.VAL(LONGINT,BitMaps[Plane]) + BM.bytesPerRow);
  1090.         INC(Plane);
  1091.       END;
  1092.       INC(Line);
  1093.     END;
  1094.   END;
  1095.   IF ODD(FileLength) THEN
  1096.     BYTEBuffer[0] := 0X;
  1097.     len := d.Write(OutH,Buffer^,1);
  1098.     INC(FileLength);
  1099.   END;
  1100.  
  1101.   len := d.Seek(OutH,BodyPos+12,d.beginning);
  1102.   LONGBuffer[0] := BodyLength;
  1103.   len := d.Write(OutH,Buffer^,4);
  1104.  
  1105. (*------  Done:  ------*)
  1106.  
  1107.   len := d.Seek(OutH,4,d.beginning);
  1108.   LONGBuffer[0] := FileLength;
  1109.   len := d.Write(OutH,Buffer^,4);
  1110.   d.OldClose(OutH);
  1111.   OutH := NIL;
  1112.   IF len#4 THEN
  1113.     IF d.DeleteFile(Name) THEN END;
  1114.     IFFError := iffReadWritefailed;
  1115.     RETURN FALSE;
  1116.   ELSE
  1117.     RETURN TRUE;
  1118.   END;
  1119. END WriteILBMAll;
  1120.  
  1121. (*-------------------------------------------------------------------------*)
  1122. (*                                                                         *)
  1123. (*                 Save a RastPort and ViewPort ILBM-File:                 *)
  1124. (*                                                                         *)
  1125. (*-------------------------------------------------------------------------*)
  1126.  
  1127. PROCEDURE WriteILBM*(Name: ARRAY OF CHAR;
  1128.                     RP: g.RastPortPtr;
  1129.                     VP: g.ViewPortPtr;
  1130.                     Rect: g.RectanglePtr;
  1131.                     CompressIt: BOOLEAN): BOOLEAN;
  1132.  
  1133. (* Creates an ILBM-File                                                    *)
  1134. (* Name:       File's Name                                                 *)
  1135. (* RP:         RastPort containing the BitMap etc.                         *)
  1136. (* VP:         ViewPort containing the Colors, ViewModes etc.              *)
  1137. (* Rect:       The Rectangle Region in your RastPort, that should be saved *)
  1138. (*             or NIL to save hole RastPort                                *)
  1139. (* Compressit: Create compressed ILBM-File or not ?                        *)
  1140. (* Result is FALSE if any Error occured.                                   *)
  1141. (* example to save a Window:                                               *)
  1142. (*      OK := WriteILBM("Test.iff",                                        *)
  1143. (*                      MyWindow.rPort,                                   *)
  1144. (*                      y.ADR(MyWindow.screen.viewPort,                    *)
  1145. (*                      TRUE);                                             *)
  1146.  
  1147. BEGIN
  1148.  
  1149.   InitIFFInfo(y.ADR(IFFInfo),RP,VP,Rect);
  1150.  
  1151.   RETURN WriteILBMAll(Name,y.ADR(IFFInfo),RP.bitMap,
  1152.                       Rect.minY,Rect.minX,CompressIt);
  1153.  
  1154. END WriteILBM;
  1155.  
  1156. (*-------------------------------------------------------------------------*)
  1157. (*                                                                         *)
  1158. (*                    Save a Screen as ILBM-File:                          *)
  1159. (*                                                                         *)
  1160. (*-------------------------------------------------------------------------*)
  1161.  
  1162. PROCEDURE WriteILBMScreen*(Name: ARRAY OF CHAR;
  1163.                           Screen: I.ScreenPtr;
  1164.                           Rect: g.RectanglePtr;
  1165.                           CompressIt: BOOLEAN): BOOLEAN;
  1166.  
  1167. (* This creates an ILBM-File from a Screen                                 *)
  1168. (* Name:       File's Name                                                 *)
  1169. (* Screen:     Screen to be saved                                          *)
  1170. (* Rect:       The Rectangle Region in your Screen, that should be saved   *)
  1171. (*             or NIL to save hole Screen                                  *)
  1172. (* CompressIt: Create a Compressed ILBM-File                               *)
  1173. (* Returns TRUE if no Error occured.                                       *)
  1174. (* example: OK := WriteILBMScreen("Test.iff",MyScreen,NIL,TRUE);           *)
  1175.  
  1176. BEGIN
  1177.  
  1178.   RETURN WriteILBM(Name,y.ADR(Screen.rastPort),y.ADR(Screen.viewPort),Rect,CompressIt);
  1179.  
  1180. END WriteILBMScreen;
  1181.  
  1182. (*-----------------------  Initialization:  -------------------------------*)
  1183.  
  1184. BEGIN
  1185.  
  1186.   InH := NIL; OutH := NIL;
  1187.   NEW(Buffer);
  1188.   TextBuffer := y.VAL(e.ADDRESS,Buffer);
  1189.   LONGBuffer := y.VAL(e.ADDRESS,Buffer);
  1190.   WORDBuffer := y.VAL(e.ADDRESS,Buffer);
  1191.   BYTEBuffer := y.VAL(e.ADDRESS,Buffer);
  1192.   NEW(RQBuffer);
  1193.   IF (Buffer=NIL) OR (RQBuffer=NIL) THEN HALT(20) END;
  1194.   i := 0; REPEAT CycleInfos[i].VP:=NIL; INC(i) UNTIL i=32;
  1195.  
  1196. CLOSE
  1197.  
  1198.   IF InH #NIL THEN d.OldClose(InH ) END;
  1199.   IF OutH#NIL THEN d.OldClose(OutH) END;
  1200.  
  1201. END IFFSupport.
  1202.