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